diff options
| author | Eduardo Julian | 2022-04-08 05:42:36 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-04-08 05:42:36 -0400 |
| commit | 0d909187d5b9effcd08f533d50af7d29c0d6bfd8 (patch) | |
| tree | c50f12c5e47e3db90c3a701b54ee9953da942210 | |
| parent | e5e4c2aff562e5c01fefb808d1d68a40f29c9cc5 (diff) | |
De-sigil-ification: $
533 files changed, 31537 insertions, 31534 deletions
diff --git a/.github/workflows/setup_aedifex/action.yml b/.github/workflows/setup_aedifex/action.yml index a571dea74..8ccceba4f 100644 --- a/.github/workflows/setup_aedifex/action.yml +++ b/.github/workflows/setup_aedifex/action.yml @@ -18,9 +18,9 @@ runs: shell: bash # Make the `lux` command available. - - run: echo "$HOME/shell" >> $GITHUB_PATH + - run: mv ./shell/lux.sh ./lux.sh shell: bash - - run: cd ./stdlib/ && lux clean && cd .. + - run: cd ./stdlib/ && ../lux.sh clean && cd .. shell: bash diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 6b98a1ad3..ab2d26cfb 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -6,13 +6,13 @@ jobs: steps: - uses: actions/checkout@v2 - uses: ./.github/workflows/setup_aedifex - - run: cd ./stdlib/ && lux with jvm with bibliotheca test + - run: cd ./stdlib/ && ../lux.sh with jvm with bibliotheca test test_aedifex: runs-on: ubuntu-latest steps: - uses: actions/checkout@v2 - uses: ./.github/workflows/setup_aedifex - - run: cd ./stdlib/ && lux with aedifex test + - run: cd ./stdlib/ && ../lux.sh with aedifex test test_stdlib_on_node_js: runs-on: ubuntu-latest steps: @@ -22,7 +22,7 @@ jobs: - uses: actions/setup-node@v2 with: node-version: '14' - - run: cd ./stdlib/ && lux with js with bibliotheca test + - run: cd ./stdlib/ && ../lux.sh with js with bibliotheca test test_stdlib_on_python_3: runs-on: ubuntu-latest steps: @@ -33,7 +33,7 @@ jobs: with: python-version: '3.9' architecture: 'x64' - - run: cd ./stdlib/ && lux with python with bibliotheca test + - run: cd ./stdlib/ && ../lux.sh with python with bibliotheca test test_stdlib_on_ruby: runs-on: ubuntu-latest steps: @@ -43,7 +43,7 @@ jobs: - uses: actions/setup-ruby@v1 with: ruby-version: '2.6' - - run: cd ./stdlib/ && lux with ruby with bibliotheca test + - run: cd ./stdlib/ && ../lux.sh with ruby with bibliotheca test test_stdlib_on_lua: runs-on: ubuntu-latest steps: @@ -51,5 +51,5 @@ jobs: - uses: ./.github/workflows/setup_aedifex # https://github.com/marketplace/actions/setup-lua-luajit - uses: xpol/setup-lua@v0.3 - - run: cd ./stdlib/ && lux with lua with bibliotheca test + - run: cd ./stdlib/ && ../lux.sh with lua with bibliotheca test diff --git a/documentation/bookmark/composition.md b/documentation/bookmark/design/composition.md index 85c6daba3..85c6daba3 100644 --- a/documentation/bookmark/composition.md +++ b/documentation/bookmark/design/composition.md diff --git a/documentation/bookmark/extensibility.md b/documentation/bookmark/design/extensibility.md index 8e95e15e4..cf38f0ea9 100644 --- a/documentation/bookmark/extensibility.md +++ b/documentation/bookmark/design/extensibility.md @@ -1,4 +1,5 @@ # Reference +0. [Configuration, Extension, Maintainability - Titus Winters - CppCon](https://www.youtube.com/watch?v=J6SNO5o9ADg) 0. [Extensibility over configuration](https://www.gertgoeman.com/posts/extensibility-over-configuration/) diff --git a/documentation/bookmark/programmability.md b/documentation/bookmark/design/programmability.md index ae8af0013..706e27e29 100644 --- a/documentation/bookmark/programmability.md +++ b/documentation/bookmark/design/programmability.md @@ -1,4 +1,4 @@ # Exemplar -1. [offerzen: Developer-driven banking, for a developer-driven world.](https://www.offerzen.com/community/investec/) +0. [offerzen: Developer-driven banking, for a developer-driven world.](https://www.offerzen.com/community/investec/) diff --git a/documentation/bookmark/regular_expression.md b/documentation/bookmark/text/regular_expression.md index 584f5649d..584f5649d 100644 --- a/documentation/bookmark/regular_expression.md +++ b/documentation/bookmark/text/regular_expression.md diff --git a/documentation/bookmark/design.md b/documentation/bookmark/user_interface/design.md index a3ea6af5d..a3ea6af5d 100644 --- a/documentation/bookmark/design.md +++ b/documentation/bookmark/user_interface/design.md diff --git a/licentia/source/program/licentia/input.lux b/licentia/source/program/licentia/input.lux index 23e8ab29e..b92d0e52e 100644 --- a/licentia/source/program/licentia/input.lux +++ b/licentia/source/program/licentia/input.lux @@ -32,9 +32,9 @@ (def: identification (Parser Identification) (<json>.object - ($_ <>.and - (<json>.field "name" <json>.string) - (<json>.field "version" <json>.string)))) + (all <>.and + (<json>.field "name" <json>.string) + (<json>.field "version" <json>.string)))) (exception: .public (cannot_use_fractional_amount [amount Frac]) (exception.report @@ -76,48 +76,48 @@ (def: copyright_holder (Parser copyright.Holder) (<json>.object - ($_ <>.and - (<json>.field "name" <json>.string) - (<json>.field "period" ..period)))) + (all <>.and + (<json>.field "name" <json>.string) + (<json>.field "period" ..period)))) (def: termination (Parser Termination) (<json>.object - ($_ <>.and - (<json>.field "patent retaliation?" <json>.boolean) - (<json>.field "termination period" ..amount) - (<json>.field "grace period" ..amount)))) + (all <>.and + (<json>.field "patent retaliation?" <json>.boolean) + (<json>.field "termination period" ..amount) + (<json>.field "grace period" ..amount)))) (def: liability (Parser Liability) (<json>.object - ($_ <>.and - (<json>.field "can accept?" <json>.boolean) - (<json>.field "disclaim high risk?" <json>.boolean)))) + (all <>.and + (<json>.field "can accept?" <json>.boolean) + (<json>.field "disclaim high risk?" <json>.boolean)))) (def: distribution (Parser Distribution) (<json>.object - ($_ <>.and - (<json>.field "can re-license?" <json>.boolean) - (<json>.field "can multi-license?" <json>.boolean)))) + (all <>.and + (<json>.field "can re-license?" <json>.boolean) + (<json>.field "can multi-license?" <json>.boolean)))) (def: commercial (Parser Commercial) (<json>.object - ($_ <>.and - (<json>.field "can sell?" <json>.boolean) - (<json>.field "require contributor credit?" <json>.boolean) - (<json>.field "allow contributor endorsement?" <json>.boolean)))) + (all <>.and + (<json>.field "can sell?" <json>.boolean) + (<json>.field "require contributor credit?" <json>.boolean) + (<json>.field "allow contributor endorsement?" <json>.boolean)))) (def: extension (Parser Extension) (<json>.object - ($_ <>.and - (<json>.field "same license?" <json>.boolean) - (<json>.field "must be distinguishable?" <json>.boolean) - (<json>.field "notification period" (<json>.nullable ..period)) - (<json>.field "must describe modifications?" <json>.boolean)))) + (all <>.and + (<json>.field "same license?" <json>.boolean) + (<json>.field "must be distinguishable?" <json>.boolean) + (<json>.field "notification period" (<json>.nullable ..period)) + (<json>.field "must describe modifications?" <json>.boolean)))) (def: entity (Parser Entity) @@ -126,9 +126,9 @@ (def: black_list (Parser Black_List) (<json>.object - ($_ <>.and - (<json>.field "justification" (<json>.nullable <json>.string)) - (<json>.field "entities" (<json>.array (<>.many ..entity)))))) + (all <>.and + (<json>.field "justification" (<json>.nullable <json>.string)) + (<json>.field "entities" (<json>.array (<>.many ..entity)))))) (def: url (Parser URL) @@ -137,32 +137,32 @@ (def: attribution (Parser Attribution) (<json>.object - ($_ <>.and - (<json>.field "copyright-notice" <json>.string) - (<json>.field "phrase" (<json>.nullable <json>.string)) - (<json>.field "url" ..url) - (<json>.field "image" (<json>.nullable ..url))))) + (all <>.and + (<json>.field "copyright-notice" <json>.string) + (<json>.field "phrase" (<json>.nullable <json>.string)) + (<json>.field "url" ..url) + (<json>.field "image" (<json>.nullable ..url))))) (def: addendum (Parser Addendum) (<json>.object - ($_ <>.and - (<json>.field "commons clause?" <json>.boolean) - ))) + (all <>.and + (<json>.field "commons clause?" <json>.boolean) + ))) (def: .public license (Parser License) (<json>.object - ($_ <>.and - (<json>.field "copyright-holders" (<json>.array (<>.many ..copyright_holder))) - (<json>.field "identification" (<json>.nullable ..identification)) - (<json>.field "termination" ..termination) - (<json>.field "liability" ..liability) - (<json>.field "distribution" ..distribution) - (<json>.field "commercial" ..commercial) - (<json>.field "extension" ..extension) - (<json>.field "black-lists" (<json>.array (<>.some ..black_list))) - (<json>.field "attribution" (<json>.nullable ..attribution)) - (<>.default [//.#commons_clause? false] - (<json>.field "addendum" ..addendum)) - ))) + (all <>.and + (<json>.field "copyright-holders" (<json>.array (<>.many ..copyright_holder))) + (<json>.field "identification" (<json>.nullable ..identification)) + (<json>.field "termination" ..termination) + (<json>.field "liability" ..liability) + (<json>.field "distribution" ..distribution) + (<json>.field "commercial" ..commercial) + (<json>.field "extension" ..extension) + (<json>.field "black-lists" (<json>.array (<>.some ..black_list))) + (<json>.field "attribution" (<json>.nullable ..attribution)) + (<>.default [//.#commons_clause? false] + (<json>.field "addendum" ..addendum)) + ))) diff --git a/licentia/source/program/licentia/license/distribution.lux b/licentia/source/program/licentia/license/distribution.lux index 849b7294a..87b397ff7 100644 --- a/licentia/source/program/licentia/license/distribution.lux +++ b/licentia/source/program/licentia/license/distribution.lux @@ -104,10 +104,10 @@ (def: .public (extension distribution) (-> Distribution Text) - ($.paragraph ($_ list#composite - (if (the //.#can_re_license? distribution) - (list allow_re_licensing) - (list)) - (if (the //.#can_multi_license? distribution) - (list allow_multi_licensing) - (list))))) + ($.paragraph (all list#composite + (if (the //.#can_re_license? distribution) + (list allow_re_licensing) + (list)) + (if (the //.#can_multi_license? distribution) + (list allow_multi_licensing) + (list))))) diff --git a/licentia/source/test/licentia.lux b/licentia/source/test/licentia.lux index c753cd555..c24c1231e 100644 --- a/licentia/source/test/licentia.lux +++ b/licentia/source/test/licentia.lux @@ -58,49 +58,49 @@ (def: copyright_holder (Random copyright.Holder) - ($_ random.and - (random.ascii 10) - ..period)) + (all random.and + (random.ascii 10) + ..period)) (def: identification (Random Identification) - ($_ random.and - (random.ascii 10) - (random.ascii 10))) + (all random.and + (random.ascii 10) + (random.ascii 10))) (def: termination (Random Termination) - ($_ random.and - random.bit - random.nat - random.nat)) + (all random.and + random.bit + random.nat + random.nat)) (def: liability (Random Liability) - ($_ random.and - random.bit - random.bit)) + (all random.and + random.bit + random.bit)) (def: distribution (Random Distribution) - ($_ random.and - random.bit - random.bit)) + (all random.and + random.bit + random.bit)) (def: commercial (Random Commercial) - ($_ random.and - random.bit - random.bit - random.bit)) + (all random.and + random.bit + random.bit + random.bit)) (def: extension (Random Extension) - ($_ random.and - random.bit - random.bit - (random.maybe ..period) - random.bit)) + (all random.and + random.bit + random.bit + (random.maybe ..period) + random.bit)) (def: entity (Random Entity) @@ -115,9 +115,9 @@ (def: black_list (Random Black_List) - ($_ random.and - (random.maybe (random.ascii 10)) - (variable_list 10 ..entity))) + (all random.and + (random.maybe (random.ascii 10)) + (variable_list 10 ..entity))) (def: url (Random URL) @@ -125,163 +125,163 @@ (def: attribution (Random Attribution) - ($_ random.and - (random.ascii 10) - (random.maybe (random.ascii 10)) - ..url - (random.maybe ..url))) + (all random.and + (random.ascii 10) + (random.maybe (random.ascii 10)) + ..url + (random.maybe ..url))) (def: addendum (Random Addendum) - ($_ random.and - random.bit - )) + (all random.and + random.bit + )) (def: license (Random License) - ($_ random.and - (random.list 2 ..copyright_holder) - (random.maybe ..identification) - ..termination - ..liability - ..distribution - ..commercial - ..extension - (variable_list 3 ..black_list) - (random.maybe attribution) - ..addendum - )) + (all random.and + (random.list 2 ..copyright_holder) + (random.maybe ..identification) + ..termination + ..liability + ..distribution + ..commercial + ..extension + (variable_list 3 ..black_list) + (random.maybe attribution) + ..addendum + )) (type: (Concern a) (-> (-> Text Bit) a Test)) (def: (about_grant present? termination) (Concern Termination) - ($_ _.and - (_.test "Copyright grant is present." - (present? grant.copyright)) - (_.test "Patent grant is present." - (present? (grant.patent (the license.#patent_retaliation? termination)))) - (_.test "Effective date for the grants is present." - (present? grant.date)) - (_.test "Patent grant is present." - (present? (grant.termination (the license.#termination_period termination) - (the license.#grace_period termination)))) - (_.test "The termination period is accurately conveyed." - (present? (grant.grant_restoration_clause (the license.#termination_period termination)))) - (_.test "The grace period is accurately conveyed." - (present? (grant.grace_period_clause (the license.#grace_period termination)))) - (_.test "The grants are not retro-actively terminated." - (present? grant.no_retroactive_termination)) - )) + (all _.and + (_.test "Copyright grant is present." + (present? grant.copyright)) + (_.test "Patent grant is present." + (present? (grant.patent (the license.#patent_retaliation? termination)))) + (_.test "Effective date for the grants is present." + (present? grant.date)) + (_.test "Patent grant is present." + (present? (grant.termination (the license.#termination_period termination) + (the license.#grace_period termination)))) + (_.test "The termination period is accurately conveyed." + (present? (grant.grant_restoration_clause (the license.#termination_period termination)))) + (_.test "The grace period is accurately conveyed." + (present? (grant.grace_period_clause (the license.#grace_period termination)))) + (_.test "The grants are not retro-actively terminated." + (present? grant.no_retroactive_termination)) + )) (def: (about_liability present? liability) (Concern Liability) - ($_ _.and - (_.test "Warranty liability disclaimer is present." - (present? liability.warranty)) - (_.test "Limitation of liability is present." - (present? liability.limitation)) - (_.test "Litigation conditions are present." - (present? liability.litigation)) - (_.test "Liability acceptance conditions may be present." - (bit#= (the license.#can_accept? liability) - (present? liability.can_accept))) - (_.test "Liability acceptance conditions may be present." - (bit#= (the license.#disclaim_high_risk? liability) - (present? liability.disclaim_high_risk))) - )) + (all _.and + (_.test "Warranty liability disclaimer is present." + (present? liability.warranty)) + (_.test "Limitation of liability is present." + (present? liability.limitation)) + (_.test "Litigation conditions are present." + (present? liability.litigation)) + (_.test "Liability acceptance conditions may be present." + (bit#= (the license.#can_accept? liability) + (present? liability.can_accept))) + (_.test "Liability acceptance conditions may be present." + (bit#= (the license.#disclaim_high_risk? liability) + (present? liability.disclaim_high_risk))) + )) (def: (about_distribution present? distribution) (Concern Distribution) - ($_ _.and - (_.test "Conditions for source-code distribution are present." - (present? distribution.source_code_form)) - (_.test "Conditions for object-code distribution are present." - (present? distribution.object_form)) - (_.test "Conditions for extension distribution are present." - (present? (distribution.extension distribution))) - )) + (all _.and + (_.test "Conditions for source-code distribution are present." + (present? distribution.source_code_form)) + (_.test "Conditions for object-code distribution are present." + (present? distribution.object_form)) + (_.test "Conditions for extension distribution are present." + (present? (distribution.extension distribution))) + )) (def: (about_commercial present? commercial) (Concern Commercial) - ($_ _.and - (_.test "Non-commercial clause is present." - (bit#= (not (the license.#can_sell? commercial)) - (present? commercial.cannot_sell))) - (_.test "Contributor credit condition is present." - (bit#= (the license.#require_contributor_credit? commercial) - (present? commercial.require_contributor_attribution))) - (_.test "Anti-endorsement condition is present." - (bit#= (not (the license.#allow_contributor_endorsement? commercial)) - (present? commercial.disallow_contributor_endorsement))) - )) + (all _.and + (_.test "Non-commercial clause is present." + (bit#= (not (the license.#can_sell? commercial)) + (present? commercial.cannot_sell))) + (_.test "Contributor credit condition is present." + (bit#= (the license.#require_contributor_credit? commercial) + (present? commercial.require_contributor_attribution))) + (_.test "Anti-endorsement condition is present." + (bit#= (not (the license.#allow_contributor_endorsement? commercial)) + (present? commercial.disallow_contributor_endorsement))) + )) (def: (about_extension present? extension) (Concern Extension) - ($_ _.and - (_.test "The license is viral." - (bit#= (the license.#same_license? extension) - (and (list.every? present? extension.sharing_requirement) - (list.every? present? extension.license_conflict_resolution)))) - (_.test "Extensions must be distinguishable from the original work." - (bit#= (the license.#must_be_distinguishable? extension) - (present? extension.distinctness_requirement))) - (_.test "The community must be notified of new extensions." - (case (the license.#notification_period extension) - {.#Some period} - (present? (extension.notification_requirement period)) - - {.#None} - true)) - (_.test "Must describe modifications." - (bit#= (the license.#must_describe_modifications? extension) - (present? extension.description_requirement))) - )) + (all _.and + (_.test "The license is viral." + (bit#= (the license.#same_license? extension) + (and (list.every? present? extension.sharing_requirement) + (list.every? present? extension.license_conflict_resolution)))) + (_.test "Extensions must be distinguishable from the original work." + (bit#= (the license.#must_be_distinguishable? extension) + (present? extension.distinctness_requirement))) + (_.test "The community must be notified of new extensions." + (case (the license.#notification_period extension) + {.#Some period} + (present? (extension.notification_requirement period)) + + {.#None} + true)) + (_.test "Must describe modifications." + (bit#= (the license.#must_describe_modifications? extension) + (present? extension.description_requirement))) + )) (def: (about_attribution present? attribution) (Concern Attribution) - ($_ _.and - (_.test "The attribution copyright notice is present." - (present? (the license.#copyright_notice attribution))) - (_.test "The attribution phrase is present." - (|> attribution - (the license.#phrase) - (maybe#each present?) - (maybe.default true))) - (_.test "The attribution URL is present." - (present? (the license.#url attribution))) - (_.test "The attribution image is present." - (|> attribution - (the license.#image) - (maybe#each present?) - (maybe.default true))) - )) + (all _.and + (_.test "The attribution copyright notice is present." + (present? (the license.#copyright_notice attribution))) + (_.test "The attribution phrase is present." + (|> attribution + (the license.#phrase) + (maybe#each present?) + (maybe.default true))) + (_.test "The attribution URL is present." + (present? (the license.#url attribution))) + (_.test "The attribution image is present." + (|> attribution + (the license.#image) + (maybe#each present?) + (maybe.default true))) + )) (def: (about_miscellaneous present?) (-> (-> Text Bit) Test) - ($_ _.and - (_.test "License constitutes the entire agreement." - (present? miscellaneous.entire_agreement)) - (_.test "Disclaims relationship of parties." - (present? miscellaneous.relationship_of_parties)) - (_.test "Explicitly allows independent development." - (present? miscellaneous.independent_development)) - (_.test "Clarifies consent to breach does not waiver." - (present? miscellaneous.not_waiver)) - (_.test "Provides severability." - (present? miscellaneous.severability)) - (_.test "Covers export restrictions." - (present? miscellaneous.export_restrictions)) - )) + (all _.and + (_.test "License constitutes the entire agreement." + (present? miscellaneous.entire_agreement)) + (_.test "Disclaims relationship of parties." + (present? miscellaneous.relationship_of_parties)) + (_.test "Explicitly allows independent development." + (present? miscellaneous.independent_development)) + (_.test "Clarifies consent to breach does not waiver." + (present? miscellaneous.not_waiver)) + (_.test "Provides severability." + (present? miscellaneous.severability)) + (_.test "Covers export restrictions." + (present? miscellaneous.export_restrictions)) + )) (def: (about_addendum present? value) (Concern Addendum) - ($_ _.and - (_.test "Commons clause" - (bit#= (the license.#commons_clause? value) - (present? addendum.commons_clause))) - )) + (all _.and + (_.test "Commons clause" + (bit#= (the license.#commons_clause? value) + (present? addendum.commons_clause))) + )) (def: test Test @@ -291,77 +291,77 @@ present? (is (-> Text Bit) (function (_ snippet) (text.contains? snippet writ)))]] - ($_ _.and - (_.test "Copyright notices are present." - (list.every? (|>> notice.copyright_holder present?) - (the license.#copyright_holders license))) - - (_.test "Identification is present (if the license is identified)." - (case (the license.#identification license) - {.#Some identification} - (and (present? (output.identification identification)) - (present? miscellaneous.new_versions)) - - {.#None} - (not (present? miscellaneous.new_versions)))) - - (_.test "Black-lists (if wanted by licensor) are explicitly enumerated and justified." - (list.every? (function (_ black_list) - (let [black_list_is_justified? (case (the license.#justification black_list) - {.#Some justification} - (present? justification) - - {.#None} - bit.yes) - every_entity_is_mentioned? (|> black_list - (the license.#entities) - (list#each black_list.entity) - (list.every? present?))] - (and black_list_is_justified? - every_entity_is_mentioned?))) - (the license.#black_lists license))) - - (_.test "All definitions are present." - (list.every? (|>> output.definition present?) - definition.all)) - - (_.test "Acceptance of the license is demanded." - (present? limitation.acceptance)) - - (..about_grant present? (the license.#termination license)) - - (_.test "All limitations are present." - (present? output.limitation)) - - (_.test "All assurances are present." - (present? output.assurance)) - - (_.test "The terms of submission are present." - (present? submission.contribution)) - - (..about_liability present? (the license.#liability license)) - - (..about_distribution present? (the license.#distribution license)) - - (..about_commercial present? (the license.#commercial license)) - - (..about_extension present? (the license.#extension license)) - - (case (the license.#attribution license) - {.#Some attribution} - (..about_attribution present? attribution) - - {.#None} - (_.test "Attribution is missing." - bit.yes)) - - (..about_miscellaneous present?) - - (..about_addendum present? (the license.#addendum license)) - - (_.test "License ending footer is present." - (present? notice.end_of_license)) - ))) + (all _.and + (_.test "Copyright notices are present." + (list.every? (|>> notice.copyright_holder present?) + (the license.#copyright_holders license))) + + (_.test "Identification is present (if the license is identified)." + (case (the license.#identification license) + {.#Some identification} + (and (present? (output.identification identification)) + (present? miscellaneous.new_versions)) + + {.#None} + (not (present? miscellaneous.new_versions)))) + + (_.test "Black-lists (if wanted by licensor) are explicitly enumerated and justified." + (list.every? (function (_ black_list) + (let [black_list_is_justified? (case (the license.#justification black_list) + {.#Some justification} + (present? justification) + + {.#None} + bit.yes) + every_entity_is_mentioned? (|> black_list + (the license.#entities) + (list#each black_list.entity) + (list.every? present?))] + (and black_list_is_justified? + every_entity_is_mentioned?))) + (the license.#black_lists license))) + + (_.test "All definitions are present." + (list.every? (|>> output.definition present?) + definition.all)) + + (_.test "Acceptance of the license is demanded." + (present? limitation.acceptance)) + + (..about_grant present? (the license.#termination license)) + + (_.test "All limitations are present." + (present? output.limitation)) + + (_.test "All assurances are present." + (present? output.assurance)) + + (_.test "The terms of submission are present." + (present? submission.contribution)) + + (..about_liability present? (the license.#liability license)) + + (..about_distribution present? (the license.#distribution license)) + + (..about_commercial present? (the license.#commercial license)) + + (..about_extension present? (the license.#extension license)) + + (case (the license.#attribution license) + {.#Some attribution} + (..about_attribution present? attribution) + + {.#None} + (_.test "Attribution is missing." + bit.yes)) + + (..about_miscellaneous present?) + + (..about_addendum present? (the license.#addendum license)) + + (_.test "License ending footer is present." + (present? notice.end_of_license)) + ))) (program: args (<| io.io diff --git a/lux-cl/source/program.lux b/lux-cl/source/program.lux index e75ed2c19..6f6c4b1fc 100644 --- a/lux-cl/source/program.lux +++ b/lux-cl/source/program.lux @@ -407,10 +407,10 @@ (def: (scope body) (-> (_.Expression Any) (_.Expression Any)) (let [@program (_.var "lux_program")] - ($_ ..then - (_.defun @program (_.args (list)) body) - (_.call/* @program (list)) - ))) + (all ..then + (_.defun @program (_.args (list)) body) + (_.call/* @program (list)) + ))) (`` (program: [service /cli.service] (let [extension ".cl"] diff --git a/lux-lua/source/program.lux b/lux-lua/source/program.lux index 5c3185252..0a1eda39b 100644 --- a/lux-lua/source/program.lux +++ b/lux-lua/source/program.lux @@ -525,44 +525,44 @@ $b4 (_.var "b4") table/insert (function (_ in/0 in/1) (_.apply (list in/0 in/1) (_.var "table.insert")))] (_.function (_.var "utf8.char") (list $var_args) - ($_ _.then - (_.local/1 $buffer (_.array (list))) - (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args)))) - ($_ _.then - (_.when (_.or (_.< (_.int +0) $v) - (_.> (!int "10FFFF") $v)) - (_.statement (_.error/2 (|> (_.string "bad argument #") - (_.concat $k) - (_.concat (_.string " to char (out of range)"))) - (_.int +2)))) - (<| (_.if (_.< (!int "80") $v) - ... Single-byte sequence + (all _.then + (_.local/1 $buffer (_.array (list))) + (<| (_.for_in (list $k $v) (_.ipairs/1 (_.array (list $var_args)))) + (all _.then + (_.when (_.or (_.< (_.int +0) $v) + (_.> (!int "10FFFF") $v)) + (_.statement (_.error/2 (|> (_.string "bad argument #") + (_.concat $k) + (_.concat (_.string " to char (out of range)"))) + (_.int +2)))) + (<| (_.if (_.< (!int "80") $v) + ... Single-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply (list $v)) + (table/insert $buffer)))) + (_.if (_.< (!int "800") $v) + ... Two-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply (list (!&|< "C0" "1F" +6 $v) + (!&| "80" "3F" $v))) + (table/insert $buffer)))) + (_.if (_.< (!int "10000") $v) + ... Three-byte sequence + (_.statement (|> (_.var "string.char") + (_.apply (list (!&|< "E0" "0F" +12 $v) + (!&|< "80" "3F" +6 $v) + (!&| "80" "3F" $v))) + (table/insert $buffer)))) + ... Four-byte sequence (_.statement (|> (_.var "string.char") - (_.apply (list $v)) - (table/insert $buffer)))) - (_.if (_.< (!int "800") $v) - ... Two-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply (list (!&|< "C0" "1F" +6 $v) - (!&| "80" "3F" $v))) - (table/insert $buffer)))) - (_.if (_.< (!int "10000") $v) - ... Three-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply (list (!&|< "E0" "0F" +12 $v) + (_.apply (list (!&|< "F0" "07" +18 $v) + (!&|< "80" "3F" +12 $v) (!&|< "80" "3F" +6 $v) (!&| "80" "3F" $v))) (table/insert $buffer)))) - ... Four-byte sequence - (_.statement (|> (_.var "string.char") - (_.apply (list (!&|< "F0" "07" +18 $v) - (!&|< "80" "3F" +12 $v) - (!&|< "80" "3F" +6 $v) - (!&| "80" "3F" $v))) - (table/insert $buffer)))) - )) - (_.return (_.apply (list $buffer (_.string "")) (_.var "table.concat"))) - )))) + )) + (_.return (_.apply (list $buffer (_.string "")) (_.var "table.concat"))) + )))) ... (def: rembulan//str_rel_to_abs ... (let [$string (_.var "string") @@ -570,10 +570,10 @@ ... $k (_.var "k") ... $v (_.var "v")] ... (<| (_.local_function $str_rel_to_abs (list $string $var_args)) - ... ($_ _.then + ... (all _.then ... (_.local/1 $args (_.array (list $var_args))) ... (<| (_.for_in (list $k $v) (_.ipairs/1 $args)) - ... ($_ _.then + ... (all _.then ... (_.if (_.> (_.int +0) $v) ... (_.set (list $v) $v) ... (_.set (list $v) (|> $v (_.+ (_.length $string)) (_.+ (_.int +1))))) @@ -592,7 +592,7 @@ ... $bx (_.var "bx") ... $end (_.var "_end")] ... (<| (_.local_function $decode (list $string $start)) - ... ($_ _.then + ... (all _.then ... (_.set (list $start) (_.apply (list $string (_.or (_.int +1) $start)) $str_rel_to_abs)) ... (_.local/1 $b1 (_.do "byte" (list $start $start) $string)) ... (<| (_.if (_.< (!int "80") $b1) @@ -603,7 +603,7 @@ ... (_.< (!int "C2") $b1)) ... (_.return _.nil)) ... ... Get 'supposed' amount of continuation bytes from primary byte - ... ($_ _.then + ... (all _.then ... (_.local/1 $end (|> (|> $b1 (_.>= (!int "F0")) (_.and (_.int +3))) ... (_.or (|> $b1 (_.>= (!int "E0")) (_.and (_.int +2)))) ... (_.or (|> $b1 (_.>= (!int "C0")) (_.and (_.int +1)))) @@ -627,16 +627,16 @@ ... $start (_.var "start") ... $end (_.var "_end")] ... (_.function (_.var "utf8.codes") (list $string) - ... ($_ _.then + ... (all _.then ... (_.local/1 $i (_.int +1)) ... (_.return (<| (_.closure (list)) ... (_.if (_.> (_.length $string) $i) ... (_.return _.nil) - ... ($_ _.then + ... (all _.then ... (_.let (list $start $end) (_.apply (list $string $i) $decode)) ... (_.if (_.not $start) ... (_.statement (_.error/2 (_.string "invalid UTF-8 code") (_.int +2))) - ... ($_ _.then + ... (all _.then ... (_.set (list $i) (_.+ (_.int +1) $end)) ... (_.return (_.multi (list $start (_.do "sub" (list $start $end) $string)))) ... )) @@ -651,16 +651,16 @@ ... $seq_end (_.var "seq_end") ... $size (_.var "size")] ... (_.function (_.var "utf8.len") (list $string $start $end) - ... ($_ _.then + ... (all _.then ... (_.set (list $start $end) (_.apply (list $string (_.or (_.int +1) $start) (_.or (_.int -1) $end)) $str_rel_to_abs)) ... (_.local/1 $size (_.int +0)) ... (_.repeat (_.>= $end $seq_end) - ... ($_ _.then + ... (all _.then ... (_.let (list $seq_start $seq_end) (_.apply (list $string $start) $decode)) ... (_.if (_.not $seq_start) ... ... Hit an invalid sequence! ... (_.return (_.multi (list (_.boolean false) $start))) - ... ($_ _.then + ... (all _.then ... (_.set (list $start) (_.+ (_.int +1) $seq_end)) ... (_.set (list $size) (_.+ (_.int +1) $size)) ... )) @@ -674,18 +674,18 @@ (def: rembulan_prelude _.Statement - ($_ _.then - (_.function (_.var "os.time") (list) - (_.return (_.int +0))) - - ... Ported from https://github.com/meepen/Lua-5.1-UTF-8 - ..rembulan//char - ... ..rembulan//str_rel_to_abs - ... ..rembulan//decode - ... ..rembulan//codes - ... ..rembulan//len - ... ..rembulan//charpattern - ))))) + (all _.then + (_.function (_.var "os.time") (list) + (_.return (_.int +0))) + + ... Ported from https://github.com/meepen/Lua-5.1-UTF-8 + ..rembulan//char + ... ..rembulan//str_rel_to_abs + ... ..rembulan//decode + ... ..rembulan//codes + ... ..rembulan//len + ... ..rembulan//charpattern + ))))) (def: host (IO [Baggage (Host _.Expression _.Statement)]) diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 715632d7c..ceb7cdabe 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -393,7 +393,7 @@ Called by `imenu--generic-function'." (jvm-host (altRE "import:" "export:" "class:" "interface:" "object" "do_to" "synchronized" "class_for")) (alternative-format (altRE "char" "bin" "oct" "hex")) (documentation (altRE "comment" "documentation:")) - (function-application (altRE "|>" "<|" "_\\$" "\\$_")) + (function-application (altRE "|>" "<|" "left" "right" "all")) (function-definition (altRE "function" "|>>" "<<|" "||>")) (remember (altRE "remember" "to_do" "fix_me")) (definition (altRE "\\.using" diff --git a/lux-python/source/program.lux b/lux-python/source/program.lux index 718cb9d95..cc7ef2162 100644 --- a/lux-python/source/program.lux +++ b/lux-python/source/program.lux @@ -537,16 +537,16 @@ (def: (program context program) (Program (_.Expression Any) (_.Statement Any)) - ($_ _.then - (_.import "sys") - (_.when (_.= (_.string "__main__") (_.var "__name__")) - (_.statement (_.apply/* (list (|> (_.var "sys") (_.the "argv") - ... The first entry in the list will be the program.py file itself - ... so, it must be removed so only the program's arguments are left. - (_.slice_from (_.int +1)) - runtime.lux::program_args) - _.none) - program))))) + (all _.then + (_.import "sys") + (_.when (_.= (_.string "__main__") (_.var "__name__")) + (_.statement (_.apply/* (list (|> (_.var "sys") (_.the "argv") + ... The first entry in the list will be the program.py file itself + ... so, it must be removed so only the program's arguments are left. + (_.slice_from (_.int +1)) + runtime.lux::program_args) + _.none) + program))))) (def: (declare_success! _) (-> Any (Async Any)) @@ -562,12 +562,12 @@ old_limit current_limit new_limit (_.bit_shl (_.int +2) old_limit)] (<| (_.comment "-*- coding: utf-8 -*-") - ($_ _.then - (; (_.do "setrecursionlimit" (list new_limit) $sys)) - ... (; (_.do "stack_size" (list current_limit) $threading)) - (_.def @program (list) body) - (; (_.apply/* (list) @program)) - )))) + (all _.then + (; (_.do "setrecursionlimit" (list new_limit) $sys)) + ... (; (_.do "stack_size" (list current_limit) $threading)) + (_.def @program (list) body) + (; (_.apply/* (list) @program)) + )))) (def: (lux_compiler it) (-> Any platform.Custom) diff --git a/lux-r/source/program.lux b/lux-r/source/program.lux index 873d41a5e..2f477efcb 100644 --- a/lux-r/source/program.lux +++ b/lux-r/source/program.lux @@ -591,10 +591,10 @@ (def: (scope body) (-> _.Expression _.Expression) (let [$program (_.var "lux_program")] - ($_ _.then - (_.set! $program (_.function (list) body)) - (_.apply/0 $program []) - ))) + (all _.then + (_.set! $program (_.function (list) body)) + (_.apply/0 $program []) + ))) (`` (program: [service /cli.service] (let [extension ".r"] diff --git a/stdlib/source/documentation/lux.lux b/stdlib/source/documentation/lux.lux index 31161cb4f..468fc588f 100644 --- a/stdlib/source/documentation/lux.lux +++ b/stdlib/source/documentation/lux.lux @@ -208,15 +208,15 @@ [(= (Tuple) (And))]) -(documentation: /._$ +(documentation: /.left "Left-association for the application of binary functions over variadic arguments." - [(_$ text#composite "Hello, " name ". How are you?") + [(left text#composite "Hello, " name ". How are you?") "=>" (text#composite (text#composite "Hello, " name) ". How are you?")]) -(documentation: /.$_ +(documentation: /.all "Right-association for the application of binary functions over variadic arguments." - [($_ text#composite "Hello, " name ". How are you?") + [(all text#composite "Hello, " name ". How are you?") "=>" (text#composite "Hello, " (text#composite name ". How are you?"))]) @@ -353,7 +353,7 @@ [(case (is (List Int) (list +1 +2 +3)) {#Item x {#Item y {#Item z {#End}}}} - {#Some ($_ * x y z)} + {#Some (all * x y z)} _ {#None})]) @@ -364,7 +364,7 @@ [(case (is (List Int) (list +1 +2 +3)) (pattern (list x y z)) - {#Some ($_ * x y z)} + {#Some (all * x y z)} _ {#None})]) @@ -711,9 +711,9 @@ [form (list (bit #1)) "(#1)"] [tuple (list (bit #1)) "[#1]"] )] - ($_ and - <tests> - )))]) + (all and + <tests> + )))]) (documentation: /.static (format "Resolves the names of definitions to their values at compile-time, assuming their values are either:" @@ -837,7 +837,7 @@ 2 3 4)] - ($_ + <operands>))]) + (all + <operands>))]) (documentation: /.char "If given a 1-character text literal, yields the char-code of the sole character." @@ -936,8 +936,8 @@ ..Tuple ..Or ..And - .._$ - ..$_ + ..left + ..all ..if ..Primitive ..` diff --git a/stdlib/source/documentation/lux/macro/syntax.lux b/stdlib/source/documentation/lux/macro/syntax.lux index 866221b4b..c4867ea7a 100644 --- a/stdlib/source/documentation/lux/macro/syntax.lux +++ b/stdlib/source/documentation/lux/macro/syntax.lux @@ -1,22 +1,22 @@ (.using - [library - [lux {"-" char} - ["$" documentation {"+" documentation:}] - [data - [text {"+" \n} - ["%" format {"+" format}]] - [collection - ["[0]" list]]]]] - ["[0]" / "_" - ["[1][0]" check] - ["[1][0]" declaration] - ["[1][0]" definition] - ["[1][0]" export] - ["[1][0]" input] - ["[1][0]" type "_" - ["[1]/[0]" variable]]] - [\\library - ["[0]" /]]) + [library + [lux {"-" char} + ["$" documentation {"+" documentation:}] + [data + [text {"+" \n} + ["%" format {"+" format}]] + [collection + ["[0]" list]]]]] + ["[0]" / "_" + ["[1][0]" check] + ["[1][0]" declaration] + ["[1][0]" definition] + ["[1][0]" export] + ["[1][0]" input] + ["[1][0]" type "_" + ["[1]/[0]" variable]]] + [\\library + ["[0]" /]]) (documentation: /.syntax: (format \n "A more advanced way to define macros than 'macro:'." @@ -29,11 +29,11 @@ interfaces (tuple (some (super_class_decl^ imports class_vars))) constructor_args (constructor_args^ imports class_vars) methods (some (overriden_method_def^ imports))]) - (let [def_code ($_ text#composite "anon-class:" - (spaced (list (super_class_decl$ (maybe.else object_super_class super)) - (with_brackets (spaced (list#each super_class_decl$ interfaces))) - (with_brackets (spaced (list#each constructor_arg$ constructor_args))) - (with_brackets (spaced (list#each (method_def$ id) methods))))))] + (let [def_code (all text#composite "anon-class:" + (spaced (list (super_class_decl$ (maybe.else object_super_class super)) + (with_brackets (spaced (list#each super_class_decl$ interfaces))) + (with_brackets (spaced (list#each constructor_arg$ constructor_args))) + (with_brackets (spaced (list#each (method_def$ id) methods))))))] (in (list (` ((~ (code.text def_code))))))))]) (.def: .public documentation diff --git a/stdlib/source/documentation/lux/math/logic.lux b/stdlib/source/documentation/lux/math/logic.lux index 02db866cc..11d930333 100644 --- a/stdlib/source/documentation/lux/math/logic.lux +++ b/stdlib/source/documentation/lux/math/logic.lux @@ -1,18 +1,18 @@ (.using - [library - [lux {"-" char} - ["$" documentation {"+" documentation:}] - [data - [text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" monoid)]]]]] - ["[0]" / "_" - ["[1][0]" continuous] - ["[1][0]" fuzzy]]) + [library + [lux {"-" char} + ["$" documentation {"+" documentation:}] + [data + [text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" monoid)]]]]] + ["[0]" / "_" + ["[1][0]" continuous] + ["[1][0]" fuzzy]]) (.def: .public documentation (.List $.Module) - ($_ list#composite - /continuous.documentation - /fuzzy.documentation)) + (all list#composite + /continuous.documentation + /fuzzy.documentation)) diff --git a/stdlib/source/documentation/lux/world.lux b/stdlib/source/documentation/lux/world.lux index f199a1e93..d226dfa3d 100644 --- a/stdlib/source/documentation/lux/world.lux +++ b/stdlib/source/documentation/lux/world.lux @@ -1,33 +1,33 @@ (.using - [library - [lux "*" - [program {"+" program:}] - ["$" documentation {"+" documentation:}] - ["[0]" debug] - [control - ["[0]" io]] - [data - [collection - ["[0]" list ("[1]#[0]" monoid)]]]]] - ["[0]" / "_" - ["[1][0]" console] - ["[1][0]" file] - ["[1][0]" input "_" - ["[1]/[0]" keyboard]] - ["[1][0]" net] - ["[1][0]" output "_" - ["[1]/[0]" video "_" - ["[1]/[0]" resolution]]] - ["[1][0]" program] - ["[1][0]" shell]]) + [library + [lux "*" + [program {"+" program:}] + ["$" documentation {"+" documentation:}] + ["[0]" debug] + [control + ["[0]" io]] + [data + [collection + ["[0]" list ("[1]#[0]" monoid)]]]]] + ["[0]" / "_" + ["[1][0]" console] + ["[1][0]" file] + ["[1][0]" input "_" + ["[1]/[0]" keyboard]] + ["[1][0]" net] + ["[1][0]" output "_" + ["[1]/[0]" video "_" + ["[1]/[0]" resolution]]] + ["[1][0]" program] + ["[1][0]" shell]]) (.def: .public documentation (.List $.Module) - ($_ list#composite - /console.documentation - /file.documentation - /input/keyboard.documentation - /net.documentation - /output/video/resolution.documentation - /program.documentation - /shell.documentation)) + (all list#composite + /console.documentation + /file.documentation + /input/keyboard.documentation + /net.documentation + /output/video/resolution.documentation + /program.documentation + /shell.documentation)) diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 5c6c625a8..7ff877259 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -1337,32 +1337,34 @@ (function' [right left] (func left right))) -(macro:' .public (_$ tokens) +(macro:' .public (left tokens) ({{#Item op tokens'} ({{#Item first nexts} (meta#in (list (list#mix (function#flipped (right_associativity op)) first nexts))) _ - (failure "Wrong syntax for _$")} + (failure "Wrong syntax for left")} tokens') _ - (failure "Wrong syntax for _$")} + (failure "Wrong syntax for left")} tokens)) -(macro:' .public ($_ tokens) +(macro:' .public (right tokens) ({{#Item op tokens'} ({{#Item last prevs} (meta#in (list (list#mix (right_associativity op) last prevs))) _ - (failure "Wrong syntax for $_")} + (failure "Wrong syntax for right")} (list#reversed tokens')) _ - (failure "Wrong syntax for $_")} + (failure "Wrong syntax for right")} tokens)) +(def:''' .public all Macro ..right) + ... (type: (Monad m) ... (Interface ... (is (All (_ a) (-> a (m a))) @@ -1531,7 +1533,7 @@ (-> Symbol Text) (let' [[module name] full_name] ({"" name - _ ($_ text#composite module ..symbol_separator name)} + _ (all text#composite module ..symbol_separator name)} module))) (def:''' .private (global_symbol full_name state) @@ -1553,11 +1555,11 @@ constant) {#None} - {#Left ($_ text#composite "Unknown definition: " (symbol#encoded full_name))}} + {#Left (all text#composite "Unknown definition: " (symbol#encoded full_name))}} (plist#value name definitions)) {#None} - {#Left ($_ text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} + {#Left (all text#composite "Unknown module: " module " @ " (symbol#encoded full_name))}} (plist#value module modules)))) (def:''' .private (:List<Code> expression) @@ -2200,7 +2202,7 @@ (def:''' .private (text#encoded original) (-> Text Text) - ($_ text#composite ..double_quote original ..double_quote)) + (all text#composite ..double_quote original ..double_quote)) (def:''' .private (code#encoded code) (-> Code Text) @@ -2226,25 +2228,25 @@ (symbol#encoded [module name]) [_ {#Form xs}] - ($_ text#composite "(" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) ")") + (all text#composite "(" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) ")") [_ {#Tuple xs}] - ($_ text#composite "[" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "]") + (all text#composite "[" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) "]") [_ {#Variant xs}] - ($_ text#composite "{" (|> xs - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite "")) "}")} + (all text#composite "{" (|> xs + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite "")) "}")} code)) (def:''' .private (normal_type type) @@ -2360,7 +2362,7 @@ ..#seed ("lux i64 +" 1 seed) ..#expected expected ..#location location ..#extensions extensions ..#scope_type_vars scope_type_vars ..#eval _eval] - (local$ ($_ text#composite "__gensym__" prefix (nat#encoded seed)))}} + (local$ (all text#composite "__gensym__" prefix (nat#encoded seed)))}} state)) (macro:' .public (exec tokens) @@ -2440,11 +2442,11 @@ (do meta_monad [] (in (list))) _ - (failure ($_ text#composite "'lux.case' expects an even number of tokens: " (|> branches - (list#each code#encoded) - (list#interposed " ") - list#reversed - (list#mix text#composite ""))))} + (failure (all text#composite "'lux.case' expects an even number of tokens: " (|> branches + (list#each code#encoded) + (list#interposed " ") + list#reversed + (list#mix text#composite ""))))} branches)) (macro:' .public (case tokens) @@ -3000,7 +3002,7 @@ {#Right state module} _ - {#Left ($_ text#composite "Unknown module: " name)})))) + {#Left (all text#composite "Unknown module: " name)})))) (def: (type_slot [module name]) (-> Symbol (Meta [Nat (List Symbol) Bit Type])) @@ -3083,38 +3085,38 @@ name _ - ($_ text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")) + (all text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")) {#Sum _} - ($_ text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") + (all text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}") {#Product _} - ($_ text#composite "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") + (all text#composite "[" (|> (flat_tuple type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "]") {#Function _} - ($_ text#composite "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") + (all text#composite "(-> " (|> (flat_lambda type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")") {#Parameter id} (nat#encoded id) {#Var id} - ($_ text#composite "-" (nat#encoded id)) + (all text#composite "-" (nat#encoded id)) {#Ex id} - ($_ text#composite "+" (nat#encoded id)) + (all text#composite "+" (nat#encoded id)) {#UnivQ env body} - ($_ text#composite "(All " (type#encoded body) ")") + (all text#composite "(All " (type#encoded body) ")") {#ExQ env body} - ($_ text#composite "(Ex " (type#encoded body) ")") + (all text#composite "(Ex " (type#encoded body) ")") {#Apply _} (let [[func args] (flat_application type)] - ($_ text#composite - "(" (type#encoded func) " " - (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) - ")")) + (all text#composite + "(" (type#encoded func) " " + (|> args (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) + ")")) {#Named name _} (symbol#encoded name) @@ -3131,9 +3133,9 @@ (meta#in tags) _ - (failure ($_ text#composite - "No tags available for type: " - (type#encoded struct_type))))) + (failure (all text#composite + "No tags available for type: " + (type#encoded struct_type))))) .let [tag_mappings (is (List [Text Code]) (list#each (function (_ tag) [(product#right tag) @@ -3164,7 +3166,7 @@ {#Item head tail} (list#mix (function (_ right left) - ($_ text#composite left separator right)) + (all text#composite left separator right)) head tail))) @@ -3478,7 +3480,7 @@ (function (again left right) (case (..text#split_by pattern right) {#Some [pre post]} - (again ($_ "lux text concat" left pre replacement) post) + (again (all "lux text concat" left pre replacement) post) {#None} ("lux text concat" left right)))) @@ -3486,7 +3488,7 @@ (def: (alias_stand_in index) (-> Nat Text) - ($_ "lux text concat" "[" (nat#encoded index) "]")) + (all "lux text concat" "[" (nat#encoded index) "]")) (def: (module_alias context aliased) (-> (List Text) Text Text) @@ -3514,7 +3516,7 @@ _ (case root "" hierarchy - _ ($_ text#composite root ..module_separator hierarchy)))) + _ (all text#composite root ..module_separator hierarchy)))) (def: (normal_parallel_path hierarchy root) (-> Text Text (Maybe Text)) @@ -3550,7 +3552,7 @@ (case (relative_ups 0 module) 0 (meta#in (if nested? - ($_ "lux text concat" relative_root ..module_separator module) + (all "lux text concat" relative_root ..module_separator module) module)) relatives @@ -3565,12 +3567,12 @@ clean ("lux text clip" relatives (|> module "lux text size" ("lux i64 -" relatives)) module) output (case ("lux text size" clean) 0 prefix - _ ($_ text#composite prefix ..module_separator clean))] + _ (all text#composite prefix ..module_separator clean))] (meta#in output)) - (failure ($_ "lux text concat" - "Cannot climb the module hierarchy..." \n - "Importing module: " module \n - " Relative Root: " relative_root \n)))))) + (failure (all "lux text concat" + "Cannot climb the module hierarchy..." \n + "Importing module: " module \n + " Relative Root: " relative_root \n)))))) (def: (imports_parser nested? relative_root context imports) (-> Bit Text (List Text) (List Code) (Meta (List Importation))) @@ -3642,9 +3644,9 @@ _ (do meta_monad [current_module current_module_name] - (failure ($_ text#composite - "Wrong syntax for import @ " current_module - \n (code#encoded token))))))) + (failure (all text#composite + "Wrong syntax for import @ " current_module + \n (code#encoded token))))))) imports)] (in (list#conjoint imports')))) @@ -3685,19 +3687,19 @@ {#Right state (list#conjoint to_alias)}) {#None} - {#Left ($_ text#composite - "Unknown module: " (text#encoded module) \n - "Current module: " (case current_module - {#Some current_module} - (text#encoded current_module) - - {#None} - "???") \n - "Known modules: " (|> modules - (list#each (function (_ [name module]) - (text$ name))) - tuple$ - code#encoded))}) + {#Left (all text#composite + "Unknown module: " (text#encoded module) \n + "Current module: " (case current_module + {#Some current_module} + (text#encoded current_module) + + {#None} + "???") \n + "Known modules: " (|> modules + (list#each (function (_ [name module]) + (text$ name))) + tuple$ + code#encoded))}) )) (def: (list#only p xs) @@ -3846,13 +3848,13 @@ {#Right [compiler struct_type]} _ - {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})) + {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})) (case (definition_type full_name compiler) {#Some struct_type} {#Right [compiler struct_type]} _ - {#Left ($_ text#composite "Unknown var: " (symbol#encoded full_name))})))] + {#Left (all text#composite "Unknown var: " (symbol#encoded full_name))})))] (case temp {#Right [compiler {#Var type_id}]} (let [[..#info _ ..#source _ ..#current_module _ ..#modules _ @@ -4108,11 +4110,11 @@ #refer_open openings]) _ - (failure ($_ text#composite "Wrong syntax for refer @ " current_module - \n (|> options - (list#each code#encoded) - (list#interposed " ") - (list#mix text#composite ""))))))) + (failure (all text#composite "Wrong syntax for refer @ " current_module + \n (|> options + (list#each code#encoded) + (list#interposed " ") + (list#mix text#composite ""))))))) (def: (referral_definitions module_name [r_defs r_opens]) (-> Text Refer (Meta (List Code))) @@ -4125,7 +4127,7 @@ (function (_ _def) (if (is_member? all_defs _def) (meta#in []) - (failure ($_ text#composite _def " is not defined in module " module_name " @ " current_module))))) + (failure (all text#composite _def " is not defined in module " module_name " @ " current_module))))) referred_defs)))] defs' (case r_defs {#All} @@ -4528,10 +4530,10 @@ (single_expansion expr) _ - (failure ($_ text#composite - "Incorrect expansion in with_expansions" - " | Binding: " (text#encoded var_name) - " | Expression: " (code#encoded expr))))] + (failure (all text#composite + "Incorrect expansion in with_expansions" + " | Binding: " (text#encoded var_name) + " | Expression: " (code#encoded expr))))] (again &rest (plist#with var_name expansion map))) {#End} @@ -4730,8 +4732,8 @@ (do meta_monad [location ..location .let [[module line column] location - location ($_ "lux text concat" (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) - message ($_ "lux text concat" "Undefined behavior @ " location)]] + location (all "lux text concat" (text#encoded module) "," (nat#encoded line) "," (nat#encoded column)) + message (all "lux text concat" "Undefined behavior @ " location)]] (in (list (` (..panic! (~ (text$ message))))))) _ @@ -4836,14 +4838,14 @@ (in (as ..Text value)) _ - (failure ($_ text#composite - "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) - " : " (..code#encoded (..type_code type)))))) + (failure (all text#composite + "Invalid target platform (must be a value of type Text): " (symbol#encoded symbol) + " : " (..code#encoded (..type_code type)))))) _ - (failure ($_ text#composite - "Invalid target platform syntax: " (..code#encoded choice) - \n "Must be either a text literal or a symbol.")))) + (failure (all text#composite + "Invalid target platform syntax: " (..code#encoded choice) + \n "Must be either a text literal or a symbol.")))) (def: (target_pick target options default) (-> Text (List [Code Code]) (Maybe Code) (Meta (List Code))) @@ -4851,7 +4853,7 @@ {#End} (case default {#None} - (failure ($_ text#composite "No code for target platform: " target)) + (failure (all text#composite "No code for target platform: " target)) {#Some default} (meta#in (list default))) diff --git a/stdlib/source/library/lux/abstract/apply.lux b/stdlib/source/library/lux/abstract/apply.lux index 9a63c3747..90fedf8d3 100644 --- a/stdlib/source/library/lux/abstract/apply.lux +++ b/stdlib/source/library/lux/abstract/apply.lux @@ -36,7 +36,7 @@ (# f_apply on fgx fgf'))) ... (let [applyF (# f_apply on) ... applyG (# g_apply on)] - ... ($_ applyF + ... (all applyF ... fgf ... (# f_monad in applyG) ... fgx)) diff --git a/stdlib/source/library/lux/abstract/comonad.lux b/stdlib/source/library/lux/abstract/comonad.lux index 72057bf06..c1b40888f 100644 --- a/stdlib/source/library/lux/abstract/comonad.lux +++ b/stdlib/source/library/lux/abstract/comonad.lux @@ -39,7 +39,7 @@ {.#Some bindings} (let [[module short] (symbol ..be) symbol (is (-> Text Code) - (|>> ($_ "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy])) + (|>> (all "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy])) g!_ (symbol "_") g!each (symbol "each") g!disjoint (symbol "disjoint") diff --git a/stdlib/source/library/lux/abstract/monad.lux b/stdlib/source/library/lux/abstract/monad.lux index 79152d481..6c853b9e4 100644 --- a/stdlib/source/library/lux/abstract/monad.lux +++ b/stdlib/source/library/lux/abstract/monad.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" all} [meta ["[0]" location]]]] [// @@ -69,7 +69,7 @@ (if (|> bindings list#size .int ("lux i64 %" +2) ("lux i64 =" +0)) (let [[module short] (symbol ..do) symbol (is (-> Text Code) - (|>> ($_ "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy])) + (|>> (.all "lux text concat" module " " short " ") [""] {.#Symbol} [location.dummy])) g!_ (symbol "_") g!each (symbol "each") g!conjoint (symbol "conjoint") diff --git a/stdlib/source/library/lux/abstract/predicate.lux b/stdlib/source/library/lux/abstract/predicate.lux index e785b7ae4..7e87cfc9d 100644 --- a/stdlib/source/library/lux/abstract/predicate.lux +++ b/stdlib/source/library/lux/abstract/predicate.lux @@ -1,12 +1,12 @@ (.using - [library - [lux {"-" or and} - [control - ["[0]" function]]]] - [// - [monoid {"+" Monoid}] - [functor - ["[0]" contravariant]]]) + [library + [lux {"-" all or and} + [control + ["[0]" function]]]] + [// + [monoid {"+" Monoid}] + [functor + ["[0]" contravariant]]]) (type: .public (Predicate a) (-> a Bit)) diff --git a/stdlib/source/library/lux/control/concatenative.lux b/stdlib/source/library/lux/control/concatenative.lux index 3fb95ed21..59c692222 100644 --- a/stdlib/source/library/lux/control/concatenative.lux +++ b/stdlib/source/library/lux/control/concatenative.lux @@ -76,8 +76,8 @@ (def: signature^ (Parser [(List Alias) Stack Stack]) - (<>.either ($_ <>.and aliases^ stack^ stack^) - ($_ <>.and (<>#in (list)) stack^ stack^))) + (<>.either (all <>.and aliases^ stack^ stack^) + (all <>.and (<>#in (list)) stack^ stack^))) (syntax: .public (=> [[aliases inputs outputs] signature^]) (let [de_alias (function (_ aliased) @@ -119,10 +119,10 @@ (def: word (Parser [Code Text Code (List Code)]) (|export|.parser - ($_ <>.and - <code>.local - <code>.any - (<>.many <code>.any)))) + (all <>.and + <code>.local + <code>.any + (<>.many <code>.any)))) (syntax: .public (word: [[export_policy name type commands] ..word]) (in (list (` (def: (~ export_policy) (~ (code.local name)) diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index 8334f6f41..25fad05eb 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -3,7 +3,7 @@ [lux "*" ["[0]" debug] [abstract - monad] + [monad {"+" do}]] [control ["[0]" pipe] ["[0]" function] @@ -229,14 +229,14 @@ (def: on_mail^ (Parser (Maybe On_MailC)) (<>.maybe (<code>.form (<>.and (<code>.form (<>.after (<code>.this (' on_mail)) - ($_ <>.and ..argument ..argument ..argument))) + (all <>.and ..argument ..argument ..argument))) <code>.any)))) (def: behavior^ (Parser BehaviorC) - ($_ <>.and - ..on_mail^ - (<>.some <code>.any))) + (all <>.and + ..on_mail^ + (<>.some <code>.any))) (def: (on_mail g!_ ?on_mail) (-> Code (Maybe On_MailC) Code) @@ -254,10 +254,10 @@ (def: actorP (Parser [Code [Text (List Text)] Code BehaviorC]) (|export|.parser - ($_ <>.and - ..actor_decl^ - <code>.any - behavior^))) + (all <>.and + ..actor_decl^ + <code>.any + behavior^))) (syntax: .public (actor: [[export_policy [name vars] state_type [?on_mail messages]] ..actorP]) (with_symbols [g!_] @@ -296,12 +296,12 @@ (def: signature^ (Parser Signature) - (<code>.form ($_ <>.and - (<>.else (list) (<code>.tuple (<>.some <code>.local))) - <code>.local - |input|.parser - <code>.local - <code>.local))) + (<code>.form (all <>.and + (<>.else (list) (<code>.tuple (<>.some <code>.local))) + <code>.local + |input|.parser + <code>.local + <code>.local))) (def: reference^ (Parser [Symbol (List Text)]) @@ -311,10 +311,10 @@ (def: messageP (Parser [Code Signature Code Code]) (|export|.parser - ($_ <>.and - ..signature^ - <code>.any - <code>.any))) + (all <>.and + ..signature^ + <code>.any + <code>.any))) (syntax: .public (message: [[export_policy signature output_type body] ..messageP]) (with_symbols [g!_ g!return] diff --git a/stdlib/source/library/lux/control/concurrency/thread.lux b/stdlib/source/library/lux/control/concurrency/thread.lux index 619b9733d..0902501b4 100644 --- a/stdlib/source/library/lux/control/concurrency/thread.lux +++ b/stdlib/source/library/lux/control/concurrency/thread.lux @@ -112,9 +112,9 @@ (case (try (io.run! action)) {try.#Failure error} (exec - ("lux io log" ($_ "lux text concat" - "ERROR DURING THREAD EXECUTION:" text.new_line - error)) + ("lux io log" (all "lux text concat" + "ERROR DURING THREAD EXECUTION:" text.new_line + error)) []) {try.#Success _} diff --git a/stdlib/source/library/lux/control/exception.lux b/stdlib/source/library/lux/control/exception.lux index 3d34b95f7..173b8b9bf 100644 --- a/stdlib/source/library/lux/control/exception.lux +++ b/stdlib/source/library/lux/control/exception.lux @@ -79,22 +79,22 @@ (def: exception (Parser [Code (List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)]) (let [private (is (Parser [(List |type_variable|.Variable) [Text (List |input|.Input)] (Maybe Code)]) - ($_ <>.and - (<>.else (list) (<code>.tuple (<>.some |type_variable|.parser))) - (<>.either (<code>.form (<>.and <code>.local |input|.parser)) - (<>.and <code>.local (<>#in (list)))) - (<>.maybe <code>.any) - ))] - ($_ <>.either - (<>.and <code>.any private) - (<>.and (<>#in (` .private)) private) - ))) + (all <>.and + (<>.else (list) (<code>.tuple (<>.some |type_variable|.parser))) + (<>.either (<code>.form (<>.and <code>.local |input|.parser)) + (<>.and <code>.local (<>#in (list)))) + (<>.maybe <code>.any) + ))] + (all <>.either + (<>.and <code>.any private) + (<>.and (<>#in (` .private)) private) + ))) (syntax: .public (exception: [[export_policy t_vars [name inputs] body] ..exception]) (macro.with_symbols [g!_ g!descriptor] (do meta.monad [current_module meta.current_module_name - .let [descriptor ($_ text#composite "{" current_module "." name "}" text.new_line) + .let [descriptor (all text#composite "{" current_module "." name "}" text.new_line) g!self (code.local name)]] (in (list (` (def: (~ export_policy) (~ g!self) @@ -126,14 +126,14 @@ text.together)] (|> message (text.replaced text.new_line on_new_line) - ($_ text#composite padding header header_separator)))))] + (all text#composite padding header header_separator)))))] (case entries {.#End} "" {.#Item head tail} (list#mix (function (_ post pre) - ($_ text#composite pre text.new_line (on_entry post))) + (all text#composite pre text.new_line (on_entry post))) (on_entry head) tail)))) @@ -156,19 +156,19 @@ ..report')) (def: separator - (let [gap ($_ "lux text concat" text.new_line text.new_line) + (let [gap (all "lux text concat" text.new_line text.new_line) horizontal_line (|> "-" (list.repeated 64) text.together)] - ($_ "lux text concat" - gap - horizontal_line - gap))) + (all "lux text concat" + gap + horizontal_line + gap))) (def: (decorated prelude error) (-> Text Text Text) - ($_ "lux text concat" - prelude - ..separator - error)) + (all "lux text concat" + prelude + ..separator + error)) (def: .public (with exception message computation) (All (_ e a) (-> (Exception e) e (Try a) (Try a))) diff --git a/stdlib/source/library/lux/control/function/inline.lux b/stdlib/source/library/lux/control/function/inline.lux index 80674c8eb..8785e6cb7 100644 --- a/stdlib/source/library/lux/control/function/inline.lux +++ b/stdlib/source/library/lux/control/function/inline.lux @@ -22,11 +22,11 @@ (def: inline (Parser [Code [Text (List Code)] Code Code]) (|export|.parser - ($_ <>.and - ..declaration - <code>.any - <code>.any - ))) + (all <>.and + ..declaration + <code>.any + <code>.any + ))) (syntax: .public (inline: [[privacy [name parameters] type term] ..inline]) (do [! meta.monad] diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux index 1c75c9f07..95a7f132f 100644 --- a/stdlib/source/library/lux/control/function/mutual.lux +++ b/stdlib/source/library/lux/control/function/mutual.lux @@ -32,11 +32,11 @@ (.def: mutual (Parser [Declaration Code Code]) - ($_ <>.and - declaration.parser - <code>.any - <code>.any - )) + (all <>.and + declaration.parser + <code>.any + <code>.any + )) (.def: (mutual_definition context g!context [g!name mutual]) (-> (List Code) Code [Code Mutual] Code) diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux index 1e360a194..2c32f7b8d 100644 --- a/stdlib/source/library/lux/control/parser/binary.lux +++ b/stdlib/source/library/lux/control/parser/binary.lux @@ -286,7 +286,7 @@ (def: .public location (Parser Location) - ($_ //.and ..text ..nat ..nat)) + (all //.and ..text ..nat ..nat)) (def: .public code (Parser Code) diff --git a/stdlib/source/library/lux/control/parser/code.lux b/stdlib/source/library/lux/control/parser/code.lux index 516e6ff2e..70a65f6e5 100644 --- a/stdlib/source/library/lux/control/parser/code.lux +++ b/stdlib/source/library/lux/control/parser/code.lux @@ -35,7 +35,7 @@ (-> (List Code) Text) (|>> (list#each code.format) (text.interposed " ") - ($_ text#composite text.new_line "Remaining input: "))) + (all text#composite text.new_line "Remaining input: "))) (def: .public any (Parser Code) @@ -58,7 +58,7 @@ {try.#Success [tokens next]}))) (template [<query> <check> <type> <tag> <eq> <desc>] - [(with_expansions [<failure> (these {try.#Failure ($_ text#composite "Cannot parse " <desc> (remaining_inputs tokens))})] + [(with_expansions [<failure> (these {try.#Failure (all text#composite "Cannot parse " <desc> (remaining_inputs tokens))})] (def: .public <query> (Parser <type>) (function (_ tokens) @@ -97,13 +97,13 @@ {.#Item [token tokens']} (if (code#= code token) {try.#Success [tokens' []]} - {try.#Failure ($_ text#composite "Expected a " (code.format code) " but instead got " (code.format token) - (remaining_inputs tokens))}) + {try.#Failure (all text#composite "Expected a " (code.format code) " but instead got " (code.format token) + (remaining_inputs tokens))}) _ {try.#Failure "There are no tokens to parse!"}))) -(with_expansions [<failure> (these {try.#Failure ($_ text#composite "Cannot parse local symbol" (remaining_inputs tokens))})] +(with_expansions [<failure> (these {try.#Failure (all text#composite "Cannot parse local symbol" (remaining_inputs tokens))})] (def: .public local (Parser Text) (function (_ tokens) @@ -126,7 +126,7 @@ _ <failure>)))) -(with_expansions [<failure> (these {try.#Failure ($_ text#composite "Cannot parse local symbol" (remaining_inputs tokens))})] +(with_expansions [<failure> (these {try.#Failure (all text#composite "Cannot parse local symbol" (remaining_inputs tokens))})] (def: .public global (Parser Symbol) (function (_ tokens) @@ -164,10 +164,10 @@ {.#Item [[_ {<tag> members}] tokens']} (case (p members) {try.#Success [{.#End} x]} {try.#Success [tokens' x]} - _ {try.#Failure ($_ text#composite "Parser was expected to fully consume " <desc> (remaining_inputs tokens))}) + _ {try.#Failure (all text#composite "Parser was expected to fully consume " <desc> (remaining_inputs tokens))}) _ - {try.#Failure ($_ text#composite "Cannot parse " <desc> (remaining_inputs tokens))})))] + {try.#Failure (all text#composite "Cannot parse " <desc> (remaining_inputs tokens))})))] [form .#Form "form"] [variant .#Variant "variant"] @@ -179,7 +179,7 @@ (function (_ tokens) (case tokens {.#End} {try.#Success [tokens []]} - _ {try.#Failure ($_ text#composite "Expected list of tokens to be empty!" (remaining_inputs tokens))}))) + _ {try.#Failure (all text#composite "Expected list of tokens to be empty!" (remaining_inputs tokens))}))) (def: .public end? (Parser Bit) diff --git a/stdlib/source/library/lux/control/parser/text.lux b/stdlib/source/library/lux/control/parser/text.lux index 1e380a218..b4f3daa90 100644 --- a/stdlib/source/library/lux/control/parser/text.lux +++ b/stdlib/source/library/lux/control/parser/text.lux @@ -177,7 +177,7 @@ (do //.monad [char any .let [char' (maybe.trusted (/.char 0 char))] - _ (//.assertion ($_ /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) + _ (//.assertion (all /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) (.and (n.>= bottom char') (n.<= top char')))] (in char))) @@ -188,7 +188,7 @@ [it ..any! char (..slice (in it)) .let [char' (maybe.trusted (/.char 0 char))] - _ (//.assertion ($_ /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) + _ (//.assertion (all /#composite "Character is not within range: " (/.of_char bottom) "-" (/.of_char top)) (.and (n.>= bottom char') (n.<= top char')))] (in it))) @@ -216,17 +216,17 @@ (def: .public hexadecimal (Parser Text) - ($_ //.either - ..decimal - (..range (char "a") (char "f")) - (..range (char "A") (char "F")))) + (all //.either + ..decimal + (..range (char "a") (char "f")) + (..range (char "A") (char "F")))) (def: .public hexadecimal! (Parser Slice) - ($_ //.either - ..decimal! - (..range! (char "a") (char "f")) - (..range! (char "A") (char "F")))) + (all //.either + ..decimal! + (..range! (char "a") (char "f")) + (..range! (char "A") (char "F")))) (template [<name>] [(exception: .public (<name> [options Text @@ -319,7 +319,7 @@ (do //.monad [=left left =right right] - (in ($_ /#composite =left =right)))) + (in (all /#composite =left =right)))) (def: .public (and! left right) (-> (Parser Slice) (Parser Slice) (Parser Slice)) diff --git a/stdlib/source/library/lux/control/parser/tree.lux b/stdlib/source/library/lux/control/parser/tree.lux index 6828da45a..2db46e2b5 100644 --- a/stdlib/source/library/lux/control/parser/tree.lux +++ b/stdlib/source/library/lux/control/parser/tree.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" left right} [abstract [monad {"+" do}]] [control diff --git a/stdlib/source/library/lux/control/parser/type.lux b/stdlib/source/library/lux/control/parser/type.lux index 3b837d8a9..f95894b0b 100644 --- a/stdlib/source/library/lux/control/parser/type.lux +++ b/stdlib/source/library/lux/control/parser/type.lux @@ -137,7 +137,7 @@ (def: (label idx) (-> Nat Code) - (code.local ($_ text#composite "label" text.tab (n#encoded idx)))) + (code.local (all text#composite "label" text.tab (n#encoded idx)))) (def: .public (with_extension type poly) (All (_ a) (-> Type (Parser a) (Parser [Code a]))) diff --git a/stdlib/source/library/lux/control/remember.lux b/stdlib/source/library/lux/control/remember.lux index 3a895593e..672783d02 100644 --- a/stdlib/source/library/lux/control/remember.lux +++ b/stdlib/source/library/lux/control/remember.lux @@ -38,17 +38,17 @@ (def: deadline (Parser Date) - ($_ <>.either - (<>#each (|>> instant.of_millis instant.date) - <c>.int) - (do <>.monad - [raw <c>.text] - (case (# date.codec decoded raw) - {try.#Success date} - (in date) - - {try.#Failure message} - (<>.failure message))))) + (all <>.either + (<>#each (|>> instant.of_millis instant.date) + <c>.int) + (do <>.monad + [raw <c>.text] + (case (# date.codec decoded raw) + {try.#Success date} + (in date) + + {try.#Failure message} + (<>.failure message))))) (syntax: .public (remember [deadline ..deadline message <c>.text diff --git a/stdlib/source/library/lux/control/security/capability.lux b/stdlib/source/library/lux/control/security/capability.lux index 322f2cf5b..4878554bf 100644 --- a/stdlib/source/library/lux/control/security/capability.lux +++ b/stdlib/source/library/lux/control/security/capability.lux @@ -41,9 +41,9 @@ (syntax: .public (capability: [[export_policy declaration [forger input output]] (|export|.parser - ($_ <>.and - |declaration|.parser - (<c>.form ($_ <>.and <c>.local <c>.any <c>.any))))]) + (all <>.and + |declaration|.parser + (<c>.form (all <>.and <c>.local <c>.any <c>.any))))]) (macro.with_symbols [g!_] (do [! meta.monad] [this_module meta.current_module_name diff --git a/stdlib/source/library/lux/control/try.lux b/stdlib/source/library/lux/control/try.lux index b2c5b02fc..1fd3037b9 100644 --- a/stdlib/source/library/lux/control/try.lux +++ b/stdlib/source/library/lux/control/try.lux @@ -159,9 +159,9 @@ text$ ("lux in-module" "library/lux" .text$)] {.#Right [state (.list (` (.if (~ test) (~ then) - {..#Failure (~ (text$ ($_ "lux text concat" - "[" (code#encoded (` .when)) "]" - " " "Invalid condition:")))})))]}) + {..#Failure (~ (text$ (all "lux text concat" + "[" (code#encoded (` .when)) "]" + " " "Invalid condition:")))})))]}) _ {.#Left "Wrong syntax for 'when'"})) diff --git a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux index e099a841b..3c95f2544 100644 --- a/stdlib/source/library/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/library/lux/data/collection/dictionary/ordered.lux @@ -552,10 +552,10 @@ (list) {.#Some node'} - ($_ list#composite - (again (the #left node')) - (list <output>) - (again (the #right node'))))))] + (all list#composite + (again (the #left node')) + (list <output>) + (again (the #right node'))))))] [entries [k v] [(the #key node') (the #value node')]] [keys k (the #key node')] diff --git a/stdlib/source/library/lux/data/collection/list.lux b/stdlib/source/library/lux/data/collection/list.lux index e0f68faa3..19ac281fc 100644 --- a/stdlib/source/library/lux/data/collection/list.lux +++ b/stdlib/source/library/lux/data/collection/list.lux @@ -1,6 +1,6 @@ (.using [library - [lux {"-" revised} + [lux {"-" revised all} ["@" target] [abstract [monoid {"+" Monoid}] @@ -387,7 +387,7 @@ (is (~~ (type_of xs)) (list))]) xs')] - ($_ composite (sorted < pre) (list x) (sorted < post))))) + (.all composite (sorted < pre) (list x) (sorted < post))))) (def: .public (empty? xs) (All (_ a) (Predicate (List a))) diff --git a/stdlib/source/library/lux/data/collection/tree/zipper.lux b/stdlib/source/library/lux/data/collection/tree/zipper.lux index e45697595..d0790fa4f 100644 --- a/stdlib/source/library/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/library/lux/data/collection/tree/zipper.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" left right} ["@" target] [abstract [functor {"+" Functor}] @@ -35,13 +35,13 @@ (Equivalence (Zipper a)))) (def: (= reference sample) - (let [== ($_ product.equivalence - (maybe.equivalence - ($_ product.equivalence - = - (list.equivalence (//.equivalence super)) - (list.equivalence (//.equivalence super)))) - (//.equivalence super))] + (let [== (all product.equivalence + (maybe.equivalence + (all product.equivalence + = + (list.equivalence (//.equivalence super)) + (list.equivalence (//.equivalence super)))) + (//.equivalence super))] (== reference sample)))) (def: .public (zipper tree) diff --git a/stdlib/source/library/lux/data/color.lux b/stdlib/source/library/lux/data/color.lux index dc2f0fff7..7a907d83e 100644 --- a/stdlib/source/library/lux/data/color.lux +++ b/stdlib/source/library/lux/data/color.lux @@ -81,10 +81,10 @@ (def: (hash value) (let [[r g b] (representation value)] - ($_ i64.or - (i64.left_shifted 16 r) - (i64.left_shifted 8 g) - b)))) + (all i64.or + (i64.left_shifted 16 r) + (i64.left_shifted 8 g) + b)))) (def: .public black Color @@ -140,8 +140,8 @@ red (..down red) green (..down green) blue (..down blue) - max ($_ f.max red green blue) - min ($_ f.min red green blue) + max (all f.max red green blue) + min (all f.min red green blue) luminance (|> (f.+ max min) (f./ +2.0))] (if (f.= max min) ... Achromatic @@ -212,8 +212,8 @@ red (..down red) green (..down green) blue (..down blue) - max ($_ f.max red green blue) - min ($_ f.min red green blue) + max (all f.max red green blue) + min (all f.min red green blue) brightness max diff (|> max (f.- min)) saturation (if (f.= +0.0 max) @@ -261,7 +261,7 @@ red (..down red) green (..down green) blue (..down blue) - key (|> +1.0 (f.- ($_ f.max red green blue))) + key (|> +1.0 (f.- (all f.max red green blue))) f (if (f.< +1.0 key) (|> +1.0 (f./ (|> +1.0 (f.- key)))) +0.0) diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux index 6e9e000ad..88ee81c34 100644 --- a/stdlib/source/library/lux/data/format/binary.lux +++ b/stdlib/source/library/lux/data/format/binary.lux @@ -265,7 +265,7 @@ (def: .public location (Writer Location) - ($_ ..and ..text ..nat ..nat)) + (all ..and ..text ..nat ..nat)) (def: .public code (Writer Code) diff --git a/stdlib/source/library/lux/data/format/html.lux b/stdlib/source/library/lux/data/format/html.lux index 28d3c849a..418513440 100644 --- a/stdlib/source/library/lux/data/format/html.lux +++ b/stdlib/source/library/lux/data/format/html.lux @@ -297,15 +297,15 @@ (def: .public (each attributes areas for) (-> Attributes (List [Attributes Shape]) Image Image) - ($_ ..and - for - (case (list#each (product.uncurried ..area) areas) - {.#End} - (..empty "map" attributes) - - {.#Item head tail} - (..tag "map" attributes - (list#mix (function.flipped ..and) head tail))))) + (all ..and + for + (case (list#each (product.uncurried ..area) areas) + {.#End} + (..empty "map" attributes) + + {.#Item head tail} + (..tag "map" attributes + (list#mix (function.flipped ..and) head tail))))) (.template [<name> <tag> <type>] [(def: .public <name> @@ -349,9 +349,9 @@ (..tag <container_tag> attributes (case description {.#Some description} - ($_ ..and - (..tag <description_tag> (list) description) - content) + (all ..and + (..tag <description_tag> (list) description) + content) {.#None} content)))] @@ -417,17 +417,17 @@ (def: (ruby_pronunciation pronunciation) (-> Content (HTML Any)) (..tag "rt" (list) - ($_ ..and - (..tag "rp" (list) (..text "(")) - pronunciation - (..tag "rp" (list) (..text ")"))))) + (all ..and + (..tag "rp" (list) (..text "(")) + pronunciation + (..tag "rp" (list) (..text ")"))))) (def: .public (ruby attributes content pronunciation) (-> Attributes Content Content Element) (..tag "ruby" attributes - ($_ ..and - content - (ruby_pronunciation pronunciation)))) + (all ..and + content + (ruby_pronunciation pronunciation)))) (type: .public Composite (-> Attributes Element Element)) @@ -462,9 +462,9 @@ (def: .public (description_list attributes descriptions) (-> Attributes (List [Content Element]) Element) (case (list#each (function (_ [term description]) - ($_ ..and - (..term term) - (..description description))) + (all ..and + (..term term) + (..description description))) descriptions) {.#End} (..empty "dl" attributes) diff --git a/stdlib/source/library/lux/data/format/json.lux b/stdlib/source/library/lux/data/format/json.lux index 2f21d8dc5..1eb7c31fb 100644 --- a/stdlib/source/library/lux/data/format/json.lux +++ b/stdlib/source/library/lux/data/format/json.lux @@ -83,17 +83,17 @@ (<code>.Parser JSON') (<>.rec (function (_ jsonP) - ($_ <>.or - (<code>.form (<>#in [])) - <code>.bit - <code>.frac - <code>.text - (<>#each sequence.of_list - (<code>.tuple (<>.some jsonP))) - (<>#each (dictionary.of_list text.hash) - (<code>.variant (<>.some (<>.and <code>.text jsonP)))) - <code>.any - )))) + (all <>.or + (<code>.form (<>#in [])) + <code>.bit + <code>.frac + <code>.text + (<>#each sequence.of_list + (<code>.tuple (<>.some jsonP))) + (<>#each (dictionary.of_list text.hash) + (<code>.variant (<>.some (<>.and <code>.text jsonP)))) + <code>.any + )))) (def: (jsonF token) (-> JSON' Code) @@ -132,7 +132,7 @@ {try.#Success (dictionary.keys obj)} _ - {try.#Failure ($_ text#composite "Cannot get the fields of a non-object.")})) + {try.#Failure (all text#composite "Cannot get the fields of a non-object.")})) (def: .public (field key json) (-> String JSON (Try JSON)) @@ -143,10 +143,10 @@ {try.#Success value} {.#None} - {try.#Failure ($_ text#composite "Missing field '" key "' on object.")}) + {try.#Failure (all text#composite "Missing field '" key "' on object.")}) _ - {try.#Failure ($_ text#composite "Cannot get field '" key "' on a non-object.")})) + {try.#Failure (all text#composite "Cannot get field '" key "' on a non-object.")})) (def: .public (has key value json) (-> String JSON JSON (Try JSON)) @@ -155,7 +155,7 @@ {try.#Success {#Object (dictionary.has key value obj)}} _ - {try.#Failure ($_ text#composite "Cannot set field '" key "' on a non-object.")})) + {try.#Failure (all text#composite "Cannot set field '" key "' on a non-object.")})) (template [<name> <tag> <type>] [(def: .public (<name> key json) @@ -165,7 +165,7 @@ {try.#Success value} {try.#Success _} - {try.#Failure ($_ text#composite "Wrong value type at key: " key)} + {try.#Failure (all text#composite "Wrong value type at key: " key)} {try.#Failure error} {try.#Failure error}))] @@ -275,11 +275,11 @@ (def: (kv_format format [key value]) (-> (-> JSON Text) (-> [String JSON] Text)) - ($_ text#composite - (..string_format key) - ..entry_separator - (format value) - )) + (all text#composite + (..string_format key) + ..entry_separator + (format value) + )) (def: (object_format format) (-> (-> JSON Text) (-> Object Text)) @@ -312,10 +312,10 @@ (def: value_separator_parser (Parser [Text Any Text]) - ($_ <>.and - ..space_parser - (<text>.this ..value_separator) - ..space_parser)) + (all <>.and + ..space_parser + (<text>.this ..value_separator) + ..space_parser)) (def: null_parser (Parser Null) @@ -336,9 +336,9 @@ (def: boolean_parser (Parser Boolean) - ($_ <>.either - ..true_parser - ..false_parser)) + (all <>.either + ..true_parser + ..false_parser)) (def: number_parser (Parser Number) @@ -354,8 +354,8 @@ [mark (<text>.one_of "eE") signed?' (<>.parses? (<text>.this "-")) offset (<text>.many <text>.decimal)] - (in ($_ text#composite mark (if signed?' "-" "") offset))))] - (case (f#decoded ($_ text#composite (if signed? "-" "") digits "." decimals exp)) + (in (all text#composite mark (if signed?' "-" "") offset))))] + (case (f#decoded (all text#composite (if signed? "-" "") digits "." decimals exp)) {try.#Failure message} (<>.failure message) @@ -364,21 +364,21 @@ (def: escaped_parser (Parser Text) - ($_ <>.either - (<>.after (<text>.this "\t") - (<>#in text.tab)) - (<>.after (<text>.this "\b") - (<>#in text.back_space)) - (<>.after (<text>.this "\n") - (<>#in text.new_line)) - (<>.after (<text>.this "\r") - (<>#in text.carriage_return)) - (<>.after (<text>.this "\f") - (<>#in text.form_feed)) - (<>.after (<text>.this (text#composite "\" text.double_quote)) - (<>#in text.double_quote)) - (<>.after (<text>.this "\\") - (<>#in "\")))) + (all <>.either + (<>.after (<text>.this "\t") + (<>#in text.tab)) + (<>.after (<text>.this "\b") + (<>#in text.back_space)) + (<>.after (<text>.this "\n") + (<>#in text.new_line)) + (<>.after (<text>.this "\r") + (<>#in text.carriage_return)) + (<>.after (<text>.this "\f") + (<>#in text.form_feed)) + (<>.after (<text>.this (text#composite "\" text.double_quote)) + (<>#in text.double_quote)) + (<>.after (<text>.this "\\") + (<>#in "\")))) (def: string_parser (Parser String) @@ -391,7 +391,7 @@ (do ! [escaped escaped_parser next_chars (again [])] - (in ($_ text#composite chars escaped next_chars))) + (in (all text#composite chars escaped next_chars))) (in chars)))) (def: (kv_parser json_parser) @@ -423,13 +423,13 @@ (Parser JSON) (<>.rec (function (_ json_parser) - ($_ <>.or - null_parser - boolean_parser - number_parser - string_parser - (array_parser json_parser) - (object_parser json_parser))))) + (all <>.or + null_parser + boolean_parser + number_parser + string_parser + (array_parser json_parser) + (object_parser json_parser))))) (implementation: .public codec (Codec Text JSON) diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux index 0069ebb85..5e3c57155 100644 --- a/stdlib/source/library/lux/data/format/tar.lux +++ b/stdlib/source/library/lux/data/format/tar.lux @@ -353,46 +353,46 @@ (def: small_number (-> Size Size) - (|>> ($_ n.+ ..blank_size ..null_size))) + (|>> (all n.+ ..blank_size ..null_size))) (def: big_number (-> Size Size) - (|>> ($_ n.+ ..blank_size))) + (|>> (all n.+ ..blank_size))) (def: string (-> Size Size) - (|>> ($_ n.+ ..null_size))) + (|>> (all n.+ ..null_size))) (def: header_size - ($_ n.+ - ... name - (..string ..path_size) - ... mode - (..small_number ..mode_size) - ... uid - (..small_number ..owner_id_size) - ... gid - (..small_number ..owner_id_size) - ... size - (..big_number ..content_size) - ... mtime - (..big_number ..modification_time_size) - ... chksum - (..small_number ..checksum_size) - ... linkflag - ..link_flag_size - ... linkname - (..string ..path_size) - ... magic - (..string ..magic_size) - ... uname - (..string ..name_size) - ... gname - (..string ..name_size) - ... devmajor - (..small_number ..device_size) - ... devminor - (..small_number ..device_size))) + (all n.+ + ... name + (..string ..path_size) + ... mode + (..small_number ..mode_size) + ... uid + (..small_number ..owner_id_size) + ... gid + (..small_number ..owner_id_size) + ... size + (..big_number ..content_size) + ... mtime + (..big_number ..modification_time_size) + ... chksum + (..small_number ..checksum_size) + ... linkflag + ..link_flag_size + ... linkname + (..string ..path_size) + ... magic + (..string ..magic_size) + ... uname + (..string ..name_size) + ... gname + (..string ..name_size) + ... devmajor + (..small_number ..device_size) + ... devminor + (..small_number ..device_size))) (abstract: Link_Flag Char @@ -493,25 +493,25 @@ (def: maximum_mode Mode - ($_ and - ..none - - ..execute_by_other - ..write_by_other - ..read_by_other - - ..execute_by_group - ..write_by_group - ..read_by_group - - ..execute_by_owner - ..write_by_owner - ..read_by_owner - - ..save_text - ..set_group_id_on_execution - ..set_user_id_on_execution - )) + (all and + ..none + + ..execute_by_other + ..write_by_other + ..read_by_other + + ..execute_by_group + ..write_by_group + ..read_by_group + + ..execute_by_owner + ..write_by_owner + ..read_by_owner + + ..save_text + ..set_group_id_on_execution + ..set_user_id_on_execution + )) (def: mode_parser (Parser Mode) @@ -622,22 +622,22 @@ (def: header_writer' (Writer Header) - ($_ format.and - ..path_writer - ..mode_writer - ..small_writer - ..small_writer - ..big_writer - ..big_writer - ..checksum_writer - ..link_flag_writer - ..path_writer - ..magic_writer - ..name_writer - ..name_writer - ..small_writer - ..small_writer - )) + (all format.and + ..path_writer + ..mode_writer + ..small_writer + ..small_writer + ..big_writer + ..big_writer + ..checksum_writer + ..link_flag_writer + ..path_writer + ..magic_writer + ..name_writer + ..name_writer + ..small_writer + ..small_writer + )) (def: (header_writer header) (Writer Header) @@ -661,9 +661,9 @@ (-> Link_Flag (Writer File)) (function (_ [path modification_time mode ownership content]) (let [[size content] (..from_content content) - writer ($_ format.and - ..header_writer - (format.segment (..rounded_content_size size)))] + writer (all format.and + ..header_writer + (format.segment (..rounded_content_size size)))] (writer [[#path path #mode mode #user_id (the [#user #id] ownership) diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux index 30e75d6e6..d30f2aeee 100644 --- a/stdlib/source/library/lux/data/format/xml.lux +++ b/stdlib/source/library/lux/data/format/xml.lux @@ -46,13 +46,13 @@ (def: xml_standard_escape_char^ (Parser Text) - ($_ <>.either - (<>.after (<text>.this "<") (<>#in "<")) - (<>.after (<text>.this ">") (<>#in ">")) - (<>.after (<text>.this "&") (<>#in "&")) - (<>.after (<text>.this "'") (<>#in "'")) - (<>.after (<text>.this """) (<>#in text.double_quote)) - )) + (all <>.either + (<>.after (<text>.this "<") (<>#in "<")) + (<>.after (<text>.this ">") (<>#in ">")) + (<>.after (<text>.this "&") (<>#in "&")) + (<>.after (<text>.this "'") (<>#in "'")) + (<>.after (<text>.this """) (<>#in text.double_quote)) + )) (def: xml_unicode_escape_char^ (Parser Text) @@ -78,17 +78,17 @@ (def: xml_char^ (Parser Text) - (<>.either (<text>.none_of ($_ text#composite "<>&" text.double_quote)) + (<>.either (<text>.none_of (all text#composite "<>&" text.double_quote)) xml_escape_char^)) (def: xml_identifier (Parser Text) (<text>.slice - ($_ <text>.and! - (<>.either (<text>.one_of! "_") - <text>.alpha!) - (<text>.some! (<>.either (<text>.one_of! "_.-") - <text>.alpha_num!))))) + (all <text>.and! + (<>.either (<text>.one_of! "_") + <text>.alpha!) + (<text>.some! (<>.either (<text>.one_of! "_.-") + <text>.alpha_num!))))) (def: namespaced_symbol^ (Parser Symbol) @@ -132,9 +132,9 @@ ..spaced^ (<>.after (<text>.this "/")) (<text>.enclosed ["<" ">"]))] - (<>.assertion ($_ text#composite "Close tag does not match open tag." \n - "Expected: " (symbol#encoded expected) \n - " Actual: " (symbol#encoded actual) \n) + (<>.assertion (all text#composite "Close tag does not match open tag." \n + "Expected: " (symbol#encoded expected) \n + " Actual: " (symbol#encoded actual) \n) (symbol#= expected actual)))) (def: comment^ @@ -177,24 +177,24 @@ [_ (<text>.this "<") tag (..spaced^ tag^) attrs (..spaced^ attrs^) - .let [no_children^ ($_ <>.either - (do <>.monad - [_ (<text>.this "/>")] - (in {#Node tag attrs (list)})) - (do <>.monad - [_ (<text>.this ">") - _ (<>.some (<>.either <text>.space! - ..comment^)) - _ (..close_tag^ tag)] - (in {#Node tag attrs (list)}))) + .let [no_children^ (all <>.either + (do <>.monad + [_ (<text>.this "/>")] + (in {#Node tag attrs (list)})) + (do <>.monad + [_ (<text>.this ">") + _ (<>.some (<>.either <text>.space! + ..comment^)) + _ (..close_tag^ tag)] + (in {#Node tag attrs (list)}))) with_children^ (do <>.monad [_ (<text>.this ">") children (<>.many node^) _ (..close_tag^ tag)] (in {#Node tag attrs children}))]] - ($_ <>.either - no_children^ - with_children^)) + (all <>.either + no_children^ + with_children^)) ..spaced^ (<>.before (<>.some ..comment^)) (<>.after (<>.some ..comment^)) @@ -215,7 +215,7 @@ (-> Tag Text) (case namespace "" name - _ ($_ text#composite namespace ..namespace_separator name))) + _ (all text#composite namespace ..namespace_separator name))) (def: .public attribute (-> Attribute Text) @@ -225,12 +225,12 @@ Text (let [quote (is (-> Text Text) (function (_ value) - ($_ text#composite text.double_quote value text.double_quote)))] - ($_ text#composite - "<?xml" - " version=" (quote "1.0") - " encoding=" (quote "UTF-8") - "?>"))) + (all text#composite text.double_quote value text.double_quote)))] + (all text#composite + "<?xml" + " version=" (quote "1.0") + " encoding=" (quote "UTF-8") + "?>"))) (implementation: .public codec (Codec Text XML) @@ -241,40 +241,40 @@ (|> attrs dictionary.entries (list#each (function (_ [key value]) - ($_ text#composite (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) + (all text#composite (..attribute key) "=" text.double_quote (sanitize_value value) text.double_quote))) (text.interposed " "))))] (function (_ input) - ($_ text#composite - ..xml_header text.new_line - (loop (again [prefix "" - input input]) - (case input - {#Text value} - (sanitize_value value) - - (pattern {#Node xml_tag xml_attrs (list {#Text value})}) - (let [tag (..tag xml_tag) - attrs (if (dictionary.empty? xml_attrs) - "" - ($_ text#composite " " (attributes xml_attrs)))] - ($_ text#composite - prefix "<" tag attrs ">" - (sanitize_value value) - "</" tag ">")) - - {#Node xml_tag xml_attrs xml_children} - (let [tag (..tag xml_tag) - attrs (if (dictionary.empty? xml_attrs) - "" - ($_ text#composite " " (attributes xml_attrs)))] - (if (list.empty? xml_children) - ($_ text#composite prefix "<" tag attrs "/>") - ($_ text#composite prefix "<" tag attrs ">" - (|> xml_children - (list#each (|>> (again (text#composite prefix text.tab)) (text#composite text.new_line))) - text.together) - text.new_line prefix "</" tag ">"))))) - )))) + (all text#composite + ..xml_header text.new_line + (loop (again [prefix "" + input input]) + (case input + {#Text value} + (sanitize_value value) + + (pattern {#Node xml_tag xml_attrs (list {#Text value})}) + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) + "" + (all text#composite " " (attributes xml_attrs)))] + (all text#composite + prefix "<" tag attrs ">" + (sanitize_value value) + "</" tag ">")) + + {#Node xml_tag xml_attrs xml_children} + (let [tag (..tag xml_tag) + attrs (if (dictionary.empty? xml_attrs) + "" + (all text#composite " " (attributes xml_attrs)))] + (if (list.empty? xml_children) + (all text#composite prefix "<" tag attrs "/>") + (all text#composite prefix "<" tag attrs ">" + (|> xml_children + (list#each (|>> (again (text#composite prefix text.tab)) (text#composite text.new_line))) + text.together) + text.new_line prefix "</" tag ">"))))) + )))) (def: decoded (<text>.result ..xml^))) diff --git a/stdlib/source/library/lux/data/product.lux b/stdlib/source/library/lux/data/product.lux index 6f4743a46..f516c7d97 100644 --- a/stdlib/source/library/lux/data/product.lux +++ b/stdlib/source/library/lux/data/product.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" left right} [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}]]]]) diff --git a/stdlib/source/library/lux/data/sum.lux b/stdlib/source/library/lux/data/sum.lux index c2b3d7512..5d1fe365b 100644 --- a/stdlib/source/library/lux/data/sum.lux +++ b/stdlib/source/library/lux/data/sum.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" left right} [abstract [equivalence {"+" Equivalence}] [hash {"+" Hash}]]]]) diff --git a/stdlib/source/library/lux/data/text.lux b/stdlib/source/library/lux/data/text.lux index 7f530a137..22ee37a50 100644 --- a/stdlib/source/library/lux/data/text.lux +++ b/stdlib/source/library/lux/data/text.lux @@ -122,7 +122,7 @@ (def: .public (enclosed [left right] content) (-> [Text Text] Text Text) - ($_ "lux text concat" left content right)) + (all "lux text concat" left content right)) (def: .public (enclosed' boundary content) (-> Text Text Text) @@ -182,7 +182,7 @@ (<| (maybe.else template) (do maybe.monad [[pre post] (..split_by pattern template)] - (in ($_ "lux text concat" pre replacement post))))) + (in (all "lux text concat" pre replacement post))))) (for @.js (these (macro: (defined? tokens lux) (case tokens @@ -216,7 +216,7 @@ right template]) (case (..split_by pattern right) {.#Some [pre post]} - (again ($_ "lux text concat" left pre replacement) post) + (again (all "lux text concat" left pre replacement) post) {.#None} ("lux text concat" left right)))] diff --git a/stdlib/source/library/lux/data/text/format.lux b/stdlib/source/library/lux/data/text/format.lux index ee3f8ddc5..5b719d954 100644 --- a/stdlib/source/library/lux/data/text/format.lux +++ b/stdlib/source/library/lux/data/text/format.lux @@ -49,7 +49,7 @@ (|>> f fb))) (syntax: .public (format [fragments (<>.many <code>.any)]) - (in (.list (` ($_ "lux text concat" (~+ fragments)))))) + (in (.list (` (all "lux text concat" (~+ fragments)))))) (template [<name> <type> <formatter>] [(def: .public <name> diff --git a/stdlib/source/library/lux/data/text/regex.lux b/stdlib/source/library/lux/data/text/regex.lux index c24c0093f..1b784bebe 100644 --- a/stdlib/source/library/lux/data/text/regex.lux +++ b/stdlib/source/library/lux/data/text/regex.lux @@ -3,7 +3,7 @@ [lux {"-" pattern} ["[0]" meta] [abstract - monad] + [monad {"+" do}]] [control ["[0]" maybe] ["[0]" try] @@ -71,11 +71,11 @@ (def: (symbol^ current_module) (-> Text (Parser Symbol)) - ($_ <>.either - (<>.and (<>#in current_module) (<>.after (<text>.this "..") symbol_part^)) - (<>.and symbol_part^ (<>.after (<text>.this ".") symbol_part^)) - (<>.and (<>#in .prelude_module) (<>.after (<text>.this ".") symbol_part^)) - (<>.and (<>#in "") symbol_part^))) + (all <>.either + (<>.and (<>#in current_module) (<>.after (<text>.this "..") symbol_part^)) + (<>.and symbol_part^ (<>.after (<text>.this ".") symbol_part^)) + (<>.and (<>#in .prelude_module) (<>.after (<text>.this ".") symbol_part^)) + (<>.and (<>#in "") symbol_part^))) (def: (re_var^ current_module) (-> Text (Parser Code)) @@ -107,12 +107,12 @@ (Parser Code) (do <>.monad [negate? (<>.maybe (<text>.this "^")) - parts (<>.many ($_ <>.either - re_range^ - re_options^))] + parts (<>.many (all <>.either + re_range^ + re_options^))] (in (case negate? - {.#Some _} (` ((~! <text>.not) ($_ ((~! <>.either)) (~+ parts)))) - {.#None} (` ($_ ((~! <>.either)) (~+ parts))))))) + {.#Some _} (` ((~! <text>.not) (all ((~! <>.either)) (~+ parts)))) + {.#None} (` (all ((~! <>.either)) (~+ parts))))))) (def: re_user_class^ (Parser Code) @@ -157,30 +157,30 @@ (Parser Code) (do <>.monad [] - ($_ <>.either - (<>.after (<text>.this ".") (in (` (~! <text>.any)))) - (<>.after (<text>.this "\d") (in (` (~! <text>.decimal)))) - (<>.after (<text>.this "\D") (in (` ((~! <text>.not) (~! <text>.decimal))))) - (<>.after (<text>.this "\s") (in (` (~! <text>.space)))) - (<>.after (<text>.this "\S") (in (` ((~! <text>.not) (~! <text>.space))))) - (<>.after (<text>.this "\w") (in (` (~! word^)))) - (<>.after (<text>.this "\W") (in (` ((~! <text>.not) (~! word^))))) - - (<>.after (<text>.this "\p{Lower}") (in (` (~! <text>.lower)))) - (<>.after (<text>.this "\p{Upper}") (in (` (~! <text>.upper)))) - (<>.after (<text>.this "\p{Alpha}") (in (` (~! <text>.alpha)))) - (<>.after (<text>.this "\p{Digit}") (in (` (~! <text>.decimal)))) - (<>.after (<text>.this "\p{Alnum}") (in (` (~! <text>.alpha_num)))) - (<>.after (<text>.this "\p{Space}") (in (` (~! <text>.space)))) - (<>.after (<text>.this "\p{HexDigit}") (in (` (~! <text>.hexadecimal)))) - (<>.after (<text>.this "\p{OctDigit}") (in (` (~! <text>.octal)))) - (<>.after (<text>.this "\p{Blank}") (in (` (~! blank^)))) - (<>.after (<text>.this "\p{ASCII}") (in (` (~! ascii^)))) - (<>.after (<text>.this "\p{Contrl}") (in (` (~! control^)))) - (<>.after (<text>.this "\p{Punct}") (in (` (~! punct^)))) - (<>.after (<text>.this "\p{Graph}") (in (` (~! graph^)))) - (<>.after (<text>.this "\p{Print}") (in (` (~! print^)))) - ))) + (all <>.either + (<>.after (<text>.this ".") (in (` (~! <text>.any)))) + (<>.after (<text>.this "\d") (in (` (~! <text>.decimal)))) + (<>.after (<text>.this "\D") (in (` ((~! <text>.not) (~! <text>.decimal))))) + (<>.after (<text>.this "\s") (in (` (~! <text>.space)))) + (<>.after (<text>.this "\S") (in (` ((~! <text>.not) (~! <text>.space))))) + (<>.after (<text>.this "\w") (in (` (~! word^)))) + (<>.after (<text>.this "\W") (in (` ((~! <text>.not) (~! word^))))) + + (<>.after (<text>.this "\p{Lower}") (in (` (~! <text>.lower)))) + (<>.after (<text>.this "\p{Upper}") (in (` (~! <text>.upper)))) + (<>.after (<text>.this "\p{Alpha}") (in (` (~! <text>.alpha)))) + (<>.after (<text>.this "\p{Digit}") (in (` (~! <text>.decimal)))) + (<>.after (<text>.this "\p{Alnum}") (in (` (~! <text>.alpha_num)))) + (<>.after (<text>.this "\p{Space}") (in (` (~! <text>.space)))) + (<>.after (<text>.this "\p{HexDigit}") (in (` (~! <text>.hexadecimal)))) + (<>.after (<text>.this "\p{OctDigit}") (in (` (~! <text>.octal)))) + (<>.after (<text>.this "\p{Blank}") (in (` (~! blank^)))) + (<>.after (<text>.this "\p{ASCII}") (in (` (~! ascii^)))) + (<>.after (<text>.this "\p{Contrl}") (in (` (~! control^)))) + (<>.after (<text>.this "\p{Punct}") (in (` (~! punct^)))) + (<>.after (<text>.this "\p{Graph}") (in (` (~! graph^)))) + (<>.after (<text>.this "\p{Print}") (in (` (~! print^)))) + ))) (def: re_class^ (Parser Code) @@ -206,12 +206,12 @@ (def: (re_simple^ current_module) (-> Text (Parser Code)) - ($_ <>.either - re_class^ - (re_var^ current_module) - re_back_reference^ - re_char^ - )) + (all <>.either + re_class^ + (re_var^ current_module) + re_back_reference^ + re_char^ + )) (def: (re_simple_quantified^ current_module) (-> Text (Parser Code)) @@ -241,24 +241,24 @@ (do [! <>.monad] [base (re_simple^ current_module)] (<| (<text>.enclosed ["{" "}"]) - ($_ <>.either - (do ! - [[from to] (<>.and number^ (<>.after (<text>.this ",") number^)) - _ (<>.assertion (exception.error ..incorrect_quantification [from to]) - (n.<= to from))] - (in (` ((~! together^) ((~! <>.between) - (~ (code.nat from)) - (~ (code.nat (n.- from to))) - (~ base)))))) - (do ! - [limit (<>.after (<text>.this ",") number^)] - (in (` ((~! together^) ((~! <>.at_most) (~ (code.nat limit)) (~ base)))))) - (do ! - [limit (<>.before (<text>.this ",") number^)] - (in (` ((~! together^) ((~! <>.at_least) (~ (code.nat limit)) (~ base)))))) - (do ! - [limit number^] - (in (` ((~! together^) ((~! <>.exactly) (~ (code.nat limit)) (~ base)))))))))) + (all <>.either + (do ! + [[from to] (<>.and number^ (<>.after (<text>.this ",") number^)) + _ (<>.assertion (exception.error ..incorrect_quantification [from to]) + (n.<= to from))] + (in (` ((~! together^) ((~! <>.between) + (~ (code.nat from)) + (~ (code.nat (n.- from to))) + (~ base)))))) + (do ! + [limit (<>.after (<text>.this ",") number^)] + (in (` ((~! together^) ((~! <>.at_most) (~ (code.nat limit)) (~ base)))))) + (do ! + [limit (<>.before (<text>.this ",") number^)] + (in (` ((~! together^) ((~! <>.at_least) (~ (code.nat limit)) (~ base)))))) + (do ! + [limit number^] + (in (` ((~! together^) ((~! <>.exactly) (~ (code.nat limit)) (~ base)))))))))) (def: (re_quantified^ current_module) (-> Text (Parser Code)) @@ -267,9 +267,9 @@ (def: (re_complex^ current_module) (-> Text (Parser Code)) - ($_ <>.either - (re_quantified^ current_module) - (re_simple^ current_module))) + (all <>.either + (re_quantified^ current_module) + (re_simple^ current_module))) (type: Re_Group (Variant @@ -380,35 +380,35 @@ (if (list.empty? tail) (in head) (in [(list#mix n.max (product.left head) (list#each product.left tail)) - (` ($_ ((~ (if capturing? - (` (~! |||^)) - (` (~! |||_^))))) - (~ (prep_alternative head)) - (~+ (list#each prep_alternative tail))))])))) + (` (all ((~ (if capturing? + (` (~! |||^)) + (` (~! |||_^))))) + (~ (prep_alternative head)) + (~+ (list#each prep_alternative tail))))])))) (def: (re_scoped^ current_module) (-> Text (Parser [Re_Group Code])) - ($_ <>.either - (do <>.monad - [_ (<text>.this "(?:") - [_ scoped] (re_alternative^ #0 re_scoped^ current_module) - _ (<text>.this ")")] - (in [{#Non_Capturing} scoped])) - (do <>.monad - [complex (re_complex^ current_module)] - (in [{#Non_Capturing} complex])) - (do <>.monad - [_ (<text>.this "(?<") - captured_symbol symbol_part^ - _ (<text>.this ">") - [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) - _ (<text>.this ")")] - (in [{#Capturing [{.#Some captured_symbol} num_captures]} pattern])) - (do <>.monad - [_ (<text>.this "(") - [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) - _ (<text>.this ")")] - (in [{#Capturing [{.#None} num_captures]} pattern])))) + (all <>.either + (do <>.monad + [_ (<text>.this "(?:") + [_ scoped] (re_alternative^ #0 re_scoped^ current_module) + _ (<text>.this ")")] + (in [{#Non_Capturing} scoped])) + (do <>.monad + [complex (re_complex^ current_module)] + (in [{#Non_Capturing} complex])) + (do <>.monad + [_ (<text>.this "(?<") + captured_symbol symbol_part^ + _ (<text>.this ">") + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) + _ (<text>.this ")")] + (in [{#Capturing [{.#Some captured_symbol} num_captures]} pattern])) + (do <>.monad + [_ (<text>.this "(") + [num_captures pattern] (re_alternative^ #1 re_scoped^ current_module) + _ (<text>.this ")")] + (in [{#Capturing [{.#None} num_captures]} pattern])))) (def: (regex^ current_module) (-> Text (Parser Code)) diff --git a/stdlib/source/library/lux/data/text/unicode/set.lux b/stdlib/source/library/lux/data/text/unicode/set.lux index df7afedc8..29552979a 100644 --- a/stdlib/source/library/lux/data/text/unicode/set.lux +++ b/stdlib/source/library/lux/data/text/unicode/set.lux @@ -152,11 +152,11 @@ (def: .public character Set - ($_ ..composite - ..character/0 - ..character/1 - ..character/2 - )) + (all ..composite + ..character/0 + ..character/1 + ..character/2 + )) (def: .public non_character Set @@ -195,10 +195,10 @@ (def: .public full Set - ($_ ..composite - ..character - ..non_character - )) + (all ..composite + ..character + ..non_character + )) (def: .public start (-> Set Char) diff --git a/stdlib/source/library/lux/debug.lux b/stdlib/source/library/lux/debug.lux index d5ed1cff8..e1729e2ad 100644 --- a/stdlib/source/library/lux/debug.lux +++ b/stdlib/source/library/lux/debug.lux @@ -389,58 +389,58 @@ (def: primitive_representation (Parser Representation) - (`` ($_ <>.either - (do <>.monad - [_ (<type>.exactly Any)] - (in (function.constant "[]"))) - - (~~ (template [<type> <formatter>] - [(do <>.monad - [_ (<type>.sub <type>)] - (in (|>> (as <type>) <formatter>)))] - - [Bit %.bit] - [Nat %.nat] - [Int %.int] - [Rev %.rev] - [Frac %.frac] - [Text %.text])) - ))) + (`` (all <>.either + (do <>.monad + [_ (<type>.exactly Any)] + (in (function.constant "[]"))) + + (~~ (template [<type> <formatter>] + [(do <>.monad + [_ (<type>.sub <type>)] + (in (|>> (as <type>) <formatter>)))] + + [Bit %.bit] + [Nat %.nat] + [Int %.int] + [Rev %.rev] + [Frac %.frac] + [Text %.text])) + ))) (def: (special_representation representation) (-> (Parser Representation) (Parser Representation)) - (`` ($_ <>.either - (~~ (template [<type> <formatter>] - [(do <>.monad - [_ (<type>.sub <type>)] - (in (|>> (as <type>) <formatter>)))] - - [Ratio %.ratio] - [Symbol %.symbol] - [Location %.location] - [Type %.type] - [Code %.code] - - [Instant %.instant] - [Duration %.duration] - [Date %.date] - [Time %.time] - [Month %.month] - [Day %.day] - - [json.JSON %.json] - [XML %.xml])) - - (do <>.monad - [[_ elemT] (<type>.applied (<>.and (<type>.exactly List) <type>.any)) - elemR (<type>.local (list elemT) representation)] - (in (|>> (as (List Any)) (%.list elemR)))) - - (do <>.monad - [[_ elemT] (<type>.applied (<>.and (<type>.exactly Maybe) <type>.any)) - elemR (<type>.local (list elemT) representation)] - (in (|>> (as (Maybe Any)) - (%.maybe elemR))))))) + (`` (all <>.either + (~~ (template [<type> <formatter>] + [(do <>.monad + [_ (<type>.sub <type>)] + (in (|>> (as <type>) <formatter>)))] + + [Ratio %.ratio] + [Symbol %.symbol] + [Location %.location] + [Type %.type] + [Code %.code] + + [Instant %.instant] + [Duration %.duration] + [Date %.date] + [Time %.time] + [Month %.month] + [Day %.day] + + [json.JSON %.json] + [XML %.xml])) + + (do <>.monad + [[_ elemT] (<type>.applied (<>.and (<type>.exactly List) <type>.any)) + elemR (<type>.local (list elemT) representation)] + (in (|>> (as (List Any)) (%.list elemR)))) + + (do <>.monad + [[_ elemT] (<type>.applied (<>.and (<type>.exactly Maybe) <type>.any)) + elemR (<type>.local (list elemT) representation)] + (in (|>> (as (Maybe Any)) + (%.maybe elemR))))))) (def: (variant_representation representation) (-> (Parser Representation) (Parser Representation)) @@ -491,27 +491,27 @@ (Parser Representation) (<>.rec (function (_ representation) - ($_ <>.either - ..primitive_representation - (..special_representation representation) - (..variant_representation representation) - (..tuple_representation representation) - - (do <>.monad - [[funcT inputsT+] (<type>.applied (<>.and <type>.any (<>.many <type>.any)))] - (case (type.applied inputsT+ funcT) - {.#Some outputT} - (<type>.local (list outputT) representation) - - {.#None} - (<>.failure ""))) - - (do <>.monad - [[name anonymous] <type>.named] - (<type>.local (list anonymous) representation)) - - (<>.failure "") - )))) + (all <>.either + ..primitive_representation + (..special_representation representation) + (..variant_representation representation) + (..tuple_representation representation) + + (do <>.monad + [[funcT inputsT+] (<type>.applied (<>.and <type>.any (<>.many <type>.any)))] + (case (type.applied inputsT+ funcT) + {.#Some outputT} + (<type>.local (list outputT) representation) + + {.#None} + (<>.failure ""))) + + (do <>.monad + [[name anonymous] <type>.named] + (<type>.local (list anonymous) representation)) + + (<>.failure "") + )))) (def: .public (representation type value) (-> Type Any (Try Text)) diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux index 37b462ea8..c50a1070a 100644 --- a/stdlib/source/library/lux/documentation.lux +++ b/stdlib/source/library/lux/documentation.lux @@ -506,35 +506,35 @@ tags (meta.tags_of name)] (with_expansions [<\n> (~! text.\n)] (macro.with_symbols [g!type] - (in (list (` ($_ ((~! md.then)) - ... Name - (<| ((~! md.heading/3)) - (~ (code.text (%.code (let [g!name (|> name product.right code.local)] - (case parameters - {.#End} - g!name - - _ - (` ((~ g!name) (~+ (list#each code.local parameters)))))))))) - ... Type - (let [(~ g!type) ("lux in-module" - (~ g!module) - (.type_of (~ (code.symbol name))))] - ((~! md.code) "clojure" - (~ (if (type#= .Type def_type) - (` (|> (~ (code.symbol name)) - (as .Type) - ((~! type.anonymous)) - ((~! ..type_definition) - (~ g!module) - [(~ (code.text (product.right name))) (list (~+ (list#each code.text parameters)))] - (.list (~+ (|> tags - (maybe.else (list)) - (list#each (|>> product.right code.text)))))) - ((~! %.format) - ((~! ..single_line_comment) ((~! ..type) (~ g!module) (~ g!type))) - <\n>))) - (` ((~! ..type) (~ g!module) (~ g!type)))))))) + (in (list (` (all ((~! md.then)) + ... Name + (<| ((~! md.heading/3)) + (~ (code.text (%.code (let [g!name (|> name product.right code.local)] + (case parameters + {.#End} + g!name + + _ + (` ((~ g!name) (~+ (list#each code.local parameters)))))))))) + ... Type + (let [(~ g!type) ("lux in-module" + (~ g!module) + (.type_of (~ (code.symbol name))))] + ((~! md.code) "clojure" + (~ (if (type#= .Type def_type) + (` (|> (~ (code.symbol name)) + (as .Type) + ((~! type.anonymous)) + ((~! ..type_definition) + (~ g!module) + [(~ (code.text (product.right name))) (list (~+ (list#each code.text parameters)))] + (.list (~+ (|> tags + (maybe.else (list)) + (list#each (|>> product.right code.text)))))) + ((~! %.format) + ((~! ..single_line_comment) ((~! ..type) (~ g!module) (~ g!type))) + <\n>))) + (` ((~! ..type) (~ g!module) (~ g!type)))))))) ))))))) (syntax: (definition_documentation @@ -542,30 +542,30 @@ description ..description examples (<>.some ..example)]) (with_expansions [<\n> (~! text.\n)] - (in (list (` ($_ ((~! md.then)) - ((~! ..minimal_definition_documentation) - ((~ (code.symbol name)) - (~+ (list#each code.local parameters)))) - ... Description - (~+ (case description - {.#Some description} - (list (` (<| ((~! md.paragraph)) - ((~! md.text)) - (~ description)))) - - {.#None} - (list))) - ... Examples - (~+ (case examples - {.#End} - (list) - - _ - (list (` (<| ((~! md.code) "clojure") - ((~! %.format) - (~+ (|> examples - (list#each (..example_documentation (product.left name))) - (list.interposed ..example_separator)))))))))) + (in (list (` (all ((~! md.then)) + ((~! ..minimal_definition_documentation) + ((~ (code.symbol name)) + (~+ (list#each code.local parameters)))) + ... Description + (~+ (case description + {.#Some description} + (list (` (<| ((~! md.paragraph)) + ((~! md.text)) + (~ description)))) + + {.#None} + (list))) + ... Examples + (~+ (case examples + {.#End} + (list) + + _ + (list (` (<| ((~! md.code) "clojure") + ((~! %.format) + (~+ (|> examples + (list#each (..example_documentation (product.left name))) + (list.interposed ..example_separator)))))))))) ))))) (type: .public Definition @@ -638,10 +638,10 @@ (list#each product.left) ..expected_format)))) ..#definitions ((~! list.together) (list (~+ definitions)))] - ($_ (# (~! list.monoid) (~' composite)) - (is (List Module) - (# (~! list.monoid) (~' identity))) - (~+ subs))))))))) + (all (# (~! list.monoid) (~' composite)) + (is (List Module) + (# (~! list.monoid) (~' identity))) + (~+ subs))))))))) (def: listing (-> (List Text) (Markdown Block)) @@ -654,51 +654,51 @@ (def: (module_documentation module) (-> Module (Markdown Block)) (let [(open "_[0]") module] - ($_ md.then - ... Name - (md.heading/1 (the #module module)) - ... Description - (case (the #description module) - "" md.empty - description (<| md.paragraph - md.text - description)) - ... Definitions - (md.heading/2 "Definitions") - (|> module - (the #definitions) - (list.only (|>> (the #definition) - (set.member? _#expected))) - ..definitions_documentation) - ... Missing documentation - (case (|> module - (the #definitions) - (list#mix (function (_ definition missing) - (set.lacks (the #definition definition) missing)) - _#expected) - set.list) - {.#End} - md.empty - - missing - ($_ md.then - (md.heading/2 "Missing documentation") - (..listing missing))) - ... Un-expected documentation - (case (|> module - (the #definitions) - (list.only (|>> (the #definition) - (set.member? _#expected) - not)) - (list#each (the #definition))) - {.#End} - md.empty - - un_expected - ($_ md.then - (md.heading/2 "Un-expected documentation") - (..listing un_expected))) - ))) + (all md.then + ... Name + (md.heading/1 (the #module module)) + ... Description + (case (the #description module) + "" md.empty + description (<| md.paragraph + md.text + description)) + ... Definitions + (md.heading/2 "Definitions") + (|> module + (the #definitions) + (list.only (|>> (the #definition) + (set.member? _#expected))) + ..definitions_documentation) + ... Missing documentation + (case (|> module + (the #definitions) + (list#mix (function (_ definition missing) + (set.lacks (the #definition definition) missing)) + _#expected) + set.list) + {.#End} + md.empty + + missing + (all md.then + (md.heading/2 "Missing documentation") + (..listing missing))) + ... Un-expected documentation + (case (|> module + (the #definitions) + (list.only (|>> (the #definition) + (set.member? _#expected) + not)) + (list#each (the #definition))) + {.#End} + md.empty + + un_expected + (all md.then + (md.heading/2 "Un-expected documentation") + (..listing un_expected))) + ))) (def: .public documentation (-> (List Module) Text) diff --git a/stdlib/source/library/lux/extension.lux b/stdlib/source/library/lux/extension.lux index b41d45138..bca5494f8 100644 --- a/stdlib/source/library/lux/extension.lux +++ b/stdlib/source/library/lux/extension.lux @@ -29,12 +29,12 @@ (def: (declaration default) (-> Code (Parser Declaration)) - (<c>.form ($_ <>.and - <c>.any - <c>.local - <c>.local - <c>.local - (<c>.tuple (<>.some <c>.any))))) + (<c>.form (all <>.and + <c>.any + <c>.local + <c>.local + <c>.local + (<c>.tuple (<>.some <c>.any))))) (template [<any> <end> <and> <result> <extension> <name>] [(syntax: .public (<name> [[name extension phase archive inputs] (..declaration (` <any>)) diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux index aff9bb6e9..000d80023 100644 --- a/stdlib/source/library/lux/ffi.jvm.lux +++ b/stdlib/source/library/lux/ffi.jvm.lux @@ -424,7 +424,7 @@ (do <>.monad [.let [dotted_name (format "::" field_name)] [_ _ value] (.is (Parser [Any Any Code]) - (<code>.form ($_ <>.and (<code>.this (' :=)) (<code>.this (code.symbol ["" dotted_name])) <code>.any)))] + (<code>.form (all <>.and (<code>.this (' :=)) (<code>.this (code.symbol ["" dotted_name])) <code>.any)))] (in (`' ("jvm member put virtual" (~ (code.text class_name)) (~ (code.text field_name)) @@ -535,19 +535,19 @@ (def: privacy_modifier^ (Parser Privacy) (let [(open "[0]") <>.monad] - ($_ <>.or - (<code>.this (' "public")) - (<code>.this (' "private")) - (<code>.this (' "protected")) - (in [])))) + (all <>.or + (<code>.this (' "public")) + (<code>.this (' "private")) + (<code>.this (' "protected")) + (in [])))) (def: inheritance_modifier^ (Parser Inheritance) (let [(open "[0]") <>.monad] - ($_ <>.or - (<code>.this (' "final")) - (<code>.this (' "abstract")) - (in [])))) + (all <>.or + (<code>.this (' "final")) + (<code>.this (' "abstract")) + (in [])))) (exception: .public (class_names_cannot_contain_periods [name Text]) (exception.report @@ -582,9 +582,9 @@ (do <>.monad [.let [class_name^ (..valid_class_name type_vars)] [name parameters] (.is (Parser [External (List (Type Parameter))]) - ($_ <>.either - (<>.and class_name^ (<>#in (list))) - (<code>.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))] + (all <>.either + (<>.and class_name^ (<>#in (list))) + (<code>.form (<>.and class_name^ (<>.some (parameter^ type_vars))))))] (in (jvm.class (name.safe name) parameters)))) (exception: .public (unknown_type_variable [name Text @@ -624,13 +624,13 @@ (<>.rec (function (_ _) (let [class^ (..class^' parameter^ type_vars)] - ($_ <>.either - (..type_variable type_vars) - ..wildcard^ - (upper^ class^) - (lower^ class^) - class^ - ))))) + (all <>.either + (..type_variable type_vars) + ..wildcard^ + (upper^ class^) + (lower^ class^) + class^ + ))))) (def: (itself^ type) (All (_ category) @@ -642,16 +642,16 @@ (def: primitive^ (Parser (Type Primitive)) - ($_ <>.either - (itself^ jvm.boolean) - (itself^ jvm.byte) - (itself^ jvm.short) - (itself^ jvm.int) - (itself^ jvm.long) - (itself^ jvm.float) - (itself^ jvm.double) - (itself^ jvm.char) - )) + (all <>.either + (itself^ jvm.boolean) + (itself^ jvm.byte) + (itself^ jvm.short) + (itself^ jvm.int) + (itself^ jvm.long) + (itself^ jvm.float) + (itself^ jvm.double) + (itself^ jvm.char) + )) (def: array^ (-> (Parser (Type Value)) (Parser (Type Array))) @@ -662,11 +662,11 @@ (-> (List (Type Var)) (Parser (Type Value))) (<>.rec (function (_ type^) - ($_ <>.either - ..primitive^ - (..parameter^ type_vars) - (..array^ type^) - )))) + (all <>.either + ..primitive^ + (..parameter^ type_vars) + (..array^ type^) + )))) (def: void^ (Parser (Type Void)) @@ -745,10 +745,10 @@ (def: state_modifier^ (Parser State) - ($_ <>.or - (<code>.this (' "volatile")) - (<code>.this (' "final")) - (# <>.monad in []))) + (all <>.or + (<code>.this (' "volatile")) + (<code>.this (' "final")) + (# <>.monad in []))) (def: (field_decl^ type_vars) (-> (List (Type Var)) (Parser [Member_Declaration FieldDecl])) @@ -792,10 +792,10 @@ strict_fp? (<>.parses? (<code>.this_text "strict")) method_vars (<>.else (list) ..vars^) .let [total_vars (list#composite class_vars method_vars)] - [_ self_name arguments] (<code>.form ($_ <>.and - (<code>.this (' new)) - <code>.local - (..arguments^ total_vars))) + [_ self_name arguments] (<code>.form (all <>.and + (<code>.this (' new)) + <code>.local + (..arguments^ total_vars))) constructor_args (..constructor_args^ total_vars) exs (throws_decl^ total_vars) annotations ..annotations^ @@ -813,10 +813,10 @@ final? (<>.parses? (<code>.this (' "final"))) method_vars (<>.else (list) ..vars^) .let [total_vars (list#composite class_vars method_vars)] - [name self_name arguments] (<code>.form ($_ <>.and - <code>.local - <code>.local - (..arguments^ total_vars))) + [name self_name arguments] (<code>.form (all <>.and + <code>.local + <code>.local + (..arguments^ total_vars))) return_type (..return^ total_vars) exs (throws_decl^ total_vars) annotations ..annotations^ @@ -834,10 +834,10 @@ method_vars (<>.else (list) ..vars^) .let [total_vars (list#composite (product.right (parser.declaration owner_class)) method_vars)] - [name self_name arguments] (<code>.form ($_ <>.and - <code>.local - <code>.local - (..arguments^ total_vars))) + [name self_name arguments] (<code>.form (all <>.and + <code>.local + <code>.local + (..arguments^ total_vars))) return_type (..return^ total_vars) exs (throws_decl^ total_vars) annotations ..annotations^ @@ -902,13 +902,13 @@ (def: (method_def^ class_vars) (-> (List (Type Var)) (Parser [Member_Declaration Method_Definition])) - ($_ <>.either - (..constructor_method^ class_vars) - (..virtual_method_def^ class_vars) - ..overriden_method_def^ - ..static_method_def^ - ..abstract_method_def^ - ..native_method_def^)) + (all <>.either + (..constructor_method^ class_vars) + (..virtual_method_def^ class_vars) + ..overriden_method_def^ + ..static_method_def^ + ..abstract_method_def^ + ..native_method_def^)) (def: partial_call^ (Parser Partial_Call) @@ -927,10 +927,10 @@ (def: import_member_return_flags^ (Parser [Bit Bit Bit]) - ($_ <>.and - (<>.parses? (<code>.this (' "io"))) - (<>.parses? (<code>.this (' "try"))) - (<>.parses? (<code>.this (' "?"))))) + (all <>.and + (<>.parses? (<code>.this (' "io"))) + (<>.parses? (<code>.this (' "try"))) + (<>.parses? (<code>.this (' "?"))))) (def: primitive_mode^ (Parser Primitive_Mode) @@ -939,65 +939,65 @@ (def: (import_member_decl^ owner_vars) (-> (List (Type Var)) (Parser Import_Member_Declaration)) - ($_ <>.either - (<code>.form (do <>.monad - [_ (<code>.this (' "enum")) - enum_members (<>.some <code>.local)] - (in {#EnumDecl enum_members}))) - (<code>.form (do <>.monad - [tvars (<>.else (list) ..vars^) - _ (<code>.this_symbol ["" "new"]) - ?alias import_member_alias^ - .let [total_vars (list#composite owner_vars tvars)] - ?prim_mode (<>.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^] - (in {#ConstructorDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) - #import_member_alias (maybe.else "new" ?alias) - #import_member_kind {#VirtualIMK} - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?] - []]}) - )) - (<code>.form (do <>.monad - [kind (.is (Parser ImportMethodKind) - (<>.or (<code>.this (' "static")) - (in []))) - tvars (<>.else (list) ..vars^) - name <code>.local - ?alias import_member_alias^ - .let [total_vars (list#composite owner_vars tvars)] - ?prim_mode (<>.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^ - return (..return^ total_vars)] - (in {#MethodDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) - #import_member_alias (maybe.else name ?alias) - #import_member_kind kind - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?] - [#import_method_name name - #import_method_return return]]}))) - (<code>.form (do <>.monad - [static? (<>.parses? (<code>.this (' "static"))) - name <code>.local - ?prim_mode (<>.maybe primitive_mode^) - gtype (..type^ owner_vars) - maybe? (<>.parses? (<code>.this (' "?"))) - setter? (<>.parses? (<code>.this (' #!)))] - (in {#FieldAccessDecl [#import_field_mode (maybe.else {#AutoPrM} ?prim_mode) - #import_field_name name - #import_field_static? static? - #import_field_maybe? maybe? - #import_field_setter? setter? - #import_field_type gtype]}))) - )) + (all <>.either + (<code>.form (do <>.monad + [_ (<code>.this (' "enum")) + enum_members (<>.some <code>.local)] + (in {#EnumDecl enum_members}))) + (<code>.form (do <>.monad + [tvars (<>.else (list) ..vars^) + _ (<code>.this_symbol ["" "new"]) + ?alias import_member_alias^ + .let [total_vars (list#composite owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^] + (in {#ConstructorDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) + #import_member_alias (maybe.else "new" ?alias) + #import_member_kind {#VirtualIMK} + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?] + []]}) + )) + (<code>.form (do <>.monad + [kind (.is (Parser ImportMethodKind) + (<>.or (<code>.this (' "static")) + (in []))) + tvars (<>.else (list) ..vars^) + name <code>.local + ?alias import_member_alias^ + .let [total_vars (list#composite owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^ + return (..return^ total_vars)] + (in {#MethodDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) + #import_member_alias (maybe.else name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?] + [#import_method_name name + #import_method_return return]]}))) + (<code>.form (do <>.monad + [static? (<>.parses? (<code>.this (' "static"))) + name <code>.local + ?prim_mode (<>.maybe primitive_mode^) + gtype (..type^ owner_vars) + maybe? (<>.parses? (<code>.this (' "?"))) + setter? (<>.parses? (<code>.this (' #!)))] + (in {#FieldAccessDecl [#import_field_mode (maybe.else {#AutoPrM} ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype]}))) + )) (def: (privacy_modifier$ pm) (-> Privacy Code) diff --git a/stdlib/source/library/lux/ffi.lux b/stdlib/source/library/lux/ffi.lux index 1888db385..fcd23b157 100644 --- a/stdlib/source/library/lux/ffi.lux +++ b/stdlib/source/library/lux/ffi.lux @@ -119,10 +119,10 @@ (template [<case> <name>] [(def: <case> (All (_ a) (-> (Parser a) (Parser (Named a)))) - (|>> ($_ <>.and - <name> - ..alias - )))] + (|>> (all <>.and + <name> + ..alias + )))] [named <code>.local] [anonymous (<>#in "")] @@ -160,11 +160,11 @@ (def: input (Parser Input) - ($_ <>.and - (<>#in (list)) - (<code>.tuple (<>.some ..optional)) - (<>.parses? (<code>.this_text "io")) - (<>.parses? (<code>.this_text "try")))) + (all <>.and + (<>#in (list)) + (<code>.tuple (<>.some ..optional)) + (<>.parses? (<code>.this_text "io")) + (<>.parses? (<code>.this_text "try")))) (type: Constructor (Named Input)) @@ -215,10 +215,10 @@ (Parser (Named Procedure)) (<| (..generalized (has [#anonymous #input #variables])) ..named - ($_ <>.and - ..input - ..optional - ))) + (all <>.and + ..input + ..optional + ))) (type: Method (Member (Named Procedure))) @@ -239,13 +239,13 @@ (`` (`` (def: sub (Parser Sub) - ($_ <>.or - (~~ (for @.lua (~~ (these)) - @.ruby (~~ (these)) - ..constructor)) - ..field - ..method - )))) + (all <>.or + (~~ (for @.lua (~~ (these)) + @.ruby (~~ (these)) + ..constructor)) + ..field + ..method + )))) (def: parameters (-> (List Optional) (List Optional)) @@ -319,14 +319,14 @@ (def: class (Parser Class) - ($_ <>.and - (<>.either (<>.and <code>.local - (<>#in (list))) - (<code>.form (<>.and <code>.local - (<>.some <code>.local)))) - ..alias - <code>.text - (<>.some ..sub))) + (all <>.and + (<>.either (<>.and <code>.local + (<>#in (list))) + (<code>.form (<>.and <code>.local + (<>.some <code>.local)))) + ..alias + <code>.text + (<>.some ..sub))) (type: Import (Variant @@ -336,10 +336,10 @@ (def: import (Parser Import) - ($_ <>.or - ..class - (<code>.form ..procedure) - (<code>.form (..named ..output)))) + (all <>.or + ..class + (<code>.form ..procedure) + (<code>.form (..named ..output)))) (def: (input_type input :it:) (-> Input Code Code) @@ -603,9 +603,9 @@ (for @.ruby (these) (syntax: .public (function [[self inputs] (<code>.form - ($_ <>.and - <code>.local - (<code>.tuple (<>.some (<>.and <code>.any <code>.any))))) + (all <>.and + <code>.local + (<code>.tuple (<>.some (<>.and <code>.any <code>.any))))) type <code>.any term <code>.any]) (in (list (` (.<| (.as ..Function) diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux index 1758cb5bc..e79861b38 100644 --- a/stdlib/source/library/lux/ffi.old.lux +++ b/stdlib/source/library/lux/ffi.old.lux @@ -458,7 +458,7 @@ (do <>.monad [.let [dotted_name (format "::" field_name)] [_ _ value] (.is (Parser [Any Any Code]) - (<code>.form ($_ <>.and (<code>.this (' :=)) (<code>.this (code.symbol ["" dotted_name])) <code>.any)))] + (<code>.form (all <>.and (<code>.this (' :=)) (<code>.this (code.symbol ["" dotted_name])) <code>.any)))] (in (`' ((~ (code.text (format "jvm putfield" ":" class_name ":" field_name))) _jvm_this (~ value)))))) (def: (pre_walk_replace f input) @@ -554,19 +554,19 @@ (def: privacy_modifier^ (Parser Privacy) (let [(open "[0]") <>.monad] - ($_ <>.or - (<code>.this (' "public")) - (<code>.this (' "private")) - (<code>.this (' "protected")) - (in [])))) + (all <>.or + (<code>.this (' "public")) + (<code>.this (' "private")) + (<code>.this (' "protected")) + (in [])))) (def: inheritance_modifier^ (Parser Inheritance) (let [(open "[0]") <>.monad] - ($_ <>.or - (<code>.this (' "final")) - (<code>.this (' "abstract")) - (in [])))) + (all <>.or + (<code>.this (' "final")) + (<code>.this (' "abstract")) + (in [])))) (def: bound_kind^ (Parser BoundKind) @@ -582,46 +582,46 @@ (-> (List Type_Parameter) (Parser GenericType)) (<>.rec (function (_ again^) - ($_ <>.either - (do <>.monad - [_ (<code>.this (' ?))] - (in {#GenericWildcard {.#None}})) - (<code>.tuple (do <>.monad - [_ (<code>.this (' ?)) - bound_kind bound_kind^ - bound again^] - (in {#GenericWildcard {.#Some [bound_kind bound]}}))) - (do <>.monad - [name <code>.local - _ (no_periods_assertion name)] - (if (list.member? text.equivalence (list#each product.left type_vars) name) - (in {#GenericTypeVar name}) - (in {#GenericClass name (list)}))) - (<code>.tuple (do <>.monad - [component again^] - (case component - (^.template [<class> <name>] - [{#GenericClass <name> {.#End}} - (in {#GenericClass <class> (list)})]) - (["[Z" "boolean"] - ["[B" "byte"] - ["[S" "short"] - ["[I" "int"] - ["[J" "long"] - ["[F" "float"] - ["[D" "double"] - ["[C" "char"]) - - _ - (in {#GenericArray component})))) - (<code>.form (do <>.monad - [name <code>.local - _ (no_periods_assertion name) - params (<>.some again^) - _ (<>.assertion (format name " cannot be a type-parameter!") - (not (list.member? text.equivalence (list#each product.left type_vars) name)))] - (in {#GenericClass name params}))) - )))) + (all <>.either + (do <>.monad + [_ (<code>.this (' ?))] + (in {#GenericWildcard {.#None}})) + (<code>.tuple (do <>.monad + [_ (<code>.this (' ?)) + bound_kind bound_kind^ + bound again^] + (in {#GenericWildcard {.#Some [bound_kind bound]}}))) + (do <>.monad + [name <code>.local + _ (no_periods_assertion name)] + (if (list.member? text.equivalence (list#each product.left type_vars) name) + (in {#GenericTypeVar name}) + (in {#GenericClass name (list)}))) + (<code>.tuple (do <>.monad + [component again^] + (case component + (^.template [<class> <name>] + [{#GenericClass <name> {.#End}} + (in {#GenericClass <class> (list)})]) + (["[Z" "boolean"] + ["[B" "byte"] + ["[S" "short"] + ["[I" "int"] + ["[J" "long"] + ["[F" "float"] + ["[D" "double"] + ["[C" "char"]) + + _ + (in {#GenericArray component})))) + (<code>.form (do <>.monad + [name <code>.local + _ (no_periods_assertion name) + params (<>.some again^) + _ (<>.assertion (format name " cannot be a type-parameter!") + (not (list.member? text.equivalence (list#each product.left type_vars) name)))] + (in {#GenericClass name params}))) + )))) (def: type_param^ (Parser Type_Parameter) @@ -718,10 +718,10 @@ (def: state_modifier^ (Parser State) - ($_ <>.or - (<code>.this (' "volatile")) - (<code>.this (' "final")) - (# <>.monad in []))) + (all <>.or + (<code>.this (' "volatile")) + (<code>.this (' "final")) + (# <>.monad in []))) (def: (field_decl^ type_vars) (-> (List Type_Parameter) (Parser [Member_Declaration FieldDecl])) @@ -783,10 +783,10 @@ final? (<>.parses? (<code>.this (' "final"))) method_vars ..type_params^ .let [total_vars (list#composite class_vars method_vars)] - [name this_name arg_decls] (<code>.form ($_ <>.and - <code>.local - <code>.local - (..arg_decls^ total_vars))) + [name this_name arg_decls] (<code>.form (all <>.and + <code>.local + <code>.local + (..arg_decls^ total_vars))) return_type (..generic_type^ total_vars) exs (..throws_decl^ total_vars) annotations ..annotations^ @@ -806,10 +806,10 @@ owner_class ..class_decl^ method_vars ..type_params^ .let [total_vars (list#composite (product.right owner_class) method_vars)] - [name this_name arg_decls] (<code>.form ($_ <>.and - <code>.local - <code>.local - (..arg_decls^ total_vars))) + [name this_name arg_decls] (<code>.form (all <>.and + <code>.local + <code>.local + (..arg_decls^ total_vars))) return_type (..generic_type^ total_vars) exs (..throws_decl^ total_vars) annotations ..annotations^ @@ -877,13 +877,13 @@ (def: (method_def^ class_vars) (-> (List Type_Parameter) (Parser [Member_Declaration Method_Definition])) - ($_ <>.either - (..constructor_method^ class_vars) - (..virtual_method_def^ class_vars) - ..overriden_method_def^ - ..static_method_def^ - ..abstract_method_def^ - ..native_method_def^)) + (all <>.either + (..constructor_method^ class_vars) + (..virtual_method_def^ class_vars) + ..overriden_method_def^ + ..static_method_def^ + ..abstract_method_def^ + ..native_method_def^)) (def: partial_call^ (Parser Partial_Call) @@ -901,7 +901,7 @@ (def: import_member_return_flags^ (Parser [Bit Bit Bit]) - ($_ <>.and (<>.parses? (<code>.this (' "io"))) (<>.parses? (<code>.this (' "try"))) (<>.parses? (<code>.this (' "?"))))) + (all <>.and (<>.parses? (<code>.this (' "io"))) (<>.parses? (<code>.this (' "try"))) (<>.parses? (<code>.this (' "?"))))) (def: primitive_mode^ (Parser Primitive_Mode) @@ -910,64 +910,64 @@ (def: (import_member_decl^ owner_vars) (-> (List Type_Parameter) (Parser Import_Member_Declaration)) - ($_ <>.either - (<code>.form (do <>.monad - [_ (<code>.this (' "enum")) - enum_members (<>.some <code>.local)] - (in {#EnumDecl enum_members}))) - (<code>.form (do <>.monad - [tvars ..type_params^ - _ (<code>.this (' new)) - ?alias import_member_alias^ - .let [total_vars (list#composite owner_vars tvars)] - ?prim_mode (<>.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^] - (in {#ConstructorDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) - #import_member_alias (maybe.else "new" ?alias) - #import_member_kind {#VirtualIMK} - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?] - []]}))) - (<code>.form (do <>.monad - [kind (.is (Parser ImportMethodKind) - (<>.or (<code>.this (' "static")) - (in []))) - tvars ..type_params^ - name <code>.local - ?alias import_member_alias^ - .let [total_vars (list#composite owner_vars tvars)] - ?prim_mode (<>.maybe primitive_mode^) - args (..import_member_args^ total_vars) - [io? try? maybe?] import_member_return_flags^ - return (..generic_type^ total_vars)] - (in {#MethodDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) - #import_member_alias (maybe.else name ?alias) - #import_member_kind kind - #import_member_tvars tvars - #import_member_args args - #import_member_maybe? maybe? - #import_member_try? try? - #import_member_io? io?] - [#import_method_name name - #import_method_return return]]}))) - (<code>.form (do <>.monad - [static? (<>.parses? (<code>.this (' "static"))) - name <code>.local - ?prim_mode (<>.maybe primitive_mode^) - gtype (..generic_type^ owner_vars) - maybe? (<>.parses? (<code>.this (' "?"))) - setter? (<>.parses? (<code>.this (' "!")))] - (in {#FieldAccessDecl [#import_field_mode (maybe.else {#AutoPrM} ?prim_mode) - #import_field_name name - #import_field_static? static? - #import_field_maybe? maybe? - #import_field_setter? setter? - #import_field_type gtype]}))) - )) + (all <>.either + (<code>.form (do <>.monad + [_ (<code>.this (' "enum")) + enum_members (<>.some <code>.local)] + (in {#EnumDecl enum_members}))) + (<code>.form (do <>.monad + [tvars ..type_params^ + _ (<code>.this (' new)) + ?alias import_member_alias^ + .let [total_vars (list#composite owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^] + (in {#ConstructorDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) + #import_member_alias (maybe.else "new" ?alias) + #import_member_kind {#VirtualIMK} + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?] + []]}))) + (<code>.form (do <>.monad + [kind (.is (Parser ImportMethodKind) + (<>.or (<code>.this (' "static")) + (in []))) + tvars ..type_params^ + name <code>.local + ?alias import_member_alias^ + .let [total_vars (list#composite owner_vars tvars)] + ?prim_mode (<>.maybe primitive_mode^) + args (..import_member_args^ total_vars) + [io? try? maybe?] import_member_return_flags^ + return (..generic_type^ total_vars)] + (in {#MethodDecl [[#import_member_mode (maybe.else {#AutoPrM} ?prim_mode) + #import_member_alias (maybe.else name ?alias) + #import_member_kind kind + #import_member_tvars tvars + #import_member_args args + #import_member_maybe? maybe? + #import_member_try? try? + #import_member_io? io?] + [#import_method_name name + #import_method_return return]]}))) + (<code>.form (do <>.monad + [static? (<>.parses? (<code>.this (' "static"))) + name <code>.local + ?prim_mode (<>.maybe primitive_mode^) + gtype (..generic_type^ owner_vars) + maybe? (<>.parses? (<code>.this (' "?"))) + setter? (<>.parses? (<code>.this (' "!")))] + (in {#FieldAccessDecl [#import_field_mode (maybe.else {#AutoPrM} ?prim_mode) + #import_field_name name + #import_field_static? static? + #import_field_maybe? maybe? + #import_field_setter? setter? + #import_field_type gtype]}))) + )) ... Generators (def: with_parens diff --git a/stdlib/source/library/lux/ffi.php.lux b/stdlib/source/library/lux/ffi.php.lux index 840fb30de..bd2176adb 100644 --- a/stdlib/source/library/lux/ffi.php.lux +++ b/stdlib/source/library/lux/ffi.php.lux @@ -71,19 +71,19 @@ (def: field (Parser Field) - (<code>.form ($_ <>.and - (<>.parses? ..static!) - <code>.local - (<>.maybe ..alias) - ..nullable))) + (<code>.form (all <>.and + (<>.parses? ..static!) + <code>.local + (<>.maybe ..alias) + ..nullable))) (def: constant (Parser Field) - (<code>.form ($_ <>.and - (<>#in true) - <code>.local - (<>.maybe ..alias) - ..nullable))) + (<code>.form (all <>.and + (<>#in true) + <code>.local + (<>.maybe ..alias) + ..nullable))) (type: Common_Method (Record @@ -104,13 +104,13 @@ (def: common_method (Parser Common_Method) - ($_ <>.and - <code>.local - (<>.maybe ..alias) - (<code>.tuple (<>.some ..nullable)) - (<>.parses? (<code>.this (' "io"))) - (<>.parses? (<code>.this (' "try"))) - ..nullable)) + (all <>.and + <code>.local + (<>.maybe ..alias) + (<code>.tuple (<>.some ..nullable)) + (<>.parses? (<code>.this (' "io"))) + (<>.parses? (<code>.this (' "try"))) + ..nullable)) (def: static_method (<>.after ..static! ..common_method)) @@ -127,10 +127,10 @@ (def: member (Parser Member) - ($_ <>.or - ..field - ..method - )) + (all <>.or + ..field + ..method + )) (def: input_variables (-> (List Nullable) (List [Bit Code])) @@ -175,16 +175,16 @@ (def: import (Parser Import) - ($_ <>.or - ($_ <>.and - <code>.local - (<>.maybe ..alias) - (<>.else ["" (list)] - (<code>.tuple (<>.and <code>.text - (<>.some member))))) - (<code>.form ..common_method) - ..constant - )) + (all <>.or + (all <>.and + <code>.local + (<>.maybe ..alias) + (<>.else ["" (list)] + (<code>.tuple (<>.and <code>.text + (<>.some member))))) + (<code>.form ..common_method) + ..constant + )) (syntax: .public (try [expression <code>.any]) ... {.#doc (example (case (try (risky_computation input)) diff --git a/stdlib/source/library/lux/ffi.scm.lux b/stdlib/source/library/lux/ffi.scm.lux index 7b338dfd4..79b042679 100644 --- a/stdlib/source/library/lux/ffi.scm.lux +++ b/stdlib/source/library/lux/ffi.scm.lux @@ -71,19 +71,19 @@ (def: field (Parser Field) - (<code>.form ($_ <>.and - (<>.parses? ..static!) - <code>.local - (<>.maybe ..alias) - ..nilable))) + (<code>.form (all <>.and + (<>.parses? ..static!) + <code>.local + (<>.maybe ..alias) + ..nilable))) (def: constant (Parser Field) - (<code>.form ($_ <>.and - (<>#in true) - <code>.local - (<>.maybe ..alias) - ..nilable))) + (<code>.form (all <>.and + (<>#in true) + <code>.local + (<>.maybe ..alias) + ..nilable))) (type: Common_Method (Record @@ -96,13 +96,13 @@ (def: common_method (Parser Common_Method) - ($_ <>.and - <code>.local - (<>.maybe ..alias) - (<code>.tuple (<>.some ..nilable)) - (<>.parses? (<code>.this (' "io"))) - (<>.parses? (<code>.this (' "try"))) - ..nilable)) + (all <>.and + <code>.local + (<>.maybe ..alias) + (<code>.tuple (<>.some ..nilable)) + (<>.parses? (<code>.this (' "io"))) + (<>.parses? (<code>.this (' "try"))) + ..nilable)) (def: input_variables (-> (List Nilable) (List [Bit Code])) @@ -146,10 +146,10 @@ (def: import (Parser Import) - ($_ <>.or - (<code>.form ..common_method) - ..constant - )) + (all <>.or + (<code>.form ..common_method) + ..constant + )) (syntax: .public (try [expression <code>.any]) ... {.#doc (example (case (try (risky_computation input)) diff --git a/stdlib/source/library/lux/ffi/export.js.lux b/stdlib/source/library/lux/ffi/export.js.lux index ffe1daa6a..e889ad68f 100644 --- a/stdlib/source/library/lux/ffi/export.js.lux +++ b/stdlib/source/library/lux/ffi/export.js.lux @@ -42,9 +42,9 @@ (<code>.result (<| <code>.form (<>.after (<code>.this_text "lux def")) (<>.before <code>.any) - ($_ <>.and - <code>.local - <code>.any))) + (all <>.and + <code>.local + <code>.any))) meta.lifted)) (with_expansions [<extension> (static.random (|>> %.nat (%.format "lua export ") code.text) @@ -77,9 +77,9 @@ definition (/.define (/.var name) term) export (/.when (/.not (/.= (/.string "undefined") (/.type_of $module))) (/.set (/.the name $exports) (/.var name))) - code ($_ /.then - definition - export)] + code (all /.then + definition + export)] _ (generation.execute! definition) _ (generation.save! @self {.#None} code)] (generation.log! (%.format "Export " (%.text name)))))] diff --git a/stdlib/source/library/lux/ffi/export.jvm.lux b/stdlib/source/library/lux/ffi/export.jvm.lux index fa1631922..ec79f469f 100644 --- a/stdlib/source/library/lux/ffi/export.jvm.lux +++ b/stdlib/source/library/lux/ffi/export.jvm.lux @@ -21,11 +21,11 @@ (def: (api of) (All (_ of) (-> (Parser of) (Parser (API of)))) (<code>.form - ($_ <>.and - of - <code>.any - <code>.any - ))) + (all <>.and + of + <code>.any + <code>.any + ))) (type: Constant Text) @@ -43,14 +43,14 @@ (def: function (Parser Function) (<code>.form - ($_ <>.and - (<>.else (list) (<code>.tuple (<>.some <code>.local))) - <code>.local - (<code>.tuple (<>.some ($_ <>.and - <code>.local - <code>.any - ))) - ))) + (all <>.and + (<>.else (list) (<code>.tuple (<>.some <code>.local))) + <code>.local + (<code>.tuple (<>.some (all <>.and + <code>.local + <code>.any + ))) + ))) (type: Export (Variant @@ -59,10 +59,10 @@ (def: export (Parser Export) - ($_ <>.or - (..api ..constant) - (..api ..function) - )) + (all <>.or + (..api ..constant) + (..api ..function) + )) (syntax: .public (export: [api <code>.local exports (<>.many ..export)]) diff --git a/stdlib/source/library/lux/ffi/export.lua.lux b/stdlib/source/library/lux/ffi/export.lua.lux index 33601347b..86365d524 100644 --- a/stdlib/source/library/lux/ffi/export.lua.lux +++ b/stdlib/source/library/lux/ffi/export.lua.lux @@ -42,9 +42,9 @@ (<code>.result (<| <code>.form (<>.after (<code>.this_text "lux def")) (<>.before <code>.any) - ($_ <>.and - <code>.local - <code>.any))) + (all <>.and + <code>.local + <code>.any))) meta.lifted)) ... [15.2 – Privacy](https://www.lua.org/pil/15.2.html) @@ -87,17 +87,17 @@ (list)) (/.var name)) export! (/.when exporting? - ($_ /.then - (/.when no_exports? - initialize_exports!) - export_definition! - ))] - _ (generation.execute! ($_ /.then - (/.set (list (/.var name)) term) - export!)) - _ (generation.save! @self {.#None} ($_ /.then - (/.local/1 (/.var name) term) - export!))] + (all /.then + (/.when no_exports? + initialize_exports!) + export_definition! + ))] + _ (generation.execute! (all /.then + (/.set (list (/.var name)) term) + export!)) + _ (generation.save! @self {.#None} (all /.then + (/.local/1 (/.var name) term) + export!))] (generation.log! (%.format "Export " (%.text name)))))] (in directive.no_requirements))) diff --git a/stdlib/source/library/lux/ffi/export.py.lux b/stdlib/source/library/lux/ffi/export.py.lux index febcdaf89..08ef62188 100644 --- a/stdlib/source/library/lux/ffi/export.py.lux +++ b/stdlib/source/library/lux/ffi/export.py.lux @@ -42,9 +42,9 @@ (<code>.result (<| <code>.form (<>.after (<code>.this_text "lux def")) (<>.before <code>.any) - ($_ <>.and - <code>.local - <code>.any))) + (all <>.and + <code>.local + <code>.any))) meta.lifted)) (with_expansions [<extension> (static.random (|>> %.nat (%.format "python export ") code.text) diff --git a/stdlib/source/library/lux/ffi/export.rb.lux b/stdlib/source/library/lux/ffi/export.rb.lux index 59fba650f..017f40093 100644 --- a/stdlib/source/library/lux/ffi/export.rb.lux +++ b/stdlib/source/library/lux/ffi/export.rb.lux @@ -44,12 +44,12 @@ (def: sigil! (<text>.one_of! "_")) (def: tail! - ($_ <>.either - ..upper! - ..lower! - ..decimal! - ..sigil! - )) + (all <>.either + ..upper! + ..lower! + ..decimal! + ..sigil! + )) (template [<name> <head>] [(def: <name> @@ -80,9 +80,9 @@ (<code>.result (<| <code>.form (<>.after (<code>.this_text "lux def")) (<>.before <code>.any) - ($_ <>.and - (<text>.then ..name <code>.local) - <code>.any))) + (all <>.and + (<text>.then ..name <code>.local) + <code>.any))) meta.lifted)) (with_expansions [<extension> (static.random (|>> %.nat (%.format "ruby export ") code.text) diff --git a/stdlib/source/library/lux/ffi/node_js.js.lux b/stdlib/source/library/lux/ffi/node_js.js.lux index 08e649fa9..dd83109f1 100644 --- a/stdlib/source/library/lux/ffi/node_js.js.lux +++ b/stdlib/source/library/lux/ffi/node_js.js.lux @@ -19,7 +19,7 @@ (def: .public (require module) (-> Text (Maybe Any)) (maybe#each (function.on module) - ($_ maybe#composite - ..normal_require - ..global_require - ..process_load))) + (all maybe#composite + ..normal_require + ..global_require + ..process_load))) diff --git a/stdlib/source/library/lux/macro.lux b/stdlib/source/library/lux/macro.lux index d8e677ba6..f4b582ef6 100644 --- a/stdlib/source/library/lux/macro.lux +++ b/stdlib/source/library/lux/macro.lux @@ -97,7 +97,7 @@ [id //.seed] (in (|> id (# nat.decimal encoded) - ($_ text#composite "__gensym__" prefix) + (all text#composite "__gensym__" prefix) [""] code.symbol)))) (def: (local ast) @@ -161,7 +161,7 @@ (do //.monad [location //.location output (<func> token) - .let [_ ("lux io log" ($_ text#composite (symbol#encoded macro_name) " " (location.format location))) + .let [_ ("lux io log" (all text#composite (symbol#encoded macro_name) " " (location.format location))) _ (list#each (|>> code.format "lux io log") output) _ ("lux io log" "")]] diff --git a/stdlib/source/library/lux/macro/code.lux b/stdlib/source/library/lux/macro/code.lux index 4df6d86e0..e86024d13 100644 --- a/stdlib/source/library/lux/macro/code.lux +++ b/stdlib/source/library/lux/macro/code.lux @@ -104,16 +104,16 @@ (^.template [<tag> <open> <close>] [[_ {<tag> members}] - ($_ text#composite - <open> - (list#mix (function (_ next prev) - (let [next (format next)] - (if (text#= "" prev) - next - ($_ text#composite prev " " next)))) - "" - members) - <close>)]) + (all text#composite + <open> + (list#mix (function (_ next prev) + (let [next (format next)] + (if (text#= "" prev) + next + (all text#composite prev " " next)))) + "" + members) + <close>)]) ([.#Form "(" ")"] [.#Variant "{" "}"] [.#Tuple "[" "]"]) diff --git a/stdlib/source/library/lux/macro/syntax.lux b/stdlib/source/library/lux/macro/syntax.lux index 8a3783149..9a2e566f0 100644 --- a/stdlib/source/library/lux/macro/syntax.lux +++ b/stdlib/source/library/lux/macro/syntax.lux @@ -33,9 +33,9 @@ {try.#Success [tokens output]} {try.#Failure error} - {try.#Failure ($_ text#composite - "Failed to parse: " (code.format binding) text.new_line - error)}))) + {try.#Failure (all text#composite + "Failed to parse: " (code.format binding) text.new_line + error)}))) (def: (un_paired pairs) (All (_ a) (-> (List [a a]) (List a))) @@ -46,11 +46,11 @@ (def: syntax (Parser [Code [Text (List Code)] Code]) (/export.parser - ($_ <>.and - (</>.form ($_ <>.and - </>.local - (</>.tuple (<>.some </>.any)))) - </>.any))) + (all <>.and + (</>.form (all <>.and + </>.local + (</>.tuple (<>.some </>.any)))) + </>.any))) (macro: .public (syntax: tokens) (case (</>.result ..syntax tokens) diff --git a/stdlib/source/library/lux/macro/syntax/check.lux b/stdlib/source/library/lux/macro/syntax/check.lux index da0ad9ca1..da68a8f25 100644 --- a/stdlib/source/library/lux/macro/syntax/check.lux +++ b/stdlib/source/library/lux/macro/syntax/check.lux @@ -24,10 +24,10 @@ (def: .public equivalence (Equivalence Check) - ($_ product.equivalence - code.equivalence - code.equivalence - )) + (all product.equivalence + code.equivalence + code.equivalence + )) (def: .public (format (open "_[0]")) (-> Check Code) diff --git a/stdlib/source/library/lux/macro/syntax/declaration.lux b/stdlib/source/library/lux/macro/syntax/declaration.lux index f6c92855e..be174fdd5 100644 --- a/stdlib/source/library/lux/macro/syntax/declaration.lux +++ b/stdlib/source/library/lux/macro/syntax/declaration.lux @@ -21,10 +21,10 @@ (def: .public equivalence (Equivalence Declaration) - ($_ product.equivalence - text.equivalence - (list.equivalence text.equivalence) - )) + (all product.equivalence + text.equivalence + (list.equivalence text.equivalence) + )) (def: .public parser (Parser Declaration) diff --git a/stdlib/source/library/lux/macro/syntax/definition.lux b/stdlib/source/library/lux/macro/syntax/definition.lux index af8e3baf0..47b419339 100644 --- a/stdlib/source/library/lux/macro/syntax/definition.lux +++ b/stdlib/source/library/lux/macro/syntax/definition.lux @@ -32,14 +32,14 @@ (def: .public equivalence (Equivalence Definition) - ($_ product.equivalence - text.equivalence - ($_ sum.equivalence - //check.equivalence - code.equivalence - ) - bit.equivalence - )) + (all product.equivalence + text.equivalence + (all sum.equivalence + //check.equivalence + code.equivalence + ) + bit.equivalence + )) (def: extension "lux def") @@ -73,12 +73,12 @@ (<| (<code>.locally me_raw) <code>.form (<>.after (<code>.this_text ..extension)) - ($_ <>.and - <code>.local - (<>.or //check.parser - <code>.any) - <code>.bit - )))) + (all <>.and + <code>.local + (<>.or //check.parser + <code>.any) + <code>.bit + )))) (exception: .public (lacks_type [definition Definition]) (exception.report diff --git a/stdlib/source/library/lux/macro/syntax/input.lux b/stdlib/source/library/lux/macro/syntax/input.lux index 6d7d8c357..9e66ad43e 100644 --- a/stdlib/source/library/lux/macro/syntax/input.lux +++ b/stdlib/source/library/lux/macro/syntax/input.lux @@ -20,10 +20,10 @@ (def: .public equivalence (Equivalence Input) - ($_ product.equivalence - code.equivalence - code.equivalence - )) + (all product.equivalence + code.equivalence + code.equivalence + )) (def: .public format (-> (List Input) Code) @@ -37,7 +37,7 @@ (Parser (List Input)) (<| <code>.tuple <>.some - ($_ <>.and - <code>.any - <code>.any - ))) + (all <>.and + <code>.any + <code>.any + ))) diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux index 090a25ac4..e866798bb 100644 --- a/stdlib/source/library/lux/macro/template.lux +++ b/stdlib/source/library/lux/macro/template.lux @@ -59,18 +59,18 @@ (def: (snippet module_side?) (-> Bit (Parser Text)) (.let [full_symbol (..symbol_side module_side? <code>.symbol)] - ($_ <>.either - <code>.text - (if module_side? - full_symbol - (<>.either <code>.local - full_symbol)) - (<>#each bit#encoded <code>.bit) - (<>#each nat#encoded <code>.nat) - (<>#each int#encoded <code>.int) - (<>#each rev#encoded <code>.rev) - (<>#each frac#encoded <code>.frac) - ))) + (all <>.either + <code>.text + (if module_side? + full_symbol + (<>.either <code>.local + full_symbol)) + (<>#each bit#encoded <code>.bit) + (<>#each nat#encoded <code>.nat) + (<>#each int#encoded <code>.int) + (<>#each rev#encoded <code>.rev) + (<>#each frac#encoded <code>.frac) + ))) (def: (part module_side?) (-> Bit (Parser (List Text))) diff --git a/stdlib/source/library/lux/math/infix.lux b/stdlib/source/library/lux/math/infix.lux index b5b44fc24..c7dd7efa5 100644 --- a/stdlib/source/library/lux/math/infix.lux +++ b/stdlib/source/library/lux/math/infix.lux @@ -1,22 +1,22 @@ (.using - [library - [lux "*" - [abstract - [monad {"+" do}]] - [control - ["<>" parser ("[1]#[0]" functor) - ["<[0]>" code {"+" Parser}]]] - [data - ["[0]" product] - [collection - ["[0]" list ("[1]#[0]" mix)]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code]] - [math - [number - ["n" nat] - ["i" int]]]]]) + [library + [lux "*" + [abstract + [monad {"+" do}]] + [control + ["<>" parser ("[1]#[0]" functor) + ["<[0]>" code {"+" Parser}]]] + [data + ["[0]" product] + [collection + ["[0]" list ("[1]#[0]" mix)]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]] + [math + [number + ["n" nat] + ["i" int]]]]]) (type: Infix (Rec Infix @@ -28,32 +28,32 @@ (def: literal (Parser Code) - ($_ <>.either - (<>#each code.bit <code>.bit) - (<>#each code.nat <code>.nat) - (<>#each code.int <code>.int) - (<>#each code.rev <code>.rev) - (<>#each code.frac <code>.frac) - (<>#each code.text <code>.text) - (<>#each code.symbol <code>.symbol))) + (all <>.either + (<>#each code.bit <code>.bit) + (<>#each code.nat <code>.nat) + (<>#each code.int <code>.int) + (<>#each code.rev <code>.rev) + (<>#each code.frac <code>.frac) + (<>#each code.text <code>.text) + (<>#each code.symbol <code>.symbol))) (def: expression (Parser Infix) (<| <>.rec (function (_ expression)) - ($_ <>.or - ..literal - (<code>.form (<>.many <code>.any)) - (<code>.tuple (<>.and <code>.any expression)) - (<code>.tuple (do <>.monad - [init_subject expression - init_op <code>.any - init_param expression - steps (<>.some (<>.and <code>.any expression))] - (in (list#mix (function (_ [op param] [_subject _op _param]) - [{#Binary _subject _op _param} op param]) - [init_subject init_op init_param] - steps)))) - ))) + (all <>.or + ..literal + (<code>.form (<>.many <code>.any)) + (<code>.tuple (<>.and <code>.any expression)) + (<code>.tuple (do <>.monad + [init_subject expression + init_op <code>.any + init_param expression + steps (<>.some (<>.and <code>.any expression))] + (in (list#mix (function (_ [op param] [_subject _op _param]) + [{#Binary _subject _op _param} op param]) + [init_subject init_op init_param] + steps)))) + ))) (def: (prefix infix) (-> Infix Code) diff --git a/stdlib/source/library/lux/math/modular.lux b/stdlib/source/library/lux/math/modular.lux index f23071295..6c4263f23 100644 --- a/stdlib/source/library/lux/math/modular.lux +++ b/stdlib/source/library/lux/math/modular.lux @@ -65,15 +65,15 @@ (def: (encoded modular) (let [[_ value] (representation modular)] - ($_ text#composite - (i#encoded value) - ..separator - (i#encoded (//.divisor expected))))) + (all text#composite + (i#encoded value) + ..separator + (i#encoded (//.divisor expected))))) (def: decoded (<text>.result (do <>.monad - [[value _ actual] ($_ <>.and intL (<text>.this ..separator) intL) + [[value _ actual] (all <>.and intL (<text>.this ..separator) intL) _ (<>.assertion (exception.error ..incorrect_modulus [expected actual]) (i.= (//.divisor expected) actual))] (in (..modular expected value)))))) diff --git a/stdlib/source/library/lux/math/number/frac.lux b/stdlib/source/library/lux/math/number/frac.lux index 0169ec4f5..14f6c9746 100644 --- a/stdlib/source/library/lux/math/number/frac.lux +++ b/stdlib/source/library/lux/math/number/frac.lux @@ -694,10 +694,10 @@ (//int.+ (.int ..double_bias)) (//i64.and ..exponent_mask)) mantissa_bits (..int mantissa)] - ($_ //i64.or - (//i64.left_shifted ..sign_offset sign_bit) - (//i64.left_shifted ..exponent_offset exponent_bits) - (//i64.zero ..mantissa_size mantissa_bits))) + (all //i64.or + (//i64.left_shifted ..sign_offset sign_bit) + (//i64.left_shifted ..exponent_offset exponent_bits) + (//i64.zero ..mantissa_size mantissa_bits))) ))) (template [<getter> <size> <offset>] @@ -783,14 +783,14 @@ mantissa (..mantissa bits) exponent (//int.- (.int ..double_bias) (..exponent bits)) sign (..sign bits)] - ($_ "lux text concat" - (case (.nat sign) - 1 "-" - 0 "+" - _ (undefined)) - (# <nat> encoded (.nat mantissa)) - ".0E" - (# <int> encoded exponent)))) + (all "lux text concat" + (case (.nat sign) + 1 "-" + 0 "+" + _ (undefined)) + (# <nat> encoded (.nat mantissa)) + ".0E" + (# <int> encoded exponent)))) (def: (decoded representation) (let [negative? (text.starts_with? "-" representation) @@ -817,10 +817,10 @@ _ ("lux text concat" whole (# <nat> encoded decimal)))) .let [sign (if negative? 1 0)]] (in (..of_bits - ($_ //i64.or - (//i64.left_shifted ..sign_offset (.i64 sign)) - (//i64.left_shifted ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) - (//i64.zero ..mantissa_size (.i64 mantissa)))))) + (all //i64.or + (//i64.left_shifted ..sign_offset (.i64 sign)) + (//i64.left_shifted ..mantissa_size (.i64 (//int.+ (.int ..double_bias) exponent))) + (//i64.zero ..mantissa_size (.i64 mantissa)))))) {try.#Failure ("lux text concat" <error> representation)}))))] [binary //nat.binary //int.binary "Invalid binary syntax: "] diff --git a/stdlib/source/library/lux/math/number/ratio.lux b/stdlib/source/library/lux/math/number/ratio.lux index 883e63dae..5af8853ad 100644 --- a/stdlib/source/library/lux/math/number/ratio.lux +++ b/stdlib/source/library/lux/math/number/ratio.lux @@ -132,9 +132,9 @@ (Codec Text Ratio) (def: (encoded (open "_[0]")) - ($_ text#composite - (n#encoded _#numerator) - ..separator (n#encoded _#denominator))) + (all text#composite + (n#encoded _#numerator) + ..separator (n#encoded _#denominator))) (def: (decoded input) (case (text.split_by ..separator input) diff --git a/stdlib/source/library/lux/math/number/rev.lux b/stdlib/source/library/lux/math/number/rev.lux index c6cdd0995..e6154d42f 100644 --- a/stdlib/source/library/lux/math/number/rev.lux +++ b/stdlib/source/library/lux/math/number/rev.lux @@ -343,10 +343,10 @@ output (..digits [])]) (if (//int.< +0 (.int idx)) output - (let [raw ($_ //nat.+ - carry - (..digit idx param) - (..digit idx subject))] + (let [raw (all //nat.+ + carry + (..digit idx param) + (..digit idx subject))] (again (-- idx) (//nat./ 10 raw) (digits#put! idx (//nat.% 10 raw) output)))))) diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux index f1337c481..3f6c82f27 100644 --- a/stdlib/source/library/lux/meta.lux +++ b/stdlib/source/library/lux/meta.lux @@ -123,7 +123,7 @@ {try.#Success [lux module]} _ - {try.#Failure ($_ text#composite "Unknown module: " name)}))) + {try.#Failure (all text#composite "Unknown module: " name)}))) (def: .public current_module_name (Meta Text) @@ -275,7 +275,7 @@ ((clean_type var_type) lux) {.#None} - {try.#Failure ($_ text#composite "Unknown variable: " name)})))) + {try.#Failure (all text#composite "Unknown variable: " name)})))) (def: without_lux_runtime (-> (List Text) (List Text)) @@ -285,7 +285,7 @@ (def: listing_separator Text - ($_ text#composite text.new_line " ")) + (all text#composite text.new_line " ")) (def: module_listing (-> (List Text) Text) @@ -314,52 +314,52 @@ (the .#modules) (list#each product.left) ..module_listing)] - {try.#Failure ($_ text#composite - "Unknown definition: " (symbol#encoded name) text.new_line - " Current module: " current_module text.new_line - (case (plist.value current_module (the .#modules lux)) - {.#Some this_module} - (let [candidates (|> lux - (the .#modules) - (list#each (function (_ [module_name module]) - (|> module - (the .#definitions) - (list.all (function (_ [def_name global]) - (case global - (^.or {.#Definition [exported? _]} - {.#Type [exported? _]}) - (if (and exported? - (text#= normal_short def_name)) - {.#Some (symbol#encoded [module_name def_name])} - {.#None}) - - {.#Alias _} - {.#None} - - {.#Tag _} - {.#None} - - {.#Slot _} - {.#None})))))) - list.together - (list.sorted text#<) - (text.interposed ..listing_separator)) - imports (|> this_module - (the .#imports) - ..module_listing) - aliases (|> this_module - (the .#module_aliases) - (list#each (function (_ [alias real]) ($_ text#composite alias " => " real))) - (list.sorted text#<) - (text.interposed ..listing_separator))] - ($_ text#composite - " Candidates: " candidates text.new_line - " Imports: " imports text.new_line - " Aliases: " aliases text.new_line)) - - _ - "") - " All known modules: " all_known_modules text.new_line)}))))) + {try.#Failure (all text#composite + "Unknown definition: " (symbol#encoded name) text.new_line + " Current module: " current_module text.new_line + (case (plist.value current_module (the .#modules lux)) + {.#Some this_module} + (let [candidates (|> lux + (the .#modules) + (list#each (function (_ [module_name module]) + (|> module + (the .#definitions) + (list.all (function (_ [def_name global]) + (case global + (^.or {.#Definition [exported? _]} + {.#Type [exported? _]}) + (if (and exported? + (text#= normal_short def_name)) + {.#Some (symbol#encoded [module_name def_name])} + {.#None}) + + {.#Alias _} + {.#None} + + {.#Tag _} + {.#None} + + {.#Slot _} + {.#None})))))) + list.together + (list.sorted text#<) + (text.interposed ..listing_separator)) + imports (|> this_module + (the .#imports) + ..module_listing) + aliases (|> this_module + (the .#module_aliases) + (list#each (function (_ [alias real]) (all text#composite alias " => " real))) + (list.sorted text#<) + (text.interposed ..listing_separator))] + (all text#composite + " Candidates: " candidates text.new_line + " Imports: " imports text.new_line + " Aliases: " aliases text.new_line)) + + _ + "") + " All known modules: " all_known_modules text.new_line)}))))) (def: .public (export name) (-> Symbol (Meta Definition)) @@ -370,27 +370,27 @@ (let [[exported? def_type def_value] definition] (if exported? (in definition) - (failure ($_ text#composite "Definition is not an export: " (symbol#encoded name))))) + (failure (all text#composite "Definition is not an export: " (symbol#encoded name))))) {.#Type [exported? type labels]} (if exported? (in [exported? .Type type]) - (failure ($_ text#composite "Type is not an export: " (symbol#encoded name)))) + (failure (all text#composite "Type is not an export: " (symbol#encoded name)))) {.#Alias de_aliased} - (failure ($_ text#composite - "Aliases are not considered exports: " - (symbol#encoded name))) + (failure (all text#composite + "Aliases are not considered exports: " + (symbol#encoded name))) {.#Tag _} - (failure ($_ text#composite - "Tags are not considered exports: " - (symbol#encoded name))) + (failure (all text#composite + "Tags are not considered exports: " + (symbol#encoded name))) {.#Slot _} - (failure ($_ text#composite - "Slots are not considered exports: " - (symbol#encoded name)))))) + (failure (all text#composite + "Slots are not considered exports: " + (symbol#encoded name)))))) (def: .public (definition_type name) (-> Symbol (Meta Type)) @@ -407,14 +407,14 @@ (in .Type) {.#Tag _} - (failure ($_ text#composite - "Tags have no type: " - (symbol#encoded name))) + (failure (all text#composite + "Tags have no type: " + (symbol#encoded name))) {.#Slot _} - (failure ($_ text#composite - "Slots have no type: " - (symbol#encoded name)))))) + (failure (all text#composite + "Slots have no type: " + (symbol#encoded name)))))) (def: .public (type name) (-> Symbol (Meta Type)) @@ -441,23 +441,23 @@ (type_code .Type) (type_code def_type))) (in (as Type def_value)) - (..failure ($_ text#composite "Definition is not a type: " (symbol#encoded name))))) + (..failure (all text#composite "Definition is not a type: " (symbol#encoded name))))) {.#Type [exported? type labels]} (in type) {.#Tag _} - (..failure ($_ text#composite "Tag is not a type: " (symbol#encoded name))) + (..failure (all text#composite "Tag is not a type: " (symbol#encoded name))) {.#Slot _} - (..failure ($_ text#composite "Slot is not a type: " (symbol#encoded name)))))) + (..failure (all text#composite "Slot is not a type: " (symbol#encoded name)))))) (def: .public (globals module) (-> Text (Meta (List [Text Global]))) (function (_ lux) (case (plist.value module (the .#modules lux)) {.#None} - {try.#Failure ($_ text#composite "Unknown module: " module)} + {try.#Failure (all text#composite "Unknown module: " module)} {.#Some module} {try.#Success [lux (the .#definitions module)]}))) @@ -562,11 +562,11 @@ (if (or (text#= this_module_name module) exported?) (in [idx (list#each (|>> [module]) group) type]) - (..failure ($_ text#composite "Cannot access " <description> ": " (symbol#encoded label_name) " from module " this_module_name))) + (..failure (all text#composite "Cannot access " <description> ": " (symbol#encoded label_name) " from module " this_module_name))) _ - (..failure ($_ text#composite - "Unknown " <description> ": " (symbol#encoded label_name))))))] + (..failure (all text#composite + "Unknown " <description> ": " (symbol#encoded label_name))))))] [tag .#Tag "tag"] [slot .#Slot "slot"] diff --git a/stdlib/source/library/lux/meta/location.lux b/stdlib/source/library/lux/meta/location.lux index b1448bf9e..13bb059d3 100644 --- a/stdlib/source/library/lux/meta/location.lux +++ b/stdlib/source/library/lux/meta/location.lux @@ -35,16 +35,16 @@ (-> Location Text) (let [separator "," [file line column] it] - ($_ "lux text concat" - "@" - (`` (("lux in-module" (~~ (static .prelude_module)) .text#encoded) file)) separator - (`` (("lux in-module" (~~ (static .prelude_module)) .nat#encoded) line)) separator - (`` (("lux in-module" (~~ (static .prelude_module)) .nat#encoded) column))))) + (all "lux text concat" + "@" + (`` (("lux in-module" (~~ (static .prelude_module)) .text#encoded) file)) separator + (`` (("lux in-module" (~~ (static .prelude_module)) .nat#encoded) line)) separator + (`` (("lux in-module" (~~ (static .prelude_module)) .nat#encoded) column))))) (def: \n ("lux i64 char" +10)) (def: .public (with location error) (-> Location Text Text) - ($_ "lux text concat" (..format location) \n - error)) + (all "lux text concat" (..format location) \n + error)) diff --git a/stdlib/source/library/lux/meta/symbol.lux b/stdlib/source/library/lux/meta/symbol.lux index e745413af..15e96c352 100644 --- a/stdlib/source/library/lux/meta/symbol.lux +++ b/stdlib/source/library/lux/meta/symbol.lux @@ -48,7 +48,7 @@ (def: (encoded [module short]) (case module "" short - _ ($_ text#composite module ..separator short))) + _ (all text#composite module ..separator short))) (def: (decoded input) (case (text.all_split_by ..separator input) diff --git a/stdlib/source/library/lux/target/jvm/attribute.lux b/stdlib/source/library/lux/target/jvm/attribute.lux index 6fd6eba84..c59e77236 100644 --- a/stdlib/source/library/lux/target/jvm/attribute.lux +++ b/stdlib/source/library/lux/target/jvm/attribute.lux @@ -39,10 +39,10 @@ (All (_ about) (-> (Equivalence about) (Equivalence (Info about)))) - ($_ product.equivalence - //index.equivalence - //unsigned.equivalence - Equivalence<about>)) + (all product.equivalence + //index.equivalence + //unsigned.equivalence + Equivalence<about>)) (def: (info_writer writer) (All (_ about) @@ -52,7 +52,7 @@ (let [[nameS nameT] (//index.writer name) [lengthS lengthT] (//unsigned.writer/4 length) [infoS infoT] (writer info)] - [($_ n.+ nameS lengthS infoS) + [(all n.+ nameS lengthS infoS) (|>> nameT lengthT infoT)]))) (with_expansions [<Code> (these (/code.Code Attribute))] @@ -71,19 +71,19 @@ (Equivalence Attribute) (equivalence.rec (function (_ equivalence) - ($_ sum.equivalence - (info_equivalence /constant.equivalence) - (info_equivalence (/code.equivalence equivalence)) - (info_equivalence //index.equivalence) - )))) + (all sum.equivalence + (info_equivalence /constant.equivalence) + (info_equivalence (/code.equivalence equivalence)) + (info_equivalence //index.equivalence) + )))) (def: common_attribute_length - ($_ n.+ - ... u2 attribute_name_index; - //unsigned.bytes/2 - ... u4 attribute_length; - //unsigned.bytes/4 - )) + (all n.+ + ... u2 attribute_name_index; + //unsigned.bytes/2 + ... u4 attribute_length; + //unsigned.bytes/4 + )) (def: (length attribute) (-> Attribute Nat) diff --git a/stdlib/source/library/lux/target/jvm/attribute/code.lux b/stdlib/source/library/lux/target/jvm/attribute/code.lux index 9916f97b0..5d2ed4879 100644 --- a/stdlib/source/library/lux/target/jvm/attribute/code.lux +++ b/stdlib/source/library/lux/target/jvm/attribute/code.lux @@ -31,53 +31,53 @@ (def: .public (length length code) (All (_ Attribute) (-> (-> Attribute Nat) (Code Attribute) Nat)) - ($_ n.+ - ... u2 max_stack; - ... u2 max_locals; - ///limit.length - ... u4 code_length; - ///unsigned.bytes/4 - ... u1 code[code_length]; - (binary.size (the #code code)) - ... u2 exception_table_length; - ///unsigned.bytes/2 - ... exception_table[exception_table_length]; - (|> code - (the #exception_table) - sequence.size - (n.* /exception.length)) - ... u2 attributes_count; - ///unsigned.bytes/2 - ... attribute_info attributes[attributes_count]; - (|> code - (the #attributes) - (sequence#each length) - (sequence#mix n.+ 0)))) + (all n.+ + ... u2 max_stack; + ... u2 max_locals; + ///limit.length + ... u4 code_length; + ///unsigned.bytes/4 + ... u1 code[code_length]; + (binary.size (the #code code)) + ... u2 exception_table_length; + ///unsigned.bytes/2 + ... exception_table[exception_table_length]; + (|> code + (the #exception_table) + sequence.size + (n.* /exception.length)) + ... u2 attributes_count; + ///unsigned.bytes/2 + ... attribute_info attributes[attributes_count]; + (|> code + (the #attributes) + (sequence#each length) + (sequence#mix n.+ 0)))) (def: .public (equivalence attribute_equivalence) (All (_ attribute) (-> (Equivalence attribute) (Equivalence (Code attribute)))) - ($_ product.equivalence - ///limit.equivalence - binary.equivalence - (sequence.equivalence /exception.equivalence) - (sequence.equivalence attribute_equivalence) - )) + (all product.equivalence + ///limit.equivalence + binary.equivalence + (sequence.equivalence /exception.equivalence) + (sequence.equivalence attribute_equivalence) + )) ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 (def: .public (writer writer code) (All (_ Attribute) (-> (Writer Attribute) (Writer (Code Attribute)))) - ($_ binaryF#composite - ... u2 max_stack; - ... u2 max_locals; - (///limit.writer (the #limit code)) - ... u4 code_length; - ... u1 code[code_length]; - (binaryF.binary_32 (the #code code)) - ... u2 exception_table_length; - ... exception_table[exception_table_length]; - ((binaryF.sequence_16 /exception.writer) (the #exception_table code)) - ... u2 attributes_count; - ... attribute_info attributes[attributes_count]; - ((binaryF.sequence_16 writer) (the #attributes code)) - )) + (all binaryF#composite + ... u2 max_stack; + ... u2 max_locals; + (///limit.writer (the #limit code)) + ... u4 code_length; + ... u1 code[code_length]; + (binaryF.binary_32 (the #code code)) + ... u2 exception_table_length; + ... exception_table[exception_table_length]; + ((binaryF.sequence_16 /exception.writer) (the #exception_table code)) + ... u2 attributes_count; + ... attribute_info attributes[attributes_count]; + ((binaryF.sequence_16 writer) (the #attributes code)) + )) diff --git a/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux b/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux index 6dc9cade9..649049e0b 100644 --- a/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux +++ b/stdlib/source/library/lux/target/jvm/attribute/code/exception.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}]] - [data - ["[0]" product] - ["[0]" format "_" - ["[1]" binary {"+" Writer}]]] - [math - [number - ["n" nat]]]]] - ["[0]" // "_" - ["//[1]" /// "_" - [constant {"+" Class}] - ["[1][0]" index {"+" Index}] - [bytecode - ["[1][0]" address {"+" Address}]] - [encoding - ["[1][0]" unsigned {"+" U2}]]]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}]] + [data + ["[0]" product] + ["[0]" format "_" + ["[1]" binary {"+" Writer}]]] + [math + [number + ["n" nat]]]]] + ["[0]" // "_" + ["//[1]" /// "_" + [constant {"+" Class}] + ["[1][0]" index {"+" Index}] + [bytecode + ["[1][0]" address {"+" Address}]] + [encoding + ["[1][0]" unsigned {"+" U2}]]]]) (type: .public Exception (Record @@ -28,32 +28,32 @@ (def: .public equivalence (Equivalence Exception) - ($_ product.equivalence - ////address.equivalence - ////address.equivalence - ////address.equivalence - ////index.equivalence - )) + (all product.equivalence + ////address.equivalence + ////address.equivalence + ////address.equivalence + ////index.equivalence + )) ... https://docs.oracle.com/javase/specs/jvms/se8/html/jvms-4.html#jvms-4.7.3 (def: .public length Nat - ($_ n.+ - ... u2 start_pc; - ////unsigned.bytes/2 - ... u2 end_pc; - ////unsigned.bytes/2 - ... u2 handler_pc; - ////unsigned.bytes/2 - ... u2 catch_type; - ////unsigned.bytes/2 - )) + (all n.+ + ... u2 start_pc; + ////unsigned.bytes/2 + ... u2 end_pc; + ////unsigned.bytes/2 + ... u2 handler_pc; + ////unsigned.bytes/2 + ... u2 catch_type; + ////unsigned.bytes/2 + )) (def: .public writer (Writer Exception) - ($_ format.and - ////address.writer - ////address.writer - ////address.writer - ////index.writer - )) + (all format.and + ////address.writer + ////address.writer + ////address.writer + ////index.writer + )) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux index 3d3bb2d8d..eb98b1262 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/environment/limit.lux @@ -38,22 +38,22 @@ ) (def: .public length - ($_ n.+ - ... u2 max_stack; - /stack.length - ... u2 max_locals; - /registry.length)) + (all n.+ + ... u2 max_stack; + /stack.length + ... u2 max_locals; + /registry.length)) (def: .public equivalence (Equivalence Limit) - ($_ product.equivalence - /stack.equivalence - /registry.equivalence - )) + (all product.equivalence + /stack.equivalence + /registry.equivalence + )) (def: .public (writer limit) (Writer Limit) - ($_ format#composite - (/stack.writer (the #stack limit)) - (/registry.writer (the #registry limit)) - )) + (all format#composite + (/stack.writer (the #stack limit)) + (/registry.writer (the #registry limit)) + )) diff --git a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux index 379adfd35..61201beb5 100644 --- a/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux +++ b/stdlib/source/library/lux/target/jvm/bytecode/instruction.lux @@ -578,14 +578,14 @@ (-> S4 Big_Jump [Big_Jump (List Big_Jump)] Instruction)] (let [estimator (is (-> Nat Estimator) (function (_ amount_of_afterwards offset) - (|> ($_ n.+ - (///unsigned.value ..opcode_size) - (switch_padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big_jump_size) - (///unsigned.value ..integer_size) - (///unsigned.value ..integer_size) - (n.* (///unsigned.value ..big_jump_size) - (++ amount_of_afterwards))) + (|> (all n.+ + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (///unsigned.value ..integer_size) + (n.* (///unsigned.value ..big_jump_size) + (++ amount_of_afterwards))) ///unsigned.u2 try.trusted)))] [estimator @@ -644,12 +644,12 @@ (///unsigned.value ..big_jump_size)) estimator (is (-> Nat Estimator) (function (_ amount_of_cases offset) - (|> ($_ n.+ - (///unsigned.value ..opcode_size) - (switch_padding (///unsigned.value (//address.value offset))) - (///unsigned.value ..big_jump_size) - (///unsigned.value ..integer_size) - (n.* amount_of_cases case_size)) + (|> (all n.+ + (///unsigned.value ..opcode_size) + (switch_padding (///unsigned.value (//address.value offset))) + (///unsigned.value ..big_jump_size) + (///unsigned.value ..integer_size) + (n.* amount_of_cases case_size)) ///unsigned.u2 try.trusted)))] [estimator diff --git a/stdlib/source/library/lux/target/jvm/class.lux b/stdlib/source/library/lux/target/jvm/class.lux index 8447c56de..cd459643a 100644 --- a/stdlib/source/library/lux/target/jvm/class.lux +++ b/stdlib/source/library/lux/target/jvm/class.lux @@ -58,18 +58,18 @@ (def: .public equivalence (Equivalence Class) - ($_ product.equivalence - //unsigned.equivalence - //unsigned.equivalence - //unsigned.equivalence - //pool.equivalence - //modifier.equivalence - //index.equivalence - //index.equivalence - (sequence.equivalence //index.equivalence) - (sequence.equivalence //field.equivalence) - (sequence.equivalence //method.equivalence) - (sequence.equivalence //attribute.equivalence))) + (all product.equivalence + //unsigned.equivalence + //unsigned.equivalence + //unsigned.equivalence + //pool.equivalence + //modifier.equivalence + //index.equivalence + //index.equivalence + (sequence.equivalence //index.equivalence) + (sequence.equivalence //field.equivalence) + (sequence.equivalence //method.equivalence) + (sequence.equivalence //attribute.equivalence))) (def: (install_classes this super interfaces) (-> Internal Internal (List Internal) @@ -128,23 +128,23 @@ (def: .public (writer class) (Writer Class) - (`` ($_ binaryF#composite - (~~ (template [<writer> <slot>] - [(<writer> (the <slot> class))] + (`` (all binaryF#composite + (~~ (template [<writer> <slot>] + [(<writer> (the <slot> class))] - [//magic.writer #magic] - [//version.writer #minor_version] - [//version.writer #major_version] - [//pool.writer #constant_pool] - [//modifier.writer #modifier] - [//index.writer #this] - [//index.writer #super])) - (~~ (template [<writer> <slot>] - [((binaryF.sequence_16 <writer>) (the <slot> class))] + [//magic.writer #magic] + [//version.writer #minor_version] + [//version.writer #major_version] + [//pool.writer #constant_pool] + [//modifier.writer #modifier] + [//index.writer #this] + [//index.writer #super])) + (~~ (template [<writer> <slot>] + [((binaryF.sequence_16 <writer>) (the <slot> class))] - [//index.writer #interfaces] - [//field.writer #fields] - [//method.writer #methods] - [//attribute.writer #attributes] - )) - ))) + [//index.writer #interfaces] + [//field.writer #fields] + [//method.writer #methods] + [//attribute.writer #attributes] + )) + ))) diff --git a/stdlib/source/library/lux/target/jvm/constant.lux b/stdlib/source/library/lux/target/jvm/constant.lux index c32ca731c..230157059 100644 --- a/stdlib/source/library/lux/target/jvm/constant.lux +++ b/stdlib/source/library/lux/target/jvm/constant.lux @@ -140,15 +140,15 @@ (template [<type> <equivalence> <writer>] [(def: .public <equivalence> (Equivalence (<type> Any)) - ($_ product.equivalence - //index.equivalence - //index.equivalence)) + (all product.equivalence + //index.equivalence + //index.equivalence)) (def: <writer> (Writer (<type> Any)) - ($_ binaryF.and - //index.writer - //index.writer))] + (all binaryF.and + //index.writer + //index.writer))] [Name_And_Type name_and_type_equivalence name_and_type_writer] [Reference reference_equivalence reference_writer] @@ -201,7 +201,7 @@ _ false))) - ... ($_ sum.equivalence + ... (all sum.equivalence ... ... #UTF8 ... text.equivalence ... ... #Long diff --git a/stdlib/source/library/lux/target/jvm/field.lux b/stdlib/source/library/lux/target/jvm/field.lux index 5db3ac6b0..d97951fbf 100644 --- a/stdlib/source/library/lux/target/jvm/field.lux +++ b/stdlib/source/library/lux/target/jvm/field.lux @@ -42,23 +42,23 @@ (def: .public equivalence (Equivalence Field) - ($_ product.equivalence - modifier.equivalence - //index.equivalence - //index.equivalence - (sequence.equivalence //attribute.equivalence))) + (all product.equivalence + modifier.equivalence + //index.equivalence + //index.equivalence + (sequence.equivalence //attribute.equivalence))) (def: .public (writer field) (Writer Field) - (`` ($_ binaryF#composite - (~~ (template [<writer> <slot>] - [(<writer> (the <slot> field))] + (`` (all binaryF#composite + (~~ (template [<writer> <slot>] + [(<writer> (the <slot> field))] - [modifier.writer #modifier] - [//index.writer #name] - [//index.writer #descriptor] - [(binaryF.sequence_16 //attribute.writer) #attributes])) - ))) + [modifier.writer #modifier] + [//index.writer #name] + [//index.writer #descriptor] + [(binaryF.sequence_16 //attribute.writer) #attributes])) + ))) (def: .public (field modifier name with_signature? type attributes) (-> (Modifier Field) UTF8 Bit (Type Value) (Sequence Attribute) diff --git a/stdlib/source/library/lux/target/jvm/method.lux b/stdlib/source/library/lux/target/jvm/method.lux index cac656214..193bb4db8 100644 --- a/stdlib/source/library/lux/target/jvm/method.lux +++ b/stdlib/source/library/lux/target/jvm/method.lux @@ -89,21 +89,21 @@ (def: .public equivalence (Equivalence Method) - ($_ product.equivalence - //modifier.equivalence - //index.equivalence - //index.equivalence - (sequence.equivalence //attribute.equivalence) - )) + (all product.equivalence + //modifier.equivalence + //index.equivalence + //index.equivalence + (sequence.equivalence //attribute.equivalence) + )) (def: .public (writer field) (Writer Method) - (`` ($_ format#composite - (~~ (template [<writer> <slot>] - [(<writer> (the <slot> field))] + (`` (all format#composite + (~~ (template [<writer> <slot>] + [(<writer> (the <slot> field))] - [//modifier.writer #modifier] - [//index.writer #name] - [//index.writer #descriptor] - [(format.sequence_16 //attribute.writer) #attributes])) - ))) + [//modifier.writer #modifier] + [//index.writer #name] + [//index.writer #descriptor] + [(format.sequence_16 //attribute.writer) #attributes])) + ))) diff --git a/stdlib/source/library/lux/target/jvm/type/alias.lux b/stdlib/source/library/lux/target/jvm/type/alias.lux index 9c802f924..39f8aba69 100644 --- a/stdlib/source/library/lux/target/jvm/type/alias.lux +++ b/stdlib/source/library/lux/target/jvm/type/alias.lux @@ -1,28 +1,28 @@ (.using - [library - [lux {"-" Type Primitive int char type parameter} - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try] - ["[0]" exception {"+" exception:}] - ["<>" parser - ["<[0]>" text {"+" Parser}]]] - [data - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" dictionary {"+" Dictionary}]]]]] - ["[0]" // {"+" Type} - [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter}] - ["[1][0]" descriptor] - ["[1][0]" signature {"+" Signature}] - ["[1][0]" reflection] - ["[1][0]" parser] - ["/[1]" // "_" - [encoding - ["[1][0]" name]]]]) + [library + [lux {"-" Type Primitive int char type parameter} + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try] + ["[0]" exception {"+" exception:}] + ["<>" parser + ["<[0]>" text {"+" Parser}]]] + [data + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" dictionary {"+" Dictionary}]]]]] + ["[0]" // {"+" Type} + [category {"+" Void Value Return Method Primitive Object Class Array Var Parameter}] + ["[1][0]" descriptor] + ["[1][0]" signature {"+" Signature}] + ["[1][0]" reflection] + ["[1][0]" parser] + ["/[1]" // "_" + [encoding + ["[1][0]" name]]]]) (type: .public Aliasing (Dictionary Text Text)) @@ -67,23 +67,23 @@ (<>.rec (function (_ parameter) (let [class (..class parameter)] - ($_ <>.either - (..var aliasing) - //parser.wildcard - (..lower class) - (..upper class) - class - ))))) + (all <>.either + (..var aliasing) + //parser.wildcard + (..lower class) + (..upper class) + class + ))))) (def: (value aliasing) (-> Aliasing (Parser (Type Value))) (<>.rec (function (_ value) - ($_ <>.either - //parser.primitive - (parameter aliasing) - (//parser.array' value) - )))) + (all <>.either + //parser.primitive + (parameter aliasing) + (//parser.array' value) + )))) (def: (inputs aliasing) (-> Aliasing (Parser (List (Type Value)))) @@ -93,10 +93,10 @@ (def: (return aliasing) (-> Aliasing (Parser (Type Return))) - ($_ <>.either - //parser.void - (..value aliasing) - )) + (all <>.either + //parser.void + (..value aliasing) + )) (def: (exception aliasing) (-> Aliasing (Parser (Type Class))) diff --git a/stdlib/source/library/lux/target/jvm/type/lux.lux b/stdlib/source/library/lux/target/jvm/type/lux.lux index c608b7a94..60960123d 100644 --- a/stdlib/source/library/lux/target/jvm/type/lux.lux +++ b/stdlib/source/library/lux/target/jvm/type/lux.lux @@ -85,29 +85,29 @@ (def: primitive (Parser (Check Type)) - ($_ <>.either - ..boolean - ..byte - ..short - ..int - ..long - ..float - ..double - ..char - )) + (all <>.either + ..boolean + ..byte + ..short + ..int + ..long + ..float + ..double + ..char + )) (def: boxed_primitive (Parser (Check Type)) - ($_ <>.either - ..boxed_boolean - ..boxed_byte - ..boxed_short - ..boxed_int - ..boxed_long - ..boxed_float - ..boxed_double - ..boxed_char - )) + (all <>.either + ..boxed_boolean + ..boxed_byte + ..boxed_short + ..boxed_int + ..boxed_long + ..boxed_float + ..boxed_double + ..boxed_char + )) (def: wildcard (Parser (Check Type)) @@ -157,13 +157,13 @@ (<>.rec (function (_ parameter) (let [class (..class' parameter)] - ($_ <>.either - (..var mapping) - ..wildcard - (..lower class) - (..upper class) - class - ))))) + (all <>.either + (..var mapping) + ..wildcard + (..lower class) + (..upper class) + class + ))))) (def: .public class (-> Mapping (Parser (Check Type))) @@ -196,35 +196,35 @@ (-> Mapping (Parser (Check Type))) (<>.rec (function (_ type) - ($_ <>.either - ..primitive - (parameter mapping) - (..array type) - )))) + (all <>.either + ..primitive + (parameter mapping) + (..array type) + )))) (def: .public (boxed_type mapping) (-> Mapping (Parser (Check Type))) (<>.rec (function (_ type) - ($_ <>.either - ..boxed_primitive - (parameter mapping) - (..array type) - )))) + (all <>.either + ..boxed_primitive + (parameter mapping) + (..array type) + )))) (def: .public (return mapping) (-> Mapping (Parser (Check Type))) - ($_ <>.either - ..void - (..type mapping) - )) + (all <>.either + ..void + (..type mapping) + )) (def: .public (boxed_return mapping) (-> Mapping (Parser (Check Type))) - ($_ <>.either - ..void - (..boxed_type mapping) - )) + (all <>.either + ..void + (..boxed_type mapping) + )) (def: .public (check operation input) (All (_ a) (-> (Parser (Check a)) Text (Check a))) diff --git a/stdlib/source/library/lux/target/jvm/type/parser.lux b/stdlib/source/library/lux/target/jvm/type/parser.lux index b576c8d5b..e7c2a2c70 100644 --- a/stdlib/source/library/lux/target/jvm/type/parser.lux +++ b/stdlib/source/library/lux/target/jvm/type/parser.lux @@ -42,16 +42,16 @@ (def: .public primitive (Parser (Type Primitive)) - ($_ <>.either - ..boolean - ..byte - ..short - ..int - ..long - ..float - ..double - ..char - )) + (all <>.either + ..boolean + ..byte + ..short + ..int + ..long + ..float + ..double + ..char + )) (def: var/head (format "abcdefghijklmnopqrstuvwxyz" @@ -137,23 +137,23 @@ (<>.rec (function (_ parameter) (let [class (..class' parameter)] - ($_ <>.either - ..var - ..wildcard - (..lower parameter) - (..upper parameter) - (..array' value) - class - ))))) + (all <>.either + ..var + ..wildcard + (..lower parameter) + (..upper parameter) + (..array' value) + class + ))))) (def: .public value (Parser (Type Value)) (<>.rec (function (_ value) - ($_ <>.either - ..primitive - (..parameter' value) - )))) + (all <>.either + ..primitive + (..parameter' value) + )))) (def: .public parameter (Parser (Type Parameter)) @@ -188,9 +188,9 @@ (def: .public object (Parser (Type Object)) - ($_ <>.either - ..class - ..array)) + (all <>.either + ..class + ..array)) (def: inputs (|> (<>.some ..value) @@ -225,14 +225,14 @@ (List (Type Value)) (Type Return) (List (Type Class))]) - ($_ <>.and - (|> (<>.some (<>#each product.left ..var_declaration)) - (<>.after (<text>.this //signature.parameters_start)) - (<>.before (<text>.this //signature.parameters_end)) - (<>.else (list))) - ..inputs - ..return - (<>.some ..exception)))] + (all <>.and + (|> (<>.some (<>#each product.left ..var_declaration)) + (<>.after (<text>.this //signature.parameters_start)) + (<>.before (<text>.this //signature.parameters_end)) + (<>.else (list))) + ..inputs + ..return + (<>.some ..exception)))] (|>> //.signature //signature.signature (<text>.result parser) diff --git a/stdlib/source/library/lux/time.lux b/stdlib/source/library/lux/time.lux index 1d8bf0de5..c03676e09 100644 --- a/stdlib/source/library/lux/time.lux +++ b/stdlib/source/library/lux/time.lux @@ -139,11 +139,11 @@ utc_second ..second_parser utc_millis ..millis_parser] (in (abstraction - ($_ n.+ - (n.* utc_hour hour) - (n.* utc_minute minute) - (n.* utc_second second) - (n.* utc_millis millis))))))) + (all n.+ + (n.* utc_hour hour) + (n.* utc_minute minute) + (n.* utc_second second) + (n.* utc_millis millis))))))) ) (def: (padded value) @@ -161,10 +161,10 @@ (def: (millis_format millis) (-> Nat Text) (cond (n.= 0 millis) "" - (n.< 10 millis) ($_ text#composite ".00" (n#encoded millis)) - (n.< 100 millis) ($_ text#composite ".0" (n#encoded millis)) + (n.< 10 millis) (all text#composite ".00" (n#encoded millis)) + (n.< 100 millis) (all text#composite ".0" (n#encoded millis)) ... (n.< 1,000 millis) - ($_ text#composite "." (n#encoded millis)))) + (all text#composite "." (n#encoded millis)))) (type: .public Clock (Record @@ -189,11 +189,11 @@ (def: .public (time clock) (-> Clock (Try Time)) - (|> ($_ duration.composite - (duration.up (the #hour clock) duration.hour) - (duration.up (the #minute clock) duration.minute) - (duration.up (the #second clock) duration.second) - (duration.of_millis (.int (the #milli_second clock)))) + (|> (all duration.composite + (duration.up (the #hour clock) duration.hour) + (duration.up (the #minute clock) duration.minute) + (duration.up (the #second clock) duration.second) + (duration.of_millis (.int (the #milli_second clock)))) duration.millis .nat ..of_millis)) @@ -201,11 +201,11 @@ (def: (format time) (-> Time Text) (let [(open "_[0]") (..clock time)] - ($_ text#composite - (..padded _#hour) - ..separator (..padded _#minute) - ..separator (..padded _#second) - (..millis_format _#milli_second)))) + (all text#composite + (..padded _#hour) + ..separator (..padded _#minute) + ..separator (..padded _#second) + (..millis_format _#milli_second)))) (implementation: .public codec (Codec Text Time) diff --git a/stdlib/source/library/lux/time/date.lux b/stdlib/source/library/lux/time/date.lux index c19df3444..d47ed902c 100644 --- a/stdlib/source/library/lux/time/date.lux +++ b/stdlib/source/library/lux/time/date.lux @@ -184,10 +184,10 @@ (def: (format value) (-> Date Text) - ($_ text#composite - (# //year.codec encoded (..year value)) - ..separator (..padded (|> value ..month //month.number)) - ..separator (..padded (..day_of_month value)))) + (all text#composite + (# //year.codec encoded (..year value)) + ..separator (..padded (|> value ..month //month.number)) + ..separator (..padded (..day_of_month value)))) (implementation: .public codec (Codec Text Date) diff --git a/stdlib/source/library/lux/time/day.lux b/stdlib/source/library/lux/time/day.lux index 1a5b0a10f..02926f610 100644 --- a/stdlib/source/library/lux/time/day.lux +++ b/stdlib/source/library/lux/time/day.lux @@ -153,10 +153,10 @@ (exception: .public (invalid_day [number Nat]) (exception.report "Number" (# n.decimal encoded number) - "Valid range" ($_ "lux text concat" - (# n.decimal encoded (..number {#Sunday})) - " ~ " - (# n.decimal encoded (..number {#Saturday}))))) + "Valid range" (all "lux text concat" + (# n.decimal encoded (..number {#Sunday})) + " ~ " + (# n.decimal encoded (..number {#Saturday}))))) (def: .public (by_number number) (-> Nat (Try Day)) diff --git a/stdlib/source/library/lux/time/duration.lux b/stdlib/source/library/lux/time/duration.lux index 85e271547..84588ff83 100644 --- a/stdlib/source/library/lux/time/duration.lux +++ b/stdlib/source/library/lux/time/duration.lux @@ -127,10 +127,10 @@ (def: (encoded duration) (if (# ..equivalence = ..empty duration) - ($_ text#composite - ..positive_sign - (nat#encoded 0) - ..milli_second_suffix) + (all text#composite + ..positive_sign + (nat#encoded 0) + ..milli_second_suffix) (let [signed? (negative? duration) [days time_left] [(ticks day duration) (framed day duration)] days (if signed? @@ -143,14 +143,14 @@ [minutes time_left] [(ticks minute time_left) (framed minute time_left)] [seconds time_left] [(ticks second time_left) (framed second time_left)] millis (..millis time_left)] - ($_ text#composite - (if signed? ..negative_sign ..positive_sign) - (if (i.= +0 days) "" (text#composite (nat#encoded (.nat days)) ..day_suffix)) - (if (i.= +0 hours) "" (text#composite (nat#encoded (.nat hours)) ..hour_suffix)) - (if (i.= +0 minutes) "" (text#composite (nat#encoded (.nat minutes)) ..minute_suffix)) - (if (i.= +0 seconds) "" (text#composite (nat#encoded (.nat seconds)) ..second_suffix)) - (if (i.= +0 millis) "" (text#composite (nat#encoded (.nat millis)) ..milli_second_suffix)) - )))) + (all text#composite + (if signed? ..negative_sign ..positive_sign) + (if (i.= +0 days) "" (text#composite (nat#encoded (.nat days)) ..day_suffix)) + (if (i.= +0 hours) "" (text#composite (nat#encoded (.nat hours)) ..hour_suffix)) + (if (i.= +0 minutes) "" (text#composite (nat#encoded (.nat minutes)) ..minute_suffix)) + (if (i.= +0 seconds) "" (text#composite (nat#encoded (.nat seconds)) ..second_suffix)) + (if (i.= +0 millis) "" (text#composite (nat#encoded (.nat millis)) ..milli_second_suffix)) + )))) (def: parser (Parser Duration) diff --git a/stdlib/source/library/lux/time/instant.lux b/stdlib/source/library/lux/time/instant.lux index d32879232..5ba290670 100644 --- a/stdlib/source/library/lux/time/instant.lux +++ b/stdlib/source/library/lux/time/instant.lux @@ -123,9 +123,9 @@ (-> Instant Text) (let [[date time] (..date_time instant) time (..clock_time time)] - ($_ text#composite - (# date.codec encoded date) ..date_suffix - (# //.codec encoded time) ..time_suffix))) + (all text#composite + (# date.codec encoded date) ..date_suffix + (# //.codec encoded time) ..time_suffix))) (def: parser (Parser Instant) diff --git a/stdlib/source/library/lux/time/month.lux b/stdlib/source/library/lux/time/month.lux index 503780519..351a6ecf7 100644 --- a/stdlib/source/library/lux/time/month.lux +++ b/stdlib/source/library/lux/time/month.lux @@ -81,10 +81,10 @@ (exception: .public (invalid_month [number Nat]) (exception.report "Number" (# n.decimal encoded number) - "Valid range" ($_ "lux text concat" - (# n.decimal encoded (..number {#January})) - " ~ " - (# n.decimal encoded (..number {#December}))))) + "Valid range" (all "lux text concat" + (# n.decimal encoded (..number {#January})) + " ~ " + (# n.decimal encoded (..number {#December}))))) (def: .public (by_number number) (-> Nat (Try Month)) diff --git a/stdlib/source/library/lux/tool/compiler/default/platform.lux b/stdlib/source/library/lux/tool/compiler/default/platform.lux index 4937ec9c1..ac43de9f2 100644 --- a/stdlib/source/library/lux/tool/compiler/default/platform.lux +++ b/stdlib/source/library/lux/tool/compiler/default/platform.lux @@ -100,13 +100,13 @@ (All (_ a) (-> (Writer a) (Writer [(module.Module a) Registry]))) - ($_ _.and - ($_ _.and - _.nat - descriptor.writer - (document.writer //)) - registry.writer - )) + (all _.and + (all _.and + _.nat + descriptor.writer + (document.writer //)) + registry.writer + )) (def: (cache_module context platform @module key format entry) (All (_ <type_vars> document) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux index f237ebeae..eb6cd78d7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux @@ -23,80 +23,80 @@ (def: .public writer (Writer .Module) (let [definition (is (Writer Definition) - ($_ _.and _.bit _.type _.any)) + (all _.and _.bit _.type _.any)) labels (is (Writer [Text (List Text)]) (_.and _.text (_.list _.text))) global_type (is (Writer [Bit Type (Either [Text (List Text)] [Text (List Text)])]) - ($_ _.and _.bit _.type (_.or labels labels))) + (all _.and _.bit _.type (_.or labels labels))) global_label (is (Writer .Label) - ($_ _.and _.bit _.type (_.list _.text) _.nat)) + (all _.and _.bit _.type (_.list _.text) _.nat)) alias (is (Writer Alias) (_.and _.text _.text)) global (is (Writer Global) - ($_ _.or - definition - global_type - global_label - global_label - alias))] - ($_ _.and - ... #module_hash - _.nat - ... #module_aliases - (_.list alias) - ... #definitions - (_.list (_.and _.text global)) - ... #imports - (_.list _.text) - ... #module_state - _.any))) + (all _.or + definition + global_type + global_label + global_label + alias))] + (all _.and + ... #module_hash + _.nat + ... #module_aliases + (_.list alias) + ... #definitions + (_.list (_.and _.text global)) + ... #imports + (_.list _.text) + ... #module_state + _.any))) (def: .public parser (Parser .Module) (let [definition (is (Parser Definition) - ($_ <>.and - <binary>.bit - <binary>.type - <binary>.any)) + (all <>.and + <binary>.bit + <binary>.type + <binary>.any)) labels (is (Parser [Text (List Text)]) - ($_ <>.and - <binary>.text - (<binary>.list <binary>.text))) + (all <>.and + <binary>.text + (<binary>.list <binary>.text))) global_type (is (Parser [Bit Type (Either [Text (List Text)] [Text (List Text)])]) - ($_ <>.and - <binary>.bit - <binary>.type - (<binary>.or labels labels))) - global_label (is (Parser .Label) - ($_ <>.and + (all <>.and <binary>.bit <binary>.type - (<binary>.list <binary>.text) - <binary>.nat)) + (<binary>.or labels labels))) + global_label (is (Parser .Label) + (all <>.and + <binary>.bit + <binary>.type + (<binary>.list <binary>.text) + <binary>.nat)) alias (is (Parser Alias) - ($_ <>.and - <binary>.text - <binary>.text)) + (all <>.and + <binary>.text + <binary>.text)) global (is (Parser Global) - ($_ <binary>.or - definition - global_type - global_label - global_label - alias))] - ($_ <>.and - ... #module_hash - <binary>.nat - ... #module_aliases - (<binary>.list alias) - ... #definitions - (<binary>.list (<>.and <binary>.text global)) - ... #imports - (<binary>.list <binary>.text) - ... #module_state - (# <>.monad in {.#Cached})))) + (all <binary>.or + definition + global_type + global_label + global_label + alias))] + (all <>.and + ... #module_hash + <binary>.nat + ... #module_aliases + (<binary>.list alias) + ... #definitions + (<binary>.list (<>.and <binary>.text global)) + ... #imports + (<binary>.list <binary>.text) + ... #module_state + (# <>.monad in {.#Cached})))) (def: .public key (Key .Module) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux index 738795545..f4cf115d5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/complex.lux @@ -75,14 +75,14 @@ (def: (hash value) (case value {#Variant [lefts right? value]} - ($_ n.* 2 - (# n.hash hash lefts) - (# bit.hash hash right?) - (# super hash value)) + (all n.* 2 + (# n.hash hash lefts) + (# bit.hash hash right?) + (# super hash value)) {#Tuple members} - ($_ n.* 3 - (# (list.hash super) hash members)) + (all n.* 3 + (# (list.hash super) hash members)) ))) (def: .public (format %it it) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux index 578cad62c..040298209 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/analysis/scope.lux @@ -2,7 +2,7 @@ [library [lux {"-" local} [abstract - monad] + [monad {"+" do}]] [control ["[0]" maybe ("[1]#[0]" monad)] ["[0]" try] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux index 5bdfe1718..6416fbe77 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -3,7 +3,7 @@ [lux {"-" function} ["[0]" meta] [abstract - monad] + [monad {"+" do}]] [control ["[0]" maybe] ["[0]" try] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 6f23ba667..e5f1914ab 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -3,7 +3,7 @@ [lux "*" ["[0]" meta] [abstract - monad] + [monad {"+" do}]] [control ["[0]" exception {"+" exception:}]] [data diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux index 1d0c1f86b..39a8ef632 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/js.lux @@ -76,7 +76,7 @@ (def: array::write Handler (custom - [($_ <>.and <code>.any <code>.any <code>.any) + [(all <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -95,7 +95,7 @@ (def: array::delete Handler (custom - [($_ <>.and <code>.any <code>.any) + [(all <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -123,7 +123,7 @@ (def: object::new Handler (custom - [($_ <>.and <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [constructorC inputsC]) (do [! phase.monad] [constructorA (analysis/type.expecting Any @@ -135,7 +135,7 @@ (def: object::get Handler (custom - [($_ <>.and <code>.text <code>.any) + [(all <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.expecting Any @@ -147,7 +147,7 @@ (def: object::do Handler (custom - [($_ <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] [objectA (analysis/type.expecting Any @@ -183,7 +183,7 @@ (def: js::apply Handler (custom - [($_ <>.and <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (analysis/type.expecting Any @@ -206,7 +206,7 @@ (def: js::function Handler (custom - [($_ <>.and <code>.nat <code>.any) + [(all <>.and <code>.nat <code>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad [.let [inputT (type.tuple (list.repeated arity Any))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux index 3547f8029..6a54bf8e5 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux @@ -231,7 +231,7 @@ (def: member (Parser Member) - ($_ <>.and <code>.text <code>.text)) + (all <>.and <code>.text <code>.text)) (type: Method_Signature (Record @@ -918,7 +918,7 @@ (def: (object::instance? class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and <code>.text <code>.any) + [(all <>.and <code>.text <code>.any) (function (_ extension_name analyse archive [sub_class objectC]) (do phase.monad [_ (..ensure_fresh_class! class_loader sub_class) @@ -1070,7 +1070,7 @@ (def: (put::static class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..member <code>.any) + [(all <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] valueC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1095,7 +1095,7 @@ (def: (get::virtual class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..member <code>.any) + [(all <>.and ..member <code>.any) (function (_ extension_name analyse archive [[class field] objectC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1120,7 +1120,7 @@ (def: (put::virtual class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..member <code>.any <code>.any) + [(all <>.and ..member <code>.any <code>.any) (function (_ extension_name analyse archive [[class field] valueC objectC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1516,7 +1516,7 @@ (def: (invoke::static class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..type_vars ..member ..type_vars (<>.some ..input)) + [(all <>.and ..type_vars ..member ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars argsTC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1534,7 +1534,7 @@ (def: (invoke::virtual class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) + [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1559,7 +1559,7 @@ (def: (invoke::special class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) + [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class method] method_tvars objectC argsTC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1584,7 +1584,7 @@ (def: (invoke::interface class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) + [(all <>.and ..type_vars ..member ..type_vars <code>.any (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars [class_name method] method_tvars objectC argsTC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class_name) @@ -1613,7 +1613,7 @@ (def: (invoke::constructor class_loader) (-> java/lang/ClassLoader Handler) (..custom - [($_ <>.and ..type_vars <code>.text ..type_vars (<>.some ..input)) + [(all <>.and ..type_vars <code>.text ..type_vars (<>.some ..input)) (function (_ extension_name analyse archive [class_tvars class method_tvars argsTC]) (do phase.monad [_ (..ensure_fresh_class! class_loader class) @@ -1781,12 +1781,12 @@ (def: .public visibility' (<text>.Parser Visibility) - ($_ <>.or - (<text>.this ..public_tag) - (<text>.this ..private_tag) - (<text>.this ..protected_tag) - (<text>.this ..default_tag) - )) + (all <>.or + (<text>.this ..public_tag) + (<text>.this ..private_tag) + (<text>.this ..protected_tag) + (<text>.this ..default_tag) + )) (def: .public visibility (Parser Visibility) @@ -1826,14 +1826,14 @@ (Parser (Abstract_Method Code)) (<| <code>.form (<>.after (<code>.this_text ..abstract_tag)) - ($_ <>.and - <code>.text - ..visibility - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..var)) - (<code>.tuple (<>.some ..argument)) - ..return - (<code>.tuple (<>.some ..class))))) + (all <>.and + <code>.text + ..visibility + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + (<code>.tuple (<>.some ..argument)) + ..return + (<code>.tuple (<>.some ..class))))) (def: (method_mapping of_class parameters) (-> Mapping (List (Type Var)) (Check Mapping)) @@ -1888,16 +1888,16 @@ (Parser (Constructor Code)) (<| <code>.form (<>.after (<code>.this_text ..constructor_tag)) - ($_ <>.and - ..visibility - <code>.bit - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..var)) - (<code>.tuple (<>.some ..class)) - <code>.text - (<code>.tuple (<>.some ..argument)) - (<code>.tuple (<>.some ..input)) - <code>.any))) + (all <>.and + ..visibility + <code>.bit + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + (<code>.tuple (<>.some ..class)) + <code>.text + (<code>.tuple (<>.some ..argument)) + (<code>.tuple (<>.some ..input)) + <code>.any))) (def: .public (analyse_constructor_method analyse archive selfT mapping method) (-> Phase Archive .Type Mapping (Constructor Code) (Operation Analysis)) @@ -1968,18 +1968,18 @@ (Parser (Virtual_Method Code)) (<| <code>.form (<>.after (<code>.this_text ..virtual_tag)) - ($_ <>.and - <code>.text - ..visibility - <code>.bit - <code>.bit - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..var)) - <code>.text - (<code>.tuple (<>.some ..argument)) - ..return - (<code>.tuple (<>.some ..class)) - <code>.any))) + (all <>.and + <code>.text + ..visibility + <code>.bit + <code>.bit + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + <code>.text + (<code>.tuple (<>.some ..argument)) + ..return + (<code>.tuple (<>.some ..class)) + <code>.any))) (type: .public (Method_Declaration a) (Record @@ -1993,14 +1993,14 @@ (def: .public method_declaration (Parser (Method_Declaration Code)) (<code>.form - ($_ <>.and - <code>.text - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..var)) - (<code>.tuple (<>.some ..class)) - (<code>.tuple (<>.some ..type)) - ..return - ))) + (all <>.and + <code>.text + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + (<code>.tuple (<>.some ..class)) + (<code>.tuple (<>.some ..type)) + ..return + ))) (def: .public (analyse_virtual_method analyse archive selfT mapping method) (-> Phase Archive .Type Mapping (Virtual_Method Code) (Operation Analysis)) @@ -2066,16 +2066,16 @@ (Parser (Static_Method Code)) (<| <code>.form (<>.after (<code>.this_text ..static_tag)) - ($_ <>.and - <code>.text - ..visibility - <code>.bit - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..var)) - (<code>.tuple (<>.some ..argument)) - ..return - (<code>.tuple (<>.some ..class)) - <code>.any))) + (all <>.and + <code>.text + ..visibility + <code>.bit + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + (<code>.tuple (<>.some ..argument)) + ..return + (<code>.tuple (<>.some ..class)) + <code>.any))) (def: .public (analyse_static_method analyse archive mapping method) (-> Phase Archive Mapping (Static_Method Code) (Operation Analysis)) @@ -2140,18 +2140,18 @@ (Parser (Overriden_Method Code)) (<| <code>.form (<>.after (<code>.this_text ..overriden_tag)) - ($_ <>.and - ..class - <code>.text - <code>.bit - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..var)) - <code>.text - (<code>.tuple (<>.some ..argument)) - ..return - (<code>.tuple (<>.some ..class)) - <code>.any - ))) + (all <>.and + ..class + <code>.text + <code>.bit + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..var)) + <code>.text + (<code>.tuple (<>.some ..argument)) + ..return + (<code>.tuple (<>.some ..class)) + <code>.any + ))) (exception: .public (unknown_super [name Text supers (List (Type Class))]) @@ -2396,9 +2396,9 @@ (try#each (|>> (format.result class.writer) [name]) (class.class version.v6_0 - ($_ modifier#composite - class.public - modifier) + (all modifier#composite + class.public + modifier) (name.internal name) {.#Some signature} (..class_name super) @@ -2409,11 +2409,11 @@ (def: constant::modifier (Modifier field.Field) - ($_ modifier#composite - field.public - field.static - field.final - )) + (all modifier#composite + field.public + field.static + field.final + )) (def: (field_definition field) (-> Field (Resource field.Field)) @@ -2484,24 +2484,24 @@ _.return {.#Left valueT} - ($_ _.composite - (mock_value valueT) - (case (jvm.primitive? valueT) - {.#Left classT} - _.areturn - - {.#Right primitiveT} - (cond (# jvm.equivalence = jvm.long primitiveT) - _.lreturn + (all _.composite + (mock_value valueT) + (case (jvm.primitive? valueT) + {.#Left classT} + _.areturn + + {.#Right primitiveT} + (cond (# jvm.equivalence = jvm.long primitiveT) + _.lreturn - (# jvm.equivalence = jvm.float primitiveT) - _.freturn + (# jvm.equivalence = jvm.float primitiveT) + _.freturn - (# jvm.equivalence = jvm.double primitiveT) - _.dreturn + (# jvm.equivalence = jvm.double primitiveT) + _.dreturn - ... jvm.boolean jvm.byte jvm.short jvm.int jvm.char - _.ireturn))))) + ... jvm.boolean jvm.byte jvm.short jvm.int jvm.char + _.ireturn))))) (def: (mock_method super method) (-> (Type Class) (Method_Definition Code) (Resource method.Method)) @@ -2509,32 +2509,32 @@ {#Constructor [privacy strict_floating_point? annotations variables exceptions self arguments constructor_arguments body]} - (method.method ($_ modifier#composite - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty)) + (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) ..constructor_name #0 (jvm.method [variables (list#each product.right arguments) jvm.void exceptions]) (list) - {.#Some ($_ _.composite - (_.aload 0) - (|> constructor_arguments - (list#each (|>> product.left ..mock_value)) - (monad.all _.monad)) - (|> (jvm.method [(list) (list#each product.left constructor_arguments) jvm.void (list)]) - (_.invokespecial super ..constructor_name)) - _.return - )}) + {.#Some (all _.composite + (_.aload 0) + (|> constructor_arguments + (list#each (|>> product.left ..mock_value)) + (monad.all _.monad)) + (|> (jvm.method [(list) (list#each product.left constructor_arguments) jvm.void (list)]) + (_.invokespecial super ..constructor_name)) + _.return + )}) {#Overriden_Method [super name strict_floating_point? annotations variables self arguments return exceptions body]} - (method.method ($_ modifier#composite - method.public - (if strict_floating_point? - method.strict - modifier.empty)) + (method.method (all modifier#composite + method.public + (if strict_floating_point? + method.strict + modifier.empty)) name #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -2543,14 +2543,14 @@ {#Virtual_Method [name privacy final? strict_floating_point? annotations variables self arguments return exceptions body]} - (method.method ($_ modifier#composite - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty) - (if final? - method.final - modifier.empty)) + (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty) + (if final? + method.final + modifier.empty)) name #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -2559,12 +2559,12 @@ {#Static_Method [name privacy strict_floating_point? annotations variables arguments return exceptions body]} - (method.method ($_ modifier#composite - method.static - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty)) + (method.method (all modifier#composite + method.static + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) name #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -2572,9 +2572,9 @@ {#Abstract_Method [name privacy annotations variables arguments return exceptions]} - (method.method ($_ modifier#composite - method.abstract - (..method_privacy privacy)) + (method.method (all modifier#composite + method.abstract + (..method_privacy privacy)) name #0 (jvm.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -2594,12 +2594,12 @@ (def: (class::anonymous class_loader host) (-> java/lang/ClassLoader runtime.Host Handler) (..custom - [($_ <>.and - (<code>.tuple (<>.some ..var)) - ..class - (<code>.tuple (<>.some ..class)) - (<code>.tuple (<>.some ..input)) - (<code>.tuple (<>.some ..overriden_method_definition))) + [(all <>.and + (<code>.tuple (<>.some ..var)) + ..class + (<code>.tuple (<>.some ..class)) + (<code>.tuple (<>.some ..input)) + (<code>.tuple (<>.some ..overriden_method_definition))) (function (_ extension_name analyse archive [parameters super_class super_interfaces diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux index a0e5d2a1c..6f5b62016 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lua.lux @@ -88,7 +88,7 @@ (def: array::write Handler (custom - [($_ <>.and <code>.any <code>.any <code>.any) + [(all <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -107,7 +107,7 @@ (def: array::delete Handler (custom - [($_ <>.and <code>.any <code>.any) + [(all <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -135,7 +135,7 @@ (def: object::get Handler (custom - [($_ <>.and <code>.text <code>.any) + [(all <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.expecting ..Object @@ -147,7 +147,7 @@ (def: object::do Handler (custom - [($_ <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] [objectA (analysis/type.expecting ..Object @@ -204,7 +204,7 @@ (def: lua::apply Handler (custom - [($_ <>.and <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (analysis/type.expecting ..Function @@ -216,7 +216,7 @@ (def: lua::power Handler (custom - [($_ <>.and <code>.any <code>.any) + [(all <>.and <code>.any <code>.any) (function (_ extension phase archive [powerC baseC]) (do [! phase.monad] [powerA (analysis/type.expecting Frac @@ -238,7 +238,7 @@ (def: lua::function Handler (custom - [($_ <>.and <code>.nat <code>.any) + [(all <>.and <code>.nat <code>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad [.let [inputT (type.tuple (list.repeated arity Any))] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index bf2f53507..6ff97bb35 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -96,11 +96,11 @@ (def: lux::syntax_char_case! (..custom - [($_ <>.and - <code>.any - (<code>.tuple (<>.some (<>.and (<code>.tuple (<>.many ..text_char)) - <code>.any))) - <code>.any) + [(all <>.and + <code>.any + (<code>.tuple (<>.some (<>.and (<code>.tuple (<>.many ..text_char)) + <code>.any))) + <code>.any) (function (_ extension_name phase archive [input conditionals else]) (do [! ////.monad] [input (<| (typeA.expecting text.Char) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux index 760db788c..6d7b0d128 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/php.lux @@ -72,7 +72,7 @@ (def: array::write Handler (custom - [($_ <>.and <c>.any <c>.any <c>.any) + [(all <>.and <c>.any <c>.any <c>.any) (function (_ extension phase archive [indexC valueC arrayC]) (<| analysis/type.with_var (function (_ [@var :var:])) @@ -89,7 +89,7 @@ (def: array::delete Handler (custom - [($_ <>.and <c>.any <c>.any) + [(all <>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) (<| analysis/type.with_var (function (_ [@var :var:])) @@ -127,7 +127,7 @@ (def: object::new Handler (custom - [($_ <>.and <c>.text (<>.some <c>.any)) + [(all <>.and <c>.text (<>.some <c>.any)) (function (_ extension phase archive [constructor inputsC]) (do [! phase.monad] [inputsA (monad.each ! (|>> (phase archive) (analysis/type.with_type Any)) inputsC) @@ -137,7 +137,7 @@ (def: object::get Handler (custom - [($_ <>.and <c>.text <c>.any) + [(all <>.and <c>.text <c>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.with_type ..Object @@ -149,7 +149,7 @@ (def: object::do Handler (custom - [($_ <>.and <c>.text <c>.any (<>.some <c>.any)) + [(all <>.and <c>.text <c>.any (<>.some <c>.any)) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] [objectA (analysis/type.with_type ..Object @@ -183,7 +183,7 @@ (def: php::apply Handler (custom - [($_ <>.and <c>.any (<>.some <c>.any)) + [(all <>.and <c>.any (<>.some <c>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (analysis/type.with_type ..Function @@ -195,7 +195,7 @@ (def: php::pack Handler (custom - [($_ <>.and <c>.any <c>.any) + [(all <>.and <c>.any <c>.any) (function (_ extension phase archive [formatC dataC]) (do [! phase.monad] [formatA (analysis/type.with_type Text diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux index ceecbce4f..9156e497b 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/python.lux @@ -76,7 +76,7 @@ (def: array::write Handler (custom - [($_ <>.and <code>.any <code>.any <code>.any) + [(all <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -95,7 +95,7 @@ (def: array::delete Handler (custom - [($_ <>.and <code>.any <code>.any) + [(all <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -139,7 +139,7 @@ (def: object::get Handler (custom - [($_ <>.and <code>.text <code>.any) + [(all <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (analysis/type.expecting ..Object @@ -151,7 +151,7 @@ (def: object::do Handler (custom - [($_ <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] [objectA (analysis/type.expecting ..Object @@ -193,7 +193,7 @@ (def: python::apply Handler (custom - [($_ <>.and <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (analysis/type.expecting ..Function @@ -205,7 +205,7 @@ (def: python::function Handler (custom - [($_ <>.and <code>.nat <code>.any) + [(all <>.and <code>.nat <code>.any) (function (_ extension phase archive [arity abstractionC]) (do phase.monad [.let [inputT (type.tuple (list.repeated arity Any))] @@ -218,7 +218,7 @@ (def: python::exec Handler (custom - [($_ <>.and <code>.any <code>.any) + [(all <>.and <code>.any <code>.any) (function (_ extension phase archive [codeC globalsC]) (do phase.monad [codeA (analysis/type.expecting Text diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux index 8af81e312..9ab5d8351 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/ruby.lux @@ -76,7 +76,7 @@ (def: array::write Handler (custom - [($_ <>.and <code>.any <code>.any <code>.any) + [(all <>.and <code>.any <code>.any <code>.any) (function (_ extension phase archive [indexC valueC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -95,7 +95,7 @@ (def: array::delete Handler (custom - [($_ <>.and <code>.any <code>.any) + [(all <>.and <code>.any <code>.any) (function (_ extension phase archive [indexC arrayC]) (<| analysis/type.with_var (function (_ [@read :read:])) @@ -135,7 +135,7 @@ (def: object::get Handler (custom - [($_ <>.and <code>.text <code>.any) + [(all <>.and <code>.text <code>.any) (function (_ extension phase archive [fieldC objectC]) (do phase.monad [objectA (<| (analysis/type.expecting ..Object) @@ -147,7 +147,7 @@ (def: object::do Handler (custom - [($_ <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.text <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [methodC objectC inputsC]) (do [! phase.monad] [objectA (<| (analysis/type.expecting ..Object) @@ -180,7 +180,7 @@ (def: ruby::apply Handler (custom - [($_ <>.and <code>.any (<code>.tuple (<>.some <code>.any))) + [(all <>.and <code>.any (<code>.tuple (<>.some <code>.any))) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (<| (analysis/type.expecting ..Function) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux index da2c2e828..fb119ae7e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/scheme.lux @@ -72,7 +72,7 @@ (def: array::write Handler (custom - [($_ <>.and <c>.any <c>.any <c>.any) + [(all <>.and <c>.any <c>.any <c>.any) (function (_ extension phase archive [indexC valueC arrayC]) (<| analysis/type.with_var (function (_ [@var :var:])) @@ -89,7 +89,7 @@ (def: array::delete Handler (custom - [($_ <>.and <c>.any <c>.any) + [(all <>.and <c>.any <c>.any) (function (_ extension phase archive [indexC arrayC]) (<| analysis/type.with_var (function (_ [@var :var:])) @@ -140,7 +140,7 @@ (def: scheme::apply Handler (custom - [($_ <>.and <c>.any (<>.some <c>.any)) + [(all <>.and <c>.any (<>.some <c>.any)) (function (_ extension phase archive [abstractionC inputsC]) (do [! phase.monad] [abstractionA (analysis/type.with_type ..Function diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux index 0906183ef..1a30f6bc6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/jvm.lux @@ -111,14 +111,14 @@ (def: visibility' (<text>.Parser (Modifier field.Field)) - (`` ($_ <>.either - (~~ (template [<label> <modifier>] - [(<>.after (<text>.this <label>) (<>#in <modifier>))] + (`` (all <>.either + (~~ (template [<label> <modifier>] + [(<>.after (<text>.this <label>) (<>#in <modifier>))] - ["public" field.public] - ["private" field.private] - ["protected" field.protected] - ["default" modifier.empty]))))) + ["public" field.public] + ["private" field.private] + ["protected" field.protected] + ["default" modifier.empty]))))) (def: visibility (Parser (Modifier field.Field)) @@ -126,23 +126,23 @@ (def: inheritance (Parser (Modifier class.Class)) - (`` ($_ <>.either - (~~ (template [<label> <modifier>] - [(<>.after (<code>.this_text <label>) (<>#in <modifier>))] + (`` (all <>.either + (~~ (template [<label> <modifier>] + [(<>.after (<code>.this_text <label>) (<>#in <modifier>))] - ["final" class.final] - ["abstract" class.abstract] - ["default" modifier.empty]))))) + ["final" class.final] + ["abstract" class.abstract] + ["default" modifier.empty]))))) (def: state (Parser (Modifier field.Field)) - (`` ($_ <>.either - (~~ (template [<label> <modifier>] - [(<>.after (<code>.this_text <label>) (<>#in <modifier>))] + (`` (all <>.either + (~~ (template [<label> <modifier>] + [(<>.after (<code>.this_text <label>) (<>#in <modifier>))] - ["volatile" field.volatile] - ["final" field.final] - ["default" modifier.empty]))))) + ["volatile" field.volatile] + ["final" field.final] + ["default" modifier.empty]))))) (type: Annotation Any) @@ -161,12 +161,12 @@ (Parser Constant) (<| <code>.form (<>.after (<code>.this_text "constant")) - ($_ <>.and - <code>.text - (<code>.tuple (<>.some ..annotation)) - ..field_type - <code>.any - ))) + (all <>.and + <code>.text + (<code>.tuple (<>.some ..annotation)) + ..field_type + <code>.any + ))) (type: Variable [Text (Modifier field.Field) (Modifier field.Field) Bit (List Annotation) (Type Value)]) @@ -175,14 +175,14 @@ (Parser Variable) (<| <code>.form (<>.after (<code>.this_text "variable")) - ($_ <>.and - <code>.text - ..visibility - ..state - (<>.parses? (<code>.this_text jvm.static_tag)) - (<code>.tuple (<>.some ..annotation)) - ..field_type - ))) + (all <>.and + <code>.text + ..visibility + ..state + (<>.parses? (<code>.this_text jvm.static_tag)) + (<code>.tuple (<>.some ..annotation)) + ..field_type + ))) (type: Field (Variant @@ -191,10 +191,10 @@ (def: field (Parser Field) - ($_ <>.or - ..constant - ..variable - )) + (all <>.or + ..constant + ..variable + )) (type: (Method_Definition a) (Variant @@ -206,13 +206,13 @@ (def: method (Parser (Method_Definition Code)) - ($_ <>.or - jvm.constructor_definition - jvm.virtual_method_definition - jvm.static_method_definition - jvm.overriden_method_definition - jvm.abstract_method_definition - )) + (all <>.or + jvm.constructor_definition + jvm.virtual_method_definition + jvm.static_method_definition + jvm.overriden_method_definition + jvm.abstract_method_definition + )) (def: $Object (Type Class) @@ -220,10 +220,10 @@ (def: constant::modifier (Modifier field.Field) - ($_ modifier#composite - field.public - field.static - field.final)) + (all modifier#composite + field.public + field.static + field.final)) (def: (field_definition field) (-> Field (Resource field.Field)) @@ -254,12 +254,12 @@ ... TODO: Handle annotations. {#Variable [name visibility state static? annotations type]} - (field.field ($_ modifier#composite - (if static? - field.static - modifier.empty) - visibility - state) + (field.field (all modifier#composite + (if static? + field.static + modifier.empty) + visibility + state) name #1 type sequence.empty))) (def: annotation_parameter_synthesis @@ -295,114 +295,114 @@ (<synthesis>.function 1) (<synthesis>.loop (<>.exactly 0 <synthesis>.any)) <synthesis>.tuple - ($_ <>.either - (<| (<>.after (<synthesis>.this_text "")) - (<>#each (host.hidden_method_body arity)) - <synthesis>.any) - <synthesis>.any))) + (all <>.either + (<| (<>.after (<synthesis>.this_text "")) + (<>#each (host.hidden_method_body arity)) + <synthesis>.any) + <synthesis>.any))) (def: constructor_synthesis (<synthesis>.Parser (jvm.Constructor Synthesis)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.constructor_tag)) - ($_ <>.and - (<text>.then jvm.visibility' <synthesis>.text) - <synthesis>.bit - (<synthesis>.tuple (<>.some ..annotation_synthesis)) - (<synthesis>.tuple (<>.some ..var_type_synthesis)) - (<synthesis>.tuple (<>.some ..class_type_synthesis)) - <synthesis>.text - (do <>.monad - [args (<synthesis>.tuple (<>.some ..argument_synthesis))] - ($_ <>.and - (in args) - (<synthesis>.tuple (<>.some ..input_synthesis)) - (..method_body (list.size args)))) - ))) + (all <>.and + (<text>.then jvm.visibility' <synthesis>.text) + <synthesis>.bit + (<synthesis>.tuple (<>.some ..annotation_synthesis)) + (<synthesis>.tuple (<>.some ..var_type_synthesis)) + (<synthesis>.tuple (<>.some ..class_type_synthesis)) + <synthesis>.text + (do <>.monad + [args (<synthesis>.tuple (<>.some ..argument_synthesis))] + (all <>.and + (in args) + (<synthesis>.tuple (<>.some ..input_synthesis)) + (..method_body (list.size args)))) + ))) (def: overriden_method_synthesis (<synthesis>.Parser (jvm.Overriden_Method Synthesis)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.overriden_tag)) - ($_ <>.and - ..class_type_synthesis - <synthesis>.text - <synthesis>.bit - (<synthesis>.tuple (<>.some ..annotation_synthesis)) - (<synthesis>.tuple (<>.some ..var_type_synthesis)) - <synthesis>.text - (do <>.monad - [args (<synthesis>.tuple (<>.some ..argument_synthesis))] - ($_ <>.and - (in args) - ..return_type_synthesis - (<synthesis>.tuple (<>.some ..class_type_synthesis)) - (..method_body (list.size args)))) - ))) + (all <>.and + ..class_type_synthesis + <synthesis>.text + <synthesis>.bit + (<synthesis>.tuple (<>.some ..annotation_synthesis)) + (<synthesis>.tuple (<>.some ..var_type_synthesis)) + <synthesis>.text + (do <>.monad + [args (<synthesis>.tuple (<>.some ..argument_synthesis))] + (all <>.and + (in args) + ..return_type_synthesis + (<synthesis>.tuple (<>.some ..class_type_synthesis)) + (..method_body (list.size args)))) + ))) (def: virtual_method_synthesis (<synthesis>.Parser (jvm.Virtual_Method Synthesis)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.virtual_tag)) - ($_ <>.and - <synthesis>.text - (<text>.then jvm.visibility' <synthesis>.text) - <synthesis>.bit - <synthesis>.bit - (<synthesis>.tuple (<>.some ..annotation_synthesis)) - (<synthesis>.tuple (<>.some ..var_type_synthesis)) - <synthesis>.text - (do <>.monad - [args (<synthesis>.tuple (<>.some ..argument_synthesis))] - ($_ <>.and - (in args) - ..return_type_synthesis - (<synthesis>.tuple (<>.some ..class_type_synthesis)) - (..method_body (list.size args)))) - ))) + (all <>.and + <synthesis>.text + (<text>.then jvm.visibility' <synthesis>.text) + <synthesis>.bit + <synthesis>.bit + (<synthesis>.tuple (<>.some ..annotation_synthesis)) + (<synthesis>.tuple (<>.some ..var_type_synthesis)) + <synthesis>.text + (do <>.monad + [args (<synthesis>.tuple (<>.some ..argument_synthesis))] + (all <>.and + (in args) + ..return_type_synthesis + (<synthesis>.tuple (<>.some ..class_type_synthesis)) + (..method_body (list.size args)))) + ))) (def: static_method_synthesis (<synthesis>.Parser (jvm.Static_Method Synthesis)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.static_tag)) - ($_ <>.and - <synthesis>.text - (<text>.then jvm.visibility' <synthesis>.text) - <synthesis>.bit - (<synthesis>.tuple (<>.some ..annotation_synthesis)) - (<synthesis>.tuple (<>.some ..var_type_synthesis)) - (do <>.monad - [args (<synthesis>.tuple (<>.some ..argument_synthesis))] - ($_ <>.and - (in args) - ..return_type_synthesis - (<synthesis>.tuple (<>.some ..class_type_synthesis)) - (..method_body (list.size args)))) - ))) + (all <>.and + <synthesis>.text + (<text>.then jvm.visibility' <synthesis>.text) + <synthesis>.bit + (<synthesis>.tuple (<>.some ..annotation_synthesis)) + (<synthesis>.tuple (<>.some ..var_type_synthesis)) + (do <>.monad + [args (<synthesis>.tuple (<>.some ..argument_synthesis))] + (all <>.and + (in args) + ..return_type_synthesis + (<synthesis>.tuple (<>.some ..class_type_synthesis)) + (..method_body (list.size args)))) + ))) (def: abstract_method_synthesis (<synthesis>.Parser (jvm.Abstract_Method Synthesis)) (<| <synthesis>.tuple (<>.after (<synthesis>.this_text jvm.abstract_tag)) - ($_ <>.and - <synthesis>.text - (<text>.then jvm.visibility' <synthesis>.text) - (<synthesis>.tuple (<>.some ..annotation_synthesis)) - (<synthesis>.tuple (<>.some ..var_type_synthesis)) - (<synthesis>.tuple (<>.some ..argument_synthesis)) - ..return_type_synthesis - (<synthesis>.tuple (<>.some ..class_type_synthesis)) - ))) + (all <>.and + <synthesis>.text + (<text>.then jvm.visibility' <synthesis>.text) + (<synthesis>.tuple (<>.some ..annotation_synthesis)) + (<synthesis>.tuple (<>.some ..var_type_synthesis)) + (<synthesis>.tuple (<>.some ..argument_synthesis)) + ..return_type_synthesis + (<synthesis>.tuple (<>.some ..class_type_synthesis)) + ))) (def: method_synthesis (<synthesis>.Parser (Method_Definition Synthesis)) - ($_ <>.or - ..constructor_synthesis - ..virtual_method_synthesis - ..static_method_synthesis - ..overriden_method_synthesis - ..abstract_method_synthesis - )) + (all <>.or + ..constructor_synthesis + ..virtual_method_synthesis + ..static_method_synthesis + ..overriden_method_synthesis + ..abstract_method_synthesis + )) (def: composite (-> (List (Bytecode Any)) (Bytecode Any)) @@ -419,17 +419,17 @@ [(n.+ 1 jvm_register) (if (n.= lux_register jvm_register) (_#in []) - ($_ _.composite - (_.aload jvm_register) - (_.astore lux_register)))] + (all _.composite + (_.aload jvm_register) + (_.astore lux_register)))] {.#Right argumentT} (template.let [(wrap_primitive <shift> <load> <type>) [[(n.+ <shift> jvm_register) - ($_ _.composite - (<load> jvm_register) - (value.wrap <type>) - (_.astore lux_register))]]] + (all _.composite + (<load> jvm_register) + (value.wrap <type>) + (_.astore lux_register))]]] (`` (cond (~~ (template [<shift> <load> <type>] [(# type.equivalence = <type> argumentT) (wrap_primitive <shift> <load> <type>)] @@ -451,7 +451,7 @@ list.enumeration (list#mix (function (_ [lux_register type] [jvm_register before]) (let [[jvm_register' after] (method_argument (n.+ offset lux_register) type jvm_register)] - [jvm_register' ($_ _.composite before after)])) + [jvm_register' (all _.composite before after)])) (is [Register (Bytecode Any)] [offset (_#in [])])) product.right)) @@ -473,22 +473,22 @@ type.void (list)]) argumentsT (list#each product.right arguments)]] - (in (method.method ($_ modifier#composite - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty)) + (in (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) ..constructor_name #1 (type.method [method_tvars argumentsT type.void exceptions]) (list) - {.#Some ($_ _.composite - (_.aload 0) - (..composite constructor_argumentsG) - (_.invokespecial super_class ..constructor_name super_constructorT) - (method_arguments 1 argumentsT) - bodyG - _.return - )}))))) + {.#Some (all _.composite + (_.aload 0) + (..composite constructor_argumentsG) + (_.invokespecial super_class ..constructor_name super_constructorT) + (method_arguments 1 argumentsT) + bodyG + _.return + )}))))) (def: (method_return returnT) (-> (Type Return) (Bytecode Any)) @@ -501,18 +501,18 @@ {.#Left returnT} (case (type.class? returnT) {.#Some class_name} - ($_ _.composite - (_.checkcast returnT) - _.areturn) + (all _.composite + (_.checkcast returnT) + _.areturn) {.#None} _.areturn) {.#Right returnT} (template.let [(unwrap_primitive <return> <type>) - [($_ _.composite - (value.unwrap <type>) - <return>)]] + [(all _.composite + (value.unwrap <type>) + <return>)]] (`` (cond (~~ (template [<return> <type>] [(# type.equivalence = <type> returnT) (unwrap_primitive <return> <type>)] @@ -539,18 +539,18 @@ (do ! [bodyG (generate archive bodyS) .let [argumentsT (list#each product.right arguments)]] - (in (method.method ($_ modifier#composite - method.public - (if strict_floating_point? - method.strict - modifier.empty)) + (in (method.method (all modifier#composite + method.public + (if strict_floating_point? + method.strict + modifier.empty)) method_name #1 (type.method [method_tvars argumentsT returnJ exceptionsJ]) (list) - {.#Some ($_ _.composite - (method_arguments 1 argumentsT) - bodyG - (method_return returnJ))})))))) + {.#Some (all _.composite + (method_arguments 1 argumentsT) + bodyG + (method_return returnJ))})))))) (def: (virtual_method_generation archive method) (-> Archive (jvm.Virtual_Method Synthesis) (Operation (Resource Method))) @@ -563,21 +563,21 @@ (do ! [bodyG (generate archive bodyS) .let [argumentsT (list#each product.right arguments)]] - (in (method.method ($_ modifier#composite - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty) - (if final? - method.final - modifier.empty)) + (in (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty) + (if final? + method.final + modifier.empty)) method_name #1 (type.method [method_tvars argumentsT returnJ exceptionsJ]) (list) - {.#Some ($_ _.composite - (method_arguments 1 argumentsT) - bodyG - (method_return returnJ))})))))) + {.#Some (all _.composite + (method_arguments 1 argumentsT) + bodyG + (method_return returnJ))})))))) (def: (static_method_generation archive method) (-> Archive (jvm.Static_Method Synthesis) (Operation (Resource Method))) @@ -590,27 +590,27 @@ (do ! [bodyG (generate archive bodyS) .let [argumentsT (list#each product.right arguments)]] - (in (method.method ($_ modifier#composite - (..method_privacy privacy) - method.static - (if strict_floating_point? - method.strict - modifier.empty)) + (in (method.method (all modifier#composite + (..method_privacy privacy) + method.static + (if strict_floating_point? + method.strict + modifier.empty)) method_name #1 (type.method [method_tvars argumentsT returnJ exceptionsJ]) (list) - {.#Some ($_ _.composite - (method_arguments 0 argumentsT) - bodyG - (method_return returnJ))})))))) + {.#Some (all _.composite + (method_arguments 0 argumentsT) + bodyG + (method_return returnJ))})))))) (def: (abstract_method_generation method) (-> (jvm.Abstract_Method Synthesis) (Resource Method)) (let [[name privacy annotations variables arguments return exceptions] method] - (method.method ($_ modifier#composite - (..method_privacy privacy) - method.abstract) + (method.method (all modifier#composite + (..method_privacy privacy) + method.abstract) name #1 (type.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -687,9 +687,9 @@ (try#each (|>> (format.result class.writer) [name]) (class.class version.v6_0 - ($_ modifier#composite - class.public - modifier) + (all modifier#composite + class.public + modifier) (name.internal name) {.#Some signature} (..class_name super) @@ -724,24 +724,24 @@ _.return {.#Left valueT} - ($_ _.composite - (mock_value valueT) - (case (type.primitive? valueT) - {.#Left classT} - _.areturn - - {.#Right primitiveT} - (cond (# type.equivalence = type.long primitiveT) - _.lreturn + (all _.composite + (mock_value valueT) + (case (type.primitive? valueT) + {.#Left classT} + _.areturn + + {.#Right primitiveT} + (cond (# type.equivalence = type.long primitiveT) + _.lreturn - (# type.equivalence = type.float primitiveT) - _.freturn + (# type.equivalence = type.float primitiveT) + _.freturn - (# type.equivalence = type.double primitiveT) - _.dreturn + (# type.equivalence = type.double primitiveT) + _.dreturn - ... type.boolean type.byte type.short type.int type.char - _.ireturn))))) + ... type.boolean type.byte type.short type.int type.char + _.ireturn))))) (def: (mock_method super method) (-> (Type Class) (Method_Definition Code) (Resource method.Method)) @@ -749,32 +749,32 @@ {#Constructor [privacy strict_floating_point? annotations variables exceptions self arguments constructor_arguments body]} - (method.method ($_ modifier#composite - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty)) + (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) ..constructor_name #1 (type.method [variables (list#each product.right arguments) type.void exceptions]) (list) - {.#Some ($_ _.composite - (_.aload 0) - (|> constructor_arguments - (list#each (|>> product.left ..mock_value)) - (monad.all _.monad)) - (|> (type.method [(list) (list#each product.left constructor_arguments) type.void (list)]) - (_.invokespecial super ..constructor_name)) - _.return - )}) + {.#Some (all _.composite + (_.aload 0) + (|> constructor_arguments + (list#each (|>> product.left ..mock_value)) + (monad.all _.monad)) + (|> (type.method [(list) (list#each product.left constructor_arguments) type.void (list)]) + (_.invokespecial super ..constructor_name)) + _.return + )}) {#Overriden_Method [super name strict_floating_point? annotations variables self arguments return exceptions body]} - (method.method ($_ modifier#composite - method.public - (if strict_floating_point? - method.strict - modifier.empty)) + (method.method (all modifier#composite + method.public + (if strict_floating_point? + method.strict + modifier.empty)) name #1 (type.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -783,14 +783,14 @@ {#Virtual_Method [name privacy final? strict_floating_point? annotations variables self arguments return exceptions body]} - (method.method ($_ modifier#composite - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty) - (if final? - method.final - modifier.empty)) + (method.method (all modifier#composite + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty) + (if final? + method.final + modifier.empty)) name #1 (type.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -799,12 +799,12 @@ {#Static_Method [name privacy strict_floating_point? annotations variables arguments return exceptions body]} - (method.method ($_ modifier#composite - method.static - (..method_privacy privacy) - (if strict_floating_point? - method.strict - modifier.empty)) + (method.method (all modifier#composite + method.static + (..method_privacy privacy) + (if strict_floating_point? + method.strict + modifier.empty)) name #1 (type.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -812,9 +812,9 @@ {#Abstract_Method [name privacy annotations variables arguments return exceptions]} - (method.method ($_ modifier#composite - method.abstract - (..method_privacy privacy)) + (method.method (all modifier#composite + method.abstract + (..method_privacy privacy)) name #1 (type.method [variables (list#each product.right arguments) return exceptions]) (list) @@ -855,14 +855,14 @@ (def: jvm::class (Handler Anchor (Bytecode Any) Definition) (/.custom - [($_ <>.and - ..class_declaration - jvm.class - (<code>.tuple (<>.some jvm.class)) - ..inheritance - (<code>.tuple (<>.some ..annotation)) - (<code>.tuple (<>.some ..field)) - (<code>.tuple (<>.some ..method))) + [(all <>.and + ..class_declaration + jvm.class + (<code>.tuple (<>.some jvm.class)) + ..inheritance + (<code>.tuple (<>.some ..annotation)) + (<code>.tuple (<>.some ..field)) + (<code>.tuple (<>.some ..method))) (function (_ extension phase archive [class_declaration super @@ -904,9 +904,9 @@ bytecode (<| (# ! each (format.result class.writer)) phase.lifted (class.class version.v6_0 - ($_ modifier#composite - class.public - inheritance) + (all modifier#composite + class.public + inheritance) (name.internal name) {.#Some type_declaration} (..class_name super) @@ -920,9 +920,9 @@ (def: (method_declaration (open "/[0]")) (-> (jvm.Method_Declaration Code) (Resource Method)) (let [type (type.method [/#type_variables /#arguments /#return /#exceptions])] - (method.method ($_ modifier#composite - method.public - method.abstract) + (method.method (all modifier#composite + method.public + method.abstract) /#name #1 type (list) @@ -931,22 +931,22 @@ (def: jvm::class::interface (Handler Anchor (Bytecode Any) Definition) (/.custom - [($_ <>.and - ..class_declaration - (<code>.tuple (<>.some jvm.class)) - ... TODO: Handle annotations. - (<code>.tuple (<>.some ..annotation)) - (<>.some jvm.method_declaration)) + [(all <>.and + ..class_declaration + (<code>.tuple (<>.some jvm.class)) + ... TODO: Handle annotations. + (<code>.tuple (<>.some ..annotation)) + (<>.some jvm.method_declaration)) (function (_ extension_name phase archive [[name parameters] supers annotations method_declarations]) (directive.lifted_generation (do [! phase.monad] [bytecode (<| (# ! each (format.result class.writer)) phase.lifted (class.class version.v6_0 - ($_ modifier#composite - class.public - class.abstract - class.interface) + (all modifier#composite + class.public + class.abstract + class.interface) (name.internal name) {.#Some (signature.inheritance (list#each type.signature parameters) (type.signature $Object) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux index a25d02ed7..2d07295c0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux @@ -274,10 +274,10 @@ (def: (def::type_tagged expander host_analysis) (-> Expander /////analysis.Bundle Handler) (..custom - [($_ <>.and <code>.local <code>.any - (<>.or (<code>.variant (<>.some <code>.text)) - (<code>.tuple (<>.some <code>.text))) - <code>.any) + [(all <>.and <code>.local <code>.any + (<>.or (<code>.variant (<>.some <code>.text)) + (<code>.tuple (<>.some <code>.text))) + <code>.any) (function (_ extension_name phase archive [short_name valueC labels exported?C]) (do phase.monad [current_module (/////directive.lifted_analysis @@ -366,7 +366,7 @@ (def: def::alias Handler (..custom - [($_ <>.and <code>.local <code>.symbol) + [(all <>.and <code>.local <code>.symbol) (function (_ extension_name phase archive [alias def_name]) (do phase.monad [_ (///.lifted diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux index 9e68d5992..1c4b6e9d3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/common_lisp/common.lux @@ -56,10 +56,10 @@ ... ... TODO: Get rid of this ASAP ... (def: lux::syntax_char_case! -... (..custom [($_ <>.and +... (..custom [(all <>.and ... <s>.any ... <s>.any -... (<>.some (<s>.tuple ($_ <>.and +... (<>.some (<s>.tuple (all <>.and ... (<s>.tuple (<>.many <s>.i64)) ... <s>.any)))) ... (function (_ extension_name phase archive [input else conditionals]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 3d2fd35f3..a85bc1fb6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -94,9 +94,9 @@ ... [[IO]] (def: (io//log messageG) (Unary Expression) - ($_ _., - (//runtime.io//log messageG) - //runtime.unit)) + (all _., + (//runtime.io//log messageG) + //runtime.unit)) (def: .public (statement expression archive synthesis) Phase! @@ -149,12 +149,12 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) + (..custom [(all <>.and + <s>.any + <s>.any + (<>.some (<s>.tuple (all <>.and + (<s>.tuple (<>.many <s>.i64)) + <s>.any)))) (function (_ extension_name phase archive [input else conditionals]) (do [! /////.monad] [inputG (phase archive input) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux index 5037742a3..783dde8e3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/js/host.lux @@ -64,7 +64,7 @@ (def: object::new (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [constructorS inputsS]) (do [! ////////phase.monad] [constructorG (phase archive constructorS) @@ -74,7 +74,7 @@ (def: object::get Handler (custom - [($_ <>.and <s>.text <s>.any) + [(all <>.and <s>.text <s>.any) (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] @@ -83,7 +83,7 @@ (def: object::do Handler (custom - [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + [(all <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase archive [methodS objectS inputsS]) (do [! ////////phase.monad] [objectG (phase archive objectS) @@ -119,7 +119,7 @@ (def: js::apply (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) @@ -128,7 +128,7 @@ (def: js::function (custom - [($_ <>.and <s>.i64 <s>.any) + [(all <>.and <s>.i64 <s>.any) (function (_ extension phase archive [arity abstractionS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) @@ -139,12 +139,12 @@ (list.repeated (.nat arity) [])) g!abstraction (variable "abstraction")] (in (_.closure g!inputs - ($_ _.then - (_.define g!abstraction abstractionG) - (_.return (case (.nat arity) - 0 (_.apply_1 g!abstraction //runtime.unit) - 1 (_.apply_* g!abstraction g!inputs) - _ (_.apply_1 g!abstraction (_.array g!inputs)))))))))])) + (all _.then + (_.define g!abstraction abstractionG) + (_.return (case (.nat arity) + 0 (_.apply_1 g!abstraction //runtime.unit) + 1 (_.apply_* g!abstraction g!inputs) + _ (_.apply_1 g!abstraction (_.array g!inputs)))))))))])) (def: .public bundle Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux index 87684f26d..4b27edabb 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm.lux @@ -14,7 +14,7 @@ (def: .public bundle Bundle - ($_ dictionary.composite - /common.bundle - /host.bundle - )) + (all dictionary.composite + /common.bundle + /host.bundle + )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux index eb7cb76d4..7ecc092e8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/common.lux @@ -68,15 +68,15 @@ (def: lux_int (Bytecode Any) - ($_ _.composite - _.i2l - (///value.wrap type.long))) + (all _.composite + _.i2l + (///value.wrap type.long))) (def: jvm_int (Bytecode Any) - ($_ _.composite - (///value.unwrap type.long) - _.l2i)) + (all _.composite + (///value.unwrap type.long) + _.l2i)) (def: (predicate bytecode) (-> (-> Label (Bytecode Any)) @@ -84,23 +84,23 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.composite - (bytecode @then) - (_.getstatic $Boolean "FALSE" $Boolean) - (_.goto @end) - (_.set_label @then) - (_.getstatic $Boolean "TRUE" $Boolean) - (_.set_label @end) - ))) + (all _.composite + (bytecode @then) + (_.getstatic $Boolean "FALSE" $Boolean) + (_.goto @end) + (_.set_label @then) + (_.getstatic $Boolean "TRUE" $Boolean) + (_.set_label @end) + ))) ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <synthesis>.any - <synthesis>.any - (<>.some (<synthesis>.tuple ($_ <>.and - (<synthesis>.tuple (<>.many <synthesis>.i64)) - <synthesis>.any)))) + (..custom [(all <>.and + <synthesis>.any + <synthesis>.any + (<>.some (<synthesis>.tuple (all <>.and + (<synthesis>.tuple (<>.many <synthesis>.i64)) + <synthesis>.any)))) (function (_ extension_name phase archive [inputS elseS conditionalsS]) (do [! /////.monad] [@end ///runtime.forge_label @@ -115,10 +115,10 @@ (in [(list#each (function (_ char) [(try.trusted (signed.s4 (.int char))) @branch]) chars) - ($_ _.composite - (_.set_label @branch) - branchG - (_.when_continuous (_.goto @end)))]))) + (all _.composite + (_.set_label @branch) + branchG + (_.when_continuous (_.goto @end)))]))) conditionalsS)) .let [table (|> conditionalsG+ (list#each product.left) @@ -128,29 +128,29 @@ (monad.all _.monad))]] (in (do _.monad [@else _.new_label] - ($_ _.composite - inputG (///value.unwrap type.long) _.l2i - (_.lookupswitch @else table) - conditionalsG - (_.set_label @else) - elseG - (<| (_.when_acknowledged @end) - (_.set_label @end)) - )))))])) + (all _.composite + inputG (///value.unwrap type.long) _.l2i + (_.lookupswitch @else table) + conditionalsG + (_.set_label @else) + elseG + (<| (_.when_acknowledged @end) + (_.set_label @end)) + )))))])) (def: (lux::is [referenceG sampleG]) (Binary (Bytecode Any)) - ($_ _.composite - referenceG - sampleG - (..predicate _.if_acmpeq))) + (all _.composite + referenceG + sampleG + (..predicate _.if_acmpeq))) (def: (lux::try riskyG) (Unary (Bytecode Any)) - ($_ _.composite - riskyG - (_.checkcast ///function.class) - ///runtime.try)) + (all _.composite + riskyG + (_.checkcast ///function.class) + ///runtime.try)) (def: bundle::lux Bundle @@ -162,10 +162,10 @@ (template [<name> <op>] [(def: (<name> [maskG inputG]) (Binary (Bytecode Any)) - ($_ _.composite - inputG (///value.unwrap type.long) - maskG (///value.unwrap type.long) - <op> (///value.wrap type.long)))] + (all _.composite + inputG (///value.unwrap type.long) + maskG (///value.unwrap type.long) + <op> (///value.wrap type.long)))] [i64::and _.land] [i64::or _.lor] @@ -175,10 +175,10 @@ (template [<name> <op>] [(def: (<name> [shiftG inputG]) (Binary (Bytecode Any)) - ($_ _.composite - inputG (///value.unwrap type.long) - shiftG ..jvm_int - <op> (///value.wrap type.long)))] + (all _.composite + inputG (///value.unwrap type.long) + shiftG ..jvm_int + <op> (///value.wrap type.long)))] [i64::left_shifted _.lshl] [i64::right_shifted _.lushr] @@ -187,10 +187,10 @@ (template [<name> <type> <op>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) - ($_ _.composite - subjectG (///value.unwrap <type>) - paramG (///value.unwrap <type>) - <op> (///value.wrap <type>)))] + (all _.composite + subjectG (///value.unwrap <type>) + paramG (///value.unwrap <type>) + <op> (///value.wrap <type>)))] [i64::+ type.long _.ladd] [i64::- type.long _.lsub] @@ -209,12 +209,12 @@ [(template [<name> <reference>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) - ($_ _.composite - subjectG (///value.unwrap <type>) - paramG (///value.unwrap <type>) - <cmp> - <reference> - (..predicate _.if_icmpeq)))] + (all _.composite + subjectG (///value.unwrap <type>) + paramG (///value.unwrap <type>) + <cmp> + <reference> + (..predicate _.if_icmpeq)))] [<eq> _.iconst_0] [<lt> _.iconst_m1])] @@ -230,29 +230,29 @@ (template [<name> <prepare> <transform>] [(def: (<name> inputG) (Unary (Bytecode Any)) - ($_ _.composite - inputG - <prepare> - <transform>))] + (all _.composite + inputG + <prepare> + <transform>))] [i64::f64 (///value.unwrap type.long) - ($_ _.composite - _.l2d - (///value.wrap type.double))] + (all _.composite + _.l2d + (///value.wrap type.double))] [i64::char (///value.unwrap type.long) - ($_ _.composite - _.l2i - _.i2c - (..::toString ..$Character type.char))] + (all _.composite + _.l2i + _.i2c + (..::toString ..$Character type.char))] [f64::i64 (///value.unwrap type.double) - ($_ _.composite - _.d2l - (///value.wrap type.long))] + (all _.composite + _.d2l + (///value.wrap type.long))] [f64::encode (///value.unwrap type.double) @@ -299,21 +299,21 @@ (def: (text::size inputG) (Unary (Bytecode Any)) - ($_ _.composite - inputG - (_.checkcast $String) - (_.invokevirtual ..$String "length" (type.method [(list) (list) type.int (list)])) - ..lux_int)) + (all _.composite + inputG + (_.checkcast $String) + (_.invokevirtual ..$String "length" (type.method [(list) (list) type.int (list)])) + ..lux_int)) (def: no_op (Bytecode Any) (_#in [])) (template [<name> <pre_subject> <pre_param> <op> <post>] [(def: (<name> [paramG subjectG]) (Binary (Bytecode Any)) - ($_ _.composite - subjectG <pre_subject> - paramG <pre_param> - <op> <post>))] + (all _.composite + subjectG <pre_subject> + paramG <pre_param> + <op> <post>))] [text::= ..no_op ..no_op (_.invokevirtual ..$Object "equals" (type.method [(list) (list ..$Object) type.boolean (list)])) @@ -328,20 +328,20 @@ (def: (text::concat [leftG rightG]) (Binary (Bytecode Any)) - ($_ _.composite - leftG (_.checkcast $String) - rightG (_.checkcast $String) - (_.invokevirtual ..$String "concat" (type.method [(list) (list ..$String) ..$String (list)])))) + (all _.composite + leftG (_.checkcast $String) + rightG (_.checkcast $String) + (_.invokevirtual ..$String "concat" (type.method [(list) (list ..$String) ..$String (list)])))) (def: (text::clip [offset! length! subject!]) (Trinary (Bytecode Any)) - ($_ _.composite - subject! (_.checkcast $String) - offset! ..jvm_int - _.dup - length! ..jvm_int - _.iadd - (_.invokevirtual ..$String "substring" (type.method [(list) (list type.int type.int) ..$String (list)])))) + (all _.composite + subject! (_.checkcast $String) + offset! ..jvm_int + _.dup + length! ..jvm_int + _.iadd + (_.invokevirtual ..$String "substring" (type.method [(list) (list type.int type.int) ..$String (list)])))) (def: index_method (type.method [(list) (list ..$String type.int) type.int (list)])) (def: (text::index [startG partG textG]) @@ -349,21 +349,21 @@ (do _.monad [@not_found _.new_label @end _.new_label] - ($_ _.composite - textG (_.checkcast $String) - partG (_.checkcast $String) - startG ..jvm_int - (_.invokevirtual ..$String "indexOf" index_method) - _.dup - _.iconst_m1 - (_.if_icmpeq @not_found) - ..lux_int - ///runtime.some_injection - (_.goto @end) - (_.set_label @not_found) - _.pop - ///runtime.none_injection - (_.set_label @end)))) + (all _.composite + textG (_.checkcast $String) + partG (_.checkcast $String) + startG ..jvm_int + (_.invokevirtual ..$String "indexOf" index_method) + _.dup + _.iconst_m1 + (_.if_icmpeq @not_found) + ..lux_int + ///runtime.some_injection + (_.goto @end) + (_.set_label @not_found) + _.pop + ///runtime.none_injection + (_.set_label @end)))) (def: bundle::text Bundle @@ -380,22 +380,22 @@ (def: string_method (type.method [(list) (list ..$String) type.void (list)])) (def: (io::log messageG) (Unary (Bytecode Any)) - ($_ _.composite - (_.getstatic ..$System "out" ..$PrintStream) - messageG - (_.checkcast $String) - (_.invokevirtual ..$PrintStream "println" ..string_method) - ///runtime.unit)) + (all _.composite + (_.getstatic ..$System "out" ..$PrintStream) + messageG + (_.checkcast $String) + (_.invokevirtual ..$PrintStream "println" ..string_method) + ///runtime.unit)) (def: (io::error messageG) (Unary (Bytecode Any)) - ($_ _.composite - (_.new ..$Error) - _.dup - messageG - (_.checkcast $String) - (_.invokespecial ..$Error "<init>" ..string_method) - _.athrow)) + (all _.composite + (_.new ..$Error) + _.dup + messageG + (_.checkcast $String) + (_.invokespecial ..$Error "<init>" ..string_method) + _.athrow)) (def: bundle::io Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux index f5fbdaf17..908057f4d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/jvm/host.lux @@ -82,9 +82,9 @@ (template [<name> <0>] [(def: <name> (Bytecode Any) - ($_ _.composite - _.l2i - <0>))] + (all _.composite + _.l2i + <0>))] [l2s _.i2s] [l2b _.i2b] @@ -96,9 +96,9 @@ (Unary (Bytecode Any)) (if (same? _.nop <conversion>) inputG - ($_ _.composite - inputG - <conversion>)))] + (all _.composite + inputG + <conversion>)))] [_.d2f conversion::double_to_float] [_.d2i conversion::double_to_int] @@ -171,10 +171,10 @@ (template [<name> <op>] [(def: (<name> [parameter! subject!]) (Binary (Bytecode Any)) - ($_ _.composite - subject! - parameter! - <op>))] + (all _.composite + subject! + parameter! + <op>))] [int::+ _.iadd] [int::- _.isub] @@ -223,15 +223,15 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.composite - subject - reference - (<op> @then) - falseG - (_.goto @end) - (_.set_label @then) - trueG - (_.set_label @end))))] + (all _.composite + subject + reference + (<op> @then) + falseG + (_.goto @end) + (_.set_label @then) + trueG + (_.set_label @end))))] [int::= _.if_icmpeq] [int::< _.if_icmplt] @@ -246,17 +246,17 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.composite - subject - reference - <op> - (_.int (i32.i32 (.i64 <reference>))) - (_.if_icmpeq @then) - falseG - (_.goto @end) - (_.set_label @then) - trueG - (_.set_label @end))))] + (all _.composite + subject + reference + <op> + (_.int (i32.i32 (.i64 <reference>))) + (_.if_icmpeq @then) + falseG + (_.goto @end) + (_.set_label @then) + trueG + (_.set_label @end))))] [long::= _.lcmp +0] [long::< _.lcmp -1] @@ -389,22 +389,22 @@ (function (_ extension_name generate archive arrayS) (do //////.monad [arrayG (generate archive arrayS)] - (in ($_ _.composite - arrayG - (_.checkcast (type.array jvm_primitive)) - _.arraylength))))])) + (in (all _.composite + arrayG + (_.checkcast (type.array jvm_primitive)) + _.arraylength))))])) (def: array::length::object Handler (..custom - [($_ <>.and ..object_array <synthesis>.any) + [(all <>.and ..object_array <synthesis>.any) (function (_ extension_name generate archive [elementJT arrayS]) (do //////.monad [arrayG (generate archive arrayS)] - (in ($_ _.composite - arrayG - (_.checkcast (type.array elementJT)) - _.arraylength))))])) + (in (all _.composite + arrayG + (_.checkcast (type.array elementJT)) + _.arraylength))))])) (def: (new_primitive_array_handler jvm_primitive) (-> Primitive_Array_Type Handler) @@ -413,82 +413,82 @@ (function (_ extension_name generate archive [lengthS]) (do //////.monad [lengthG (generate archive lengthS)] - (in ($_ _.composite - lengthG - (_.newarray jvm_primitive)))))])) + (in (all _.composite + lengthG + (_.newarray jvm_primitive)))))])) (def: array::new::object Handler (..custom - [($_ <>.and ..object <synthesis>.any) + [(all <>.and ..object <synthesis>.any) (function (_ extension_name generate archive [objectJT lengthS]) (do //////.monad [lengthG (generate archive lengthS)] - (in ($_ _.composite - lengthG - (_.anewarray objectJT)))))])) + (in (all _.composite + lengthG + (_.anewarray objectJT)))))])) (def: (read_primitive_array_handler jvm_primitive loadG) (-> (Type Primitive) (Bytecode Any) Handler) (..custom - [($_ <>.and <synthesis>.any <synthesis>.any) + [(all <>.and <synthesis>.any <synthesis>.any) (function (_ extension_name generate archive [idxS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] - (in ($_ _.composite - arrayG - (_.checkcast (type.array jvm_primitive)) - idxG - loadG))))])) + (in (all _.composite + arrayG + (_.checkcast (type.array jvm_primitive)) + idxG + loadG))))])) (def: array::read::object Handler (..custom - [($_ <>.and ..object_array <synthesis>.any <synthesis>.any) + [(all <>.and ..object_array <synthesis>.any <synthesis>.any) (function (_ extension_name generate archive [elementJT idxS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS)] - (in ($_ _.composite - arrayG - (_.checkcast (type.array elementJT)) - idxG - _.aaload))))])) + (in (all _.composite + arrayG + (_.checkcast (type.array elementJT)) + idxG + _.aaload))))])) (def: (write_primitive_array_handler jvm_primitive storeG) (-> (Type Primitive) (Bytecode Any) Handler) (..custom - [($_ <>.and <synthesis>.any <synthesis>.any <synthesis>.any) + [(all <>.and <synthesis>.any <synthesis>.any <synthesis>.any) (function (_ extension_name generate archive [idxS valueS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS) valueG (generate archive valueS)] - (in ($_ _.composite - arrayG - (_.checkcast (type.array jvm_primitive)) - _.dup - idxG - valueG - storeG))))])) + (in (all _.composite + arrayG + (_.checkcast (type.array jvm_primitive)) + _.dup + idxG + valueG + storeG))))])) (def: array::write::object Handler (..custom - [($_ <>.and ..object_array <synthesis>.any <synthesis>.any <synthesis>.any) + [(all <>.and ..object_array <synthesis>.any <synthesis>.any <synthesis>.any) (function (_ extension_name generate archive [elementJT idxS valueS arrayS]) (do //////.monad [arrayG (generate archive arrayS) idxG (generate archive idxS) valueG (generate archive valueS)] - (in ($_ _.composite - arrayG - (_.checkcast (type.array elementJT)) - _.dup - idxG - valueG - _.aastore))))])) + (in (all _.composite + arrayG + (_.checkcast (type.array elementJT)) + _.dup + idxG + valueG + _.aastore))))])) (def: bundle::array Bundle @@ -549,30 +549,30 @@ (do _.monad [@then _.new_label @end _.new_label] - ($_ _.composite - objectG - (_.ifnull @then) - ..falseG - (_.goto @end) - (_.set_label @then) - ..trueG - (_.set_label @end)))) + (all _.composite + objectG + (_.ifnull @then) + ..falseG + (_.goto @end) + (_.set_label @then) + ..trueG + (_.set_label @end)))) (def: (object::synchronized [monitorG exprG]) (Binary (Bytecode Any)) - ($_ _.composite - monitorG - _.dup - _.monitorenter - exprG - _.swap - _.monitorexit)) + (all _.composite + monitorG + _.dup + _.monitorenter + exprG + _.swap + _.monitorexit)) (def: (object::throw exceptionG) (Unary (Bytecode Any)) - ($_ _.composite - exceptionG - _.athrow)) + (all _.composite + exceptionG + _.athrow)) (def: $Class (type.class "java.lang.Class" (list))) (def: $String (type.class "java.lang.String" (list))) @@ -584,41 +584,41 @@ (function (_ extension_name generate archive [class]) (do //////.monad [] - (in ($_ _.composite - (_.string class) - (_.invokestatic ..$Class "forName" (type.method [(list) (list ..$String) ..$Class (list)]))))))])) + (in (all _.composite + (_.string class) + (_.invokestatic ..$Class "forName" (type.method [(list) (list ..$String) ..$Class (list)]))))))])) (def: object::instance? Handler (..custom - [($_ <>.and <synthesis>.text <synthesis>.any) + [(all <>.and <synthesis>.text <synthesis>.any) (function (_ extension_name generate archive [class objectS]) (do //////.monad [objectG (generate archive objectS)] - (in ($_ _.composite - objectG - (_.instanceof (type.class class (list))) - (///value.wrap type.boolean)))))])) + (in (all _.composite + objectG + (_.instanceof (type.class class (list))) + (///value.wrap type.boolean)))))])) (def: object::cast Handler (..custom - [($_ <>.and <synthesis>.text <synthesis>.text <synthesis>.any) + [(all <>.and <synthesis>.text <synthesis>.text <synthesis>.any) (function (_ extension_name generate archive [from to valueS]) (do //////.monad [valueG (generate archive valueS)] (in (`` (cond (~~ (template [<object> <type>] [(and (text#= (..reflection <type>) from) (text#= <object> to)) - ($_ _.composite - valueG - (///value.wrap <type>)) + (all _.composite + valueG + (///value.wrap <type>)) (and (text#= <object> from) (text#= (..reflection <type>) to)) - ($_ _.composite - valueG - (///value.unwrap <type>))] + (all _.composite + valueG + (///value.unwrap <type>))] [box.boolean type.boolean] [box.byte type.byte] @@ -647,7 +647,7 @@ (def: get::static Handler (..custom - [($_ <>.and <synthesis>.text <synthesis>.text ..value) + [(all <>.and <synthesis>.text <synthesis>.text ..value) (function (_ extension_name generate archive [class field :unboxed:]) (# //////.monad in (_.getstatic (type.class class (list)) field :unboxed:)))])) @@ -657,39 +657,39 @@ (def: put::static Handler (..custom - [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) + [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) (function (_ extension_name generate archive [class field :unboxed: valueS]) (do //////.monad [valueG (generate archive valueS)] - (in ($_ _.composite - valueG - (case (parser.object? :unboxed:) - {.#Some :unboxed:} - (_.checkcast :unboxed:) - - {.#None} - (_#in [])) - (_.putstatic (type.class class (list)) field :unboxed:) - ..unitG))))])) + (in (all _.composite + valueG + (case (parser.object? :unboxed:) + {.#Some :unboxed:} + (_.checkcast :unboxed:) + + {.#None} + (_#in [])) + (_.putstatic (type.class class (list)) field :unboxed:) + ..unitG))))])) (def: get::virtual Handler (..custom - [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) + [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any) (function (_ extension_name generate archive [class field :unboxed: objectS]) (do //////.monad [objectG (generate archive objectS) .let [:class: (type.class class (list)) getG (_.getfield :class: field :unboxed:)]] - (in ($_ _.composite - objectG - (_.checkcast :class:) - getG))))])) + (in (all _.composite + objectG + (_.checkcast :class:) + getG))))])) (def: put::virtual Handler (..custom - [($_ <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.any) + [(all <>.and <synthesis>.text <synthesis>.text ..value <synthesis>.any <synthesis>.any) (function (_ extension_name generate archive [class field :unboxed: valueS objectS]) (do //////.monad [valueG (generate archive valueS) @@ -697,18 +697,18 @@ .let [:class: (type.class class (list)) putG (case (parser.object? :unboxed:) {.#Some :unboxed:} - ($_ _.composite - (_.checkcast :unboxed:) - (_.putfield :class: field :unboxed:)) + (all _.composite + (_.checkcast :unboxed:) + (_.putfield :class: field :unboxed:)) {.#None} (_.putfield :class: field :unboxed:))]] - (in ($_ _.composite - objectG - (_.checkcast :class:) - _.dup - valueG - putG))))])) + (in (all _.composite + objectG + (_.checkcast :class:) + _.dup + valueG + putG))))])) (type: Input (Typed Synthesis)) @@ -726,9 +726,9 @@ (in [valueT valueG]) {.#Left valueT} - (in [valueT ($_ _.composite - valueG - (_.checkcast valueT))])))) + (in [valueT (all _.composite + valueG + (_.checkcast valueT))])))) (def: (prepare_output outputT) (-> (Type Return) (Bytecode Any)) @@ -742,32 +742,32 @@ (def: invoke::static Handler (..custom - [($_ <>.and ..class <synthesis>.text ..return (<>.some ..input)) + [(all <>.and ..class <synthesis>.text ..return (<>.some ..input)) (function (_ extension_name generate archive [class method outputT inputsTS]) (do [! //////.monad] [inputsTG (monad.each ! (generate_input generate archive) inputsTS)] - (in ($_ _.composite - (monad.each _.monad product.right inputsTG) - (_.invokestatic class method (type.method [(list) (list#each product.left inputsTG) outputT (list)])) - (prepare_output outputT)))))])) + (in (all _.composite + (monad.each _.monad product.right inputsTG) + (_.invokestatic class method (type.method [(list) (list#each product.left inputsTG) outputT (list)])) + (prepare_output outputT)))))])) (template [<check_cast?> <name> <invoke>] [(def: <name> Handler (..custom - [($_ <>.and ..class <synthesis>.text ..return <synthesis>.any (<>.some ..input)) + [(all <>.and ..class <synthesis>.text ..return <synthesis>.any (<>.some ..input)) (function (_ extension_name generate archive [class method outputT objectS inputsTS]) (do [! //////.monad] [objectG (generate archive objectS) inputsTG (monad.each ! (generate_input generate archive) inputsTS)] - (in ($_ _.composite - objectG - (if <check_cast?> - (_.checkcast class) - (_#in [])) - (monad.each _.monad product.right inputsTG) - (<invoke> class method (type.method [(list) (list#each product.left inputsTG) outputT (list)])) - (prepare_output outputT)))))]))] + (in (all _.composite + objectG + (if <check_cast?> + (_.checkcast class) + (_#in [])) + (monad.each _.monad product.right inputsTG) + (<invoke> class method (type.method [(list) (list#each product.left inputsTG) outputT (list)])) + (prepare_output outputT)))))]))] [#1 invoke::virtual _.invokevirtual] [#0 invoke::special _.invokespecial] @@ -777,15 +777,15 @@ (def: invoke::constructor Handler (..custom - [($_ <>.and ..class (<>.some ..input)) + [(all <>.and ..class (<>.some ..input)) (function (_ extension_name generate archive [class inputsTS]) (do [! //////.monad] [inputsTG (monad.each ! (generate_input generate archive) inputsTS)] - (in ($_ _.composite - (_.new class) - _.dup - (monad.each _.monad product.right inputsTG) - (_.invokespecial class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)]))))))])) + (in (all _.composite + (_.new class) + _.dup + (monad.each _.monad product.right inputsTG) + (_.invokespecial class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)]))))))])) (def: bundle::member Bundle @@ -993,42 +993,42 @@ {.#Left type} (_.checkcast type))] - ($_ _.composite - (_.aload (++ register)) - then!)))) + (all _.composite + (_.aload (++ register)) + then!)))) list.reversed (list#mix _.composite (_#in []))) store_captured! (|> env list.size list.indices (monad.each _.monad (.function (_ register) - ($_ _.composite - (_.aload 0) - (_.aload (n.+ inputs_offset (++ register))) - (_.putfield class (///reference.foreign_name register) $Object)))))] + (all _.composite + (_.aload 0) + (_.aload (n.+ inputs_offset (++ register))) + (_.putfield class (///reference.foreign_name register) $Object)))))] (method.method method.public "<init>" #1 (anonymous_init_method env inputsTG) (list) - {.#Some ($_ _.composite - (_.aload 0) - inputs! - (_.invokespecial super_class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)])) - store_captured! - _.return)}))) + {.#Some (all _.composite + (_.aload 0) + inputs! + (_.invokespecial super_class "<init>" (type.method [(list) (list#each product.left inputsTG) type.void (list)])) + store_captured! + _.return)}))) (def: (anonymous_instance generate archive class env inputsTI) (-> Phase Archive (Type category.Class) (Environment Synthesis) (List (Typed (Bytecode Any))) (Operation (Bytecode Any))) (do [! //////.monad] [captureG+ (monad.each ! (generate archive) env)] - (in ($_ _.composite - (_.new class) - _.dup - (|> inputsTI - (list#each product.right) - list.reversed - (list#mix _.composite (_#in []))) - (monad.all _.monad captureG+) - (_.invokespecial class "<init>" (anonymous_init_method env inputsTI)))))) + (in (all _.composite + (_.new class) + _.dup + (|> inputsTI + (list#each product.right) + list.reversed + (list#mix _.composite (_#in []))) + (monad.all _.monad captureG+) + (_.invokespecial class "<init>" (anonymous_init_method env inputsTI)))))) (def: (returnG returnT) (-> (Type Return) (Bytecode Any)) @@ -1041,18 +1041,18 @@ {.#Left returnT} (case (type.class? returnT) {.#Some class_name} - ($_ _.composite - (_.checkcast returnT) - _.areturn) + (all _.composite + (_.checkcast returnT) + _.areturn) {.#None} _.areturn) {.#Right returnT} (template.let [(unwrap_primitive <return> <type>) - [($_ _.composite - (///value.unwrap <type>) - <return>)]] + [(all _.composite + (///value.unwrap <type>) + <return>)]] (`` (cond (~~ (template [<return> <type>] [(# type.equivalence = <type> returnT) (unwrap_primitive <return> <type>)] @@ -1085,10 +1085,10 @@ list.together (monad.each ! (cache/artifact.dependencies archive))) all_method_dependencies (monad.each ! (|>> product.right (method_dependencies archive)) overriden_methods)] - (in (cache/artifact.all ($_ list#composite - all_input_dependencies - all_closure_dependencies - all_method_dependencies))))) + (in (cache/artifact.all (all list#composite + all_input_dependencies + all_closure_dependencies + all_method_dependencies))))) (def: (prepare_argument lux_register argumentT jvm_register) (-> Register (Type Value) Register [Register (Bytecode Any)]) @@ -1097,17 +1097,17 @@ [(n.+ 1 jvm_register) (if (n.= lux_register jvm_register) (_#in []) - ($_ _.composite - (_.aload jvm_register) - (_.astore lux_register)))] + (all _.composite + (_.aload jvm_register) + (_.astore lux_register)))] {.#Right argumentT} (template.let [(wrap_primitive <shift> <load> <type>) [[(n.+ <shift> jvm_register) - ($_ _.composite - (<load> jvm_register) - (///value.wrap <type>) - (_.astore lux_register))]]] + (all _.composite + (<load> jvm_register) + (///value.wrap <type>) + (_.astore lux_register))]]] (`` (cond (~~ (template [<shift> <load> <type>] [(# type.equivalence = <type> argumentT) (wrap_primitive <shift> <load> <type>)] @@ -1130,9 +1130,9 @@ (list#mix (function (_ [lux_register type] [jvm_register before]) (let [[jvm_register' after] (prepare_argument (n.+ offset lux_register) type jvm_register)] [jvm_register' - ($_ _.composite - before - after)])) + (all _.composite + before + after)])) (is [Register (Bytecode Any)] [offset (_#in [])])) @@ -1184,28 +1184,28 @@ (phase archive bodyS)) .let [argumentsT (list#each product.right arguments) methodT (type.method [vars argumentsT returnT exceptionsT])]] - (in (method.method ($_ modifier#composite - method.public - method.final - (if strict_fp? - method.strict - modifier#identity)) + (in (method.method (all modifier#composite + method.public + method.final + (if strict_fp? + method.strict + modifier#identity)) name #1 methodT (list) - {.#Some ($_ _.composite - (prepare_arguments 1 argumentsT) - bodyG - (returnG returnT))}))))) + {.#Some (all _.composite + (prepare_arguments 1 argumentsT) + bodyG + (returnG returnT))}))))) (def: class::anonymous Handler (..custom - [($_ <>.and - ..class - (<synthesis>.tuple (<>.some ..class)) - (<synthesis>.tuple (<>.some ..input)) - (<synthesis>.tuple (<>.some ..overriden_method_definition))) + [(all <>.and + ..class + (<synthesis>.tuple (<>.some ..class)) + (<synthesis>.tuple (<>.some ..input)) + (<synthesis>.tuple (<>.some ..overriden_method_definition))) (function (_ extension_name generate archive [super_class super_interfaces inputsTS @@ -1224,7 +1224,7 @@ (monad.each ! (method_definition generate archive artifact_id))) bytecode (<| (# ! each (format.result class.writer)) //////.lifted - (class.class version.v6_0 ($_ modifier#composite class.public class.final) + (class.class version.v6_0 (all modifier#composite class.public class.final) (name.internal anonymous_class_name) {.#None} (name.internal (..reflection super_class)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux index ea9f1b1c9..cb29b9c89 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/common.lux @@ -112,12 +112,12 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) + (..custom [(all <>.and + <s>.any + <s>.any + (<>.some (<s>.tuple (all <>.and + (<s>.tuple (<>.many <s>.i64)) + <s>.any)))) (function (_ extension_name phase archive [input else conditionals]) (|> conditionals (list#each (function (_ [chars branch]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux index d854e210d..1d3f9cae4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/lua/host.lux @@ -67,7 +67,7 @@ (def: object::get Handler (custom - [($_ <>.and <s>.text <s>.any) + [(all <>.and <s>.text <s>.any) (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] @@ -76,7 +76,7 @@ (def: object::do Handler (custom - [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + [(all <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase archive [methodS objectS inputsS]) (do [! ////////phase.monad] [objectG (phase archive objectS) @@ -141,7 +141,7 @@ (def: lua::apply (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) @@ -150,7 +150,7 @@ (def: lua::power (custom - [($_ <>.and <s>.any <s>.any) + [(all <>.and <s>.any <s>.any) (function (_ extension phase archive [powerS baseS]) (do [! ////////phase.monad] [powerG (phase archive powerS) @@ -166,7 +166,7 @@ (def: lua::function (custom - [($_ <>.and <s>.i64 <s>.any) + [(all <>.and <s>.i64 <s>.any) (function (_ extension phase archive [arity abstractionS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux index 1caff3899..e592ebd5c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/common.lux @@ -56,12 +56,12 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) + (..custom [(all <>.and + <s>.any + <s>.any + (<>.some (<s>.tuple (all <>.and + (<s>.tuple (<>.many <s>.i64)) + <s>.any)))) (function (_ extension_name phase archive [input else conditionals]) (do [! /////.monad] [inputG (phase archive input) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux index 4f4f010da..2e257bcfc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/php/host.lux @@ -62,7 +62,7 @@ (def: object::new (custom - [($_ <>.and <s>.text (<>.some <s>.any)) + [(all <>.and <s>.text (<>.some <s>.any)) (function (_ extension phase archive [constructor inputsS]) (do [! ////////phase.monad] [inputsG (monad.each ! (phase archive) inputsS)] @@ -71,7 +71,7 @@ (def: object::get Handler (custom - [($_ <>.and <s>.text <s>.any) + [(all <>.and <s>.text <s>.any) (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] @@ -80,7 +80,7 @@ (def: object::do Handler (custom - [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + [(all <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase archive [methodS objectS inputsS]) (do [! ////////phase.monad] [objectG (phase archive objectS) @@ -113,7 +113,7 @@ (def: php::apply (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) @@ -122,7 +122,7 @@ (def: php::pack (custom - [($_ <>.and <s>.any <s>.any) + [(all <>.and <s>.any <s>.any) (function (_ extension phase archive [formatS dataS]) (do [! ////////phase.monad] [formatG (phase archive formatS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux index 12260ae49..9de656cd2 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/common.lux @@ -103,12 +103,12 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <synthesis>.any - <synthesis>.any - (<>.some (<synthesis>.tuple ($_ <>.and - (<synthesis>.tuple (<>.many <synthesis>.i64)) - <synthesis>.any)))) + (..custom [(all <>.and + <synthesis>.any + <synthesis>.any + (<>.some (<synthesis>.tuple (all <>.and + (<synthesis>.tuple (<>.many <synthesis>.i64)) + <synthesis>.any)))) (function (_ extension_name phase archive [input else conditionals]) (do [! /////.monad] [inputG (phase archive input) @@ -137,7 +137,7 @@ ... conditionals)})) ... @closure (_.var (reference.artifact artifact_id)) ... closure (_.def @closure dependencies - ... ($_ _.then + ... (all _.then ... (_.set (list @input) inputG) ... (list#mix (function (_ [test then!] else!) ... (_.if test then! else!)) @@ -149,12 +149,12 @@ ... (in (_.apply/* @closure dependencies)) (in (<| (as (Expression Any)) (is (Statement Any)) - ($_ _.then - (_.set (list @input) inputG) - (list#mix (function (_ [test then!] else!) - (_.if test then! else!)) - else! - conditionals!))))))])) + (all _.then + (_.set (list @input) inputG) + (list#mix (function (_ [test then!] else!) + (_.if test then! else!)) + else! + conditionals!))))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux index 1522dc667..766979aa0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/python/host.lux @@ -68,7 +68,7 @@ (def: object::get Handler (custom - [($_ <>.and <s>.text <s>.any) + [(all <>.and <s>.text <s>.any) (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] @@ -77,7 +77,7 @@ (def: object::do Handler (custom - [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + [(all <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase archive [methodS objectS inputsS]) (do [! ////////phase.monad] [objectG (phase archive objectS) @@ -119,7 +119,7 @@ (def: python::apply (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) @@ -128,7 +128,7 @@ (def: python::function (custom - [($_ <>.and <s>.i64 <s>.any) + [(all <>.and <s>.i64 <s>.any) (function (_ extension phase archive [arity abstractionS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) @@ -145,7 +145,7 @@ (def: python::exec (custom - [($_ <>.and <s>.any <s>.any) + [(all <>.and <s>.any <s>.any) (function (_ extension phase archive [codeS globalsS]) (do [! ////////phase.monad] [codeG (phase archive codeS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux index e48ccb29c..5b6428fa8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/r/common.lux @@ -56,10 +56,10 @@ ... ... ... TODO: Get rid of this ASAP ... ... (def: lux::syntax_char_case! -... ... (..custom [($_ <>.and +... ... (..custom [(all <>.and ... ... <s>.any ... ... <s>.any -... ... (<>.some (<s>.tuple ($_ <>.and +... ... (<>.some (<s>.tuple (all <>.and ... ... (<s>.tuple (<>.many <s>.i64)) ... ... <s>.any)))) ... ... (function (_ extension_name phase archive [input else conditionals]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux index 0221c118b..2a838bef9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/common.lux @@ -102,12 +102,12 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) + (..custom [(all <>.and + <s>.any + <s>.any + (<>.some (<s>.tuple (all <>.and + (<s>.tuple (<>.many <s>.i64)) + <s>.any)))) (function (_ extension_name phase archive [input else conditionals]) (do [! /////.monad] [inputG (phase archive input) @@ -135,12 +135,12 @@ ... (in (_.apply_lambda/* (list inputG) closure)) (in (<| (as Expression) (is Statement) - ($_ _.then - (_.set (list @input) inputG) - (list#mix (function (_ [test then!] else!) - (_.if test then! else!)) - else! - conditionals!))))))])) + (all _.then + (_.set (list @input) inputG) + (list#mix (function (_ [test then!] else!) + (_.if test then! else!)) + else! + conditionals!))))))])) (def: lux_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux index bb512a883..2c6013cf1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/ruby/host.lux @@ -67,7 +67,7 @@ (def: object::get Handler (custom - [($_ <>.and <s>.text <s>.any) + [(all <>.and <s>.text <s>.any) (function (_ extension phase archive [fieldS objectS]) (do ////////phase.monad [objectG (phase archive objectS)] @@ -76,7 +76,7 @@ (def: object::do Handler (custom - [($_ <>.and <s>.text <s>.any (<>.some <s>.any)) + [(all <>.and <s>.text <s>.any (<>.some <s>.any)) (function (_ extension phase archive [methodS objectS inputsS]) (do [! ////////phase.monad] [objectG (phase archive objectS) @@ -108,7 +108,7 @@ (def: ruby::apply (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux index c73614b6d..144415363 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/common.lux @@ -56,12 +56,12 @@ ... TODO: Get rid of this ASAP (def: lux::syntax_char_case! - (..custom [($_ <>.and - <s>.any - <s>.any - (<>.some (<s>.tuple ($_ <>.and - (<s>.tuple (<>.many <s>.i64)) - <s>.any)))) + (..custom [(all <>.and + <s>.any + <s>.any + (<>.some (<s>.tuple (all <>.and + (<s>.tuple (<>.many <s>.i64)) + <s>.any)))) (function (_ extension_name phase archive [input else conditionals]) (do [! /////.monad] [@input (# ! each _.var (generation.symbol "input")) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux index 2b4e5cd45..6b53f712f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/generation/scheme/host.lux @@ -89,7 +89,7 @@ (def: scheme::apply (custom - [($_ <>.and <s>.any (<>.some <s>.any)) + [(all <>.and <s>.any (<>.some <s>.any)) (function (_ extension phase archive [abstractionS inputsS]) (do [! ////////phase.monad] [abstractionG (phase archive abstractionS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux index 43ca63829..2f5b895e3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/case.lux @@ -131,12 +131,12 @@ (def: (alternation @otherwise pre! post!) (-> _.Tag (Expression Any) (Expression Any) (Expression Any)) - (_.tagbody ($_ list#composite - (list ..save! - pre! - @otherwise) - ..restore! - (list post!)))) + (_.tagbody (all list#composite + (list ..save! + pre! + @otherwise) + ..restore! + (list post!)))) (def: (pattern_matching' expression archive) (Generator [Var/1 _.Tag _.Tag Path]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux index fe6ef4179..527ee9822 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/extension/common.lux @@ -114,9 +114,9 @@ (def: (void code) (-> (Expression Any) (Expression Any)) - ($_ _.progn - code - ///runtime.unit)) + (all _.progn + code + ///runtime.unit)) (def: io_procs Bundle diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux index 4fc1e5427..947dd7cc7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/common_lisp/runtime.lux @@ -165,9 +165,9 @@ (def: last_index (|>> _.length/1 [(_.int +1)] _.-/2)) -(with_expansions [<recur> (these ($_ _.then - (_.; (_.set lefts (_.-/2 [last_index_right lefts]))) - (_.; (_.set tuple (_.nth last_index_right tuple)))))] +(with_expansions [<recur> (these (all _.then + (_.; (_.set lefts (_.-/2 [last_index_right lefts]))) + (_.; (_.set tuple (_.nth last_index_right tuple)))))] (template: (!recur <side>) (<side> (_.-/2 [last_index_right lefts]) (_.elt/2 [tuple last_index_right]))) @@ -272,12 +272,12 @@ (list @io//exit)) (def: runtime - (_.progn ($_ list#composite - runtime//adt - runtime//lux - runtime//i64 - runtime//text - runtime//io))) + (_.progn (all list#composite + runtime//adt + runtime//lux + runtime//i64 + runtime//text + runtime//io))) (def: .public generate (Operation [Registry Output]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux index 1573a17e5..515518eb7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/case.lux @@ -53,9 +53,9 @@ (do ///////phase.monad [this (expression archive this) that (statement expression archive that)] - (in ($_ _.then - (_.statement this) - that)))) + (in (all _.then + (_.statement this) + that)))) (def: .public (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) @@ -72,9 +72,9 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (in ($_ _.then - (_.define (..register register) valueO) - bodyO)))) + (in (all _.then + (_.define (..register register) valueO) + bodyO)))) (def: .public (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -152,15 +152,15 @@ (template [<name> <flag>] [(def: (<name> simple? idx) (-> Bit Nat Statement) - ($_ _.then - (_.set @temp (//runtime.sum//get ..peek_cursor <flag> - (|> idx .int _.i32))) - (.if simple? - (_.when (_.= _.null @temp) - ..fail_pm!) - (_.if (_.= _.null @temp) - ..fail_pm! - (push_cursor! @temp)))))] + (all _.then + (_.set @temp (//runtime.sum//get ..peek_cursor <flag> + (|> idx .int _.i32))) + (.if simple? + (_.when (_.= _.null @temp) + ..fail_pm!) + (_.if (_.= _.null @temp) + ..fail_pm! + (push_cursor! @temp)))))] [left_choice _.null] [right_choice //runtime.unit] @@ -168,14 +168,14 @@ (def: (alternation pre! post!) (-> Statement Statement Statement) - ($_ _.then - (_.do_while (_.boolean false) - ($_ _.then - ..save_cursor! - pre!)) - ($_ _.then - ..restore_cursor! - post!))) + (all _.then + (_.do_while (_.boolean false) + (all _.then + ..save_cursor! + pre!)) + (all _.then + ..restore_cursor! + post!))) (def: (optimized_pattern_matching again pathP) (-> (-> Path (Operation Statement)) @@ -198,9 +198,9 @@ (/////synthesis.!bind_top register thenP))) (do ///////phase.monad [then! (again thenP)] - (in {.#Some ($_ _.then - (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) - then!)})) + (in {.#Some (all _.then + (_.define (..register register) (_.at (_.i32 +0) ..peek_cursor)) + then!)})) ... Extra optimization (^.template [<pm> <getter>] @@ -209,26 +209,26 @@ (/////synthesis.!bind_top register thenP))) (do ///////phase.monad [then! (again thenP)] - (in {.#Some ($_ _.then - (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek_cursor)) - then!)}))]) + (in {.#Some (all _.then + (_.define (..register register) (<getter> (_.i32 (.int lefts)) ..peek_cursor)) + then!)}))]) ([/////synthesis.member/left //runtime.tuple//left] [/////synthesis.member/right //runtime.tuple//right]) (pattern (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (again thenP)] - (in {.#Some ($_ _.then - (_.define (..register register) ..peek_and_pop_cursor) - then!)})) + (in {.#Some (all _.then + (_.define (..register register) ..peek_and_pop_cursor) + then!)})) (pattern (/////synthesis.!multi_pop nextP)) (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] (do ///////phase.monad [next! (again nextP')] - (in {.#Some ($_ _.then - (multi_pop_cursor! (n.+ 2 extra_pops)) - next!)}))) + (in {.#Some (all _.then + (multi_pop_cursor! (n.+ 2 extra_pops)) + next!)}))) _ (///////phase#in {.#None}))) @@ -322,21 +322,21 @@ (-> Phase! Phase Archive Path (Operation Statement)) (do ///////phase.monad [pattern_matching! (pattern_matching' statement expression archive pathP)] - (in ($_ _.then - (_.do_while (_.boolean false) - pattern_matching!) - (_.throw (_.string ////synthesis/case.pattern_matching_error)))))) + (in (all _.then + (_.do_while (_.boolean false) + pattern_matching!) + (_.throw (_.string ////synthesis/case.pattern_matching_error)))))) (def: .public (case! statement expression archive [valueS pathP]) (Generator! [Synthesis Path]) (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] - (in ($_ _.then - (_.declare @temp) - (_.define @cursor (_.array (list stack_init))) - (_.define @savepoint (_.array (list))) - pattern_matching!)))) + (in (all _.then + (_.declare @temp) + (_.define @cursor (_.array (list stack_init))) + (_.define @savepoint (_.array (list))) + pattern_matching!)))) (def: .public (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux index 39fdda23a..4f3b402f6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/function.lux @@ -89,42 +89,42 @@ (|> func (_.do "apply" (list _.null args)))) initialize_self! (_.define (//case.register 0) @self) initialize! (list#mix (.function (_ post pre!) - ($_ _.then - pre! - (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) + (all _.then + pre! + (_.define (..input post) (_.at (_.i32 (.int post)) @@arguments)))) initialize_self! (list.indices arity))] environment (monad.each ! (expression archive) environment) .let [[definition instantiation] (with_closure @self environment - ($_ _.then - (_.define @num_args (_.the "length" @@arguments)) - (<| (_.if (|> @num_args (_.= arityO)) - ($_ _.then - initialize! - (_.with_label (_.label @scope) - (_.do_while (_.boolean true) - body!)))) - (_.if (|> @num_args (_.> arityO)) - (let [arity_inputs (|> (_.array (list)) - (_.the "slice") - (_.do "call" (list @@arguments (_.i32 +0) arityO))) - extra_inputs (|> (_.array (list)) - (_.the "slice") - (_.do "call" (list @@arguments arityO)))] - (_.return (|> @self - (apply_poly arity_inputs) - (apply_poly extra_inputs))))) - ... (|> @num_args (_.< arityO)) - (let [all_inputs (|> (_.array (list)) - (_.the "slice") - (_.do "call" (list @@arguments)))] - ($_ _.then - (_.define @curried all_inputs) - (_.return (_.closure (list) - (let [@missing all_inputs] - (_.return (apply_poly (_.do "concat" (list @missing) @curried) - @self)))))))) - ))] + (all _.then + (_.define @num_args (_.the "length" @@arguments)) + (<| (_.if (|> @num_args (_.= arityO)) + (all _.then + initialize! + (_.with_label (_.label @scope) + (_.do_while (_.boolean true) + body!)))) + (_.if (|> @num_args (_.> arityO)) + (let [arity_inputs (|> (_.array (list)) + (_.the "slice") + (_.do "call" (list @@arguments (_.i32 +0) arityO))) + extra_inputs (|> (_.array (list)) + (_.the "slice") + (_.do "call" (list @@arguments arityO)))] + (_.return (|> @self + (apply_poly arity_inputs) + (apply_poly extra_inputs))))) + ... (|> @num_args (_.< arityO)) + (let [all_inputs (|> (_.array (list)) + (_.the "slice") + (_.do "call" (list @@arguments)))] + (all _.then + (_.define @curried all_inputs) + (_.return (_.closure (list) + (let [@missing all_inputs] + (_.return (apply_poly (_.do "concat" (list @missing) @curried) + @self)))))))) + ))] _ (/////generation.execute! definition) _ (/////generation.save! (product.right function_name) {.#None} definition)] (in instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux index 5321ca9f8..8d92a81dd 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/loop.lux @@ -41,12 +41,12 @@ (pattern (list binding)) (let [$binding (//case.register offset)] - ($_ _.then - (if initial? - (_.define $binding binding) - (_.set $binding binding)) - body - )) + (all _.then + (if initial? + (_.define $binding binding) + (_.set $binding binding)) + body + )) _ (|> bindings @@ -104,12 +104,12 @@ [[offset @scope] /////generation.anchor argsO+ (monad.each ! (expression archive) argsS+) $iteration (# ! each ..$iteration /////generation.next)] - (in ($_ _.then - (_.define @temp (_.array argsO+)) - (..setup $iteration - false offset - (|> argsO+ - list.enumeration - (list#each (function (_ [idx _]) - (_.at (_.i32 (.int idx)) @temp)))) - (_.continue_at (_.label @scope))))))) + (in (all _.then + (_.define @temp (_.array argsO+)) + (..setup $iteration + false offset + (|> argsO+ + list.enumeration + (list#each (function (_ [idx _]) + (_.at (_.i32 (.int idx)) @temp)))) + (_.continue_at (_.label @scope))))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux index 36db99857..57f34fed4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/js/runtime.lux @@ -140,33 +140,33 @@ (_.at (..last_index tuple) tuple)) -(with_expansions [<recur> (these ($_ _.then - (_.set lefts (_.- last_index_right lefts)) - (_.set tuple (_.at last_index_right tuple))))] +(with_expansions [<recur> (these (all _.then + (_.set lefts (_.- last_index_right lefts)) + (_.set tuple (_.at last_index_right tuple))))] (runtime: (tuple//left lefts tuple) (with_vars [last_index_right] (<| (_.while (_.boolean true)) - ($_ _.then - (_.define last_index_right (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.at lefts tuple)) - ... Needs recursion - <recur>))))) + (all _.then + (_.define last_index_right (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.at lefts tuple)) + ... Needs recursion + <recur>))))) (runtime: (tuple//right lefts tuple) (with_vars [last_index_right right_index] (<| (_.while (_.boolean true)) - ($_ _.then - (_.define last_index_right (..last_index tuple)) - (_.define right_index (_.+ (_.i32 +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (_.at right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - <recur>) - (_.return (_.do "slice" (list right_index) tuple))) - ))))) + (all _.then + (_.define last_index_right (..last_index tuple)) + (_.define right_index (_.+ (_.i32 +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.at right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + <recur>) + (_.return (_.do "slice" (list right_index) tuple))) + ))))) (def: .public variant_tag_field "_lux_tag") (def: .public variant_flag_field "_lux_flag") @@ -176,11 +176,11 @@ (let [@this (_.var "this")] (with_vars [tag is_last value] (_.closure (list tag is_last value) - ($_ _.then - (_.set (_.the ..variant_tag_field @this) tag) - (_.set (_.the ..variant_flag_field @this) is_last) - (_.set (_.the ..variant_value_field @this) value) - ))))) + (all _.then + (_.set (_.the ..variant_tag_field @this) tag) + (_.set (_.the ..variant_flag_field @this) is_last) + (_.set (_.the ..variant_value_field @this) value) + ))))) (def: .public (variant tag last? value) (-> Expression Expression Expression Computation) @@ -192,11 +192,11 @@ actual##right? (|> sum (_.the ..variant_flag_field)) actual##value (|> sum (_.the ..variant_value_field)) is_last? (_.= ..unit actual##right?) - recur! ($_ _.then - (_.set expected##lefts (|> expected##lefts - (_.- actual##lefts) - (_.- (_.i32 +1)))) - (_.set sum actual##value))] + recur! (all _.then + (_.set expected##lefts (|> expected##lefts + (_.- actual##lefts) + (_.- (_.i32 +1)))) + (_.set sum actual##value))] (<| (_.while (_.boolean true)) (_.if (_.= expected##lefts actual##lefts) (_.if (_.= expected##right? actual##right?) @@ -232,12 +232,12 @@ (def: runtime//structure Statement - ($_ _.then - @tuple//left - @tuple//right - @variant//new - @sum//get - )) + (all _.then + @tuple//left + @tuple//right + @variant//new + @sum//get + )) (runtime: (lux//try op) (with_vars [ex] @@ -246,22 +246,22 @@ (runtime: (lux//program_args inputs) (with_vars [output idx] - ($_ _.then - (_.define output ..none) - (_.for idx - (..last_index inputs) - (_.>= (_.i32 +0) idx) - (_.-- idx) - (_.set output (..some (_.array (list (_.at idx inputs) - output))))) - (_.return output)))) + (all _.then + (_.define output ..none) + (_.for idx + (..last_index inputs) + (_.>= (_.i32 +0) idx) + (_.-- idx) + (_.set output (..some (_.array (list (_.at idx inputs) + output))))) + (_.return output)))) (def: runtime//lux Statement - ($_ _.then - @lux//try - @lux//program_args - )) + (all _.then + @lux//try + @lux//program_args + )) (def: .public i64_low_field Text "_lux_low") (def: .public i64_high_field Text "_lux_high") @@ -270,10 +270,10 @@ (let [@this (_.var "this")] (with_vars [high low] (_.closure (list high low) - ($_ _.then - (_.set (_.the ..i64_high_field @this) high) - (_.set (_.the ..i64_low_field @this) low) - ))))) + (all _.then + (_.set (_.the ..i64_high_field @this) high) + (_.set (_.the ..i64_low_field @this) low) + ))))) (def: .public (i64 high low) (-> Expression Expression Computation) @@ -309,58 +309,58 @@ (|>> (_.< (_.i32 +32)))) (runtime: (i64##left_shifted input shift) - ($_ _.then - (..cap_shift! shift) - (_.return (<| (..no_shift! shift input) - (_.? (..small_shift? shift) - (let [high (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift shift)) - (|> input (_.the ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32))))) - low (|> input (_.the ..i64_low_field) (_.left_shift shift))] - (..i64 high low))) - (let [high (|> input (_.the ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))] - (..i64 high (_.i32 +0))))) - )) + (all _.then + (..cap_shift! shift) + (_.return (<| (..no_shift! shift input) + (_.? (..small_shift? shift) + (let [high (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift shift)) + (|> input (_.the ..i64_low_field) (_.logic_right_shift (_.- shift (_.i32 +32))))) + low (|> input (_.the ..i64_low_field) (_.left_shift shift))] + (..i64 high low))) + (let [high (|> input (_.the ..i64_low_field) (_.left_shift (_.- (_.i32 +32) shift)))] + (..i64 high (_.i32 +0))))) + )) (runtime: (i64##arithmetic_right_shifted input shift) - ($_ _.then - (..cap_shift! shift) - (_.return (<| (..no_shift! shift input) - (_.? (..small_shift? shift) - (let [high (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift shift)) - low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) - (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] - (..i64 high low))) - (let [high (_.? (|> input (_.the ..i64_high_field) (_.>= (_.i32 +0))) - (_.i32 +0) - (_.i32 -1)) - low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] - (..i64 high low)))))) + (all _.then + (..cap_shift! shift) + (_.return (<| (..no_shift! shift input) + (_.? (..small_shift? shift) + (let [high (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift shift)) + low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) + (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] + (..i64 high low))) + (let [high (_.? (|> input (_.the ..i64_high_field) (_.>= (_.i32 +0))) + (_.i32 +0) + (_.i32 -1)) + low (|> input (_.the ..i64_high_field) (_.arithmetic_right_shift (_.- (_.i32 +32) shift)))] + (..i64 high low)))))) (runtime: (i64##right_shifted input shift) - ($_ _.then - (..cap_shift! shift) - (_.return (<| (..no_shift! shift input) - (_.? (..small_shift? shift) - (let [high (|> input (_.the ..i64_high_field) (_.logic_right_shift shift)) - low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) - (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] - (..i64 high low))) - (_.? (|> shift (_.= (_.i32 +32))) - (..i64 (_.i32 +0) (|> input (_.the ..i64_high_field)))) - (..i64 (_.i32 +0) - (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) + (all _.then + (..cap_shift! shift) + (_.return (<| (..no_shift! shift input) + (_.? (..small_shift? shift) + (let [high (|> input (_.the ..i64_high_field) (_.logic_right_shift shift)) + low (|> input (_.the ..i64_low_field) (_.logic_right_shift shift) + (_.bit_or (|> input (_.the ..i64_high_field) (_.left_shift (_.- shift (_.i32 +32))))))] + (..i64 high low))) + (_.? (|> shift (_.= (_.i32 +32))) + (..i64 (_.i32 +0) (|> input (_.the ..i64_high_field)))) + (..i64 (_.i32 +0) + (|> input (_.the ..i64_high_field) (_.logic_right_shift (_.- (_.i32 +32) shift)))))))) (def: runtime//bit Statement - ($_ _.then - @i64##and - @i64##or - @i64##xor - @i64##not - @i64##left_shifted - @i64##arithmetic_right_shifted - @i64##right_shifted - )) + (all _.then + @i64##and + @i64##or + @i64##xor + @i64##not + @i64##left_shifted + @i64##arithmetic_right_shifted + @i64##right_shifted + )) (runtime: i64##2^16 (_.left_shift (_.i32 +16) (_.i32 +1))) @@ -416,38 +416,38 @@ (with_vars [l48 l32 l16 l00 r48 r32 r16 r00 x48 x32 x16 x00] - ($_ _.then - (_.define l48 (hh subject)) - (_.define l32 (hl subject)) - (_.define l16 (lh subject)) - (_.define l00 (ll subject)) - - (_.define r48 (hh parameter)) - (_.define r32 (hl parameter)) - (_.define r16 (lh parameter)) - (_.define r00 (ll parameter)) - - (_.define x00 (_.+ l00 r00)) - - (_.define x16 (|> (high_16 x00) - (_.+ l16) - (_.+ r16))) - (_.set x00 (low_16 x00)) - - (_.define x32 (|> (high_16 x16) - (_.+ l32) - (_.+ r32))) - (_.set x16 (low_16 x16)) - - (_.define x48 (|> (high_16 x32) - (_.+ l48) - (_.+ r48) - low_16)) - (_.set x32 (low_16 x32)) - - (_.return (..i64 (_.bit_or (up_16 x48) x32) - (_.bit_or (up_16 x16) x00))) - )))) + (all _.then + (_.define l48 (hh subject)) + (_.define l32 (hl subject)) + (_.define l16 (lh subject)) + (_.define l00 (ll subject)) + + (_.define r48 (hh parameter)) + (_.define r32 (hl parameter)) + (_.define r16 (lh parameter)) + (_.define r00 (ll parameter)) + + (_.define x00 (_.+ l00 r00)) + + (_.define x16 (|> (high_16 x00) + (_.+ l16) + (_.+ r16))) + (_.set x00 (low_16 x00)) + + (_.define x32 (|> (high_16 x16) + (_.+ l32) + (_.+ r32))) + (_.set x16 (low_16 x16)) + + (_.define x48 (|> (high_16 x32) + (_.+ l48) + (_.+ r48) + low_16)) + (_.set x32 (low_16 x32)) + + (_.return (..i64 (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) + )))) (runtime: (i64##opposite value) (_.return (_.? (i64##= i64##min value) @@ -483,56 +483,56 @@ (with_vars [l48 l32 l16 l00 r48 r32 r16 r00 x48 x32 x16 x00] - ($_ _.then - (_.define l48 (hh subject)) - (_.define l32 (hl subject)) - (_.define l16 (lh subject)) - (_.define l00 (ll subject)) - - (_.define r48 (hh parameter)) - (_.define r32 (hl parameter)) - (_.define r16 (lh parameter)) - (_.define r00 (ll parameter)) - - (_.define x00 (_.* l00 r00)) - (_.define x16 (high_16 x00)) - (_.set x00 (low_16 x00)) - - (_.set x16 (|> x16 (_.+ (_.* l16 r00)))) - (_.define x32 (high_16 x16)) (_.set x16 (low_16 x16)) - (_.set x16 (|> x16 (_.+ (_.* l00 r16)))) - (_.set x32 (|> x32 (_.+ (high_16 x16)))) (_.set x16 (low_16 x16)) - - (_.set x32 (|> x32 (_.+ (_.* l32 r00)))) - (_.define x48 (high_16 x32)) (_.set x32 (low_16 x32)) - (_.set x32 (|> x32 (_.+ (_.* l16 r16)))) - (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) - (_.set x32 (|> x32 (_.+ (_.* l00 r32)))) - (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) - - (_.set x48 (|> x48 - (_.+ (_.* l48 r00)) - (_.+ (_.* l32 r16)) - (_.+ (_.* l16 r32)) - (_.+ (_.* l00 r48)) - low_16)) - - (_.return (..i64 (_.bit_or (up_16 x48) x32) - (_.bit_or (up_16 x16) x00))) - )))) + (all _.then + (_.define l48 (hh subject)) + (_.define l32 (hl subject)) + (_.define l16 (lh subject)) + (_.define l00 (ll subject)) + + (_.define r48 (hh parameter)) + (_.define r32 (hl parameter)) + (_.define r16 (lh parameter)) + (_.define r00 (ll parameter)) + + (_.define x00 (_.* l00 r00)) + (_.define x16 (high_16 x00)) + (_.set x00 (low_16 x00)) + + (_.set x16 (|> x16 (_.+ (_.* l16 r00)))) + (_.define x32 (high_16 x16)) (_.set x16 (low_16 x16)) + (_.set x16 (|> x16 (_.+ (_.* l00 r16)))) + (_.set x32 (|> x32 (_.+ (high_16 x16)))) (_.set x16 (low_16 x16)) + + (_.set x32 (|> x32 (_.+ (_.* l32 r00)))) + (_.define x48 (high_16 x32)) (_.set x32 (low_16 x32)) + (_.set x32 (|> x32 (_.+ (_.* l16 r16)))) + (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) + (_.set x32 (|> x32 (_.+ (_.* l00 r32)))) + (_.set x48 (|> x48 (_.+ (high_16 x32)))) (_.set x32 (low_16 x32)) + + (_.set x48 (|> x48 + (_.+ (_.* l48 r00)) + (_.+ (_.* l32 r16)) + (_.+ (_.* l16 r32)) + (_.+ (_.* l00 r48)) + low_16)) + + (_.return (..i64 (_.bit_or (up_16 x48) x32) + (_.bit_or (up_16 x16) x00))) + )))) (runtime: (i64##< parameter subject) (let [negative? (|>> (_.the ..i64_high_field) (_.< (_.i32 +0)))] (with_vars [-subject? -parameter?] - ($_ _.then - (_.define -subject? (negative? subject)) - (_.define -parameter? (negative? parameter)) - (_.return (<| (_.? (_.and -subject? (_.not -parameter?)) - (_.boolean true)) - (_.? (_.and (_.not -subject?) -parameter?) - (_.boolean false)) - (negative? (i64##- parameter subject)))) - )))) + (all _.then + (_.define -subject? (negative? subject)) + (_.define -parameter? (negative? parameter)) + (_.return (<| (_.? (_.and -subject? (_.not -parameter?)) + (_.boolean true)) + (_.? (_.and (_.not -subject?) -parameter?) + (_.boolean false)) + (negative? (i64##- parameter subject)))) + )))) (def: (i64##<= param subject) (-> Expression Expression Expression) @@ -555,20 +555,20 @@ (_.return i64##one)) (with_vars [approximation] (let [subject/2 (..i64##arithmetic_right_shifted subject (_.i32 +1))] - ($_ _.then - (_.define approximation (i64##left_shifted (i64##/ parameter - subject/2) - (_.i32 +1))) - (_.if (i64##= i64##zero approximation) - (_.return (_.? (..negative? parameter) - i64##one - i64##-one)) - (let [remainder (i64##- (i64##* approximation - parameter) - subject)] - (_.return (i64##+ (i64##/ parameter - remainder) - approximation))))))))) + (all _.then + (_.define approximation (i64##left_shifted (i64##/ parameter + subject/2) + (_.i32 +1))) + (_.if (i64##= i64##zero approximation) + (_.return (_.? (..negative? parameter) + i64##one + i64##-one)) + (let [remainder (i64##- (i64##* approximation + parameter) + subject)] + (_.return (i64##+ (i64##/ parameter + remainder) + approximation))))))))) (_.if (i64##= i64##min parameter) (_.return i64##zero)) (_.if (..negative? subject) @@ -580,43 +580,43 @@ (_.if (..negative? parameter) (_.return (i64##opposite (i64##/ (i64##opposite parameter) subject)))) (with_vars [result remainder] - ($_ _.then - (_.define result i64##zero) - (_.define remainder subject) - (_.while (i64##<= remainder parameter) - (with_vars [approximate approximate_result approximate_remainder log2 delta] - (let [approximate_result' (i64##of_number approximate) - approx_remainder (i64##* parameter approximate_result)] - ($_ _.then - (_.define approximate (|> (i64##number remainder) - (_./ (i64##number parameter)) - (_.apply_1 (_.var "Math.floor")) - (_.apply_2 (_.var "Math.max") (_.i32 +1)))) - (_.define log2 (|> approximate - (_.apply_1 (_.var "Math.log")) - (_./ (_.var "Math.LN2")) - (_.apply_1 (_.var "Math.ceil")))) - (_.define delta (_.? (_.> (_.i32 +48) log2) - (_.apply_2 (_.var "Math.pow") - (_.i32 +2) - (_.- (_.i32 +48) - log2)) - (_.i32 +1))) - (_.define approximate_result approximate_result') - (_.define approximate_remainder approx_remainder) - (_.while (_.or (..negative? approximate_remainder) - (i64##< approximate_remainder - remainder)) - ($_ _.then - (_.set approximate (_.- delta approximate)) - (_.set approximate_result approximate_result') - (_.set approximate_remainder approx_remainder))) - (_.set result (i64##+ (_.? (i64##= i64##zero approximate_result) - i64##one - approximate_result) - result)) - (_.set remainder (i64##- approximate_remainder remainder)))))) - (_.return result))))) + (all _.then + (_.define result i64##zero) + (_.define remainder subject) + (_.while (i64##<= remainder parameter) + (with_vars [approximate approximate_result approximate_remainder log2 delta] + (let [approximate_result' (i64##of_number approximate) + approx_remainder (i64##* parameter approximate_result)] + (all _.then + (_.define approximate (|> (i64##number remainder) + (_./ (i64##number parameter)) + (_.apply_1 (_.var "Math.floor")) + (_.apply_2 (_.var "Math.max") (_.i32 +1)))) + (_.define log2 (|> approximate + (_.apply_1 (_.var "Math.log")) + (_./ (_.var "Math.LN2")) + (_.apply_1 (_.var "Math.ceil")))) + (_.define delta (_.? (_.> (_.i32 +48) log2) + (_.apply_2 (_.var "Math.pow") + (_.i32 +2) + (_.- (_.i32 +48) + log2)) + (_.i32 +1))) + (_.define approximate_result approximate_result') + (_.define approximate_remainder approx_remainder) + (_.while (_.or (..negative? approximate_remainder) + (i64##< approximate_remainder + remainder)) + (all _.then + (_.set approximate (_.- delta approximate)) + (_.set approximate_result approximate_result') + (_.set approximate_remainder approx_remainder))) + (_.set result (i64##+ (_.? (i64##= i64##zero approximate_result) + i64##one + approximate_result) + result)) + (_.set remainder (i64##- approximate_remainder remainder)))))) + (_.return result))))) (runtime: (i64##% parameter subject) (let [flat (|> subject @@ -626,39 +626,39 @@ (def: runtime//i64 Statement - ($_ _.then - ..runtime//bit - - @i64##2^16 - @i64##2^32 - @i64##2^64 - @i64##2^63 - @i64##unsigned_low - @i64##new - @i64##zero - @i64##min - @i64##max - @i64##one - @i64##= - @i64##+ - @i64##opposite - @i64##-one - @i64##number - @i64##of_number - @i64##- - @i64##* - @i64##< - @i64##/ - @i64##% - )) + (all _.then + ..runtime//bit + + @i64##2^16 + @i64##2^32 + @i64##2^64 + @i64##2^63 + @i64##unsigned_low + @i64##new + @i64##zero + @i64##min + @i64##max + @i64##one + @i64##= + @i64##+ + @i64##opposite + @i64##-one + @i64##number + @i64##of_number + @i64##- + @i64##* + @i64##< + @i64##/ + @i64##% + )) (runtime: (text//index start part text) (with_vars [idx] - ($_ _.then - (_.define idx (|> text (_.do "indexOf" (list part (i64##number start))))) - (_.return (_.? (_.= (_.i32 -1) idx) - ..none - (..some (i64##of_number idx))))))) + (all _.then + (_.define idx (|> text (_.do "indexOf" (list part (i64##number start))))) + (_.return (_.? (_.= (_.i32 -1) idx) + ..none + (..some (i64##of_number idx))))))) (runtime: (text//clip offset length text) (_.return (|> text (_.do "substring" (list (_.the ..i64_low_field offset) @@ -667,19 +667,19 @@ (runtime: (text//char idx text) (with_vars [result] - ($_ _.then - (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64_low_field idx))))) - (_.if (_.not_a_number? result) - (_.throw (_.string "[Lux Error] Cannot get char from text.")) - (_.return (i64##of_number result)))))) + (all _.then + (_.define result (|> text (_.do "charCodeAt" (list (_.the ..i64_low_field idx))))) + (_.if (_.not_a_number? result) + (_.throw (_.string "[Lux Error] Cannot get char from text.")) + (_.return (i64##of_number result)))))) (def: runtime//text Statement - ($_ _.then - @text//index - @text//clip - @text//char - )) + (all _.then + @text//index + @text//clip + @text//char + )) (runtime: (io//log message) (let [console (_.var "console") @@ -687,16 +687,16 @@ end! (_.return ..unit)] (<| (_.if (|> console _.type_of (_.= (_.string "undefined")) _.not (_.and (_.the "log" console))) - ($_ _.then - (_.statement (|> console (_.do "log" (list message)))) - end!)) + (all _.then + (_.statement (|> console (_.do "log" (list message)))) + end!)) (_.if (|> print _.type_of (_.= (_.string "undefined")) _.not) - ($_ _.then - (_.statement (_.apply_1 print (_.? (_.= (_.string "string") - (_.type_of message)) - message - (_.apply_1 (_.var "JSON.stringify") message)))) - end!)) + (all _.then + (_.statement (_.apply_1 print (_.? (_.= (_.string "string") + (_.type_of message)) + message + (_.apply_1 (_.var "JSON.stringify") message)))) + end!)) end!))) (runtime: (io//error message) @@ -704,65 +704,65 @@ (def: runtime//io Statement - ($_ _.then - @io//log - @io//error - )) + (all _.then + @io//log + @io//error + )) (runtime: (js//get object field) (with_vars [temp] - ($_ _.then - (_.define temp (_.at field object)) - (_.return (_.? (_.= _.undefined temp) - ..none - (..some temp)))))) + (all _.then + (_.define temp (_.at field object)) + (_.return (_.? (_.= _.undefined temp) + ..none + (..some temp)))))) (runtime: (js//set object field input) - ($_ _.then - (_.set (_.at field object) input) - (_.return object))) + (all _.then + (_.set (_.at field object) input) + (_.return object))) (runtime: (js//delete object field) - ($_ _.then - (_.statement (_.delete (_.at field object))) - (_.return object))) + (all _.then + (_.statement (_.delete (_.at field object))) + (_.return object))) (def: runtime//js Statement - ($_ _.then - @js//get - @js//set - @js//delete - )) + (all _.then + @js//get + @js//set + @js//delete + )) (runtime: (array//write idx value array) - ($_ _.then - (_.set (_.at (_.the ..i64_low_field idx) array) value) - (_.return array))) + (all _.then + (_.set (_.at (_.the ..i64_low_field idx) array) value) + (_.return array))) (runtime: (array//delete idx array) - ($_ _.then - (_.statement (_.delete (_.at (_.the ..i64_low_field idx) array))) - (_.return array))) + (all _.then + (_.statement (_.delete (_.at (_.the ..i64_low_field idx) array))) + (_.return array))) (def: runtime//array Statement - ($_ _.then - @array//write - @array//delete - )) + (all _.then + @array//write + @array//delete + )) (def: runtime Statement - ($_ _.then - runtime//structure - runtime//i64 - runtime//text - runtime//io - runtime//js - runtime//array - runtime//lux - )) + (all _.then + runtime//structure + runtime//i64 + runtime//text + runtime//io + runtime//js + runtime//array + runtime//lux + )) (def: module_id 0) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux index 4e237921c..455121d02 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/case.lux @@ -46,9 +46,9 @@ 1 _.pop 2 _.pop2 _ ... (n.> 2) - ($_ _.composite - _.pop2 - (pop_alt (n.- 2 stack_depth))))) + (all _.composite + _.pop2 + (pop_alt (n.- 2 stack_depth))))) (def: int (-> (I64 Any) (Bytecode Any)) @@ -60,34 +60,34 @@ (def: peek (Bytecode Any) - ($_ _.composite - _.dup - (//runtime.get //runtime.stack_head))) + (all _.composite + _.dup + (//runtime.get //runtime.stack_head))) (def: pop (Bytecode Any) - ($_ _.composite - (//runtime.get //runtime.stack_tail) - (_.checkcast //type.stack))) + (all _.composite + (//runtime.get //runtime.stack_tail) + (_.checkcast //type.stack))) (def: (left_projection lefts) (-> Nat (Bytecode Any)) - ($_ _.composite - (_.checkcast //type.tuple) - (..int lefts) - (.case lefts - 0 - _.aaload - - lefts - //runtime.left_projection))) + (all _.composite + (_.checkcast //type.tuple) + (..int lefts) + (.case lefts + 0 + _.aaload + + lefts + //runtime.left_projection))) (def: (right_projection lefts) (-> Nat (Bytecode Any)) - ($_ _.composite - (_.checkcast //type.tuple) - (..int lefts) - //runtime.right_projection)) + (all _.composite + (_.checkcast //type.tuple) + (..int lefts) + //runtime.right_projection)) (def: equals@Object (.let [class (type.class "java.lang.Object" (list)) @@ -96,9 +96,9 @@ (def: (path|bind register) (-> Register (Operation (Bytecode Any))) - (operation#in ($_ _.composite - ..peek - (_.astore register)))) + (operation#in (all _.composite + ..peek + (_.astore register)))) (def: (path|bit_fork again @else [when thenP elseP]) (-> (-> Path (Operation (Bytecode Any))) @@ -115,13 +115,13 @@ .let [if! (.if when _.ifeq _.ifne)]] (in (do _.monad [@else _.new_label] - ($_ _.composite - ..peek - (//value.unwrap type.boolean) - (if! @else) - then! - (_.set_label @else) - else!))))) + (all _.composite + ..peek + (//value.unwrap type.boolean) + (if! @else) + then! + (_.set_label @else) + else!))))) (template [<name> <type> <unwrap> <dup> <pop> <test> <comparison> <if>] [(def: (<name> again @else cons) @@ -134,23 +134,23 @@ [then! (again thenP)] (in (do _.monad [@else _.new_label] - ($_ _.composite - <dup> - (<test> test) - <comparison> - (<if> @else) - <pop> - then! - (_.set_label @else) - else!))))) - ($_ _.composite - <pop> - (_.goto @else)) + (all _.composite + <dup> + (<test> test) + <comparison> + (<if> @else) + <pop> + then! + (_.set_label @else) + else!))))) + (all _.composite + <pop> + (_.goto @else)) {.#Item cons})] - (in ($_ _.composite - ..peek - <unwrap> - fork!))))] + (in (all _.composite + ..peek + <unwrap> + fork!))))] [path|i64_fork (I64 Any) (//value.unwrap type.long) _.dup2 _.pop2 ..long _.lcmp _.ifne] [path|f64_fork Frac (//value.unwrap type.double) _.dup2 _.pop2 _.double _.dcmpl _.ifne] @@ -178,34 +178,34 @@ {synthesis.#Then bodyS} (do phase.monad [body! (phase archive bodyS)] - (in ($_ _.composite - (..pop_alt stack_depth) - body! - (_.when_continuous (_.goto @end))))) + (in (all _.composite + (..pop_alt stack_depth) + body! + (_.when_continuous (_.goto @end))))) (pattern (synthesis.side lefts right?)) (operation#in (do _.monad [@success _.new_label] - ($_ _.composite - ..peek - (_.checkcast //type.variant) - (//structure.lefts lefts) - (//structure.right? right?) - //runtime.case - _.dup - (_.ifnonnull @success) - _.pop - (_.goto @else) - (_.set_label @success) - //runtime.push))) + (all _.composite + ..peek + (_.checkcast //type.variant) + (//structure.lefts lefts) + (//structure.right? right?) + //runtime.case + _.dup + (_.ifnonnull @success) + _.pop + (_.goto @else) + (_.set_label @success) + //runtime.push))) (^.template [<pattern> <projection>] [(pattern (<pattern> lefts)) - (operation#in ($_ _.composite - ..peek - (<projection> lefts) - //runtime.push)) + (operation#in (all _.composite + ..peek + (<projection> lefts) + //runtime.push)) ... Extra optimization (pattern (synthesis.path/seq @@ -213,11 +213,11 @@ (synthesis.!bind_top register thenP))) (do phase.monad [then! (path' stack_depth @else @end phase archive thenP)] - (in ($_ _.composite - ..peek - (<projection> lefts) - (_.astore register) - then!)))]) + (in (all _.composite + ..peek + (<projection> lefts) + (_.astore register) + then!)))]) ([synthesis.member/left ..left_projection] [synthesis.member/right ..right_projection]) @@ -225,21 +225,21 @@ (do phase.monad [left! (path' stack_depth @else @end phase archive leftP) right! (path' stack_depth @else @end phase archive rightP)] - (in ($_ _.composite - left! - right!))) + (in (all _.composite + left! + right!))) {synthesis.#Alt leftP rightP} (do phase.monad [@alt_else //runtime.forge_label left! (path' (++ stack_depth) @alt_else @end phase archive leftP) right! (path' stack_depth @else @end phase archive rightP)] - (in ($_ _.composite - _.dup - left! - (_.set_label @alt_else) - _.pop - right!))) + (in (all _.composite + _.dup + left! + (_.set_label @alt_else) + _.pop + right!))) ))) (def: (path @end phase archive path) @@ -247,15 +247,15 @@ (do phase.monad [@else //runtime.forge_label path! (..path' 1 @else @end phase archive path)] - (in ($_ _.composite - path! - (<| (_.when_acknowledged @else) - ($_ _.composite - (_.set_label @else) - //runtime.pm_failure - (_.goto @end) - )) - )))) + (in (all _.composite + path! + (<| (_.when_acknowledged @else) + (all _.composite + (_.set_label @else) + //runtime.pm_failure + (_.goto @end) + )) + )))) (def: .public (if phase archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -266,36 +266,36 @@ (in (do _.monad [@else _.new_label @end _.new_label] - ($_ _.composite - test! - (//value.unwrap type.boolean) - (_.ifeq @else) - then! - (_.when_continuous (_.goto @end)) - (_.set_label @else) - else! - (<| (_.when_acknowledged @end) - (_.set_label @end))))))) + (all _.composite + test! + (//value.unwrap type.boolean) + (_.ifeq @else) + then! + (_.when_continuous (_.goto @end)) + (_.set_label @else) + else! + (<| (_.when_acknowledged @end) + (_.set_label @end))))))) (def: .public (exec phase archive [this that]) (Generator [Synthesis Synthesis]) (do phase.monad [this! (phase archive this) that! (phase archive that)] - (in ($_ _.composite - this! - _.pop - that!)))) + (in (all _.composite + this! + _.pop + that!)))) (def: .public (let phase archive [inputS register bodyS]) (Generator [Synthesis Register Synthesis]) (do phase.monad [input! (phase archive inputS) body! (phase archive bodyS)] - (in ($_ _.composite - input! - (_.astore register) - body!)))) + (in (all _.composite + input! + (_.astore register) + body!)))) (def: .public (get phase archive [path recordS]) (Generator [(List Member) Synthesis]) @@ -305,9 +305,9 @@ (.let [next! (.if (the member.#right? step) (..right_projection (the member.#lefts step)) (..left_projection (the member.#lefts step)))] - ($_ _.composite - so_far! - next!))) + (all _.composite + so_far! + next!))) record! (list.reversed path))))) @@ -317,10 +317,10 @@ [@end //runtime.forge_label value! (phase archive valueS) path! (..path @end phase archive path)] - (in ($_ _.composite - _.aconst_null - value! - //runtime.push - path! - (<| (_.when_acknowledged @end) - (_.set_label @end)))))) + (in (all _.composite + _.aconst_null + value! + //runtime.push + path! + (<| (_.when_acknowledged @end) + (_.set_label @end)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux index 1de6aba52..77f1a415f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function.lux @@ -92,9 +92,9 @@ (def: modifier (Modifier Class) - ($_ modifier#composite - class.public - class.final)) + (all modifier#composite + class.public + class.final)) (def: this_offset 1) @@ -131,18 +131,18 @@ (Generator [(Bytecode Any) (List Synthesis)]) (do [! phase.monad] [inputsG (monad.each ! (generate archive) inputsS)] - (in ($_ _.composite - abstractionG - (|> inputsG - (list.sub /arity.maximum) - (monad.each _.monad - (function (_ batchG) - ($_ _.composite - (_.checkcast /abstract.class) - (monad.all _.monad batchG) - (_.invokevirtual /abstract.class //runtime.apply::name (//runtime.apply::type (list.size batchG))) - )))) - )))) + (in (all _.composite + abstractionG + (|> inputsG + (list.sub /arity.maximum) + (monad.each _.monad + (function (_ batchG) + (all _.composite + (_.checkcast /abstract.class) + (monad.all _.monad batchG) + (_.invokevirtual /abstract.class //runtime.apply::name (//runtime.apply::type (list.size batchG))) + )))) + )))) (def: (apply/? generate archive [abstractionS inputsS]) (Generator Apply) @@ -156,11 +156,11 @@ [.let [:abstraction: (type.class (//runtime.class_name @abstraction) (list))] abstractionG (//reference.constant archive $abstraction) inputsG (monad.each ! (generate archive) inputsS)] - (in ($_ _.composite - abstractionG - (monad.all _.monad inputsG) - (/implementation.call :abstraction: arity) - )))) + (in (all _.composite + abstractionG + (monad.all _.monad inputsG) + (/implementation.call :abstraction: arity) + )))) (def: (apply/> generate archive [$abstraction @abstraction arity inputsS]) (Generator [Symbol unit.ID Arity (List Synthesis)]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux index 7d0bc8ae0..bccc114a9 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/constant.lux @@ -1,25 +1,25 @@ (.using - [library - [lux {"-" Type type} - [data - [collection - ["[0]" sequence]]] - [target - [jvm - ["[0]" field {"+" Field}] - ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] - [type {"+" Type} - [category {"+" Value}]] - [constant - [pool {"+" Resource}]]]]]]) + [library + [lux {"-" Type type} + [data + [collection + ["[0]" sequence]]] + [target + [jvm + ["[0]" field {"+" Field}] + ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] + [type {"+" Type} + [category {"+" Value}]] + [constant + [pool {"+" Resource}]]]]]]) (def: modifier (Modifier Field) - ($_ modifier#composite - field.public - field.static - field.final - )) + (all modifier#composite + field.public + field.static + field.final + )) (def: .public (constant name type) (-> Text (Type Value) (Resource Field)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux index 4e0684215..179fdb273 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable.lux @@ -1,48 +1,48 @@ (.using - [library - [lux {"-" Type type} - [data - [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" sequence]]] - [target - [jvm - ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] - ["[0]" field {"+" Field}] - ["_" bytecode {"+" Bytecode}] - [type {"+" Type} - [category {"+" Value Class}]] - [constant - [pool {"+" Resource}]]]]]] - ["[0]" //// "_" - ["[1][0]" type] - ["[1][0]" reference] - [////// - [reference - [variable {"+" Register}]]]]) + [library + [lux {"-" Type type} + [data + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" sequence]]] + [target + [jvm + ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] + ["[0]" field {"+" Field}] + ["_" bytecode {"+" Bytecode}] + [type {"+" Type} + [category {"+" Value Class}]] + [constant + [pool {"+" Resource}]]]]]] + ["[0]" //// "_" + ["[1][0]" type] + ["[1][0]" reference] + [////// + [reference + [variable {"+" Register}]]]]) (def: .public type ////type.value) (def: .public (get class name) (-> (Type Class) Text (Bytecode Any)) - ($_ _.composite - ////reference.this - (_.getfield class name ..type) - )) + (all _.composite + ////reference.this + (_.getfield class name ..type) + )) (def: .public (put naming class register value) (-> (-> Register Text) (Type Class) Register (Bytecode Any) (Bytecode Any)) - ($_ _.composite - ////reference.this - value - (_.putfield class (naming register) ..type))) + (all _.composite + ////reference.this + value + (_.putfield class (naming register) ..type))) (def: modifier (Modifier Field) - ($_ modifier#composite - field.private - field.final - )) + (all modifier#composite + field.private + field.final + )) (def: .public (variable name type) (-> Text (Type Value) (Resource Field)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/count.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/count.lux index a73192e16..c3a960653 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/count.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/count.lux @@ -1,17 +1,17 @@ (.using - [library - [lux {"-" type} - [control - ["[0]" try]] - [target - [jvm - ["_" bytecode {"+" Bytecode}] - ["[0]" type] - [encoding - [name {"+" External}] - ["[0]" signed]]]]]] - ["[0]" //// "_" - ["[1][0]" abstract]]) + [library + [lux {"-" type} + [control + ["[0]" try]] + [target + [jvm + ["_" bytecode {"+" Bytecode}] + ["[0]" type] + [encoding + [name {"+" External}] + ["[0]" signed]]]]]] + ["[0]" //// "_" + ["[1][0]" abstract]]) (def: .public field "partials") (def: .public type type.int) @@ -28,7 +28,7 @@ (def: .public value (Bytecode Any) - ($_ _.composite - ..this - (_.getfield ////abstract.class ..field ..type) - )) + (all _.composite + ..this + (_.getfield ////abstract.class ..field ..type) + )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux index a0880a4e2..d6f86409c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/field/variable/partial.lux @@ -31,11 +31,11 @@ (def: .public (initial amount) (-> Nat (Bytecode Any)) - ($_ _.composite - (|> _.aconst_null - (list.repeated amount) - (monad.all _.monad)) - (_#in []))) + (all _.composite + (|> _.aconst_null + (list.repeated amount) + (monad.all _.monad)) + (_#in []))) (def: .public (get class register) (-> (Type Class) Register (Bytecode Any)) @@ -52,7 +52,7 @@ (def: .public (new arity) (-> Arity (Bytecode Any)) (if (arity.multiary? arity) - ($_ _.composite - //count.initial - (initial (n.- ///arity.minimum arity))) + (all _.composite + //count.initial + (initial (n.- ///arity.minimum arity))) (_#in []))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux index 2f7a0afe3..e684f86bc 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method.lux @@ -1,14 +1,14 @@ (.using - [library - [lux "*" - [target - [jvm - ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] - ["[0]" method {"+" Method}]]]]]) + [library + [lux "*" + [target + [jvm + ["[0]" modifier {"+" Modifier} ("[1]#[0]" monoid)] + ["[0]" method {"+" Method}]]]]]) (def: .public modifier (Modifier Method) - ($_ modifier#composite - method.public - method.strict - )) + (all modifier#composite + method.public + method.strict + )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux index cd8ecbbb5..e4b3c7802 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/apply.lux @@ -50,31 +50,31 @@ (def: (increment by) (-> Nat (Bytecode Any)) - ($_ _.composite - (<| _.int .i64 by) - _.iadd)) + (all _.composite + (<| _.int .i64 by) + _.iadd)) (def: (inputs offset amount) (-> Register Nat (Bytecode Any)) - ($_ _.composite - (|> amount - list.indices - (monad.each _.monad (|>> (n.+ offset) _.aload))) - (_#in []) - )) + (all _.composite + (|> amount + list.indices + (monad.each _.monad (|>> (n.+ offset) _.aload))) + (_#in []) + )) (def: (apply offset amount) (-> Register Nat (Bytecode Any)) (let [arity (n.min amount ///arity.maximum)] - ($_ _.composite - (_.checkcast ///abstract.class) - (..inputs offset arity) - (_.invokevirtual ///abstract.class ////runtime.apply::name (////runtime.apply::type arity)) - (if (n.> ///arity.maximum amount) - (apply (n.+ ///arity.maximum offset) - (n.- ///arity.maximum amount)) - (_#in [])) - ))) + (all _.composite + (_.checkcast ///abstract.class) + (..inputs offset arity) + (_.invokevirtual ///abstract.class ////runtime.apply::name (////runtime.apply::type arity)) + (if (n.> ///arity.maximum amount) + (apply (n.+ ///arity.maximum offset) + (n.- ///arity.maximum amount)) + (_#in [])) + ))) (def: this_offset 1) @@ -87,11 +87,11 @@ #0 (////runtime.apply::type apply_arity) (list) {.#Some (case num_partials - 0 ($_ _.composite - ////reference.this - (..inputs ..this_offset apply_arity) - (//implementation.call class function_arity) - _.areturn) + 0 (all _.composite + ////reference.this + (..inputs ..this_offset apply_arity) + (//implementation.call class function_arity) + _.areturn) _ (do _.monad [@default _.new_label @labelsH _.new_label @@ -108,51 +108,51 @@ already_partial? (n.> 0 stage) exact_match? (i.= over_extent (.int stage)) has_more_than_necessary? (i.> over_extent (.int stage))] - ($_ _.composite - (_.set_label @case) - (cond exact_match? - ($_ _.composite - ////reference.this - (if already_partial? - (_.invokevirtual class //reset.name (//reset.type class)) - (_#in [])) - current_partials - (..inputs ..this_offset apply_arity) - (//implementation.call class function_arity) - _.areturn) - - has_more_than_necessary? - (let [arity_inputs (|> function_arity (n.- stage)) - additional_inputs (|> apply_arity (n.- arity_inputs))] - ($_ _.composite + (all _.composite + (_.set_label @case) + (cond exact_match? + (all _.composite ////reference.this - (_.invokevirtual class //reset.name (//reset.type class)) + (if already_partial? + (_.invokevirtual class //reset.name (//reset.type class)) + (_#in [])) current_partials - (..inputs ..this_offset arity_inputs) + (..inputs ..this_offset apply_arity) (//implementation.call class function_arity) - (apply (n.+ ..this_offset arity_inputs) additional_inputs) - _.areturn)) + _.areturn) + + has_more_than_necessary? + (let [arity_inputs (|> function_arity (n.- stage)) + additional_inputs (|> apply_arity (n.- arity_inputs))] + (all _.composite + ////reference.this + (_.invokevirtual class //reset.name (//reset.type class)) + current_partials + (..inputs ..this_offset arity_inputs) + (//implementation.call class function_arity) + (apply (n.+ ..this_offset arity_inputs) additional_inputs) + _.areturn)) - ... (i.< over_extent (.int stage)) - (let [current_environment (|> (list.indices (list.size environment)) - (list#each (///foreign.get class)) - (monad.all _.monad)) - missing_partials (|> _.aconst_null - (list.repeated (|> num_partials (n.- apply_arity) (n.- stage))) - (monad.all _.monad))] - ($_ _.composite - (_.new class) - _.dup - current_environment - ///count.value - (..increment apply_arity) - current_partials - (..inputs ..this_offset apply_arity) - missing_partials - (_.invokespecial class //init.name (//init.type environment function_arity)) - _.areturn))))))) + ... (i.< over_extent (.int stage)) + (let [current_environment (|> (list.indices (list.size environment)) + (list#each (///foreign.get class)) + (monad.all _.monad)) + missing_partials (|> _.aconst_null + (list.repeated (|> num_partials (n.- apply_arity) (n.- stage))) + (monad.all _.monad))] + (all _.composite + (_.new class) + _.dup + current_environment + ///count.value + (..increment apply_arity) + current_partials + (..inputs ..this_offset apply_arity) + missing_partials + (_.invokespecial class //init.name (//init.type environment function_arity)) + _.areturn))))))) (monad.all _.monad))]] - ($_ _.composite - ///count.value - (_.tableswitch (try.trusted (signed.s4 +0)) @default [@labelsH @labelsT]) - cases)))}))) + (all _.composite + ///count.value + (_.tableswitch (try.trusted (signed.s4 +0)) @default [@labelsH @labelsT]) + cases)))}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux index 165c3e502..eb17c5044 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/implementation.lux @@ -36,10 +36,10 @@ (list)])) (def: modifier - ($_ modifier#composite - method.static - //.modifier - )) + (all modifier#composite + method.static + //.modifier + )) (def: .public (method :it: arity @begin body) (-> (Type Class) Arity Label (Bytecode Any) (Resource Method)) @@ -47,11 +47,11 @@ ..name #0 (..type :it: arity) (list) - {.#Some ($_ _.composite - (_.set_label @begin) - body - (_.when_continuous _.areturn) - )})) + {.#Some (all _.composite + (_.set_label @begin) + body + (_.when_continuous _.areturn) + )})) (def: .public (call :it: arity) (-> (Type Class) Arity (Bytecode Any)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux index 554f0cb8e..d909c1aaf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/init.lux @@ -67,11 +67,11 @@ (def: .public (super environment_size arity) (-> Nat Arity (Bytecode Any)) (let [arity_register (++ environment_size)] - ($_ _.composite - (if (arity.unary? arity) - ..no_partials - (_.iload arity_register)) - (_.invokespecial ///abstract.class ..name ///abstract.init)))) + (all _.composite + (if (arity.unary? arity) + ..no_partials + (_.iload arity_register)) + (_.invokespecial ///abstract.class ..name ///abstract.init)))) (def: (store_all amount put offset) (-> Nat @@ -96,9 +96,9 @@ (method.method //.modifier ..name #0 (..type environment arity) (list) - {.#Some ($_ _.composite - ////reference.this - (..super environment_size arity) - (store_all environment_size (///foreign.put class) offset_foreign) - (store_all (-- arity) (///partial.put class) offset_partial) - _.return)}))) + {.#Some (all _.composite + ////reference.this + (..super environment_size arity) + (store_all environment_size (///foreign.put class) offset_foreign) + (store_all (-- arity) (///partial.put class) offset_partial) + _.return)}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux index 5087f0357..06c0b32d3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/new.lux @@ -45,12 +45,12 @@ (def: .public (instance' foreign_setup class environment arity) (-> (List (Bytecode Any)) (Type Class) (Environment Synthesis) Arity (Bytecode Any)) - ($_ _.composite - (_.new class) - _.dup - (monad.all _.monad foreign_setup) - (///partial.new arity) - (_.invokespecial class //init.name (//init.type environment arity)))) + (all _.composite + (_.new class) + _.dup + (monad.all _.monad foreign_setup) + (///partial.new arity) + (_.invokespecial class //init.name (//init.type environment arity)))) (def: .public (instance generate archive class environment arity) (-> Phase Archive (Type Class) (Environment Synthesis) Arity (Operation (Bytecode Any))) @@ -70,13 +70,13 @@ (method.method //.modifier //init.name #0 (//init.type environment arity) (list) - {.#Some ($_ _.composite - ////reference.this - (//init.super environment_size arity) - (monad.each _.monad (function (_ register) - (///foreign.put class register (_.aload (after_this register)))) - (list.indices environment_size)) - (monad.each _.monad (function (_ register) - (///partial.put class register (_.aload (after_arity register)))) - (list.indices (n.- ///arity.minimum arity))) - _.areturn)}))) + {.#Some (all _.composite + ////reference.this + (//init.super environment_size arity) + (monad.each _.monad (function (_ register) + (///foreign.put class register (_.aload (after_this register)))) + (list.indices environment_size)) + (monad.each _.monad (function (_ register) + (///partial.put class register (_.aload (after_arity register)))) + (list.indices (n.- ///arity.minimum arity))) + _.areturn)}))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux index 037f2958d..ea9f1fc21 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/function/method/reset.lux @@ -1,30 +1,30 @@ (.using - [library - [lux {"-" Type type} - [data - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [target - [jvm - ["[0]" method {"+" Method}] - ["_" bytecode {"+" Bytecode}] - [constant - [pool {"+" Resource}]] - ["[0]" type {"+" Type} - ["[0]" category {"+" Class}]]]]]] - ["[0]" // - ["[1][0]" new] + [library + [lux {"-" Type type} + [data + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [target + [jvm + ["[0]" method {"+" Method}] + ["_" bytecode {"+" Bytecode}] + [constant + [pool {"+" Resource}]] + ["[0]" type {"+" Type} + ["[0]" category {"+" Class}]]]]]] + ["[0]" // + ["[1][0]" new] + ["/[1]" // "_" + [field + [variable + ["[1][0]" foreign]]] ["/[1]" // "_" - [field - [variable - ["[1][0]" foreign]]] - ["/[1]" // "_" - ["[1][0]" reference] - [//// - [analysis {"+" Environment}] - [synthesis {"+" Synthesis}] - [/// - ["[0]" arity {"+" Arity}]]]]]]) + ["[1][0]" reference] + [//// + [analysis {"+" Environment}] + [synthesis {"+" Synthesis}] + [/// + ["[0]" arity {"+" Arity}]]]]]]) (def: .public name "reset") @@ -43,8 +43,8 @@ (method.method //.modifier ..name #0 (..type class) (list) - {.#Some ($_ _.composite - (if (arity.multiary? arity) - (//new.instance' (..current_environment class environment) class environment arity) - ////reference.this) - _.areturn)})) + {.#Some (all _.composite + (if (arity.multiary? arity) + (//new.instance' (..current_environment class environment) class environment arity) + ////reference.this) + _.areturn)})) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux index d512d7050..d9f873984 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/host.lux @@ -62,10 +62,10 @@ (import: java/lang/ClassLoader "[1]::[0]") -(def: value::modifier ($_ modifier#composite field.public field.final field.static)) +(def: value::modifier (all modifier#composite field.public field.final field.static)) (def: init::type (type.method [(list) (list) type.void (list)])) -(def: init::modifier ($_ modifier#composite method.public method.static method.strict)) +(def: init::modifier (all modifier#composite method.public method.static method.strict)) (exception: .public (cannot_load [class Text error Text]) @@ -126,10 +126,10 @@ #0 ..init::type (list) {.#Some - ($_ _.composite - valueG - (_.putstatic (type.class bytecode_name (list)) //value.field :value:) - _.return)})) + (all _.composite + valueG + (_.putstatic (type.class bytecode_name (list)) //value.field :value:) + _.return)})) (sequence.sequence))] (io.run! (do [! (try.with io.monad)] [bytecode (# ! each (format.result class.writer) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux index 0d510baa6..167e22442 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/loop.lux @@ -54,23 +54,23 @@ [fetchG (translate archive updateS) .let [storeG (_.astore register)]] (in [fetchG storeG]))))))] - (in ($_ _.composite - ... It may look weird that first I fetch all the values separately, - ... and then I store them all. - ... It must be done that way in order to avoid a potential bug. - ... Let's say that you'll recur with 2 expressions: X and Y. - ... If Y depends on the value of X, and you don't perform fetches - ... and stores separately, then by the time Y is evaluated, it - ... will refer to the new value of X, instead of the old value, as - ... should be the case. - (|> updatesG - (list#each product.left) - (monad.all _.monad)) - (|> updatesG - list.reversed - (list#each product.right) - (monad.all _.monad)) - (_.goto @begin))))) + (in (all _.composite + ... It may look weird that first I fetch all the values separately, + ... and then I store them all. + ... It must be done that way in order to avoid a potential bug. + ... Let's say that you'll recur with 2 expressions: X and Y. + ... If Y depends on the value of X, and you don't perform fetches + ... and stores separately, then by the time Y is evaluated, it + ... will refer to the new value of X, instead of the old value, as + ... should be the case. + (|> updatesG + (list#each product.left) + (monad.all _.monad)) + (|> updatesG + list.reversed + (list#each product.right) + (monad.all _.monad)) + (_.goto @begin))))) (def: .public (scope translate archive [offset initsS+ iterationS]) (Generator [Nat (List Synthesis) Synthesis]) @@ -82,13 +82,13 @@ .let [initializationG (list#each (function (_ [index initG]) [initG (_.astore (n.+ offset index))]) (list.enumeration initsI+))]] - (in ($_ _.composite - (|> initializationG - (list#each product.left) - (monad.all _.monad)) - (|> initializationG - list.reversed - (list#each product.right) - (monad.all _.monad)) - (_.set_label @begin) - iterationG)))) + (in (all _.composite + (|> initializationG + (list#each product.left) + (monad.all _.monad)) + (|> initializationG + list.reversed + (list#each product.right) + (monad.all _.monad)) + (_.set_label @begin) + iterationG)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux index 2b761e907..dacdd2318 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/program.lux @@ -47,67 +47,67 @@ (def: main::modifier (Modifier Method) - ($_ modifier#composite - method.public - method.static - method.strict - )) + (all modifier#composite + method.public + method.static + method.strict + )) (def: program::modifier (Modifier Class) - ($_ modifier#composite - class.public - class.final - )) + (all modifier#composite + class.public + class.final + )) (def: list:end //runtime.none_injection) (def: amount_of_inputs (Bytecode Any) - ($_ _.composite - _.aload_0 - _.arraylength)) + (all _.composite + _.aload_0 + _.arraylength)) (def: decrease (Bytecode Any) - ($_ _.composite - _.iconst_1 - _.isub)) + (all _.composite + _.iconst_1 + _.isub)) (def: head (Bytecode Any) - ($_ _.composite - _.dup - _.aload_0 - _.swap - _.aaload - _.swap - _.dup_x2 - _.pop)) + (all _.composite + _.dup + _.aload_0 + _.swap + _.aaload + _.swap + _.dup_x2 + _.pop)) (def: pair (Bytecode Any) - (let [empty_pair ($_ _.composite - _.iconst_2 - (_.anewarray ^Object) - ) + (let [empty_pair (all _.composite + _.iconst_2 + (_.anewarray ^Object) + ) set_side! (is (-> (Bytecode Any) (Bytecode Any)) (function (_ index) - ($_ _.composite - ... ?P - _.dup_x1 ... P?P - _.swap ... PP? - index ... PP?I - _.swap ... PPI? - _.aastore ... P - )))] - ($_ _.composite - ... RL - empty_pair ... RLP - (set_side! _.iconst_0) ... RP - (set_side! _.iconst_1) ... P - ))) + (all _.composite + ... ?P + _.dup_x1 ... P?P + _.swap ... PP? + index ... PP?I + _.swap ... PPI? + _.aastore ... P + )))] + (all _.composite + ... RL + empty_pair ... RLP + (set_side! _.iconst_0) ... RP + (set_side! _.iconst_1) ... P + ))) (def: list:item //runtime.right_injection) @@ -116,30 +116,30 @@ (do _.monad [@loop _.new_label @end _.new_label] - ($_ _.composite - ..list:end - ..amount_of_inputs - (_.set_label @loop) - ..decrease - _.dup - (_.iflt @end) - ..head - ..pair - ..list:item - _.swap - (_.goto @loop) - (_.set_label @end) - _.pop))) + (all _.composite + ..list:end + ..amount_of_inputs + (_.set_label @loop) + ..decrease + _.dup + (_.iflt @end) + ..head + ..pair + ..list:item + _.swap + (_.goto @loop) + (_.set_label @end) + _.pop))) (def: feed_inputs //runtime.apply) (def: run_io (Bytecode Any) - ($_ _.composite - (_.checkcast //function/abstract.class) - //runtime.unit - //runtime.apply)) + (all _.composite + (_.checkcast //function/abstract.class) + //runtime.unit + //runtime.apply)) (def: .public (program artifact_name context program) (-> (-> unit.ID Text) (Program (Bytecode Any) Definition)) @@ -147,12 +147,12 @@ main (method.method ..main::modifier "main" #0 ..main::type (list) - {.#Some ($_ _.composite - program - ..input_list - ..feed_inputs - ..run_io - _.return)}) + {.#Some (all _.composite + program + ..input_list + ..feed_inputs + ..run_io + _.return)}) class (artifact_name context)] [class (<| (format.result class.writer) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux index cc36c0cd2..725952b30 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/reference.lux @@ -44,11 +44,11 @@ (do [! ////.monad] [bytecode_name (# ! each //runtime.class_name (generation.context archive))] - (in ($_ _.composite - ..this - (_.getfield (type.class bytecode_name (list)) - (..foreign_name variable) - //type.value))))) + (in (all _.composite + ..this + (_.getfield (type.class bytecode_name (list)) + (..foreign_name variable) + //type.value))))) (def: .public (variable archive variable) (-> Archive Variable (Operation (Bytecode Any))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux index 136c1c359..cb82ec642 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux @@ -109,11 +109,11 @@ (def: modifier (Modifier Method) - ($_ modifier#composite - method.public - method.static - method.strict - )) + (all modifier#composite + method.public + method.static + method.strict + )) (def: this (Bytecode Any) @@ -121,19 +121,19 @@ (def: .public (get index) (-> (Bytecode Any) (Bytecode Any)) - ($_ _.composite - index - _.aaload)) + (all _.composite + index + _.aaload)) (def: (set! index value) (-> (Bytecode Any) (Bytecode Any) (Bytecode Any)) - ($_ _.composite - ... A - _.dup ... AA - index ... AAI - value ... AAIV - _.aastore ... A - )) + (all _.composite + ... A + _.dup ... AA + index ... AAI + value ... AAIV + _.aastore ... A + )) (def: .public unit (_.string synthesis.unit)) @@ -146,70 +146,70 @@ (def: variant_value _.iconst_2) (def: variant::method - (let [new_variant ($_ _.composite - _.iconst_3 - (_.anewarray //type.value)) - $lefts ($_ _.composite - _.iload_0 - (//value.wrap type.int)) + (let [new_variant (all _.composite + _.iconst_3 + (_.anewarray //type.value)) + $lefts (all _.composite + _.iload_0 + (//value.wrap type.int)) $right? _.aload_1 $value _.aload_2] (method.method ..modifier ..variant::name #0 ..variant::type (list) - {.#Some ($_ _.composite - new_variant ... A[3] - (..set! ..variant_lefts $lefts) ... A[3] - (..set! ..variant_right? $right?) ... A[3] - (..set! ..variant_value $value) ... A[3] - _.areturn)}))) + {.#Some (all _.composite + new_variant ... A[3] + (..set! ..variant_lefts $lefts) ... A[3] + (..set! ..variant_right? $right?) ... A[3] + (..set! ..variant_value $value) ... A[3] + _.areturn)}))) (def: .public left_right? _.aconst_null) (def: .public right_right? ..unit) (def: .public left_injection (Bytecode Any) - ($_ _.composite - _.iconst_0 - ..left_right? - _.dup2_x1 - _.pop2 - ..variant)) + (all _.composite + _.iconst_0 + ..left_right? + _.dup2_x1 + _.pop2 + ..variant)) (def: .public right_injection (Bytecode Any) - ($_ _.composite - _.iconst_0 - ..right_right? - _.dup2_x1 - _.pop2 - ..variant)) + (all _.composite + _.iconst_0 + ..right_right? + _.dup2_x1 + _.pop2 + ..variant)) (def: .public some_injection ..right_injection) (def: .public none_injection (Bytecode Any) - ($_ _.composite - _.iconst_0 - ..left_right? - ..unit - ..variant)) + (all _.composite + _.iconst_0 + ..left_right? + ..unit + ..variant)) (def: (risky $unsafe) (-> (Bytecode Any) (Bytecode Any)) (do _.monad [@try _.new_label @handler _.new_label] - ($_ _.composite - (_.try @try @handler @handler //type.error) - (_.set_label @try) - $unsafe - ..some_injection - _.areturn - (_.set_label @handler) - ..none_injection - _.areturn - ))) + (all _.composite + (_.try @try @handler @handler //type.error) + (_.set_label @try) + $unsafe + ..some_injection + _.areturn + (_.set_label @handler) + ..none_injection + _.areturn + ))) (def: decode_frac::name "decode_frac") (def: decode_frac::type (type.method [(list) (list //type.text) //type.variant (list)])) @@ -221,11 +221,11 @@ (list) {.#Some (..risky - ($_ _.composite - _.aload_0 - (_.invokestatic //type.frac "parseDouble" (type.method [(list) (list //type.text) type.double (list)])) - (//value.wrap type.double) - ))})) + (all _.composite + _.aload_0 + (_.invokestatic //type.frac "parseDouble" (type.method [(list) (list //type.text) type.double (list)])) + (//value.wrap type.double) + ))})) (def: .public log! (Bytecode Any) @@ -234,19 +234,19 @@ out (_.getstatic ^System "out" ^PrintStream) print_type (type.method [(list) (list //type.value) type.void (list)]) print! (function (_ method) (_.invokevirtual ^PrintStream method print_type))] - ($_ _.composite - out (_.string "LUX LOG: ") (print! "print") - out _.swap (print! "println")))) + (all _.composite + out (_.string "LUX LOG: ") (print! "print") + out _.swap (print! "println")))) (def: exception_constructor (type.method [(list) (list //type.text) type.void (list)])) (def: (illegal_state_exception message) (-> Text (Bytecode Any)) (let [^IllegalStateException (type.class "java.lang.IllegalStateException" (list))] - ($_ _.composite - (_.new ^IllegalStateException) - _.dup - (_.string message) - (_.invokespecial ^IllegalStateException "<init>" ..exception_constructor)))) + (all _.composite + (_.new ^IllegalStateException) + _.dup + (_.string message) + (_.invokespecial ^IllegalStateException "<init>" ..exception_constructor)))) (def: failure::type (type.method [(list) (list) type.void (list)])) @@ -257,9 +257,9 @@ #0 ..failure::type (list) {.#Some - ($_ _.composite - (..illegal_state_exception message) - _.athrow)})) + (all _.composite + (..illegal_state_exception message) + _.athrow)})) (def: pm_failure::name "pm_failure") (def: .public pm_failure (..procedure ..pm_failure::name ..failure::type)) @@ -279,16 +279,16 @@ #0 ..push::type (list) {.#Some - (let [new_stack_frame! ($_ _.composite - _.iconst_2 - (_.anewarray //type.value)) + (let [new_stack_frame! (all _.composite + _.iconst_2 + (_.anewarray //type.value)) $head _.aload_1 $tail _.aload_0] - ($_ _.composite - new_stack_frame! - (..set! ..stack_head $head) - (..set! ..stack_tail $tail) - _.areturn))})) + (all _.composite + new_stack_frame! + (..set! ..stack_head $head) + (..set! ..stack_tail $tail) + _.areturn))})) (def: case::name "case") (def: case::type (type.method [(list) (list //type.variant //type.lefts //type.right?) //type.value (list)])) @@ -309,67 +309,67 @@ $lefts _.iload_1 $right? _.aload_2 - ::lefts ($_ _.composite - (..get ..variant_lefts) - (//value.unwrap type.int)) + ::lefts (all _.composite + (..get ..variant_lefts) + (//value.unwrap type.int)) ::right? (..get ..variant_right?) ::value (..get ..variant_value) not_found _.aconst_null - super_nested_lefts ($_ _.composite - _.swap - _.isub - (_.int (i32.i32 (.i64 +1))) - _.isub) - super_nested ($_ _.composite - ... lefts, sumT - super_nested_lefts ... super_lefts - $variant ::right? ... super_lefts, super_right - $variant ::value ... super_lefts, super_right, super_value - ..variant) - - update_$variant ($_ _.composite - $variant ::value - (_.checkcast //type.variant) - _.astore_0) - update_$lefts ($_ _.composite - _.isub - (_.int (i32.i32 (.i64 +1))) - _.isub) + super_nested_lefts (all _.composite + _.swap + _.isub + (_.int (i32.i32 (.i64 +1))) + _.isub) + super_nested (all _.composite + ... lefts, sumT + super_nested_lefts ... super_lefts + $variant ::right? ... super_lefts, super_right + $variant ::value ... super_lefts, super_right, super_value + ..variant) + + update_$variant (all _.composite + $variant ::value + (_.checkcast //type.variant) + _.astore_0) + update_$lefts (all _.composite + _.isub + (_.int (i32.i32 (.i64 +1))) + _.isub) again (is (-> Label (Bytecode Any)) (function (_ @) - ($_ _.composite - ... lefts, sumT - update_$variant ... lefts, sumT - update_$lefts ... sub_lefts - (_.goto @))))]] - ($_ _.composite - $lefts - (_.set_label @loop) - $variant ::lefts - _.dup2 (_.if_icmpeq @lefts_match!) - _.dup2 (_.if_icmpgt @maybe_nested) - $right? (_.ifnull @mismatch!) ... lefts, sumT - super_nested ... super_variant - _.areturn - (_.set_label @lefts_match!) ... lefts, sumT - $right? ... lefts, sumT, wants_right? - $variant ::right? ... lefts, sumT, wants_right?, is_right? - (_.if_acmpeq @perfect_match!) ... lefts, sumT - (_.set_label @mismatch!) ... lefts, sumT - ... _.pop2 - not_found - _.areturn - (_.set_label @maybe_nested) ... lefts, sumT - $variant ::right? ... lefts, sumT, right? - (_.ifnull @mismatch!) ... lefts, sumT - (again @loop) - (_.set_label @perfect_match!) ... lefts, sumT - ... _.pop2 - $variant ::value - _.areturn - ))})) + (all _.composite + ... lefts, sumT + update_$variant ... lefts, sumT + update_$lefts ... sub_lefts + (_.goto @))))]] + (all _.composite + $lefts + (_.set_label @loop) + $variant ::lefts + _.dup2 (_.if_icmpeq @lefts_match!) + _.dup2 (_.if_icmpgt @maybe_nested) + $right? (_.ifnull @mismatch!) ... lefts, sumT + super_nested ... super_variant + _.areturn + (_.set_label @lefts_match!) ... lefts, sumT + $right? ... lefts, sumT, wants_right? + $variant ::right? ... lefts, sumT, wants_right?, is_right? + (_.if_acmpeq @perfect_match!) ... lefts, sumT + (_.set_label @mismatch!) ... lefts, sumT + ... _.pop2 + not_found + _.areturn + (_.set_label @maybe_nested) ... lefts, sumT + $variant ::right? ... lefts, sumT, right? + (_.ifnull @mismatch!) ... lefts, sumT + (again @loop) + (_.set_label @perfect_match!) ... lefts, sumT + ... _.pop2 + $variant ::value + _.areturn + ))})) (def: projection_type (type.method [(list) (list //type.tuple //type.offset) //type.value (list)])) @@ -382,29 +382,29 @@ (def: projection::method2 [(Resource Method) (Resource Method)] (let [$tuple _.aload_0 - $tuple::size ($_ _.composite - $tuple - _.arraylength) + $tuple::size (all _.composite + $tuple + _.arraylength) $lefts _.iload_1 - $last_right ($_ _.composite - $tuple::size - _.iconst_1 - _.isub) - - update_$lefts ($_ _.composite - $lefts $last_right _.isub - _.istore_1) - update_$tuple ($_ _.composite - $tuple $last_right _.aaload (_.checkcast //type.tuple) - _.astore_0) + $last_right (all _.composite + $tuple::size + _.iconst_1 + _.isub) + + update_$lefts (all _.composite + $lefts $last_right _.isub + _.istore_1) + update_$tuple (all _.composite + $tuple $last_right _.aaload (_.checkcast //type.tuple) + _.astore_0) recur (is (-> Label (Bytecode Any)) (function (_ @loop) - ($_ _.composite - update_$lefts - update_$tuple - (_.goto @loop)))) + (all _.composite + update_$lefts + update_$tuple + (_.goto @loop)))) left_projection::method (method.method ..modifier ..left_projection::name @@ -414,17 +414,17 @@ (do _.monad [@loop _.new_label @recursive _.new_label - .let [::left ($_ _.composite - $lefts - _.aaload)]] - ($_ _.composite - (_.set_label @loop) - $lefts $last_right (_.if_icmpge @recursive) - $tuple ::left - _.areturn - (_.set_label @recursive) - ... Recursive - (recur @loop)))}) + .let [::left (all _.composite + $lefts + _.aaload)]] + (all _.composite + (_.set_label @loop) + $lefts $last_right (_.if_icmpge @recursive) + $tuple ::left + _.areturn + (_.set_label @recursive) + ... Recursive + (recur @loop)))}) right_projection::method (method.method ..modifier ..right_projection::name @@ -435,34 +435,34 @@ [@loop _.new_label @not_tail _.new_label @slice _.new_label - .let [$right ($_ _.composite - $lefts - _.iconst_1 - _.iadd) - $::nested ($_ _.composite - $tuple - _.swap - _.aaload) - super_nested ($_ _.composite - $tuple - $right - $tuple::size - (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" - (type.method [(list) (list //type.tuple //type.index //type.index) //type.tuple (list)])))]] - ($_ _.composite - (_.set_label @loop) - $last_right $right - _.dup2 (_.if_icmpne @not_tail) - ... _.pop - $::nested - _.areturn - (_.set_label @not_tail) - (_.if_icmpgt @slice) - ... Must recurse - (recur @loop) - (_.set_label @slice) - super_nested - _.areturn))})] + .let [$right (all _.composite + $lefts + _.iconst_1 + _.iadd) + $::nested (all _.composite + $tuple + _.swap + _.aaload) + super_nested (all _.composite + $tuple + $right + $tuple::size + (_.invokestatic (type.class "java.util.Arrays" (list)) "copyOfRange" + (type.method [(list) (list //type.tuple //type.index //type.index) //type.tuple (list)])))]] + (all _.composite + (_.set_label @loop) + $last_right $right + _.dup2 (_.if_icmpne @not_tail) + ... _.pop + $::nested + _.areturn + (_.set_label @not_tail) + (_.if_icmpgt @slice) + ... Must recurse + (recur @loop) + (_.set_label @slice) + super_nested + _.areturn))})] [left_projection::method right_projection::method])) @@ -493,44 +493,44 @@ .let [$unsafe ..this ^StringWriter (type.class "java.io.StringWriter" (list)) - string_writer ($_ _.composite - (_.new ^StringWriter) - _.dup - (_.invokespecial ^StringWriter "<init>" (type.method [(list) (list) type.void (list)]))) + string_writer (all _.composite + (_.new ^StringWriter) + _.dup + (_.invokespecial ^StringWriter "<init>" (type.method [(list) (list) type.void (list)]))) ^PrintWriter (type.class "java.io.PrintWriter" (list)) - print_writer ($_ _.composite - ... WTW - (_.new ^PrintWriter) ... WTWP - _.dup_x1 ... WTPWP - _.swap ... WTPPW - ..true ... WTPPWZ - (_.invokespecial ^PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) - ... WTP - ) - unsafe_application ($_ _.composite - $unsafe - ..unit - ..apply) - stack_trace ($_ _.composite - ... T - string_writer ... TW - _.dup_x1 ... WTW - print_writer ... WTP - (_.invokevirtual //type.error "printStackTrace" (type.method [(list) (list ^PrintWriter) type.void (list)])) ... W - (_.invokevirtual ^StringWriter "toString" (type.method [(list) (list) //type.text (list)])) ... S - )]] - ($_ _.composite - (_.try @try @handler @handler //type.error) - (_.set_label @try) - unsafe_application - ..right_injection - _.areturn - (_.set_label @handler) ... T - stack_trace ... S - ..left_injection - _.areturn - ))})) + print_writer (all _.composite + ... WTW + (_.new ^PrintWriter) ... WTWP + _.dup_x1 ... WTPWP + _.swap ... WTPPW + ..true ... WTPPWZ + (_.invokespecial ^PrintWriter "<init>" (type.method [(list) (list (type.class "java.io.Writer" (list)) type.boolean) type.void (list)])) + ... WTP + ) + unsafe_application (all _.composite + $unsafe + ..unit + ..apply) + stack_trace (all _.composite + ... T + string_writer ... TW + _.dup_x1 ... WTW + print_writer ... WTP + (_.invokevirtual //type.error "printStackTrace" (type.method [(list) (list ^PrintWriter) type.void (list)])) ... W + (_.invokevirtual ^StringWriter "toString" (type.method [(list) (list) //type.text (list)])) ... S + )]] + (all _.composite + (_.try @try @handler @handler //type.error) + (_.set_label @try) + unsafe_application + ..right_injection + _.areturn + (_.set_label @handler) ... T + stack_trace ... S + ..left_injection + _.areturn + ))})) (def: reflection (All (_ category) @@ -543,9 +543,9 @@ (Operation [artifact.ID (Maybe Text) Binary]) (let [class (..reflection ..class) modifier (is (Modifier Class) - ($_ modifier#composite - class.public - class.final)) + (all modifier#composite + class.public + class.final)) bytecode (<| (format.result class.writer) try.trusted (class.class jvm/version.v6_0 @@ -585,13 +585,13 @@ (let [previous_inputs (|> arity list.indices (monad.each _.monad _.aload))] - ($_ _.composite - previous_inputs - (_.invokevirtual //function.class ..apply::name (..apply::type (-- arity))) - (_.checkcast //function.class) - (_.aload arity) - (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum)) - _.areturn))}))) + (all _.composite + previous_inputs + (_.invokevirtual //function.class ..apply::name (..apply::type (-- arity))) + (_.checkcast //function.class) + (_.aload arity) + (_.invokevirtual //function.class ..apply::name (..apply::type //function/arity.minimum)) + _.areturn))}))) (partial_list (method.method (modifier#composite method.public method.abstract) ..apply::name #0 (..apply::type //function/arity.minimum) @@ -602,17 +602,17 @@ (list) {.#Some (let [$partials _.iload_1] - ($_ _.composite - ..this - (_.invokespecial ^Object "<init>" (type.method [(list) (list) type.void (list)])) - ..this - $partials - (_.putfield //function.class //function/count.field //function/count.type) - _.return))}) + (all _.composite + ..this + (_.invokespecial ^Object "<init>" (type.method [(list) (list) type.void (list)])) + ..this + $partials + (_.putfield //function.class //function/count.field //function/count.type) + _.return))}) modifier (is (Modifier Class) - ($_ modifier#composite - class.public - class.abstract)) + (all modifier#composite + class.public + class.abstract)) class (..reflection //function.class) partial_count (is (Resource Field) (field.field (modifier#composite field.public field.final) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux index 0bef710e1..e40b7d122 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/value.lux @@ -1,12 +1,12 @@ (.using - [library - [lux {"-" Type Primitive type} - [target - [jvm - ["_" bytecode {"+" Bytecode}] - ["[0]" type {"+" Type} ("[1]#[0]" equivalence) - [category {"+" Primitive}] - ["[0]" box]]]]]]) + [library + [lux {"-" Type Primitive type} + [target + [jvm + ["_" bytecode {"+" Bytecode}] + ["[0]" type {"+" Type} ("[1]#[0]" equivalence) + [category {"+" Primitive}] + ["[0]" box]]]]]]) (def: .public field "value") @@ -44,6 +44,6 @@ (def: .public (unwrap type) (-> (Type Primitive) (Bytecode Any)) (let [wrapper (type.class (primitive_wrapper type) (list))] - ($_ _.composite - (_.checkcast wrapper) - (_.invokevirtual wrapper (primitive_unwrap type) (type.method [(list) (list) type (list)]))))) + (all _.composite + (_.checkcast wrapper) + (_.invokevirtual wrapper (primitive_unwrap type) (type.method [(list) (list) type (list)]))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux index 2c35a85bd..18776639d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/case.lux @@ -56,9 +56,9 @@ [this (expression archive this) that (statement expression archive that) $dummy (# ! each _.var (/////generation.symbol "_exec"))] - (in ($_ _.then - (_.set (list $dummy) this) - that)))) + (in (all _.then + (_.set (list $dummy) this) + that)))) (def: .public (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) @@ -76,9 +76,9 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (in ($_ _.then - (_.local/1 (..register register) valueO) - bodyO)))) + (in (all _.then + (_.local/1 (..register register) valueO) + bodyO)))) (def: .public (get expression archive [pathP valueS]) (Generator [(List Member) Synthesis]) @@ -154,15 +154,15 @@ (template [<name> <flag>] [(def: (<name> simple? idx) (-> Bit Nat Statement) - ($_ _.then - (_.set (list @temp) (//runtime.sum//get ..peek <flag> - (|> idx .int _.int))) - (.if simple? - (_.when (_.= _.nil @temp) - fail!) - (_.if (_.= _.nil @temp) - fail! - (..push! @temp)))))] + (all _.then + (_.set (list @temp) (//runtime.sum//get ..peek <flag> + (|> idx .int _.int))) + (.if simple? + (_.when (_.= _.nil @temp) + fail!) + (_.if (_.= _.nil @temp) + fail! + (..push! @temp)))))] [left_choice _.nil] [right_choice //runtime.unit] @@ -170,14 +170,14 @@ (def: (alternation pre! post!) (-> Statement Statement Statement) - ($_ _.then - (_.while (_.boolean true) - ($_ _.then - ..save! - pre!)) - ($_ _.then - ..restore! - post!))) + (all _.then + (_.while (_.boolean true) + (all _.then + ..save! + pre!)) + (all _.then + ..restore! + post!))) (def: (pattern_matching' statement expression archive) (-> Phase! Phase Archive Path (Operation Statement)) @@ -248,9 +248,9 @@ (pattern (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (again thenP)] - (///////phase#in ($_ _.then - (_.local/1 (..register register) ..peek_and_pop) - then!))) + (///////phase#in (all _.then + (_.local/1 (..register register) ..peek_and_pop) + then!))) (^.template [<tag> <combinator>] [(pattern (<tag> preP postP)) @@ -265,10 +265,10 @@ (-> Phase! Phase Archive Path (Operation Statement)) (do ///////phase.monad [pattern_matching! (pattern_matching' statement expression archive pathP)] - (in ($_ _.then - (_.while (_.boolean true) - pattern_matching!) - (_.statement (|> (_.var "error") (_.apply (list (_.string ////synthesis/case.pattern_matching_error))))))))) + (in (all _.then + (_.while (_.boolean true) + pattern_matching!) + (_.statement (|> (_.var "error") (_.apply (list (_.string ////synthesis/case.pattern_matching_error))))))))) (def: .public dependencies (-> Path (List Var)) @@ -288,11 +288,11 @@ (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] - (in ($_ _.then - (_.local (list @temp)) - (_.local/1 @cursor (_.array (list stack_init))) - (_.local/1 @savepoint (_.array (list))) - pattern_matching!)))) + (in (all _.then + (_.local (list @temp)) + (_.local/1 @cursor (_.array (list stack_init))) + (_.local/1 @savepoint (_.array (list))) + pattern_matching!)))) (def: .public (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux index c4fa6bb64..de0387fd7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/function.lux @@ -55,9 +55,9 @@ (let [@inits (|> (list.enumeration inits) (list#each (|>> product.left ..capture)))] [(_.function @self @inits - ($_ _.then - (_.local_function @self @args body!) - (_.return @self))) + (all _.then + (_.local_function @self @args body!) + (_.return @self))) (_.apply inits @self)]))) (def: input @@ -85,9 +85,9 @@ @self (_.var (///reference.artifact function_name)) initialize_self! (_.local/1 (//case.register 0) @self) initialize! (list#mix (.function (_ post pre!) - ($_ _.then - pre! - (_.local/1 (..input post) (_.item (|> post ++ .int _.int) @curried)))) + (all _.then + pre! + (_.local/1 (..input post) (_.item (|> post ++ .int _.int) @curried)))) initialize_self! (list.indices arity)) pack (|>> (list) _.array) @@ -96,48 +96,48 @@ (_.apply (list it) (_.var "table.unpack")))) @var_args (_.var "...")] .let [[definition instantiation] (with_closure closureO+ @self (list @var_args) - ($_ _.then - (_.local/1 @curried (pack @var_args)) - (_.local/1 @num_args (_.length @curried)) - (<| (_.if (|> @num_args (_.= arityO)) - ($_ _.then - initialize! - (_.set_label @scope) - body!)) - (_.if (|> @num_args (_.> arityO)) - (let [arity_inputs (_.apply (list @curried - (_.int +1) - arityO - (_.int +1) - (_.array (list))) - (_.var "table.move")) - extra_inputs (_.apply (list @curried - (_.+ (_.int +1) arityO) - @num_args - (_.int +1) - (_.array (list))) - (_.var "table.move"))] - (_.return (|> @self - (_.apply (list (unpack arity_inputs))) - (_.apply (list (unpack extra_inputs))))))) - ... (|> @num_args (_.< arityO)) - (_.return (_.closure (list @var_args) - (let [@extra_args (_.var "extra_args")] - ($_ _.then - (_.local/1 @extra_args (pack @var_args)) - (_.return (_.apply (list (unpack (_.apply (list @extra_args - (_.int +1) - (_.length @extra_args) - (_.+ (_.int +1) @num_args) - (_.apply (list @curried - (_.int +1) - @num_args - (_.int +1) - (_.array (list))) - (_.var "table.move"))) - (_.var "table.move")))) - @self))))))) - ))] + (all _.then + (_.local/1 @curried (pack @var_args)) + (_.local/1 @num_args (_.length @curried)) + (<| (_.if (|> @num_args (_.= arityO)) + (all _.then + initialize! + (_.set_label @scope) + body!)) + (_.if (|> @num_args (_.> arityO)) + (let [arity_inputs (_.apply (list @curried + (_.int +1) + arityO + (_.int +1) + (_.array (list))) + (_.var "table.move")) + extra_inputs (_.apply (list @curried + (_.+ (_.int +1) arityO) + @num_args + (_.int +1) + (_.array (list))) + (_.var "table.move"))] + (_.return (|> @self + (_.apply (list (unpack arity_inputs))) + (_.apply (list (unpack extra_inputs))))))) + ... (|> @num_args (_.< arityO)) + (_.return (_.closure (list @var_args) + (let [@extra_args (_.var "extra_args")] + (all _.then + (_.local/1 @extra_args (pack @var_args)) + (_.return (_.apply (list (unpack (_.apply (list @extra_args + (_.int +1) + (_.length @extra_args) + (_.+ (_.int +1) @num_args) + (_.apply (list @curried + (_.int +1) + @num_args + (_.int +1) + (_.array (list))) + (_.var "table.move"))) + (_.var "table.move")))) + @self))))))) + ))] _ (/////generation.execute! definition) _ (/////generation.save! (product.right function_name) {.#None} definition)] (in instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux index 57e35ab75..9883feaaf 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/loop.lux @@ -44,11 +44,11 @@ (list#each (|>> product.left (n.+ offset) //case.register)))] (if as_expression? body - ($_ _.then - (if initial? - (_.let variables (_.multi bindings)) - (_.set variables (_.multi bindings))) - body)))) + (all _.then + (if initial? + (_.let variables (_.multi bindings)) + (_.set variables (_.multi bindings))) + body)))) (def: .public (scope! statement expression archive as_expression? [start initsS+ bodyS]) ... (Generator! (Scope Synthesis)) @@ -70,9 +70,9 @@ (statement expression archive bodyS))] (in [initsO+ (..setup true start initsO+ as_expression? - ($_ _.then - (_.set_label @scope) - body!))])))) + (all _.then + (_.set_label @scope) + body!))])))) (def: .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -105,11 +105,11 @@ foreigns (let [@context (_.var (format (_.code @loop) "_context"))] [(_.function @context foreigns - ($_ _.then - (<| (_.local_function @loop locals) - scope!) - (_.return @loop) - )) + (all _.then + (<| (_.local_function @loop locals) + scope!) + (_.return @loop) + )) (_.apply foreigns @context)])))] _ (/////generation.execute! directive) _ (/////generation.save! artifact_id {.#None} directive)] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux index be52af3e7..9864bd037 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/lua/runtime.lux @@ -166,49 +166,49 @@ (def: last_index (|>> _.length (_.- (_.int +1)))) -(with_expansions [<recur> (these ($_ _.then - (_.set (list lefts) (_.- last_index_right lefts)) - (_.set (list tuple) (..item last_index_right tuple))))] +(with_expansions [<recur> (these (all _.then + (_.set (list lefts) (_.- last_index_right lefts)) + (_.set (list tuple) (..item last_index_right tuple))))] (runtime: (tuple//left lefts tuple) (with_vars [last_index_right] (<| (_.while (_.boolean true)) - ($_ _.then - (_.local/1 last_index_right (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (..item lefts tuple)) - ... Needs recursion - <recur>))))) + (all _.then + (_.local/1 last_index_right (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (..item lefts tuple)) + ... Needs recursion + <recur>))))) (runtime: (tuple//right lefts tuple) (with_vars [last_index_right right_index] (<| (_.while (_.boolean true)) - ($_ _.then - (_.local/1 last_index_right (..last_index tuple)) - (_.local/1 right_index (_.+ (_.int +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (..item right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - <recur>) - (_.return (_.apply (list tuple - (_.+ (_.int +1) right_index) - (_.length tuple) - (_.int +1) - (_.array (list))) - (_.var "table.move")))) - ))))) + (all _.then + (_.local/1 last_index_right (..last_index tuple)) + (_.local/1 right_index (_.+ (_.int +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (..item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + <recur>) + (_.return (_.apply (list tuple + (_.+ (_.int +1) right_index) + (_.length tuple) + (_.int +1) + (_.array (list))) + (_.var "table.move")))) + ))))) (runtime: (sum//get sum expected##right? expected##lefts) (let [mismatch! (_.return _.nil) actual##lefts (_.the ..variant_tag_field sum) actual##right? (_.the ..variant_flag_field sum) actual##value (_.the ..variant_value_field sum) - recur! ($_ _.then - (_.set (list expected##lefts) (|> expected##lefts - (_.- actual##lefts) - (_.- (_.int +1)))) - (_.set (list sum) actual##value))] + recur! (all _.then + (_.set (list expected##lefts) (|> expected##lefts + (_.- actual##lefts) + (_.- (_.int +1)))) + (_.set (list sum) actual##value))] (<| (_.while (_.boolean true)) (_.if (_.= expected##lefts actual##lefts) (_.if (_.= expected##right? actual##right?) @@ -228,37 +228,37 @@ (def: runtime//adt Statement - ($_ _.then - @tuple//left - @tuple//right - @sum//get - )) + (all _.then + @tuple//left + @tuple//right + @sum//get + )) (runtime: (lux//try risky) (with_vars [success value] - ($_ _.then - (_.let (list success value) (|> risky (_.apply (list ..unit)) - _.return (_.closure (list)) - list _.apply (|> (_.var "pcall")))) - (_.if success - (_.return (..right value)) - (_.return (..left value)))))) + (all _.then + (_.let (list success value) (|> risky (_.apply (list ..unit)) + _.return (_.closure (list)) + list _.apply (|> (_.var "pcall")))) + (_.if success + (_.return (..right value)) + (_.return (..left value)))))) (runtime: (lux//program_args raw) (with_vars [tail head idx] - ($_ _.then - (_.let (list tail) ..none) - (<| (_.for_step idx (_.length raw) (_.int +1) (_.int -1)) - (_.set (list tail) (..some (_.array (list (_.item idx raw) - tail))))) - (_.return tail)))) + (all _.then + (_.let (list tail) ..none) + (<| (_.for_step idx (_.length raw) (_.int +1) (_.int -1)) + (_.set (list tail) (..some (_.array (list (_.item idx raw) + tail))))) + (_.return tail)))) (def: runtime//lux Statement - ($_ _.then - @lux//try - @lux//program_args - )) + (all _.then + @lux//try + @lux//program_args + )) (def: cap_shift (_.% (_.int +64))) @@ -270,25 +270,25 @@ (let [mask (|> (_.int +1) (_.bit_shl (_.- param (_.int +64))) (_.- (_.int +1)))] - ($_ _.then - (_.set (list param) (..cap_shift param)) - (_.return (|> subject - (_.bit_shr param) - (_.bit_and mask)))))) + (all _.then + (_.set (list param) (..cap_shift param)) + (_.return (|> subject + (_.bit_shr param) + (_.bit_and mask)))))) (runtime: (i64//division param subject) (with_vars [floored] - ($_ _.then - (_.local/1 floored (_.// param subject)) - (let [potentially_floored? (_.< (_.int +0) floored) - inexact? (|> subject - (_.% param) - (_.= (_.int +0)) - _.not)] - (_.if (_.and potentially_floored? - inexact?) - (_.return (_.+ (_.int +1) floored)) - (_.return floored)))))) + (all _.then + (_.local/1 floored (_.// param subject)) + (let [potentially_floored? (_.< (_.int +0) floored) + inexact? (|> subject + (_.% param) + (_.= (_.int +0)) + _.not)] + (_.if (_.and potentially_floored? + inexact?) + (_.return (_.+ (_.int +1) floored)) + (_.return floored)))))) (runtime: (i64//remainder param subject) (_.return (_.- (|> subject (..i64//division param) (_.* param)) @@ -296,12 +296,12 @@ (def: runtime//i64 Statement - ($_ _.then - @i64//left_shifted - @i64//right_shifted - @i64//division - @i64//remainder - )) + (all _.then + @i64//left_shifted + @i64//right_shifted + @i64//division + @i64//remainder + )) (def: (find_byte_index subject param start) (-> Expression Expression Expression Expression) @@ -327,22 +327,22 @@ (_.var "_VERSION"))) (runtime: (text//index subject param start) - (with_expansions [<rembulan> ($_ _.then - (_.local/1 byte_index (|> start - (_.+ (_.int +1)) - (..find_byte_index subject param))) - (_.if (_.= _.nil byte_index) - (_.return ..none) - (_.return (..some (..lux_index byte_index))))) - <normal> ($_ _.then - (_.local/1 byte_index (|> start - (..byte_index subject) - (..find_byte_index subject param))) - (_.if (_.= _.nil byte_index) - (_.return ..none) - (_.return (..some (|> byte_index - (..char_index subject) - ..lux_index)))))] + (with_expansions [<rembulan> (all _.then + (_.local/1 byte_index (|> start + (_.+ (_.int +1)) + (..find_byte_index subject param))) + (_.if (_.= _.nil byte_index) + (_.return ..none) + (_.return (..some (..lux_index byte_index))))) + <normal> (all _.then + (_.local/1 byte_index (|> start + (..byte_index subject) + (..find_byte_index subject param))) + (_.if (_.= _.nil byte_index) + (_.return ..none) + (_.return (..some (|> byte_index + (..char_index subject) + ..lux_index)))))] (with_vars [byte_index] (for @.lua <normal> (_.if ..on_rembulan? @@ -374,18 +374,18 @@ (runtime: (text//char idx text) (with_expansions [<rembulan> (with_vars [char] - ($_ _.then - (_.local/1 char (_.apply (list text idx) - (_.var "string.byte"))) - (_.if (_.= _.nil char) - (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) - (_.return char)))) + (all _.then + (_.local/1 char (_.apply (list text idx) + (_.var "string.byte"))) + (_.if (_.= _.nil char) + (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) + (_.return char)))) <normal> (with_vars [offset char] - ($_ _.then - (_.local/1 offset (_.apply (list text idx) (_.var "utf8.offset"))) - (_.if (_.= _.nil offset) - (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) - (_.return (_.apply (list text offset) (_.var "utf8.codepoint"))))))] + (all _.then + (_.local/1 offset (_.apply (list text idx) (_.var "utf8.offset"))) + (_.if (_.= _.nil offset) + (_.statement (_.error/1 (_.string "[Lux Error] Cannot get char from text."))) + (_.return (_.apply (list text offset) (_.var "utf8.codepoint"))))))] (for @.lua <normal> (_.if ..on_rembulan? <rembulan> @@ -393,33 +393,33 @@ (def: runtime//text Statement - ($_ _.then - @text//index - @text//clip - @text//size - @text//char - )) + (all _.then + @text//index + @text//clip + @text//size + @text//char + )) (runtime: (array//write idx value array) - ($_ _.then - (_.set (list (..item idx array)) value) - (_.return array))) + (all _.then + (_.set (list (..item idx array)) value) + (_.return array))) (def: runtime//array Statement - ($_ _.then - @array//write - )) + (all _.then + @array//write + )) (def: runtime Statement - ($_ _.then - ..runtime//adt - ..runtime//lux - ..runtime//i64 - ..runtime//text - ..runtime//array - )) + (all _.then + ..runtime//adt + ..runtime//lux + ..runtime//i64 + ..runtime//text + ..runtime//array + )) (def: .public generate (Operation [Registry Output]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux index 761b34fab..1d2c9aea8 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/case.lux @@ -59,9 +59,9 @@ (do ///////phase.monad [valueO (expression archive valueS) body! (statement expression archive bodyS)] - (in ($_ _.then - (_.set! (..register register) valueO) - body!)))) + (in (all _.then + (_.set! (..register register) valueO) + body!)))) (def: .public (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -137,14 +137,14 @@ (template [<name> <flag> <prep>] [(def: (<name> simple? idx) (-> Bit Nat Statement) - ($_ _.then - (_.set! @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) - (.if simple? - (_.when (_.is_null/1 @temp) - fail!) - (_.if (_.is_null/1 @temp) - fail! - (..push! @temp)))))] + (all _.then + (_.set! @temp (|> idx <prep> .int _.int (//runtime.sum//get ..peek <flag>))) + (.if simple? + (_.when (_.is_null/1 @temp) + fail!) + (_.if (_.is_null/1 @temp) + fail! + (..push! @temp)))))] [left_choice _.null (<|)] [right_choice (_.string "") ++] @@ -152,14 +152,14 @@ (def: (alternation pre! post!) (-> Statement Statement Statement) - ($_ _.then - (_.do_while (_.bool false) - ($_ _.then - ..save! - pre!)) - ($_ _.then - ..restore! - post!))) + (all _.then + (_.do_while (_.bool false) + (all _.then + ..save! + pre!)) + (all _.then + ..restore! + post!))) (def: (pattern_matching' statement expression archive) (Generator! Path) @@ -229,15 +229,15 @@ (pattern (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (again thenP)] - (///////phase#in ($_ _.then - (_.set! (..register register) ..peek_and_pop) - then!))) + (///////phase#in (all _.then + (_.set! (..register register) ..peek_and_pop) + then!))) ... (pattern (/////synthesis.!multi_pop nextP)) ... (.let [[extra_pops nextP'] (////synthesis/case.count_pops nextP)] ... (do ///////phase.monad ... [next! (again nextP')] - ... (///////phase#in ($_ _.then + ... (///////phase#in (all _.then ... (..multi_pop! (n.+ 2 extra_pops)) ... next!)))) @@ -254,10 +254,10 @@ (Generator! Path) (do ///////phase.monad [iteration! (pattern_matching' statement expression archive pathP)] - (in ($_ _.then - (_.do_while (_.bool false) - iteration!) - (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error)))))))) + (in (all _.then + (_.do_while (_.bool false) + iteration!) + (_.throw (_.new (_.constant "Exception") (list (_.string ////synthesis/case.pattern_matching_error)))))))) (def: .public dependencies (-> Path (List Var)) @@ -277,10 +277,10 @@ (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching statement expression archive pathP)] - (in ($_ _.then - (_.set! @cursor (_.array/* (list stack_init))) - (_.set! @savepoint (_.array/* (list))) - pattern_matching!)))) + (in (all _.then + (_.set! @cursor (_.array/* (list stack_init))) + (_.set! @savepoint (_.array/* (list))) + pattern_matching!)))) (def: .public (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux index 5e6c9ea30..dfbc53fd3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/function.lux @@ -51,20 +51,20 @@ (-> (List Expression) Global Var Statement [Statement Expression]) (case inits {.#End} - [($_ _.then - (_.set! @selfL (_.closure (list (_.reference @selfL)) (list) body!)) - (_.set! @selfG @selfL)) + [(all _.then + (_.set! @selfL (_.closure (list (_.reference @selfL)) (list) body!)) + (_.set! @selfG @selfL)) @selfG] _ (let [@inits (|> (list.enumeration inits) (list#each (|>> product.left ..capture)))] [(_.set! @selfG (_.closure (list) (list#each _.parameter @inits) - ($_ _.then - (_.set! @selfL (_.closure (partial_list (_.reference @selfL) (list#each _.reference @inits)) - (list) - body!)) - (_.return @selfL)))) + (all _.then + (_.set! @selfL (_.closure (partial_list (_.reference @selfL) (list#each _.reference @inits)) + (list) + body!)) + (_.return @selfL)))) (_.apply/* inits @selfG)]))) (def: .public (function statement expression archive [environment arity bodyS]) @@ -85,32 +85,32 @@ @selfL (_.var (///reference.artifact function_name)) initialize_self! (_.set! (//case.register 0) @selfL) initialize! (list#mix (.function (_ post pre!) - ($_ _.then - pre! - (_.set! (..input post) (_.item (|> post .int _.int) @curried)))) + (all _.then + pre! + (_.set! (..input post) (_.item (|> post .int _.int) @curried)))) initialize_self! (list.indices arity))] .let [[definition instantiation] (..with_closure closureG+ @selfG @selfL - ($_ _.then - (_.set! @num_args (_.func_num_args/0 [])) - (_.set! @curried (_.func_get_args/0 [])) - (_.cond (list [(|> @num_args (_.=== arityG)) - ($_ _.then - initialize! - (_.set_label @scope) - body!)] - [(|> @num_args (_.> arityG)) - (let [arity_inputs (_.array_slice/3 [@curried (_.int +0) arityG]) - extra_inputs (_.array_slice/2 [@curried arityG]) - next (_.call_user_func_array/2 [@selfL arity_inputs])] - (_.return (_.call_user_func_array/2 [next extra_inputs])))]) - ... (|> @num_args (_.< arityG)) - (let [@missing (_.var "missing")] - (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list)) - ($_ _.then - (_.set! @missing (_.func_get_args/0 [])) - (_.return (_.call_user_func_array/2 [@selfL (_.array_merge/+ @curried (list @missing))]))))))) - ))] + (all _.then + (_.set! @num_args (_.func_num_args/0 [])) + (_.set! @curried (_.func_get_args/0 [])) + (_.cond (list [(|> @num_args (_.=== arityG)) + (all _.then + initialize! + (_.set_label @scope) + body!)] + [(|> @num_args (_.> arityG)) + (let [arity_inputs (_.array_slice/3 [@curried (_.int +0) arityG]) + extra_inputs (_.array_slice/2 [@curried arityG]) + next (_.call_user_func_array/2 [@selfL arity_inputs])] + (_.return (_.call_user_func_array/2 [next extra_inputs])))]) + ... (|> @num_args (_.< arityG)) + (let [@missing (_.var "missing")] + (_.return (<| (_.closure (list (_.reference @selfL) (_.reference @curried)) (list)) + (all _.then + (_.set! @missing (_.func_get_args/0 [])) + (_.return (_.call_user_func_array/2 [@selfL (_.array_merge/+ @curried (list @missing))]))))))) + ))] _ (/////generation.execute! definition) _ (/////generation.save! (product.right function_name) definition)] (in instantiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux index 1f2d6253c..fb76fdea7 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/loop.lux @@ -63,9 +63,9 @@ body! (/////generation.with_anchor [start @scope] (statement expression archive bodyS))] (in (..setup start initsO+ - ($_ _.then - (_.set_label @scope) - body!)))))) + (all _.then + (_.set_label @scope) + body!)))))) (def: .public (scope statement expression archive [start initsS+ bodyS]) (-> Phase! (Generator (Scope Synthesis))) @@ -114,11 +114,11 @@ (do [! ///////phase.monad] [[offset @scope] /////generation.anchor argsO+ (monad.each ! (expression archive) argsS+)] - (in ($_ _.then - (_.set! @temp (_.array/* argsO+)) - (..setup offset - (|> argsO+ - list.enumeration - (list#each (function (_ [idx _]) - (_.item (_.int (.int idx)) @temp)))) - (_.go_to @scope)))))) + (in (all _.then + (_.set! @temp (_.array/* argsO+)) + (..setup offset + (|> argsO+ + list.enumeration + (list#each (function (_ [idx _]) + (_.item (_.int (.int idx)) @temp)))) + (_.go_to @scope)))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux index 5baba49fc..dfa7afe2f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/php/runtime.lux @@ -128,22 +128,22 @@ (~ code)))))))))))))))) (runtime: (io//log! message) - ($_ _.then - (_.echo message) - (_.echo (_.string text.new_line)) - (_.return ..unit))) + (all _.then + (_.echo message) + (_.echo (_.string text.new_line)) + (_.return ..unit))) (runtime: (io//throw! message) - ($_ _.then - (_.throw (_.new (_.constant "Exception") (list message))) - (_.return ..unit))) + (all _.then + (_.throw (_.new (_.constant "Exception") (list message))) + (_.return ..unit))) (def: runtime//io Statement - ($_ _.then - @io//log! - @io//throw! - )) + (all _.then + @io//log! + @io//throw! + )) (def: .public tuple_size_field "_lux_size") @@ -161,16 +161,16 @@ (_.return (_.count/1 array)))) (runtime: (array//write idx value array) - ($_ _.then - (_.set! (_.item idx array) value) - (_.return array))) + (all _.then + (_.set! (_.item idx array) value) + (_.return array))) (def: runtime//array Statement - ($_ _.then - @array//length - @array//write - )) + (all _.then + @array//length + @array//write + )) (def: jphp_last_index (|>> ..tuple_size (_.- (_.int +1)))) @@ -178,14 +178,14 @@ (def: normal_last_index (|>> _.count/1 (_.- (_.int +1)))) -(with_expansions [<recur> (these ($_ _.then - (_.set! lefts (_.- last_index_right lefts)) - (_.set! tuple (_.item last_index_right tuple))))] +(with_expansions [<recur> (these (all _.then + (_.set! lefts (_.- last_index_right lefts)) + (_.set! tuple (_.item last_index_right tuple))))] (runtime: (tuple//make size values) (_.if ..jphp? - ($_ _.then - (_.set! (..tuple_size values) size) - (_.return values)) + (all _.then + (_.set! (..tuple_size values) size) + (_.return values)) ... https://www.php.net/manual/en/language.operators.assignment.php ... https://www.php.net/manual/en/language.references.php ... https://www.php.net/manual/en/functions.arguments.php @@ -196,50 +196,50 @@ (runtime: (tuple//left lefts tuple) (with_vars [last_index_right] (<| (_.while (_.bool true)) - ($_ _.then - (_.if ..jphp? - (_.set! last_index_right (..jphp_last_index tuple)) - (_.set! last_index_right (..normal_last_index tuple))) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.item lefts tuple)) - ... Needs recursion - <recur>))))) + (all _.then + (_.if ..jphp? + (_.set! last_index_right (..jphp_last_index tuple)) + (_.set! last_index_right (..normal_last_index tuple))) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.item lefts tuple)) + ... Needs recursion + <recur>))))) ... TODO: Get rid of this as soon as JPHP is no longer necessary. (runtime: (tuple//slice offset input) (with_vars [size index output] - ($_ _.then - (_.set! size (..array//length input)) - (_.set! index (_.int +0)) - (_.set! output (_.array/* (list))) - (<| (_.while (|> index (_.+ offset) (_.< size))) - ($_ _.then - (_.set! (_.item index output) (_.item (_.+ offset index) input)) - (_.set! index (_.+ (_.int +1) index)) - )) - (_.return (..tuple//make (_.- offset size) output)) - ))) + (all _.then + (_.set! size (..array//length input)) + (_.set! index (_.int +0)) + (_.set! output (_.array/* (list))) + (<| (_.while (|> index (_.+ offset) (_.< size))) + (all _.then + (_.set! (_.item index output) (_.item (_.+ offset index) input)) + (_.set! index (_.+ (_.int +1) index)) + )) + (_.return (..tuple//make (_.- offset size) output)) + ))) (runtime: (tuple//right lefts tuple) (with_vars [last_index_right right_index] (<| (_.while (_.bool true)) - ($_ _.then - (_.if ..jphp? - (_.set! last_index_right (..jphp_last_index tuple)) - (_.set! last_index_right (..normal_last_index tuple))) - (_.set! right_index (_.+ (_.int +1) lefts)) - (_.cond (list [(_.=== last_index_right right_index) - (_.return (_.item right_index tuple))] - [(_.> last_index_right right_index) - ... Needs recursion. - <recur>]) - (_.if ..jphp? - (_.return (..tuple//make (_.- right_index (..tuple_size tuple)) - (..tuple//slice right_index tuple))) - (_.return (..tuple//make (_.- right_index (_.count/1 tuple)) - (_.array_slice/2 [(_.do "getArrayCopy" (list) tuple) right_index]))))) - ))))) + (all _.then + (_.if ..jphp? + (_.set! last_index_right (..jphp_last_index tuple)) + (_.set! last_index_right (..normal_last_index tuple))) + (_.set! right_index (_.+ (_.int +1) lefts)) + (_.cond (list [(_.=== last_index_right right_index) + (_.return (_.item right_index tuple))] + [(_.> last_index_right right_index) + ... Needs recursion. + <recur>]) + (_.if ..jphp? + (_.return (..tuple//make (_.- right_index (..tuple_size tuple)) + (..tuple//slice right_index tuple))) + (_.return (..tuple//make (_.- right_index (_.count/1 tuple)) + (_.array_slice/2 [(_.do "getArrayCopy" (list) tuple) right_index]))))) + ))))) (def: .public variant_tag_field "_lux_tag") (def: .public variant_flag_field "_lux_flag") @@ -283,9 +283,9 @@ is_last? (_.=== ..unit sum_flag) test_recursion! (_.if is_last? ... Must recurse. - ($_ _.then - (_.set! wantedTag (_.- sum_tag wantedTag)) - (_.set! sum sum_value)) + (all _.then + (_.set! wantedTag (_.- sum_tag wantedTag)) + (_.set! sum sum_value)) no_match!)] (<| (_.while (_.bool true)) (_.cond (list [(_.=== sum_tag wantedTag) @@ -302,20 +302,20 @@ (def: runtime//adt Statement - ($_ _.then - @tuple//make - @tuple//left - @tuple//slice - @tuple//right - @sum//make - @sum//get - )) + (all _.then + @tuple//make + @tuple//left + @tuple//slice + @tuple//right + @sum//make + @sum//get + )) (runtime: (lux//try op) (with_vars [value] - (_.try ($_ _.then - (_.set! value (_.apply/1 op [..unit])) - (_.return (..right value))) + (_.try (all _.then + (_.set! value (_.apply/1 op [..unit])) + (_.return (..right value))) (list (with_vars [error] [_.#class (_.constant "Exception") _.#exception error @@ -323,18 +323,18 @@ (runtime: (lux//program_args inputs) (with_vars [head tail] - ($_ _.then - (_.set! tail ..none) - (<| (_.for_each (_.array_reverse/1 inputs) head) - (_.set! tail (..some (_.array/* (list head tail))))) - (_.return tail)))) + (all _.then + (_.set! tail ..none) + (<| (_.for_each (_.array_reverse/1 inputs) head) + (_.set! tail (..some (_.array/* (list head tail))))) + (_.return tail)))) (def: runtime//lux Statement - ($_ _.then - @lux//try - @lux//program_args - )) + (all _.then + @lux//try + @lux//program_args + )) (def: .public high (-> (I64 Any) (I64 Any)) @@ -358,13 +358,13 @@ (_.- (_.int +1)) (_.bit_shl (_.int +1)) (_.+ (_.int +1)))] - ($_ _.then - (_.set! param (_.% (_.int +64) param)) - (_.if (_.=== (_.int +0) param) - (_.return subject) - (_.return (|> subject - (_.bit_shr param) - (_.bit_and mask))))))) + (all _.then + (_.set! param (_.% (_.int +64) param)) + (_.if (_.=== (_.int +0) param) + (_.return subject) + (_.return (|> subject + (_.bit_shr param) + (_.bit_and mask))))))) (runtime: (i64//char code) (_.if ..jphp? @@ -389,41 +389,41 @@ (with_vars [l48 l32 l16 l00 r48 r32 r16 r00 x48 x32 x16 x00] - ($_ _.then - (_.set! l48 (hh subject)) - (_.set! l32 (hl subject)) - (_.set! l16 (lh subject)) - (_.set! l00 (ll subject)) - - (_.set! r48 (hh parameter)) - (_.set! r32 (hl parameter)) - (_.set! r16 (lh parameter)) - (_.set! r00 (ll parameter)) - - (_.set! x00 (_.+ l00 r00)) - - (_.set! x16 (|> (high_16 x00) - (_.+ l16) - (_.+ r16))) - (_.set! x00 (low_16 x00)) - - (_.set! x32 (|> (high_16 x16) - (_.+ l32) - (_.+ r32))) - (_.set! x16 (low_16 x16)) - - (_.set! x48 (|> (high_16 x32) - (_.+ l48) - (_.+ r48) - low_16)) - (_.set! x32 (low_16 x32)) - - (let [high32 (_.bit_or (up_16 x48) x32) - low32 (_.bit_or (up_16 x16) x00)] - (_.return (|> high32 - (_.bit_shl (_.int +32)) - (_.bit_or low32)))) - )))) + (all _.then + (_.set! l48 (hh subject)) + (_.set! l32 (hl subject)) + (_.set! l16 (lh subject)) + (_.set! l00 (ll subject)) + + (_.set! r48 (hh parameter)) + (_.set! r32 (hl parameter)) + (_.set! r16 (lh parameter)) + (_.set! r00 (ll parameter)) + + (_.set! x00 (_.+ l00 r00)) + + (_.set! x16 (|> (high_16 x00) + (_.+ l16) + (_.+ r16))) + (_.set! x00 (low_16 x00)) + + (_.set! x32 (|> (high_16 x16) + (_.+ l32) + (_.+ r32))) + (_.set! x16 (low_16 x16)) + + (_.set! x48 (|> (high_16 x32) + (_.+ l48) + (_.+ r48) + low_16)) + (_.set! x32 (low_16 x32)) + + (let [high32 (_.bit_or (up_16 x48) x32) + low32 (_.bit_or (up_16 x16) x00)] + (_.return (|> high32 + (_.bit_shl (_.int +32)) + (_.bit_or low32)))) + )))) (runtime: (i64//negate value) (let [i64//min (_.int (.int (hex "80,00,00,00,00,00,00,00")))] @@ -448,57 +448,57 @@ (with_vars [l48 l32 l16 l00 r48 r32 r16 r00 x48 x32 x16 x00] - ($_ _.then - (_.set! l48 (hh subject)) - (_.set! l32 (hl subject)) - (_.set! l16 (lh subject)) - (_.set! l00 (ll subject)) - - (_.set! r48 (hh parameter)) - (_.set! r32 (hl parameter)) - (_.set! r16 (lh parameter)) - (_.set! r00 (ll parameter)) - - (_.set! x00 (_.* l00 r00)) - (_.set! x16 (high_16 x00)) - (_.set! x00 (low_16 x00)) - - (_.set! x16 (|> x16 (_.+ (_.* l16 r00)))) - (_.set! x32 (high_16 x16)) (_.set! x16 (low_16 x16)) - (_.set! x16 (|> x16 (_.+ (_.* l00 r16)))) - (_.set! x32 (|> x32 (_.+ (high_16 x16)))) (_.set! x16 (low_16 x16)) - - (_.set! x32 (|> x32 (_.+ (_.* l32 r00)))) - (_.set! x48 (high_16 x32)) (_.set! x32 (low_16 x32)) - (_.set! x32 (|> x32 (_.+ (_.* l16 r16)))) - (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) - (_.set! x32 (|> x32 (_.+ (_.* l00 r32)))) - (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) - - (_.set! x48 (|> x48 - (_.+ (_.* l48 r00)) - (_.+ (_.* l32 r16)) - (_.+ (_.* l16 r32)) - (_.+ (_.* l00 r48)) - low_16)) - - (let [high32 (_.bit_or (up_16 x48) x32) - low32 (_.bit_or (up_16 x16) x00)] - (_.return (|> high32 - (_.bit_shl (_.int +32)) - (_.bit_or low32)))) - )))) + (all _.then + (_.set! l48 (hh subject)) + (_.set! l32 (hl subject)) + (_.set! l16 (lh subject)) + (_.set! l00 (ll subject)) + + (_.set! r48 (hh parameter)) + (_.set! r32 (hl parameter)) + (_.set! r16 (lh parameter)) + (_.set! r00 (ll parameter)) + + (_.set! x00 (_.* l00 r00)) + (_.set! x16 (high_16 x00)) + (_.set! x00 (low_16 x00)) + + (_.set! x16 (|> x16 (_.+ (_.* l16 r00)))) + (_.set! x32 (high_16 x16)) (_.set! x16 (low_16 x16)) + (_.set! x16 (|> x16 (_.+ (_.* l00 r16)))) + (_.set! x32 (|> x32 (_.+ (high_16 x16)))) (_.set! x16 (low_16 x16)) + + (_.set! x32 (|> x32 (_.+ (_.* l32 r00)))) + (_.set! x48 (high_16 x32)) (_.set! x32 (low_16 x32)) + (_.set! x32 (|> x32 (_.+ (_.* l16 r16)))) + (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) + (_.set! x32 (|> x32 (_.+ (_.* l00 r32)))) + (_.set! x48 (|> x48 (_.+ (high_16 x32)))) (_.set! x32 (low_16 x32)) + + (_.set! x48 (|> x48 + (_.+ (_.* l48 r00)) + (_.+ (_.* l32 r16)) + (_.+ (_.* l16 r32)) + (_.+ (_.* l00 r48)) + low_16)) + + (let [high32 (_.bit_or (up_16 x48) x32) + low32 (_.bit_or (up_16 x16) x00)] + (_.return (|> high32 + (_.bit_shl (_.int +32)) + (_.bit_or low32)))) + )))) (def: runtime//i64 Statement - ($_ _.then - @i64//right_shifted - @i64//char - @i64//+ - @i64//negate - @i64//- - @i64//* - )) + (all _.then + @i64//right_shifted + @i64//char + @i64//+ + @i64//negate + @i64//- + @i64//* + )) (runtime: (text//size value) (_.if ..jphp? @@ -510,16 +510,16 @@ (_.return (..some (_.int +0))) (with_vars [idx] (_.if ..jphp? - ($_ _.then - (_.set! idx (_.strpos/3 [subject param start])) - (_.if (_.=== (_.bool false) idx) - (_.return ..none) - (_.return (..some idx)))) - ($_ _.then - (_.set! idx (_.iconv_strpos/3 [subject param start])) - (_.if (_.=== (_.bool false) idx) - (_.return ..none) - (_.return (..some idx)))))))) + (all _.then + (_.set! idx (_.strpos/3 [subject param start])) + (_.if (_.=== (_.bool false) idx) + (_.return ..none) + (_.return (..some idx)))) + (all _.then + (_.set! idx (_.iconv_strpos/3 [subject param start])) + (_.if (_.=== (_.bool false) idx) + (_.return ..none) + (_.return (..some idx)))))))) (def: (within? top value) (-> Expression Expression Computation) @@ -545,35 +545,35 @@ (def: runtime//text Statement - ($_ _.then - @text//size - @text//index - @text//clip - @text//char - )) + (all _.then + @text//size + @text//index + @text//clip + @text//char + )) (runtime: (f64//decode value) (with_vars [output] - ($_ _.then - (_.set! output (_.floatval/1 value)) - (_.if (_.=== (_.float +0.0) output) - (_.if ($_ _.or - (_.=== (_.string "0.0") output) - (_.=== (_.string "+0.0") output) - (_.=== (_.string "-0.0") output) - (_.=== (_.string "0") output) - (_.=== (_.string "+0") output) - (_.=== (_.string "-0") output)) - (_.return (..some output)) - (_.return ..none)) - (_.return (..some output))) - ))) + (all _.then + (_.set! output (_.floatval/1 value)) + (_.if (_.=== (_.float +0.0) output) + (_.if (all _.or + (_.=== (_.string "0.0") output) + (_.=== (_.string "+0.0") output) + (_.=== (_.string "-0.0") output) + (_.=== (_.string "0") output) + (_.=== (_.string "+0") output) + (_.=== (_.string "-0") output)) + (_.return (..some output)) + (_.return ..none)) + (_.return (..some output))) + ))) (def: runtime//f64 Statement - ($_ _.then - @f64//decode - )) + (all _.then + @f64//decode + )) (def: check_necessary_conditions! Statement @@ -585,16 +585,16 @@ (def: runtime Statement - ($_ _.then - check_necessary_conditions! - runtime//array - runtime//adt - runtime//lux - runtime//i64 - runtime//f64 - runtime//text - runtime//io - )) + (all _.then + check_necessary_conditions! + runtime//array + runtime//adt + runtime//lux + runtime//i64 + runtime//f64 + runtime//text + runtime//io + )) (def: .public generate (Operation [Registry Output]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux index aed266e9f..0479e132e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/case.lux @@ -69,9 +69,9 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (in ($_ _.then - (_.set (list (..register register)) valueO) - bodyO)))) + (in (all _.then + (_.set (list (..register register)) valueO) + bodyO)))) (def: .public (exec expression archive [pre post]) (Generator [Synthesis Synthesis]) @@ -85,9 +85,9 @@ (do ///////phase.monad [pre (expression archive pre) post (statement expression archive post)] - (in ($_ _.then - (_.statement pre) - post)))) + (in (all _.then + (_.statement pre) + post)))) (def: .public (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -158,16 +158,16 @@ (template [<name> <flag>] [(def: (<name> simple? idx) (-> Bit Nat (Statement Any)) - ($_ _.then - (_.set (list @temp) (//runtime.sum::get ..peek <flag> - (|> idx .int _.int))) - (.if simple? - (_.when (_.= _.none @temp) - fail_pm!) - (_.if (_.= _.none @temp) - fail_pm! - (..push! @temp)) - )))] + (all _.then + (_.set (list @temp) (//runtime.sum::get ..peek <flag> + (|> idx .int _.int))) + (.if simple? + (_.when (_.= _.none @temp) + fail_pm!) + (_.if (_.= _.none @temp) + fail_pm! + (..push! @temp)) + )))] [left_choice _.none] [right_choice //runtime.unit] @@ -179,23 +179,23 @@ (_.while (_.bool true) body! {.#None}) - ($_ _.then - (_.set (list g!once) (_.bool true)) - (_.while g!once - ($_ _.then - (_.set (list g!once) (_.bool false)) - body!) - {.#Some _.continue})))) + (all _.then + (_.set (list g!once) (_.bool true)) + (_.while g!once + (all _.then + (_.set (list g!once) (_.bool false)) + body!) + {.#Some _.continue})))) (def: (alternation in_closure? g!once pre! post!) (-> Bit SVar (Statement Any) (Statement Any) (Statement Any)) - ($_ _.then - (..with_looping in_closure? g!once - ($_ _.then - ..save! - pre!)) - ..restore! - post!)) + (all _.then + (..with_looping in_closure? g!once + (all _.then + ..save! + pre!)) + ..restore! + post!)) (def: (primitive_pattern_matching again pathP) (-> (-> Path (Operation (Statement Any))) @@ -281,17 +281,17 @@ (pattern (/////synthesis.!bind_top register thenP)) (do ! [then! (again thenP)] - (///////phase#in ($_ _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) + (///////phase#in (all _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) (pattern (/////synthesis.!multi_pop nextP)) (.let [[extra_pops nextP'] (case.count_pops nextP)] (do ! [next! (again nextP')] - (///////phase#in ($_ _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) + (///////phase#in (all _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) (pattern (/////synthesis.path/seq preP postP)) (do ! @@ -314,10 +314,10 @@ (do ///////phase.monad [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) g!once (..symbol "once")] - (in ($_ _.then - (..with_looping in_closure? g!once - pattern_matching!) - (_.raise (_.Exception/1 (_.string case.pattern_matching_error))))))) + (in (all _.then + (..with_looping in_closure? g!once + pattern_matching!) + (_.raise (_.Exception/1 (_.string case.pattern_matching_error))))))) (def: .public dependencies (-> Path (List SVar)) @@ -337,11 +337,11 @@ (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] - (in ($_ _.then - (_.set (list @cursor) (_.list (list stack_init))) - (_.set (list @savepoint) (_.list (list))) - pattern_matching! - )))) + (in (all _.then + (_.set (list @cursor) (_.list (list stack_init))) + (_.set (list @savepoint) (_.list (list))) + pattern_matching! + )))) (def: .public (case statement expression archive [valueS pathP]) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux index efbefac6b..077cdf100 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/function.lux @@ -59,9 +59,9 @@ [.let [directive (_.def @function (|> (list.enumeration inits) (list#each (|>> product.left ..capture))) - ($_ _.then - function_definition - (_.return @function)))] + (all _.then + function_definition + (_.return @function)))] _ (/////generation.execute! directive) _ (/////generation.save! function_id {.#None} directive)] (in (_.apply/* inits @function))))) @@ -85,32 +85,32 @@ (_.apply/* (list (_.splat_poly args)) func)) initialize_self! (_.set (list (//case.register 0)) @self) initialize! (list#mix (.function (_ post pre!) - ($_ _.then - pre! - (_.set (list (..input post)) (_.item (|> post .int _.int) @curried)))) + (all _.then + pre! + (_.set (list (..input post)) (_.item (|> post .int _.int) @curried)))) initialize_self! (list.indices arity))]] (with_closure function_artifact @self environment (_.def @self (list (_.poly @curried)) - ($_ _.then - (_.set (list @num_args) (_.len/1 @curried)) - (<| (_.if (|> @num_args (_.= arityO)) - (<| (_.then initialize!) - //loop.set_scope - body!)) - (_.if (|> @num_args (_.> arityO)) - (let [arity_inputs (_.slice (_.int +0) arityO @curried) - extra_inputs (_.slice arityO @num_args @curried)] - (_.return (|> @self - (apply_poly arity_inputs) - (apply_poly extra_inputs))))) - ... (|> @num_args (_.< arityO)) - (let [@next (_.var "next") - @missing (_.var "missing")] - ($_ _.then - (_.def @next (list (_.poly @missing)) - (_.return (|> @self (apply_poly (|> @curried (_.+ @missing)))))) - (_.return @next) - ))) - ))) + (all _.then + (_.set (list @num_args) (_.len/1 @curried)) + (<| (_.if (|> @num_args (_.= arityO)) + (<| (_.then initialize!) + //loop.set_scope + body!)) + (_.if (|> @num_args (_.> arityO)) + (let [arity_inputs (_.slice (_.int +0) arityO @curried) + extra_inputs (_.slice arityO @num_args @curried)] + (_.return (|> @self + (apply_poly arity_inputs) + (apply_poly extra_inputs))))) + ... (|> @num_args (_.< arityO)) + (let [@next (_.var "next") + @missing (_.var "missing")] + (all _.then + (_.def @next (list (_.poly @missing)) + (_.return (|> @self (apply_poly (|> @curried (_.+ @missing)))))) + (_.return @next) + ))) + ))) )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux index 5c6d545f1..951fcbb18 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/loop.lux @@ -40,9 +40,9 @@ (let [variables (|> bindings list.enumeration (list#each (|>> product.left (n.+ offset) //case.register)))] - ($_ _.then - (_.set variables (_.multi bindings)) - body))) + (all _.then + (_.set variables (_.multi bindings)) + body))) (def: .public (set_scope body!) (-> (Statement Any) (Statement Any)) @@ -101,10 +101,10 @@ foreigns [(_.def @loop foreigns - ($_ _.then - actual_loop - (_.return @loop) - )) + (all _.then + actual_loop + (_.return @loop) + )) (_.apply/* foreigns @loop)]))] _ (/////generation.execute! directive) _ (/////generation.save! loop_artifact {.#None} directive)] @@ -120,7 +120,7 @@ list.enumeration (list#each (function (_ [idx _]) (_.item (_.int (.int idx)) @temp))))]] - (in ($_ _.then - (_.set (list @temp) (_.list argsO+)) - (..setup offset re_binds - _.continue))))) + (in (all _.then + (_.set (list @temp) (_.list argsO+)) + (..setup offset re_binds + _.continue))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 525b2a108..1dd017309 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -165,75 +165,75 @@ (runtime: (lux::program_args program_args) (with_vars [inputs value] - ($_ _.then - (_.set (list inputs) ..none) - (<| (_.for_in value (_.apply/* (list program_args) (_.var "reversed"))) - (_.set (list inputs) - (..some (_.list (list value inputs))))) - (_.return inputs)))) + (all _.then + (_.set (list inputs) ..none) + (<| (_.for_in value (_.apply/* (list program_args) (_.var "reversed"))) + (_.set (list inputs) + (..some (_.list (list value inputs))))) + (_.return inputs)))) (runtime: (lux::exec code globals) - ($_ _.then - (_.exec {.#Some globals} code) - (_.return ..unit))) + (all _.then + (_.exec {.#Some globals} code) + (_.return ..unit))) (def: runtime::lux (Statement Any) - ($_ _.then - @lux::try - @lux::program_args - @lux::exec - )) + (all _.then + @lux::try + @lux::program_args + @lux::exec + )) (runtime: (io::log! message) - ($_ _.then - (_.print message) - (|> (_.__import__/1 (_.unicode "sys")) - (_.the "stdout") - (_.do "flush" (list)) - _.statement) - (_.return ..unit))) + (all _.then + (_.print message) + (|> (_.__import__/1 (_.unicode "sys")) + (_.the "stdout") + (_.do "flush" (list)) + _.statement) + (_.return ..unit))) (runtime: (io::throw! message) (_.raise (_.Exception/1 message))) (def: runtime::io (Statement Any) - ($_ _.then - @io::log! - @io::throw! - )) + (all _.then + @io::log! + @io::throw! + )) (def: last_index (|>> _.len/1 (_.- (_.int +1)))) -(with_expansions [<recur> (these ($_ _.then - (_.set (list lefts) (_.- last_index_right lefts)) - (_.set (list tuple) (_.item last_index_right tuple))))] +(with_expansions [<recur> (these (all _.then + (_.set (list lefts) (_.- last_index_right lefts)) + (_.set (list tuple) (_.item last_index_right tuple))))] (runtime: (tuple::left lefts tuple) (with_vars [last_index_right] (_.while (_.bool true) - ($_ _.then - (_.set (list last_index_right) (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.item lefts tuple)) - ... Needs recursion - <recur>)) + (all _.then + (_.set (list last_index_right) (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.item lefts tuple)) + ... Needs recursion + <recur>)) {.#None}))) (runtime: (tuple::right lefts tuple) (with_vars [last_index_right right_index] (_.while (_.bool true) - ($_ _.then - (_.set (list last_index_right) (..last_index tuple)) - (_.set (list right_index) (_.+ (_.int +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (_.item right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - <recur>) - (_.return (_.slice_from right_index tuple)))) + (all _.then + (_.set (list last_index_right) (..last_index tuple)) + (_.set (list right_index) (_.+ (_.int +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + <recur>) + (_.return (_.slice_from right_index tuple)))) {.#None})))) (runtime: (sum::get sum expected##right? expected##lefts) @@ -241,11 +241,11 @@ actual##lefts (_.item (_.int +0) sum) actual##right? (_.item (_.int +1) sum) actual##value (_.item (_.int +2) sum) - recur! ($_ _.then - (_.set (list expected##lefts) (|> expected##lefts - (_.- actual##lefts) - (_.- (_.int +1)))) - (_.set (list sum) actual##value))] + recur! (all _.then + (_.set (list expected##lefts) (|> expected##lefts + (_.- actual##lefts) + (_.- (_.int +1)))) + (_.set (list sum) actual##value))] (_.while (_.bool true) (<| (_.if (_.= expected##lefts actual##lefts) (_.if (_.= expected##right? actual##right?) @@ -266,11 +266,11 @@ (def: runtime::adt (Statement Any) - ($_ _.then - @tuple::left - @tuple::right - @sum::get - )) + (all _.then + @tuple::left + @tuple::right + @sum::get + )) (def: i64::+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) (def: i64::-limit (_.manual "-0x8000000000000000")) @@ -283,11 +283,11 @@ (with_vars [temp] (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>] [(_.if (|> input <scenario>) - ($_ _.then - (_.set (list temp) (_.% <iteration> input)) - (_.return (_.? (|> temp <scenario>) - (|> temp (_.- <cap>) (_.+ <entrance>)) - temp))))] + (all _.then + (_.set (list temp) (_.% <iteration> input)) + (_.return (_.? (|> temp <scenario>) + (|> temp (_.- <cap>) (_.+ <entrance>)) + temp))))] [(_.> ..i64::+limit) ..i64::+iteration ..i64::+cap ..i64::-limit] [(_.< ..i64::-limit) ..i64::-iteration ..i64::-cap ..i64::+limit] @@ -305,30 +305,30 @@ ..i64::64))) (runtime: (i64::right_shifted param subject) - ($_ _.then - (_.set (list param) (_.% (_.int +64) param)) - (_.return (_.? (_.= (_.int +0) param) - subject - (|> subject - ..as_nat - (_.bit_shr param)))))) + (all _.then + (_.set (list param) (_.% (_.int +64) param)) + (_.return (_.? (_.= (_.int +0) param) + subject + (|> subject + ..as_nat + (_.bit_shr param)))))) (runtime: (i64#/ param subject) (with_vars [floored] - ($_ _.then - (_.set (list floored) (_.// param subject)) - (_.return (let [potentially_floored? (_.< (_.int +0) floored) - inexact? (|> subject - (_.% param) - (_.= (_.int +0)) - _.not)] - (<| (_.? (_.and potentially_floored? - inexact?) - (_.+ (_.int +1) floored)) - (_.? (_.= (_.manual "+9223372036854775808") - floored) - (_.manual "-9223372036854775808")) - floored)))))) + (all _.then + (_.set (list floored) (_.// param subject)) + (_.return (let [potentially_floored? (_.< (_.int +0) floored) + inexact? (|> subject + (_.% param) + (_.= (_.int +0)) + _.not)] + (<| (_.? (_.and potentially_floored? + inexact?) + (_.+ (_.int +1) floored)) + (_.? (_.= (_.manual "+9223372036854775808") + floored) + (_.manual "-9223372036854775808")) + floored)))))) (runtime: (i64::remainder param subject) (_.return (_.- (|> subject (..i64#/ param) (_.* param)) @@ -356,17 +356,17 @@ (def: runtime::i64 (Statement Any) - ($_ _.then - @i64::64 - @i64::left_shifted - @i64::right_shifted - @i64#/ - @i64::remainder - @i64::and - @i64::or - @i64::xor - @i64::char - )) + (all _.then + @i64::64 + @i64::left_shifted + @i64::right_shifted + @i64#/ + @i64::remainder + @i64::and + @i64::or + @i64::xor + @i64::char + )) (runtime: (f64::/ parameter subject) (_.return (_.? (_.= (_.float +0.0) parameter) @@ -385,18 +385,18 @@ (def: runtime::f64 (Statement Any) - ($_ _.then - @f64::/ - @f64::decode - )) + (all _.then + @f64::/ + @f64::decode + )) (runtime: (text::index start param subject) (with_vars [idx] - ($_ _.then - (_.set (list idx) (|> subject (_.do "find" (list param start)))) - (_.return (_.? (_.= (_.int -1) idx) - ..none - (..some (..i64::64 idx))))))) + (all _.then + (_.set (list idx) (|> subject (_.do "find" (list param start)))) + (_.return (_.? (_.= (_.int -1) idx) + ..none + (..some (..i64::64 idx))))))) (def: ++ (|>> (_.+ (_.int +1)))) @@ -416,34 +416,34 @@ (def: runtime::text (Statement Any) - ($_ _.then - @text::index - @text::clip - @text::char - )) + (all _.then + @text::index + @text::clip + @text::char + )) (runtime: (array::write idx value array) - ($_ _.then - (_.set (list (_.item idx array)) value) - (_.return array))) + (all _.then + (_.set (list (_.item idx array)) value) + (_.return array))) (def: runtime::array (Statement Any) - ($_ _.then - @array::write - )) + (all _.then + @array::write + )) (def: runtime (Statement Any) - ($_ _.then - runtime::lux - runtime::io - runtime::adt - runtime::i64 - runtime::f64 - runtime::text - runtime::array - )) + (all _.then + runtime::lux + runtime::io + runtime::adt + runtime::i64 + runtime::f64 + runtime::text + runtime::array + )) (def: module_id 0) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux index d75170250..21e45438d 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/case.lux @@ -51,9 +51,9 @@ [valueO (expression archive valueS) bodyO (expression archive bodyS)] (in (_.block - ($_ _.then - (_.set! (..register register) valueO) - bodyO))))) + (all _.then + (_.set! (..register register) valueO) + bodyO))))) (def: .public (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -182,11 +182,11 @@ (^.template [<pm> <flag> <prep>] [(pattern (<pm> idx)) - (///////phase#in ($_ _.then - (_.set! $temp (|> idx <prep> .int _.int (//runtime.sum::get ..peek (//runtime.flag <flag>)))) - (_.if (_.= _.null $temp) - ..fail! - (..push_cursor! $temp))))]) + (///////phase#in (all _.then + (_.set! $temp (|> idx <prep> .int _.int (//runtime.sum::get ..peek (//runtime.flag <flag>)))) + (_.if (_.= _.null $temp) + ..fail! + (..push_cursor! $temp))))]) ([/////synthesis.side/left false (<|)] [/////synthesis.side/right true ++]) @@ -203,21 +203,21 @@ (do ///////phase.monad [leftO (again leftP) rightO (again rightP)] - (in ($_ _.then - leftO - rightO))) + (in (all _.then + leftO + rightO))) (pattern (/////synthesis.path/alt leftP rightP)) (do [! ///////phase.monad] [leftO (again leftP) rightO (again rightP)] - (in (_.try ($_ _.then - ..save_cursor! - leftO) + (in (_.try (all _.then + ..save_cursor! + leftO) {.#None} - {.#Some (..catch ($_ _.then - ..restore_cursor! - rightO))} + {.#Some (..catch (all _.then + ..restore_cursor! + rightO))} {.#None}))) ))) @@ -234,8 +234,8 @@ (Generator [Synthesis Path]) (do [! ///////phase.monad] [valueO (expression archive valueS)] - (<| (# ! each (|>> ($_ _.then - (_.set! $cursor (_.list (list valueO))) - (_.set! $savepoint (_.list (list)))) + (<| (# ! each (|>> (all _.then + (_.set! $cursor (_.list (list valueO))) + (_.set! $savepoint (_.list (list)))) _.block)) (pattern_matching expression archive pathP)))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux index 37818bd6f..11a7de8ab 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/function.lux @@ -1,36 +1,36 @@ (.using - [library - [lux {"-" function} - [abstract - ["[0]" monad {"+" do}]] - [control - pipe] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)]]] - [target - ["_" r {"+" Expression SVar}]]]] - ["[0]" // "_" - ["[1][0]" runtime {"+" Operation Phase Generator}] + [library + [lux {"-" function} + [abstract + ["[0]" monad {"+" do}]] + [control + pipe] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)]]] + [target + ["_" r {"+" Expression SVar}]]]] + ["[0]" // "_" + ["[1][0]" runtime {"+" Operation Phase Generator}] + ["[1][0]" reference] + ["[1][0]" case] + ["/[1]" // "_" ["[1][0]" reference] - ["[1][0]" case] - ["/[1]" // "_" - ["[1][0]" reference] + ["//[1]" /// "_" + [analysis {"+" Variant Tuple Abstraction Application Analysis}] + [synthesis {"+" Synthesis}] + ["[1][0]" generation {"+" Context}] ["//[1]" /// "_" - [analysis {"+" Variant Tuple Abstraction Application Analysis}] - [synthesis {"+" Synthesis}] - ["[1][0]" generation {"+" Context}] - ["//[1]" /// "_" - [arity {"+" Arity}] - ["[1][0]" phase ("[1]#[0]" monad)] - [reference - [variable {"+" Register Variable}]] - [meta - [archive - ["[0]" artifact]]]]]]]) + [arity {"+" Arity}] + ["[1][0]" phase ("[1]#[0]" monad)] + [reference + [variable {"+" Register Variable}]] + [meta + [archive + ["[0]" artifact]]]]]]]) (def: .public (apply expression archive [functionS argsS+]) (Generator (Application Synthesis)) @@ -56,9 +56,9 @@ list.size list.indices (list#each //case.capture)) - ($_ _.then - function_definition - $function)))] + (all _.then + function_definition + $function)))] _ (/////generation.execute! closure_definition) _ (/////generation.save! (%.nat function_id) closure_definition)] (in (_.apply inits $function))))) @@ -88,30 +88,30 @@ (_.apply (list func args) (_.var "do.call")))]] (with_closure function_artifact $self closureO+ (_.set! $self (_.function (list _.var_args) - ($_ _.then - (_.set! $curried (_.list (list _.var_args))) - (_.set! $num_args (_.length $curried)) - (_.cond (list [(|> $num_args (_.= arityO)) - ($_ _.then - (_.set! (//case.register 0) $self) - (|> arity - list.indices - (list#each input_declaration) - (list#mix _.then bodyO)))] - [(|> $num_args (_.> arityO)) - (let [arity_args (_.slice (_.int +1) arityO $curried) - output_func_args (_.slice (|> arityO (_.+ (_.int +1))) - $num_args - $curried)] - (|> $self - (apply_poly arity_args) - (apply_poly output_func_args)))]) - ... (|> $num_args (_.< arityO)) - (let [$missing (_.var "missing")] - (_.function (list _.var_args) - ($_ _.then - (_.set! $missing (_.list (list _.var_args))) - (|> $self - (apply_poly (_.apply (list $curried $missing) - (_.var "append")))))))))))) + (all _.then + (_.set! $curried (_.list (list _.var_args))) + (_.set! $num_args (_.length $curried)) + (_.cond (list [(|> $num_args (_.= arityO)) + (all _.then + (_.set! (//case.register 0) $self) + (|> arity + list.indices + (list#each input_declaration) + (list#mix _.then bodyO)))] + [(|> $num_args (_.> arityO)) + (let [arity_args (_.slice (_.int +1) arityO $curried) + output_func_args (_.slice (|> arityO (_.+ (_.int +1))) + $num_args + $curried)] + (|> $self + (apply_poly arity_args) + (apply_poly output_func_args)))]) + ... (|> $num_args (_.< arityO)) + (let [$missing (_.var "missing")] + (_.function (list _.var_args) + (all _.then + (_.set! $missing (_.list (list _.var_args))) + (|> $self + (apply_poly (_.apply (list $curried $missing) + (_.var "append")))))))))))) )) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux index 860d68839..192386b79 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/loop.lux @@ -1,37 +1,37 @@ (.using - [library - [lux {"-" Scope} - [abstract - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor)] - ["[0]" set {"+" Set}]]] - [math - [number - ["n" nat]]] - [target - ["_" r]]]] - ["[0]" // "_" - [runtime {"+" Operation Phase Generator}] - ["[1][0]" case] + [library + [lux {"-" Scope} + [abstract + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor)] + ["[0]" set {"+" Set}]]] + [math + [number + ["n" nat]]] + [target + ["_" r]]]] + ["[0]" // "_" + [runtime {"+" Operation Phase Generator}] + ["[1][0]" case] + ["/[1]" // "_" + ["[1][0]" reference] ["/[1]" // "_" - ["[1][0]" reference] + [synthesis + ["[0]" case]] ["/[1]" // "_" - [synthesis - ["[0]" case]] - ["/[1]" // "_" - ["[0]"synthesis {"+" Scope Synthesis}] - ["[1][0]" generation] - ["//[1]" /// "_" - ["[1][0]" phase] - [meta - [archive {"+" Archive}]] - [reference - [variable {"+" Register}]]]]]]]) + ["[0]"synthesis {"+" Scope Synthesis}] + ["[1][0]" generation] + ["//[1]" /// "_" + ["[1][0]" phase] + [meta + [archive {"+" Archive}]] + [reference + [variable {"+" Register}]]]]]]]) (def: .public (scope expression archive [offset initsS+ bodyS]) (Generator (Scope Synthesis)) @@ -48,14 +48,14 @@ bodyO (/////generation.with_anchor $scope (expression archive bodyS))] (in (_.block - ($_ _.then - (_.set! $scope - (_.function (|> initsS+ - list.size - list.indices - (list#each (|>> (n.+ offset) //case.register))) - bodyO)) - (_.apply initsO+ $scope))))))) + (all _.then + (_.set! $scope + (_.function (|> initsS+ + list.size + list.indices + (list#each (|>> (n.+ offset) //case.register))) + bodyO)) + (_.apply initsO+ $scope))))))) (def: .public (again expression archive argsS+) (Generator (List Synthesis)) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux index ecde6abbd..9993054a4 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/procedure/common.lux @@ -125,7 +125,7 @@ (-> Text Proc) (function (_ proc_name) (function (_ translate inputsS) - (case (s.result inputsS ($_ p.and s.nat (s.tuple (p.many s.any)) s.any)) + (case (s.result inputsS (all p.and s.nat (s.tuple (p.many s.any)) s.any)) {e.#Success [offset initsS+ bodyS]} (loopT.translate_loop translate offset initsS+ bodyS) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux index c6ff7f292..acb12a286 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/r/runtime.lux @@ -179,11 +179,11 @@ (runtime: (i64::unsigned_low input) (with_vars [low] - ($_ _.then - (_.set! low (_.item (_.string ..i64_low_field) input)) - (_.if (_.< (_.int +0) low) - (_.+ f2^32 low) - low)))) + (all _.then + (_.set! low (_.item (_.string ..i64_low_field) input)) + (_.if (_.< (_.int +0) low) + (_.+ f2^32 low) + low)))) (runtime: (i64::float input) (let [high (|> input @@ -237,34 +237,34 @@ (runtime: (i64::+ param subject) (with_vars [sH sL pH pL x00 x16 x32 x48] - ($_ _.then - (_.set! sH (|> subject i64_high)) - (_.set! sL (|> subject i64_low)) - (_.set! pH (|> param i64_high)) - (_.set! pL (|> param i64_low)) - (let [bits16 (_.manual "0xFFFF") - move_top_16 (_.bit_shl (_.int +16)) - top_16 (_.bit_ushr (_.int +16)) - bottom_16 (_.bit_and bits16) - split_16 (function (_ source) - [(|> source top_16) - (|> source bottom_16)]) - split_int (function (_ high low) - [(split_16 high) - (split_16 low)]) - - [[s48 s32] [s16 s00]] (split_int sH sL) - [[p48 p32] [p16 p00]] (split_int pH pL) - new_half (function (_ top bottom) - (|> top bottom_16 move_top_16 - (_.bit_or (bottom_16 bottom))))] - ($_ _.then - (_.set! x00 (|> s00 (_.+ p00))) - (_.set! x16 (|> x00 top_16 (_.+ s16) (_.+ p16))) - (_.set! x32 (|> x16 top_16 (_.+ s32) (_.+ p32))) - (_.set! x48 (|> x32 top_16 (_.+ s48) (_.+ p48))) - (i64::new (new_half x48 x32) - (new_half x16 x00))))))) + (all _.then + (_.set! sH (|> subject i64_high)) + (_.set! sL (|> subject i64_low)) + (_.set! pH (|> param i64_high)) + (_.set! pL (|> param i64_low)) + (let [bits16 (_.manual "0xFFFF") + move_top_16 (_.bit_shl (_.int +16)) + top_16 (_.bit_ushr (_.int +16)) + bottom_16 (_.bit_and bits16) + split_16 (function (_ source) + [(|> source top_16) + (|> source bottom_16)]) + split_int (function (_ high low) + [(split_16 high) + (split_16 low)]) + + [[s48 s32] [s16 s00]] (split_int sH sL) + [[p48 p32] [p16 p00]] (split_int pH pL) + new_half (function (_ top bottom) + (|> top bottom_16 move_top_16 + (_.bit_or (bottom_16 bottom))))] + (all _.then + (_.set! x00 (|> s00 (_.+ p00))) + (_.set! x16 (|> x00 top_16 (_.+ s16) (_.+ p16))) + (_.set! x32 (|> x16 top_16 (_.+ s32) (_.+ p32))) + (_.set! x48 (|> x32 top_16 (_.+ s48) (_.+ p48))) + (i64::new (new_half x48 x32) + (new_half x16 x00))))))) (runtime: (i64::= reference sample) (let [n/a? (function (_ value) @@ -293,15 +293,15 @@ (runtime: (i64::< reference sample) (with_vars [r_? s_?] - ($_ _.then - (_.set! s_? (|> sample ..i64_high (_.< (_.int +0)))) - (_.set! r_? (|> reference ..i64_high (_.< (_.int +0)))) - (|> (|> s_? (_.and (_.not r_?))) - (_.or (|> (_.not s_?) (_.and r_?) _.not)) - (_.or (|> sample - (i64::- reference) - ..i64_high - (_.< (_.int +0)))))))) + (all _.then + (_.set! s_? (|> sample ..i64_high (_.< (_.int +0)))) + (_.set! r_? (|> reference ..i64_high (_.< (_.int +0)))) + (|> (|> s_? (_.and (_.not r_?))) + (_.or (|> (_.not s_?) (_.and r_?) _.not)) + (_.or (|> sample + (i64::- reference) + ..i64_high + (_.< (_.int +0)))))))) (runtime: (i64::of_float input) (_.cond (list [(_.apply (list input) (_.var "is.nan")) @@ -318,65 +318,65 @@ (runtime: (i64::* param subject) (with_vars [sH sL pH pL x00 x16 x32 x48] - ($_ _.then - (_.set! sH (|> subject i64_high)) - (_.set! pH (|> param i64_high)) - (let [negative_subject? (|> sH (_.< (_.int +0))) - negative_param? (|> pH (_.< (_.int +0)))] - (_.cond (list [negative_subject? - (_.if negative_param? - (i64::* (i64::opposite param) - (i64::opposite subject)) - (i64::opposite (i64::* param - (i64::opposite subject))))] - - [negative_param? - (i64::opposite (i64::* (i64::opposite param) - subject))]) - ($_ _.then - (_.set! sL (|> subject i64_low)) - (_.set! pL (|> param i64_low)) - (let [bits16 (_.manual "0xFFFF") - move_top_16 (_.bit_shl (_.int +16)) - top_16 (_.bit_ushr (_.int +16)) - bottom_16 (_.bit_and bits16) - split_16 (function (_ source) - [(|> source top_16) - (|> source bottom_16)]) - split_int (function (_ high low) - [(split_16 high) - (split_16 low)]) - new_half (function (_ top bottom) - (|> top bottom_16 move_top_16 - (_.bit_or (bottom_16 bottom)))) - x16_top (|> x16 top_16) - x32_top (|> x32 top_16)] - (with_vars [s48 s32 s16 s00 - p48 p32 p16 p00] - (let [[[_s48 _s32] [_s16 _s00]] (split_int sH sL) - [[_p48 _p32] [_p16 _p00]] (split_int pH pL) - set_subject_chunks! ($_ _.then (_.set! s48 _s48) (_.set! s32 _s32) (_.set! s16 _s16) (_.set! s00 _s00)) - set_param_chunks! ($_ _.then (_.set! p48 _p48) (_.set! p32 _p32) (_.set! p16 _p16) (_.set! p00 _p00))] - ($_ _.then - set_subject_chunks! - set_param_chunks! - (_.set! x00 (|> s00 (_.* p00))) - (_.set! x16 (|> x00 top_16 (_.+ (|> s16 (_.* p00))))) - (_.set! x32 x16_top) - (_.set! x16 (|> x16 bottom_16 (_.+ (|> s00 (_.* p16))))) - (_.set! x32 (|> x32 (_.+ x16_top) (_.+ (|> s32 (_.* p00))))) - (_.set! x48 x32_top) - (_.set! x32 (|> x32 bottom_16 (_.+ (|> s16 (_.* p16))))) - (_.set! x48 (|> x48 (_.+ x32_top))) - (_.set! x32 (|> x32 bottom_16 (_.+ (|> s00 (_.* p32))))) - (_.set! x48 (|> x48 (_.+ x32_top) - (_.+ (|> s48 (_.* p00))) - (_.+ (|> s32 (_.* p16))) - (_.+ (|> s16 (_.* p32))) - (_.+ (|> s00 (_.* p48))))) - (i64::new (new_half x48 x32) - (new_half x16 x00))))) - ))))))) + (all _.then + (_.set! sH (|> subject i64_high)) + (_.set! pH (|> param i64_high)) + (let [negative_subject? (|> sH (_.< (_.int +0))) + negative_param? (|> pH (_.< (_.int +0)))] + (_.cond (list [negative_subject? + (_.if negative_param? + (i64::* (i64::opposite param) + (i64::opposite subject)) + (i64::opposite (i64::* param + (i64::opposite subject))))] + + [negative_param? + (i64::opposite (i64::* (i64::opposite param) + subject))]) + (all _.then + (_.set! sL (|> subject i64_low)) + (_.set! pL (|> param i64_low)) + (let [bits16 (_.manual "0xFFFF") + move_top_16 (_.bit_shl (_.int +16)) + top_16 (_.bit_ushr (_.int +16)) + bottom_16 (_.bit_and bits16) + split_16 (function (_ source) + [(|> source top_16) + (|> source bottom_16)]) + split_int (function (_ high low) + [(split_16 high) + (split_16 low)]) + new_half (function (_ top bottom) + (|> top bottom_16 move_top_16 + (_.bit_or (bottom_16 bottom)))) + x16_top (|> x16 top_16) + x32_top (|> x32 top_16)] + (with_vars [s48 s32 s16 s00 + p48 p32 p16 p00] + (let [[[_s48 _s32] [_s16 _s00]] (split_int sH sL) + [[_p48 _p32] [_p16 _p00]] (split_int pH pL) + set_subject_chunks! (all _.then (_.set! s48 _s48) (_.set! s32 _s32) (_.set! s16 _s16) (_.set! s00 _s00)) + set_param_chunks! (all _.then (_.set! p48 _p48) (_.set! p32 _p32) (_.set! p16 _p16) (_.set! p00 _p00))] + (all _.then + set_subject_chunks! + set_param_chunks! + (_.set! x00 (|> s00 (_.* p00))) + (_.set! x16 (|> x00 top_16 (_.+ (|> s16 (_.* p00))))) + (_.set! x32 x16_top) + (_.set! x16 (|> x16 bottom_16 (_.+ (|> s00 (_.* p16))))) + (_.set! x32 (|> x32 (_.+ x16_top) (_.+ (|> s32 (_.* p00))))) + (_.set! x48 x32_top) + (_.set! x32 (|> x32 bottom_16 (_.+ (|> s16 (_.* p16))))) + (_.set! x48 (|> x48 (_.+ x32_top))) + (_.set! x32 (|> x32 bottom_16 (_.+ (|> s00 (_.* p32))))) + (_.set! x48 (|> x48 (_.+ x32_top) + (_.+ (|> s48 (_.* p00))) + (_.+ (|> s32 (_.* p16))) + (_.+ (|> s16 (_.* p32))) + (_.+ (|> s00 (_.* p48))))) + (i64::new (new_half x48 x32) + (new_half x16 x00))))) + ))))))) (def: (limit_shift! shift) (-> SVar Expression) @@ -388,20 +388,20 @@ input]) (runtime: (i64::left_shifted shift input) - ($_ _.then - (limit_shift! shift) - (_.cond (list (no_shift_clause shift input) - [(|> shift (_.< (_.int +32))) - (let [mid (|> (i64_low input) (_.bit_ushr (|> (_.int +32) (_.- shift)))) - high (|> (i64_high input) - (_.bit_shl shift) - (_.bit_or mid)) - low (|> (i64_low input) - (_.bit_shl shift))] - (i64::new high low))]) - (let [high (|> (i64_high input) - (_.bit_shl (|> shift (_.- (_.int +32)))))] - (i64::new high (_.int +0)))))) + (all _.then + (limit_shift! shift) + (_.cond (list (no_shift_clause shift input) + [(|> shift (_.< (_.int +32))) + (let [mid (|> (i64_low input) (_.bit_ushr (|> (_.int +32) (_.- shift)))) + high (|> (i64_high input) + (_.bit_shl shift) + (_.bit_or mid)) + low (|> (i64_low input) + (_.bit_shl shift))] + (i64::new high low))]) + (let [high (|> (i64_high input) + (_.bit_shl (|> shift (_.- (_.int +32)))))] + (i64::new high (_.int +0)))))) (runtime: (i64::arithmetic_right_shifted_32 shift input) (let [top_bit (|> input (_.bit_and (_.as::integer (_.int (hex "+80000000")))))] @@ -410,24 +410,24 @@ (_.bit_or top_bit)))) (runtime: (i64::arithmetic_right_shifted shift input) - ($_ _.then - (limit_shift! shift) - (_.cond (list (no_shift_clause shift input) - [(|> shift (_.< (_.int +32))) - (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) - high (|> (i64_high input) - (i64::arithmetic_right_shifted_32 shift)) - low (|> (i64_low input) - (_.bit_ushr shift) - (_.bit_or mid))] - (i64::new high low))]) - (let [low (|> (i64_high input) - (i64::arithmetic_right_shifted_32 (|> shift (_.- (_.int +32))))) - high (_.if (_.< (_.int +0) - (i64_high input)) - (_.int -1) - (_.int +0))] - (i64::new high low))))) + (all _.then + (limit_shift! shift) + (_.cond (list (no_shift_clause shift input) + [(|> shift (_.< (_.int +32))) + (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) + high (|> (i64_high input) + (i64::arithmetic_right_shifted_32 shift)) + low (|> (i64_low input) + (_.bit_ushr shift) + (_.bit_or mid))] + (i64::new high low))]) + (let [low (|> (i64_high input) + (i64::arithmetic_right_shifted_32 (|> shift (_.- (_.int +32))))) + high (_.if (_.< (_.int +0) + (i64_high input)) + (_.int -1) + (_.int +0))] + (i64::new high low))))) (runtime: (i64::/ param subject) (let [negative? (|>> (i64::< i64::zero)) @@ -445,21 +445,21 @@ [(|> param (i64::= i64::min)) i64::one]) (with_vars [approximation] - ($_ _.then - (_.set! approximation - (|> subject - (i64::arithmetic_right_shifted (_.int +1)) - (i64::/ param) - (i64::left_shifted (_.int +1)))) - (_.if (|> approximation (i64::= i64::zero)) - (_.if (negative? param) - i64::one - i64::-one) - (let [remainder (i64::- (i64::* param approximation) - subject)] - (|> remainder - (i64::/ param) - (i64::+ approximation)))))))] + (all _.then + (_.set! approximation + (|> subject + (i64::arithmetic_right_shifted (_.int +1)) + (i64::/ param) + (i64::left_shifted (_.int +1)))) + (_.if (|> approximation (i64::= i64::zero)) + (_.if (negative? param) + i64::one + i64::-one) + (let [remainder (i64::- (i64::* param approximation) + subject)] + (|> remainder + (i64::/ param) + (i64::+ approximation)))))))] [(|> param (i64::= i64::min)) i64::zero] @@ -477,41 +477,41 @@ (i64::/ subject) i64::opposite)]) (with_vars [result remainder approximate approximate_result log2 approximate_remainder] - ($_ _.then - (_.set! result i64::zero) - (_.set! remainder subject) - (_.while (|> (|> remainder (i64::< param)) - (_.or (|> remainder (i64::= param)))) - (let [calc_rough_estimate (_.apply (list (|> (i64::float remainder) (_./ (i64::float param)))) - (_.var "floor")) - calc_approximate_result (i64::of_float approximate) - calc_approximate_remainder (|> approximate_result (i64::* param)) - delta (_.if (_.> log2 (_.float +48.0)) - (_.** (|> log2 (_.- (_.float +48.0))) - (_.float +2.0)) - (_.float +1.0))] - ($_ _.then - (_.set! approximate (_.apply (list (_.float +1.0) calc_rough_estimate) - (_.var "max"))) - (_.set! log2 (let [log (function (_ input) - (_.apply (list input) (_.var "log")))] - (_.apply (list (|> (log (_.int +2)) - (_./ (log approximate)))) - (_.var "ceil")))) - (_.set! approximate_result calc_approximate_result) - (_.set! approximate_remainder calc_approximate_remainder) - (_.while (|> (negative? approximate_remainder) - (_.or (|> approximate_remainder (i64::< remainder)))) - ($_ _.then - (_.set! approximate (|> delta (_.- approximate))) - (_.set! approximate_result calc_approximate_result) - (_.set! approximate_remainder calc_approximate_remainder))) - (_.set! result (|> (_.if (|> approximate_result (i64::= i64::zero)) - i64::one - approximate_result) - (i64::+ result))) - (_.set! remainder (|> remainder (i64::- approximate_remainder)))))) - result)) + (all _.then + (_.set! result i64::zero) + (_.set! remainder subject) + (_.while (|> (|> remainder (i64::< param)) + (_.or (|> remainder (i64::= param)))) + (let [calc_rough_estimate (_.apply (list (|> (i64::float remainder) (_./ (i64::float param)))) + (_.var "floor")) + calc_approximate_result (i64::of_float approximate) + calc_approximate_remainder (|> approximate_result (i64::* param)) + delta (_.if (_.> log2 (_.float +48.0)) + (_.** (|> log2 (_.- (_.float +48.0))) + (_.float +2.0)) + (_.float +1.0))] + (all _.then + (_.set! approximate (_.apply (list (_.float +1.0) calc_rough_estimate) + (_.var "max"))) + (_.set! log2 (let [log (function (_ input) + (_.apply (list input) (_.var "log")))] + (_.apply (list (|> (log (_.int +2)) + (_./ (log approximate)))) + (_.var "ceil")))) + (_.set! approximate_result calc_approximate_result) + (_.set! approximate_remainder calc_approximate_remainder) + (_.while (|> (negative? approximate_remainder) + (_.or (|> approximate_remainder (i64::< remainder)))) + (all _.then + (_.set! approximate (|> delta (_.- approximate))) + (_.set! approximate_result calc_approximate_result) + (_.set! approximate_remainder calc_approximate_remainder))) + (_.set! result (|> (_.if (|> approximate_result (i64::= i64::zero)) + i64::one + approximate_result) + (i64::+ result))) + (_.set! remainder (|> remainder (i64::- approximate_remainder)))))) + result)) ))) (runtime: (i64::% param subject) @@ -520,9 +520,9 @@ (runtime: (lux::try op) (with_vars [error value] - (_.try ($_ _.then - (_.set! value (_.apply (list ..unit) op)) - (..right value)) + (_.try (all _.then + (_.set! value (_.apply (list ..unit) op)) + (..right value)) {.#None} {.#Some (_.function (list error) (..left (_.item (_.string "message") @@ -531,18 +531,18 @@ (runtime: (lux::program_args program_args) (with_vars [inputs value] - ($_ _.then - (_.set! inputs ..none) - (<| (_.for_in value program_args) - (_.set! inputs (..some (_.list (list value inputs))))) - inputs))) + (all _.then + (_.set! inputs ..none) + (<| (_.for_in value program_args) + (_.set! inputs (..some (_.list (list value inputs))))) + inputs))) (def: runtime::lux Expression - ($_ _.then - @lux::try - @lux::program_args - )) + (all _.then + @lux::try + @lux::program_args + )) (def: current_time_float Expression @@ -556,9 +556,9 @@ (def: runtime::io Expression - ($_ _.then - @io::current_time! - )) + (all _.then + @io::current_time! + )) (def: minimum_index_length (-> SVar Expression) @@ -578,28 +578,28 @@ (runtime: (tuple::left index product) (let [$index_min_length (_.var "index_min_length")] - ($_ _.then - (_.set! $index_min_length (minimum_index_length index)) - (_.if (|> (_.length product) (_.> $index_min_length)) - ... No need for recursion - (product_element product index) - ... Needs recursion - (tuple::left (updated_index $index_min_length product) - (product_tail product)))))) + (all _.then + (_.set! $index_min_length (minimum_index_length index)) + (_.if (|> (_.length product) (_.> $index_min_length)) + ... No need for recursion + (product_element product index) + ... Needs recursion + (tuple::left (updated_index $index_min_length product) + (product_tail product)))))) (runtime: (tuple::right index product) (let [$index_min_length (_.var "index_min_length")] - ($_ _.then - (_.set! $index_min_length (minimum_index_length index)) - (_.cond (list [... Last element. - (|> (_.length product) (_.= $index_min_length)) - (product_element product index)] - [... Needs recursion - (|> (_.length product) (_.< $index_min_length)) - (tuple::right (updated_index $index_min_length product) - (product_tail product))]) - ... Must slice - (|> product (_.slice_from index)))))) + (all _.then + (_.set! $index_min_length (minimum_index_length index)) + (_.cond (list [... Last element. + (|> (_.length product) (_.= $index_min_length)) + (product_element product index)] + [... Needs recursion + (|> (_.length product) (_.< $index_min_length)) + (tuple::right (updated_index $index_min_length product) + (product_tail product))]) + ... Must slice + (|> product (_.slice_from index)))))) (runtime: (sum::get sum wants_last? wanted_tag) (let [no_match _.null @@ -629,12 +629,12 @@ (def: runtime::adt Expression - ($_ _.then - @tuple::left - @tuple::right - @sum::get - @adt::variant - )) + (all _.then + @tuple::left + @tuple::right + @sum::get + @adt::variant + )) (template [<name> <op>] [(runtime: (<name> mask input) @@ -649,75 +649,75 @@ ) (runtime: (i64::right_shifted shift input) - ($_ _.then - (limit_shift! shift) - (_.cond (list (no_shift_clause shift input) - [(|> shift (_.< (_.int +32))) - (with_vars [$mid] - (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) - high (|> (i64_high input) (_.bit_ushr shift)) - low (|> (i64_low input) - (_.bit_ushr shift) - (_.bit_or (_.if (_.apply (list $mid) (_.var "is.na")) - (_.as::integer (_.int +0)) - $mid)))] - ($_ _.then - (_.set! $mid mid) - (i64::new high low))))] - [(|> shift (_.= (_.int +32))) - (let [high (i64_high input)] - (i64::new (_.int +0) high))]) - (let [low (|> (i64_high input) (_.bit_ushr (|> shift (_.- (_.int +32)))))] - (i64::new (_.int +0) low))))) + (all _.then + (limit_shift! shift) + (_.cond (list (no_shift_clause shift input) + [(|> shift (_.< (_.int +32))) + (with_vars [$mid] + (let [mid (|> (i64_high input) (_.bit_shl (|> (_.int +32) (_.- shift)))) + high (|> (i64_high input) (_.bit_ushr shift)) + low (|> (i64_low input) + (_.bit_ushr shift) + (_.bit_or (_.if (_.apply (list $mid) (_.var "is.na")) + (_.as::integer (_.int +0)) + $mid)))] + (all _.then + (_.set! $mid mid) + (i64::new high low))))] + [(|> shift (_.= (_.int +32))) + (let [high (i64_high input)] + (i64::new (_.int +0) high))]) + (let [low (|> (i64_high input) (_.bit_ushr (|> shift (_.- (_.int +32)))))] + (i64::new (_.int +0) low))))) (def: runtime::i64 Expression - ($_ _.then - @f2^32 - @f2^63 - - @i64::new - @i64::of_float - - @i64::and - @i64::or - @i64::xor - @i64::not - @i64::left_shifted - @i64::arithmetic_right_shifted_32 - @i64::arithmetic_right_shifted - @i64::right_shifted - - @i64::zero - @i64::one - @i64::min - @i64::max - @i64::= - @i64::< - @i64::+ - @i64::- - @i64::opposite - @i64::-one - @i64::unsigned_low - @i64::float - @i64::* - @i64::/ - @i64::% - )) + (all _.then + @f2^32 + @f2^63 + + @i64::new + @i64::of_float + + @i64::and + @i64::or + @i64::xor + @i64::not + @i64::left_shifted + @i64::arithmetic_right_shifted_32 + @i64::arithmetic_right_shifted + @i64::right_shifted + + @i64::zero + @i64::one + @i64::min + @i64::max + @i64::= + @i64::< + @i64::+ + @i64::- + @i64::opposite + @i64::-one + @i64::unsigned_low + @i64::float + @i64::* + @i64::/ + @i64::% + )) (runtime: (frac::decode input) (with_vars [output] - ($_ _.then - (_.set! output (_.apply (list input) (_.var "as.numeric"))) - (_.if (|> output (_.= _.n/a)) - ..none - (..some output))))) + (all _.then + (_.set! output (_.apply (list input) (_.var "as.numeric"))) + (_.if (|> output (_.= _.n/a)) + ..none + (..some output))))) (def: runtime::frac Expression - ($_ _.then - @frac::decode - )) + (all _.then + @frac::decode + )) (def: ++ (-> Expression Expression) @@ -734,32 +734,32 @@ (runtime: (text::index subject param start) (with_vars [idx startF subjectL] - ($_ _.then - (_.set! startF (i64::float start)) - (_.set! subjectL (text_length subject)) - (_.if (_.< subjectL startF) - ($_ _.then - (_.set! idx (|> (_.apply_kw (list param (_.if (|> startF (_.= (_.int +0))) - subject - (text_clip (++ startF) - (++ subjectL) - subject))) - (list ["fixed" (_.bool #1)]) - (_.var "regexpr")) - (_.item (_.int +1)))) - (_.if (|> idx (_.= (_.int -1))) - ..none - (..some (i64::of_float (|> idx (_.+ startF)))))) - ..none)))) + (all _.then + (_.set! startF (i64::float start)) + (_.set! subjectL (text_length subject)) + (_.if (_.< subjectL startF) + (all _.then + (_.set! idx (|> (_.apply_kw (list param (_.if (|> startF (_.= (_.int +0))) + subject + (text_clip (++ startF) + (++ subjectL) + subject))) + (list ["fixed" (_.bool #1)]) + (_.var "regexpr")) + (_.item (_.int +1)))) + (_.if (|> idx (_.= (_.int -1))) + ..none + (..some (i64::of_float (|> idx (_.+ startF)))))) + ..none)))) (runtime: (text::clip text minimum additional) (with_vars [length] - ($_ _.then - (_.set! length (_.length text)) - (_.set! to (_.+ additional minimum)) - (_.if (_.< length to) - (..some (text_clip (++ minimum) (++ to) text)) - ..none)))) + (all _.then + (_.set! length (_.length text)) + (_.set! to (_.+ additional minimum)) + (_.if (_.< length to) + (..some (text_clip (++ minimum) (++ to) text)) + ..none)))) (def: (char_at idx text) (-> Expression Expression Expression) @@ -768,18 +768,18 @@ (runtime: (text::char text idx) (_.if (_.< (_.length text) idx) - ($_ _.then - (_.set! idx (++ idx)) - (..some (i64::of_float (char_at idx text)))) + (all _.then + (_.set! idx (++ idx)) + (..some (i64::of_float (char_at idx text)))) ..none)) (def: runtime::text Expression - ($_ _.then - @text::index - @text::clip - @text::char - )) + (all _.then + @text::index + @text::clip + @text::char + )) (def: (check_index_out_of_bounds array idx body) (-> Expression Expression Expression Expression) @@ -789,47 +789,47 @@ (runtime: (array::new size) (with_vars [output] - ($_ _.then - (_.set! output (_.list (list))) - (_.set_item! (|> size (_.+ (_.int +1))) - _.null - output) - output))) + (all _.then + (_.set! output (_.list (list))) + (_.set_item! (|> size (_.+ (_.int +1))) + _.null + output) + output))) (runtime: (array::get array idx) (with_vars [temp] (<| (check_index_out_of_bounds array idx) - ($_ _.then - (_.set! temp (|> array (_.item (_.+ (_.int +1) idx)))) - (_.if (|> temp (_.= _.null)) - ..none - (..some temp)))))) + (all _.then + (_.set! temp (|> array (_.item (_.+ (_.int +1) idx)))) + (_.if (|> temp (_.= _.null)) + ..none + (..some temp)))))) (runtime: (array::put array idx value) (<| (check_index_out_of_bounds array idx) - ($_ _.then - (_.set_item! (_.+ (_.int +1) idx) value array) - array))) + (all _.then + (_.set_item! (_.+ (_.int +1) idx) value array) + array))) (def: runtime::array Expression - ($_ _.then - @array::new - @array::get - @array::put - )) + (all _.then + @array::new + @array::get + @array::put + )) (def: runtime Expression - ($_ _.then - runtime::lux - runtime::i64 - runtime::adt - runtime::frac - runtime::text - runtime::array - runtime::io - )) + (all _.then + runtime::lux + runtime::i64 + runtime::adt + runtime::frac + runtime::text + runtime::array + runtime::io + )) (def: .public generate (Operation [Registry Output]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux index 284fa79c6..677f622b1 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/case.lux @@ -65,10 +65,10 @@ (do ///////phase.monad [this (expression archive this) that (statement expression archive that)] - (in ($_ _.then - (_.statement this) - that - )))) + (in (all _.then + (_.statement this) + that + )))) (def: .public (let expression archive [valueS register bodyS]) (Generator [Synthesis Register Synthesis]) @@ -86,9 +86,9 @@ (do ///////phase.monad [valueO (expression archive valueS) bodyO (statement expression archive bodyS)] - (in ($_ _.then - (_.set (list (..register register)) valueO) - bodyO)))) + (in (all _.then + (_.set (list (..register register)) valueO) + bodyO)))) (def: .public (if expression archive [testS thenS elseS]) (Generator [Synthesis Synthesis Synthesis]) @@ -162,15 +162,15 @@ (template [<name> <flag>] [(def: (<name> simple? idx) (-> Bit Nat Statement) - ($_ _.then - (_.set (list @temp) (//runtime.sum//get ..peek <flag> - (|> idx .int _.int))) - (.if simple? - (_.when (_.= _.nil @temp) - fail!) - (_.if (_.= _.nil @temp) - fail! - (..push! @temp)))))] + (all _.then + (_.set (list @temp) (//runtime.sum//get ..peek <flag> + (|> idx .int _.int))) + (.if simple? + (_.when (_.= _.nil @temp) + fail!) + (_.if (_.= _.nil @temp) + fail! + (..push! @temp)))))] [left_choice _.nil] [right_choice //runtime.unit] @@ -179,32 +179,32 @@ (def: (with_looping in_closure? g!once g!continue? body!) (-> Bit LVar LVar Statement Statement) (.if in_closure? - ($_ _.then - (_.while (_.bool true) - body!)) - ($_ _.then - (_.set (list g!once) (_.bool true)) - (_.set (list g!continue?) (_.bool false)) - (<| (_.while (_.bool true)) - (_.if g!once - ($_ _.then - (_.set (list g!once) (_.bool false)) - body!) - ($_ _.then - (_.set (list g!continue?) (_.bool true)) - _.break))) - (_.when g!continue? - _.next)))) + (all _.then + (_.while (_.bool true) + body!)) + (all _.then + (_.set (list g!once) (_.bool true)) + (_.set (list g!continue?) (_.bool false)) + (<| (_.while (_.bool true)) + (_.if g!once + (all _.then + (_.set (list g!once) (_.bool false)) + body!) + (all _.then + (_.set (list g!continue?) (_.bool true)) + _.break))) + (_.when g!continue? + _.next)))) (def: (alternation in_closure? g!once g!continue? pre! post!) (-> Bit LVar LVar Statement Statement Statement) - ($_ _.then - (with_looping in_closure? g!once g!continue? - ($_ _.then - ..save! - pre!)) - ..restore! - post!)) + (all _.then + (with_looping in_closure? g!once g!continue? + (all _.then + ..save! + pre!)) + ..restore! + post!)) (def: (primitive_pattern_matching again pathP) (-> (-> Path (Operation Statement)) @@ -324,25 +324,25 @@ (pattern (/////synthesis.!bind_top register thenP)) (do ///////phase.monad [then! (again thenP)] - (///////phase#in ($_ _.then - (_.set (list (..register register)) ..peek_and_pop) - then!))) + (///////phase#in (all _.then + (_.set (list (..register register)) ..peek_and_pop) + then!))) (pattern (/////synthesis.!multi_pop nextP)) (.let [[extra_pops nextP'] (case.count_pops nextP)] (do ///////phase.monad [next! (again nextP')] - (///////phase#in ($_ _.then - (..multi_pop! (n.+ 2 extra_pops)) - next!)))) + (///////phase#in (all _.then + (..multi_pop! (n.+ 2 extra_pops)) + next!)))) (pattern (/////synthesis.path/seq preP postP)) (do ///////phase.monad [pre! (again preP) post! (again postP)] - (in ($_ _.then - pre! - post!))) + (in (all _.then + pre! + post!))) (pattern (/////synthesis.path/alt preP postP)) (do ///////phase.monad @@ -358,21 +358,21 @@ [pattern_matching! (pattern_matching' in_closure? statement expression archive pathP) g!once (..symbol "once") g!continue? (..symbol "continue")] - (in ($_ _.then - (..with_looping in_closure? g!once g!continue? - pattern_matching!) - (_.statement (_.raise (_.string case.pattern_matching_error))))))) + (in (all _.then + (..with_looping in_closure? g!once g!continue? + pattern_matching!) + (_.statement (_.raise (_.string case.pattern_matching_error))))))) (def: .public (case! in_closure? statement expression archive [valueS pathP]) (-> Bit (Generator! [Synthesis Path])) (do ///////phase.monad [stack_init (expression archive valueS) pattern_matching! (pattern_matching in_closure? statement expression archive pathP)] - (in ($_ _.then - (_.set (list @cursor) (_.array (list stack_init))) - (_.set (list @savepoint) (_.array (list))) - pattern_matching! - )))) + (in (all _.then + (_.set (list @cursor) (_.array (list stack_init))) + (_.set (list @savepoint) (_.array (list))) + pattern_matching! + )))) (def: .public (case statement expression archive case) (-> Phase! (Generator [Synthesis Path])) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux index f6b20a5d6..45e8363c3 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/function.lux @@ -56,9 +56,9 @@ [(|> (list.enumeration inits) (list#each (|>> product.left ..capture))) (let [@self (_.local self)] - ($_ _.then - (_.set (list @self) function_definition) - (_.return @self)))])) + (all _.then + (_.set (list @self) function_definition) + (_.return @self)))])) (_.apply_lambda/* inits @self)]))) (def: input @@ -86,37 +86,37 @@ (_.local function_name))) initialize_self! (_.set (list (//case.register 0)) @self) initialize! (list#mix (.function (_ post pre!) - ($_ _.then - pre! - (_.set (list (..input post)) (_.item (|> post .int _.int) @curried)))) + (all _.then + pre! + (_.set (list (..input post)) (_.item (|> post .int _.int) @curried)))) initialize_self! (list.indices arity)) [declaration instatiation] (with_closure closureO+ function_name (_.lambda {.#None} [(list (_.variadic @curried)) - ($_ _.then - (_.set (list @num_args) (_.the "length" @curried)) - (<| (_.if (|> @num_args (_.= arityO)) - (<| (_.then initialize!) - //loop.with_scope - body!)) - (_.if (|> @num_args (_.> arityO)) - (let [slice (.function (_ from to) - (_.array_range from to @curried)) - arity_args (_.splat (slice (_.int +0) limitO)) - output_func_args (_.splat (slice arityO @num_args))] - (_.return (|> @self - (_.apply_lambda/* (list arity_args)) - (_.apply_lambda/* (list output_func_args)))))) - ... (|> @num_args (_.< arityO)) - (let [@missing (_.local "missing")] - (_.return (_.lambda {.#None} - [(list (_.variadic @missing)) - (_.return (|> @self - (_.apply_lambda/* (list (_.splat (|> (_.array (list)) - (_.do "concat" (list @curried) {.#None}) - (_.do "concat" (list @missing) {.#None})))))))])))) - )]))] + (all _.then + (_.set (list @num_args) (_.the "length" @curried)) + (<| (_.if (|> @num_args (_.= arityO)) + (<| (_.then initialize!) + //loop.with_scope + body!)) + (_.if (|> @num_args (_.> arityO)) + (let [slice (.function (_ from to) + (_.array_range from to @curried)) + arity_args (_.splat (slice (_.int +0) limitO)) + output_func_args (_.splat (slice arityO @num_args))] + (_.return (|> @self + (_.apply_lambda/* (list arity_args)) + (_.apply_lambda/* (list output_func_args)))))) + ... (|> @num_args (_.< arityO)) + (let [@missing (_.local "missing")] + (_.return (_.lambda {.#None} + [(list (_.variadic @missing)) + (_.return (|> @self + (_.apply_lambda/* (list (_.splat (|> (_.array (list)) + (_.do "concat" (list @curried) {.#None}) + (_.do "concat" (list @missing) {.#None})))))))])))) + )]))] _ (/////generation.execute! declaration) _ (/////generation.save! function_artifact {.#None} declaration)] (in instatiation))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux index b69ce6b57..08ebeaf0e 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/loop.lux @@ -1,44 +1,44 @@ (.using - [library - [lux {"-" Scope symbol} - [abstract - ["[0]" monad {"+" do}]] - [data - ["[0]" product] - ["[0]" text - ["%" format {"+" format}]] - [collection - ["[0]" list ("[1]#[0]" functor mix)] - ["[0]" set]]] - [math - [number - ["n" nat]]] - [target - ["_" ruby {"+" Expression LVar Statement}]]]] - ["[0]" // "_" - [runtime {"+" Operation Phase Generator Phase! Generator!}] - ["[1][0]" case] + [library + [lux {"-" Scope symbol} + [abstract + ["[0]" monad {"+" do}]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list ("[1]#[0]" functor mix)] + ["[0]" set]]] + [math + [number + ["n" nat]]] + [target + ["_" ruby {"+" Expression LVar Statement}]]]] + ["[0]" // "_" + [runtime {"+" Operation Phase Generator Phase! Generator!}] + ["[1][0]" case] + ["/[1]" // "_" + ["[1][0]" reference] ["/[1]" // "_" - ["[1][0]" reference] + [synthesis + ["[0]" case]] ["/[1]" // "_" - [synthesis - ["[0]" case]] - ["/[1]" // "_" - ["[0]" synthesis {"+" Scope Synthesis}] - ["[1][0]" generation] - ["//[1]" /// "_" - ["[1][0]" phase] - [reference - ["[1][0]" variable {"+" Register}]]]]]]]) + ["[0]" synthesis {"+" Scope Synthesis}] + ["[1][0]" generation] + ["//[1]" /// "_" + ["[1][0]" phase] + [reference + ["[1][0]" variable {"+" Register}]]]]]]]) (def: (setup offset bindings body) (-> Register (List Expression) Statement Statement) (let [variables (|> bindings list.enumeration (list#each (|>> product.left (n.+ offset) //case.register)))] - ($_ _.then - (_.set variables (_.multi bindings)) - body))) + (all _.then + (_.set variables (_.multi bindings)) + body))) (def: symbol (_.symbol "lux_continue")) @@ -89,7 +89,7 @@ list.enumeration (list#each (function (_ [idx _]) (_.item (_.int (.int idx)) @temp))))]] - (in ($_ _.then - (_.set (list @temp) (_.array argsO+)) - (..setup offset re_binds - _.next))))) + (in (all _.then + (_.set (list @temp) (_.array argsO+)) + (..setup offset re_binds + _.next))))) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux index ed673e53a..576f8f24c 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/ruby/runtime.lux @@ -157,33 +157,33 @@ (def: last_index (|>> ..tuple_size (_.- (_.int +1)))) -(with_expansions [<recur> (these ($_ _.then - (_.set (list lefts) (_.- last_index_right lefts)) - (_.set (list tuple) (_.item last_index_right tuple))))] +(with_expansions [<recur> (these (all _.then + (_.set (list lefts) (_.- last_index_right lefts)) + (_.set (list tuple) (_.item last_index_right tuple))))] (runtime: (tuple//left lefts tuple) (with_vars [last_index_right] (<| (_.while (_.bool true)) - ($_ _.then - (_.set (list last_index_right) (..last_index tuple)) - (_.if (_.> lefts last_index_right) - ... No need for recursion - (_.return (_.item lefts tuple)) - ... Needs recursion - <recur>))))) + (all _.then + (_.set (list last_index_right) (..last_index tuple)) + (_.if (_.> lefts last_index_right) + ... No need for recursion + (_.return (_.item lefts tuple)) + ... Needs recursion + <recur>))))) (runtime: (tuple//right lefts tuple) (with_vars [last_index_right right_index] (<| (_.while (_.bool true)) - ($_ _.then - (_.set (list last_index_right) (..last_index tuple)) - (_.set (list right_index) (_.+ (_.int +1) lefts)) - (<| (_.if (_.= last_index_right right_index) - (_.return (_.item right_index tuple))) - (_.if (_.> last_index_right right_index) - ... Needs recursion. - <recur>) - (_.return (_.array_range right_index (..tuple_size tuple) tuple))) - ))))) + (all _.then + (_.set (list last_index_right) (..last_index tuple)) + (_.set (list right_index) (_.+ (_.int +1) lefts)) + (<| (_.if (_.= last_index_right right_index) + (_.return (_.item right_index tuple))) + (_.if (_.> last_index_right right_index) + ... Needs recursion. + <recur>) + (_.return (_.array_range right_index (..tuple_size tuple) tuple))) + ))))) (def: .public variant_tag_field "_lux_tag") (def: .public variant_flag_field "_lux_flag") @@ -219,11 +219,11 @@ actual##lefts (_.item (_.string ..variant_tag_field) sum) actual##right? (_.item (_.string ..variant_flag_field) sum) actual##value (_.item (_.string ..variant_value_field) sum) - recur! ($_ _.then - (_.set (list expected##lefts) (|> expected##lefts - (_.- actual##lefts) - (_.- (_.int +1)))) - (_.set (list sum) actual##value))] + recur! (all _.then + (_.set (list expected##lefts) (|> expected##lefts + (_.- actual##lefts) + (_.- (_.int +1)))) + (_.set (list sum) actual##value))] (<| (_.while (_.bool true)) (_.if (_.= expected##lefts actual##lefts) (_.if (_.= expected##right? actual##right?) @@ -243,35 +243,35 @@ (def: runtime//adt Statement - ($_ _.then - @tuple//left - @tuple//right - @sum//make - @sum//get - )) + (all _.then + @tuple//left + @tuple//right + @sum//make + @sum//get + )) (runtime: (lux//try risky) (with_vars [error value] - (_.begin ($_ _.then - (_.set (list value) (_.apply_lambda/* (list ..unit) risky)) - (_.return (..right value))) + (_.begin (all _.then + (_.set (list value) (_.apply_lambda/* (list ..unit) risky)) + (_.return (..right value))) (list [(list) error (_.return (..left (_.the "message" error)))])))) (runtime: (lux//program_args raw) (with_vars [tail head] - ($_ _.then - (_.set (list tail) ..none) - (<| (_.for_in head raw) - (_.set (list tail) (..some (_.array (list head tail))))) - (_.return tail)))) + (all _.then + (_.set (list tail) ..none) + (<| (_.for_in head raw) + (_.set (list tail) (..some (_.array (list head tail))))) + (_.return tail)))) (def: runtime//lux Statement - ($_ _.then - @lux//try - @lux//program_args - )) + (all _.then + @lux//try + @lux//program_args + )) (def: i64##+limit (_.manual "+0x7FFFFFFFFFFFFFFF")) (def: i64##-limit (_.manual "-0x8000000000000000")) @@ -286,11 +286,11 @@ (with_vars [temp] (`` (<| (~~ (template [<scenario> <iteration> <cap> <entrance>] [(_.if (|> input <scenario>) - ($_ _.then - (_.set (list temp) (_.% <iteration> input)) - (_.return (_.? (|> temp <scenario>) - (|> temp (_.- <cap>) (_.+ <entrance>)) - temp))))] + (all _.then + (_.set (list temp) (_.% <iteration> input)) + (_.return (_.? (|> temp <scenario>) + (|> temp (_.- <cap>) (_.+ <entrance>)) + temp))))] [(_.> ..i64##+limit) ..i64##+iteration ..i64##+cap ..i64##-limit] [(_.< ..i64##-limit) ..i64##-iteration ..i64##-cap ..i64##+limit] @@ -327,10 +327,10 @@ [(runtime: (<runtime> left right) [..normal_ruby? (_.return (..i64##i64 (<host> (..as_nat left) (..as_nat right))))] (with_vars [high low] - ($_ _.then - (_.set (list high) (<host> (i32##high left) (..i32##high right))) - (_.set (list low) (<host> (i32##low left) (..i32##low right))) - (_.return (..i64 high low)))))] + (all _.then + (_.set (list high) (<host> (i32##high left) (..i32##high right))) + (_.set (list low) (<host> (i32##low left) (..i32##low right))) + (_.return (..i64 high low)))))] [i64##and _.bit_and] [i64##or _.bit_or] @@ -355,43 +355,43 @@ (_.bit_shl (_.% (_.int +64) shift)) ..i64##i64))] (with_vars [high low] - ($_ _.then - (..cap_shift! shift) - (<| (..handle_no_shift! shift input) - (_.if (..small_shift? shift) - ($_ _.then - (_.set (list high) (_.bit_or (|> input i32##high (_.bit_shl shift)) - (|> input i32##low (_.bit_shr (_.- shift (_.int +32)))))) - (_.set (list low) (|> input i32##low (_.bit_shl shift))) + (all _.then + (..cap_shift! shift) + (<| (..handle_no_shift! shift input) + (_.if (..small_shift? shift) + (all _.then + (_.set (list high) (_.bit_or (|> input i32##high (_.bit_shl shift)) + (|> input i32##low (_.bit_shr (_.- shift (_.int +32)))))) + (_.set (list low) (|> input i32##low (_.bit_shl shift))) + (_.return (..i64 (i32##low high) + (i32##low low))))) + (all _.then + (_.set (list high) (|> input i32##low (_.bit_shl (_.- (_.int +32) shift)))) (_.return (..i64 (i32##low high) - (i32##low low))))) - ($_ _.then - (_.set (list high) (|> input i32##low (_.bit_shl (_.- (_.int +32) shift)))) - (_.return (..i64 (i32##low high) - (_.int +0))))) - ))) + (_.int +0))))) + ))) (runtime: (i64##right_shifted shift input) - [..normal_ruby? ($_ _.then - (_.set (list shift) (_.% (_.int +64) shift)) - (_.return (_.? (_.= (_.int +0) shift) - input - (|> input - ..as_nat - (_.bit_shr shift)))))] + [..normal_ruby? (all _.then + (_.set (list shift) (_.% (_.int +64) shift)) + (_.return (_.? (_.= (_.int +0) shift) + input + (|> input + ..as_nat + (_.bit_shr shift)))))] (with_vars [high low] - ($_ _.then - (..cap_shift! shift) - (<| (..handle_no_shift! shift input) - (_.if (..small_shift? shift) - ($_ _.then - (_.set (list high) (|> input i32##high (_.bit_shr shift))) - (_.set (list low) (|> input i32##low (_.bit_shr shift) - (_.bit_or (|> input i32##high (_.bit_shl (_.- shift (_.int +32))))))) - (_.return (..i64 high low)))) - (_.return (_.? (|> shift (_.= (_.int +32))) - (i32##high input) - (|> input i32##high (_.bit_shr (_.- (_.int +32) shift))))))))) + (all _.then + (..cap_shift! shift) + (<| (..handle_no_shift! shift input) + (_.if (..small_shift? shift) + (all _.then + (_.set (list high) (|> input i32##high (_.bit_shr shift))) + (_.set (list low) (|> input i32##low (_.bit_shr shift) + (_.bit_or (|> input i32##high (_.bit_shl (_.- shift (_.int +32))))))) + (_.return (..i64 high low)))) + (_.return (_.? (|> shift (_.= (_.int +32))) + (i32##high input) + (|> input i32##high (_.bit_shr (_.- (_.int +32) shift))))))))) (runtime: (i64##/ parameter subject) (_.return (_.? (_.and (_.= (_.int -1) parameter) @@ -405,16 +405,16 @@ (runtime: (i64##+ parameter subject) [..normal_ruby? (_.return (i64##i64 (_.+ parameter subject)))] (with_vars [high low] - ($_ _.then - (_.set (list low) (_.+ (i32##low subject) - (i32##low parameter))) - (_.set (list high) (|> (i32##high low) - (_.+ (i32##high subject)) - (_.+ (i32##high parameter)) - i32##low)) + (all _.then + (_.set (list low) (_.+ (i32##low subject) + (i32##low parameter))) + (_.set (list high) (|> (i32##high low) + (_.+ (i32##high subject)) + (_.+ (i32##high parameter)) + i32##low)) - (_.return (..i64 high (i32##low low))) - ))) + (_.return (..i64 high (i32##low low))) + ))) (def: i64##min (_.manual "-0x8000000000000000")) @@ -447,44 +447,44 @@ r48 r32 r16 r00 x48 x32 x16 x00 high low] - ($_ _.then - (_.set (list l48) (hh subject)) - (_.set (list l32) (hl subject)) - (_.set (list l16) (lh subject)) - (_.set (list l00) (ll subject)) - - (_.set (list r48) (hh parameter)) - (_.set (list r32) (hl parameter)) - (_.set (list r16) (lh parameter)) - (_.set (list r00) (ll parameter)) - - (_.set (list x00) (_.* l00 r00)) - (_.set (list x16) (i16##high x00)) - (_.set (list x00) (i16##low x00)) - - (_.set (list x16) (|> x16 (_.+ (_.* l16 r00)))) - (_.set (list x32) (i16##high x16)) (_.set (list x16) (i16##low x16)) - (_.set (list x16) (|> x16 (_.+ (_.* l00 r16)))) - (_.set (list x32) (|> x32 (_.+ (i16##high x16)))) (_.set (list x16) (i16##low x16)) - - (_.set (list x32) (|> x32 (_.+ (_.* l32 r00)))) - (_.set (list x48) (i16##high x32)) (_.set (list x32) (i16##low x32)) - (_.set (list x32) (|> x32 (_.+ (_.* l16 r16)))) - (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32)) - (_.set (list x32) (|> x32 (_.+ (_.* l00 r32)))) - (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32)) - - (_.set (list x48) (|> x48 - (_.+ (_.* l48 r00)) - (_.+ (_.* l32 r16)) - (_.+ (_.* l16 r32)) - (_.+ (_.* l00 r48)) - i16##low)) - - (_.set (list high) (_.bit_or (i16##up x48) x32)) - (_.set (list low) (_.bit_or (i16##up x16) x00)) - (_.return (..i64 high low)) - ))) + (all _.then + (_.set (list l48) (hh subject)) + (_.set (list l32) (hl subject)) + (_.set (list l16) (lh subject)) + (_.set (list l00) (ll subject)) + + (_.set (list r48) (hh parameter)) + (_.set (list r32) (hl parameter)) + (_.set (list r16) (lh parameter)) + (_.set (list r00) (ll parameter)) + + (_.set (list x00) (_.* l00 r00)) + (_.set (list x16) (i16##high x00)) + (_.set (list x00) (i16##low x00)) + + (_.set (list x16) (|> x16 (_.+ (_.* l16 r00)))) + (_.set (list x32) (i16##high x16)) (_.set (list x16) (i16##low x16)) + (_.set (list x16) (|> x16 (_.+ (_.* l00 r16)))) + (_.set (list x32) (|> x32 (_.+ (i16##high x16)))) (_.set (list x16) (i16##low x16)) + + (_.set (list x32) (|> x32 (_.+ (_.* l32 r00)))) + (_.set (list x48) (i16##high x32)) (_.set (list x32) (i16##low x32)) + (_.set (list x32) (|> x32 (_.+ (_.* l16 r16)))) + (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32)) + (_.set (list x32) (|> x32 (_.+ (_.* l00 r32)))) + (_.set (list x48) (|> x48 (_.+ (i16##high x32)))) (_.set (list x32) (i16##low x32)) + + (_.set (list x48) (|> x48 + (_.+ (_.* l48 r00)) + (_.+ (_.* l32 r16)) + (_.+ (_.* l16 r32)) + (_.+ (_.* l00 r48)) + i16##low)) + + (_.set (list high) (_.bit_or (i16##up x48) x32)) + (_.set (list low) (_.bit_or (i16##up x16) x00)) + (_.return (..i64 high low)) + ))) ) (runtime: (i64##char subject) @@ -493,48 +493,48 @@ (def: runtime//i64 Statement - ($_ _.then - @i64##+iteration - @i64##-iteration - @i64##i64 - @i64##left_shifted - @i64##right_shifted - @i64##and - @i64##or - @i64##xor - @i64##+ - @i64##- - @i64##* - @i64##/ - @i64##char - )) + (all _.then + @i64##+iteration + @i64##-iteration + @i64##i64 + @i64##left_shifted + @i64##right_shifted + @i64##and + @i64##or + @i64##xor + @i64##+ + @i64##- + @i64##* + @i64##/ + @i64##char + )) (runtime: (f64//decode inputG) (with_vars [@input @temp] - ($_ _.then - (_.set (list @input) inputG) - (_.set (list @temp) (_.do "to_f" (list) {.#None} @input)) - (_.if ($_ _.or - (_.not (_.= (_.float +0.0) @temp)) - (_.= (_.string "0") @input) - (_.= (_.string ".0") @input) - (_.= (_.string "0.0") @input)) - (_.return (..some @temp)) - (_.return ..none))))) + (all _.then + (_.set (list @input) inputG) + (_.set (list @temp) (_.do "to_f" (list) {.#None} @input)) + (_.if (all _.or + (_.not (_.= (_.float +0.0) @temp)) + (_.= (_.string "0") @input) + (_.= (_.string ".0") @input) + (_.= (_.string "0.0") @input)) + (_.return (..some @temp)) + (_.return ..none))))) (def: runtime//f64 Statement - ($_ _.then - @f64//decode - )) + (all _.then + @f64//decode + )) (runtime: (text//index subject param start) (with_vars [idx] - ($_ _.then - (_.set (list idx) (|> subject (_.do "index" (list param start) {.#None}))) - (_.if (_.= _.nil idx) - (_.return ..none) - (_.return (..some idx)))))) + (all _.then + (_.set (list idx) (|> subject (_.do "index" (list param start) {.#None}))) + (_.if (_.= _.nil idx) + (_.return ..none) + (_.return (..some idx)))))) (def: (within? top value) (-> Expression Expression Computation) @@ -553,41 +553,41 @@ (def: runtime//text Statement - ($_ _.then - @text//index - @text//clip - @text//char - )) + (all _.then + @text//index + @text//clip + @text//char + )) (runtime: (array//write idx value array) - ($_ _.then - (_.set (list (_.item idx array)) value) - (_.return array))) + (all _.then + (_.set (list (_.item idx array)) value) + (_.return array))) (def: runtime//array Statement - ($_ _.then - @array//write - )) + (all _.then + @array//write + )) (def: runtime Statement - ($_ _.then - (_.when ..mruby? - ... We're in DragonRuby territory. - (_.statement - (_.do "class_eval" (list) {.#Some [(list (_.local "_")) - (_.statement - (_.alias_method/2 (_.string "remainder") - (_.string "remainder_of_divide")))]} - $Numeric))) - runtime//adt - runtime//lux - runtime//i64 - runtime//f64 - runtime//text - runtime//array - )) + (all _.then + (_.when ..mruby? + ... We're in DragonRuby territory. + (_.statement + (_.do "class_eval" (list) {.#Some [(list (_.local "_")) + (_.statement + (_.alias_method/2 (_.string "remainder") + (_.string "remainder_of_divide")))]} + $Numeric))) + runtime//adt + runtime//lux + runtime//i64 + runtime//f64 + runtime//text + runtime//array + )) (def: .public generate (Operation [Registry Output]) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux index f40915ce9..143ff325f 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/scheme/runtime.lux @@ -139,10 +139,10 @@ (def: (variant' tag last? value) (-> Expression Expression Expression Computation) - ($_ _.cons/2 - tag - last? - value)) + (all _.cons/2 + tag + last? + value)) (runtime: (sum//make tag last? value) (variant' tag last? value)) @@ -341,9 +341,9 @@ (def: runtime//array Computation - ($_ _.then - @array//write - )) + (all _.then + @array//write + )) (def: runtime Computation diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index 3f5b73842..93ba961d0 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -29,7 +29,7 @@ [lux "*" ["@" target] [abstract - monad] + [monad {"+" do}]] [control ["[0]" maybe] ["[0]" exception {"+" exception:}] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux index 9ecea955a..888ad1793 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis.lux @@ -469,10 +469,10 @@ (n.* 5 (# n.hash hash register)) {#Bit_Fork when then else} - ($_ n.* 7 - (# bit.hash hash when) - (hash then) - (# (maybe.hash (path'_hash super)) hash else)) + (all n.* 7 + (# bit.hash hash when) + (hash then) + (# (maybe.hash (path'_hash super)) hash else)) (^.template [<factor> <tag> <hash>] [{<tag> item} @@ -535,31 +535,31 @@ (def: (hash value) (case value {#Exec this that} - ($_ n.* 2 - (# super hash this) - (# super hash that)) + (all n.* 2 + (# super hash this) + (# super hash that)) {#Let [input register body]} - ($_ n.* 3 - (# super hash input) - (# n.hash hash register) - (# super hash body)) + (all n.* 3 + (# super hash input) + (# n.hash hash register) + (# super hash body)) {#If [test then else]} - ($_ n.* 5 - (# super hash test) - (# super hash then) - (# super hash else)) + (all n.* 5 + (# super hash test) + (# super hash then) + (# super hash else)) {#Get [path record]} - ($_ n.* 7 - (# (list.hash /member.hash) hash path) - (# super hash record)) + (all n.* 7 + (# (list.hash /member.hash) hash path) + (# super hash record)) {#Case [input path]} - ($_ n.* 11 - (# super hash input) - (# (..path'_hash super) hash path)) + (all n.* 11 + (# super hash input) + (# (..path'_hash super) hash path)) ))) (implementation: (loop_equivalence (open "/#[0]")) @@ -588,14 +588,14 @@ (def: (hash value) (case value {#Scope [start inits iteration]} - ($_ n.* 2 - (# n.hash hash start) - (# (list.hash super) hash inits) - (# super hash iteration)) + (all n.* 2 + (# n.hash hash start) + (# (list.hash super) hash inits) + (# super hash iteration)) {#Again resets} - ($_ n.* 3 - (# (list.hash super) hash resets)) + (all n.* 3 + (# (list.hash super) hash resets)) ))) (implementation: (function_equivalence (open "#[0]")) @@ -626,15 +626,15 @@ (def: (hash value) (case value {#Abstraction [environment arity body]} - ($_ n.* 2 - (# (list.hash super) hash environment) - (# n.hash hash arity) - (# super hash body)) + (all n.* 2 + (# (list.hash super) hash environment) + (# n.hash hash arity) + (# super hash body)) {#Apply [abstraction arguments]} - ($_ n.* 3 - (# super hash abstraction) - (# (list.hash super) hash arguments)) + (all n.* 3 + (# super hash abstraction) + (# (list.hash super) hash arguments)) ))) (implementation: (control_equivalence (open "#[0]")) @@ -707,16 +707,16 @@ [#Extension (extension.hash again_hash)]))))) (template: .public (!bind_top register thenP) - [($_ ..path/seq - {..#Bind register} - {..#Pop} - thenP)]) + [(all ..path/seq + {..#Bind register} + {..#Pop} + thenP)]) (template: .public (!multi_pop nextP) - [($_ ..path/seq - {..#Pop} - {..#Pop} - nextP)]) + [(all ..path/seq + {..#Pop} + {..#Pop} + nextP)]) ... TODO: There are sister patterns to the simple side checks for tuples. ... These correspond to the situation where tuple members are accessed @@ -727,10 +727,10 @@ ... and thus will result in useless code being generated. (template [<name> <side>] [(template: .public (<name> idx nextP) - [($_ ..path/seq - (<side> idx) - {..#Pop} - nextP)])] + [(all ..path/seq + (<side> idx) + {..#Pop} + nextP)])] [simple_left_side ..side/left] [simple_right_side ..side/right] diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux index bdc53c382..236b46980 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access.lux @@ -28,10 +28,10 @@ (def: .public hash (Hash Access) - ($_ sum.hash - /side.hash - /member.hash - )) + (all sum.hash + /side.hash + /member.hash + )) (def: .public equivalence (Equivalence Access) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux index 128f12c26..a01e89668 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/member.lux @@ -24,10 +24,10 @@ (def: .public hash (Hash Member) - ($_ product.hash - nat.hash - bit.hash - )) + (all product.hash + nat.hash + bit.hash + )) (def: .public equivalence (Equivalence Member) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux index a694b7c45..c0be1fea6 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/synthesis/access/side.lux @@ -24,10 +24,10 @@ (def: .public hash (Hash Side) - ($_ product.hash - nat.hash - bit.hash - )) + (all product.hash + nat.hash + bit.hash + )) (def: .public equivalence (Equivalence Side) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index a2fa63404..5089188ce 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -222,17 +222,17 @@ (def: reader (Parser ..Frozen) - ($_ <>.and - <binary>.nat - <binary>.nat - (<binary>.list (<>.and <binary>.text <binary>.nat)))) + (all <>.and + <binary>.nat + <binary>.nat + (<binary>.list (<>.and <binary>.text <binary>.nat)))) (def: writer (Writer ..Frozen) - ($_ binary.and - binary.nat - binary.nat - (binary.list (binary.and binary.text binary.nat)))) + (all binary.and + binary.nat + binary.nat + (binary.list (binary.and binary.text binary.nat)))) (def: .public (export version archive) (-> Version Archive Binary) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux index bfe4e8fa3..2aa066db1 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact.lux @@ -25,8 +25,8 @@ (def: .public equivalence (Equivalence Artifact) - ($_ product.equivalence - nat.equivalence - /category.equivalence - bit.equivalence - )) + (all product.equivalence + nat.equivalence + /category.equivalence + bit.equivalence + )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux index 3f1bf2256..39bc31a5f 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/artifact/category.lux @@ -21,14 +21,14 @@ (def: .public definition_equivalence (Equivalence Definition) - ($_ product.equivalence - text.equivalence - (maybe.equivalence ($_ product.equivalence - nat.equivalence - nat.equivalence - nat.equivalence - )) - )) + (all product.equivalence + text.equivalence + (maybe.equivalence (all product.equivalence + nat.equivalence + nat.equivalence + nat.equivalence + )) + )) (type: .public Category (Variant diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux index e798429e1..a03795255 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -53,30 +53,30 @@ (def: .public equivalence (Equivalence Descriptor) - ($_ product.equivalence - text.equivalence - text.equivalence - nat.equivalence - ..module_state_equivalence - set.equivalence - )) + (all product.equivalence + text.equivalence + text.equivalence + nat.equivalence + ..module_state_equivalence + set.equivalence + )) (def: .public writer (Writer Descriptor) - ($_ format.and - format.text - format.text - format.nat - format.any - (format.set format.text) - )) + (all format.and + format.text + format.text + format.nat + format.any + (format.set format.text) + )) (def: .public parser (Parser Descriptor) - ($_ <>.and - <binary>.text - <binary>.text - <binary>.nat - (# <>.monad in {.#Cached}) - (<binary>.set text.hash <binary>.text) - )) + (all <>.and + <binary>.text + <binary>.text + <binary>.nat + (# <>.monad in {.#Cached}) + (<binary>.set text.hash <binary>.text) + )) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux index 73214b2ab..4f87f705c 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/module/document.lux @@ -62,9 +62,9 @@ (def: .public (writer content) (All (_ d) (-> (Writer d) (Writer (Document d)))) - (let [writer ($_ binary.and - signature.writer - content)] + (let [writer (all binary.and + signature.writer + content)] (|>> representation writer))) (def: .public (parser key it) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux index 26ee6ba8e..ea5245ea7 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/registry.lux @@ -107,15 +107,15 @@ (def: .public writer (Writer Registry) (let [definition (is (Writer //category.Definition) - ($_ binary.and - binary.text - (binary.maybe - ($_ binary.and - binary.nat - binary.nat - binary.nat - )) - )) + (all binary.and + binary.text + (binary.maybe + (all binary.and + binary.nat + binary.nat + binary.nat + )) + )) category (is (Writer Category) (function (_ value) (case value @@ -135,7 +135,7 @@ dependencies (is (Writer (Set unit.ID)) (binary.set dependency)) artifacts (is (Writer (Sequence [Category Bit (Set unit.ID)])) - (binary.sequence_64 ($_ binary.and category mandatory? dependencies)))] + (binary.sequence_64 (all binary.and category mandatory? dependencies)))] (|>> representation (the #artifacts) (sequence#each (function (_ [it dependencies]) @@ -151,15 +151,15 @@ (def: .public parser (Parser Registry) (let [definition (is (Parser //category.Definition) - ($_ <>.and - <binary>.text - (<binary>.maybe - ($_ <>.and - <binary>.nat - <binary>.nat - <binary>.nat - )) - )) + (all <>.and + <binary>.text + (<binary>.maybe + (all <>.and + <binary>.nat + <binary>.nat + <binary>.nat + )) + )) category (is (Parser Category) (do [! <>.monad] [tag <binary>.nat] @@ -181,7 +181,7 @@ (<>.and <binary>.nat <binary>.nat)) dependencies (is (Parser (Set unit.ID)) (<binary>.set unit.hash dependency))] - (|> (<binary>.sequence_64 ($_ <>.and category mandatory? dependencies)) + (|> (<binary>.sequence_64 (all <>.and category mandatory? dependencies)) (# <>.monad each (sequence#mix (function (_ [category mandatory? dependencies] registry) (product.right (case category diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux index 235913727..a9ade8ed9 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/signature.lux @@ -27,9 +27,9 @@ (def: .public equivalence (Equivalence Signature) - ($_ product.equivalence - symbol.equivalence - nat.equivalence)) + (all product.equivalence + symbol.equivalence + nat.equivalence)) (def: .public (description signature) (-> Signature Text) @@ -37,12 +37,12 @@ (def: .public writer (Writer Signature) - ($_ binary.and - (binary.and binary.text binary.text) - binary.nat)) + (all binary.and + (binary.and binary.text binary.text) + binary.nat)) (def: .public parser (Parser Signature) - ($_ <>.and - (<>.and <binary>.text <binary>.text) - <binary>.nat)) + (all <>.and + (<>.and <binary>.text <binary>.text) + <binary>.nat)) diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive/unit.lux b/stdlib/source/library/lux/tool/compiler/meta/archive/unit.lux index 460757c42..63221895e 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive/unit.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive/unit.lux @@ -24,9 +24,9 @@ (def: .public hash (Hash ID) - ($_ product.hash - nat.hash - nat.hash)) + (all product.hash + nat.hash + nat.hash)) (def: .public equivalence (Equivalence ID) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux index 90bee909d..84b644f47 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cache/dependency/artifact.lux @@ -47,18 +47,18 @@ (^.template [<tag>] [{<tag> left right} - ($_ list#composite - (again left) - (again right))]) + (all list#composite + (again left) + (again right))]) ([synthesis.#Alt] [synthesis.#Seq]) {synthesis.#Bit_Fork when then else} (case else {.#Some else} - ($_ list#composite - (again then) - (again else)) + (all list#composite + (again then) + (again else)) {.#None} (again then)) @@ -106,28 +106,28 @@ {synthesis.#Branch value} (case value {synthesis.#Exec this that} - ($_ list#composite - (references this) - (references that)) + (all list#composite + (references this) + (references that)) {synthesis.#Let input _ body} - ($_ list#composite - (references input) - (references body)) + (all list#composite + (references input) + (references body)) {synthesis.#If test then else} - ($_ list#composite - (references test) - (references then) - (references else)) + (all list#composite + (references test) + (references then) + (references else)) {synthesis.#Get _ record} (references record) {synthesis.#Case input path} - ($_ list#composite - (references input) - (path_references references path))) + (all list#composite + (references input) + (path_references references path))) {synthesis.#Loop value} (case value diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli.lux b/stdlib/source/library/lux/tool/compiler/meta/cli.lux index 99f7da67a..776ed07be 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli.lux @@ -87,24 +87,24 @@ (def: .public service (Parser Service) (let [compilation (is (Parser Compilation) - ($_ <>.and - (<>.some ..host_dependency_parser) - (<>.some ..library_parser) - (<>.some ..compiler_parser) - (<>.some ..source_parser) - ..target_parser - ..module_parser - (<>.else configuration.empty ..configuration_parser)))] - ($_ <>.or - (<>.after (<cli>.this "build") - compilation) - (<>.after (<cli>.this "repl") - compilation) - (<>.after (<cli>.this "export") - ($_ <>.and - (<>.some ..source_parser) - ..target_parser)) - ))) + (all <>.and + (<>.some ..host_dependency_parser) + (<>.some ..library_parser) + (<>.some ..compiler_parser) + (<>.some ..source_parser) + ..target_parser + ..module_parser + (<>.else configuration.empty ..configuration_parser)))] + (all <>.or + (<>.after (<cli>.this "build") + compilation) + (<>.after (<cli>.this "repl") + compilation) + (<>.after (<cli>.this "export") + (all <>.and + (<>.some ..source_parser) + ..target_parser)) + ))) (def: .public target (-> Service Target) diff --git a/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux b/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux index 898e4c5c3..ad3d3f124 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/cli/compiler.lux @@ -25,10 +25,10 @@ (def: .public equivalence (Equivalence Compiler) - ($_ product.equivalence - symbol.equivalence - (list.equivalence text.equivalence) - )) + (all product.equivalence + symbol.equivalence + (list.equivalence text.equivalence) + )) (template [<ascii> <name>] [(def: <name> diff --git a/stdlib/source/library/lux/tool/compiler/meta/export.lux b/stdlib/source/library/lux/tool/compiler/meta/export.lux index 4fdc63159..3d1361d10 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/export.lux @@ -31,10 +31,10 @@ "library.tar") (def: .public mode - ($_ tar.and - tar.read_by_owner tar.write_by_owner - tar.read_by_group tar.write_by_group - tar.read_by_other)) + (all tar.and + tar.read_by_owner tar.write_by_owner + tar.read_by_group tar.write_by_group + tar.read_by_other)) (def: .public ownership tar.Ownership diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index 8b0d5e6f7..37f464b01 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -59,17 +59,17 @@ (def: (module_parser key parser) (All (_ document) (-> (Key document) (Parser document) (Parser (module.Module document)))) - ($_ <>.and - <binary>.nat - descriptor.parser - (document.parser key parser))) + (all <>.and + <binary>.nat + descriptor.parser + (document.parser key parser))) (def: (parser key parser) (All (_ document) (-> (Key document) (Parser document) (Parser [(module.Module document) Registry]))) - ($_ <>.and - (..module_parser key parser) - registry.parser)) + (all <>.and + (..module_parser key parser) + registry.parser)) (def: (fresh_analysis_state host configuration) (-> Target Configuration .Lux) @@ -276,10 +276,10 @@ (..parser $.key $.parser) {.#Item [custom_state custom_key custom_format custom_parser custom_compiler] tail} - ($_ <>.either - (..parser custom_key custom_parser) - (cache_parser tail) - ))) + (all <>.either + (..parser custom_key custom_parser) + (cache_parser tail) + ))) (def: (valid_cache customs fs context import contexts [module_name @module]) (-> (List Custom) (file.System Async) Context Import (List //.Context) diff --git a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux index c7548669a..5c6b6176b 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/packager/scheme.lux @@ -78,13 +78,13 @@ (def: mode tar.Mode - ($_ tar.and - tar.read_by_group - tar.read_by_owner - - tar.write_by_other - tar.write_by_group - tar.write_by_owner)) + (all tar.and + tar.read_by_group + tar.read_by_owner + + tar.write_by_other + tar.write_by_group + tar.write_by_owner)) (def: owner tar.Owner diff --git a/stdlib/source/library/lux/type.lux b/stdlib/source/library/lux/type.lux index f82207ad0..7d3edd65f 100644 --- a/stdlib/source/library/lux/type.lux +++ b/stdlib/source/library/lux/type.lux @@ -82,57 +82,57 @@ (-> Type Text) (case type {.#Primitive name params} - ($_ text#composite - "(Primitive " - (text.enclosed' text.double_quote name) - (|> params - (list#each (|>> format (text#composite " "))) - (list#mix (function.flipped text#composite) "")) - ")") + (all text#composite + "(Primitive " + (text.enclosed' text.double_quote name) + (|> params + (list#each (|>> format (text#composite " "))) + (list#mix (function.flipped text#composite) "")) + ")") (^.template [<tag> <open> <close> <flat>] [{<tag> _} - ($_ text#composite <open> - (|> (<flat> type) - (list#each format) - list.reversed - (list.interposed " ") - (list#mix text#composite "")) - <close>)]) + (all text#composite <open> + (|> (<flat> type) + (list#each format) + list.reversed + (list.interposed " ") + (list#mix text#composite "")) + <close>)]) ([.#Sum "(Or " ")" flat_variant] [.#Product "[" "]" flat_tuple]) {.#Function input output} (.let [[ins out] (flat_function type)] - ($_ text#composite "(-> " - (|> ins - (list#each format) - list.reversed - (list.interposed " ") - (list#mix text#composite "")) - " " (format out) ")")) + (all text#composite "(-> " + (|> ins + (list#each format) + list.reversed + (list.interposed " ") + (list#mix text#composite "")) + " " (format out) ")")) {.#Parameter idx} (n#encoded idx) {.#Var id} - ($_ text#composite "-" (n#encoded id)) + (all text#composite "-" (n#encoded id)) {.#Ex id} - ($_ text#composite "+" (n#encoded id)) + (all text#composite "+" (n#encoded id)) {.#Apply param fun} (.let [[type_func type_args] (flat_application type)] - ($_ text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")")) + (all text#composite "(" (format type_func) " " (|> type_args (list#each format) list.reversed (list.interposed " ") (list#mix text#composite "")) ")")) (^.template [<tag> <desc>] [{<tag> env body} - ($_ text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")]) + (all text#composite "(" <desc> " {" (|> env (list#each format) (text.interposed " ")) "} " (format body) ")")]) ([.#UnivQ "All"] [.#ExQ "Ex"]) {.#Named [module name] type} - ($_ text#composite module "." name) + (all text#composite module "." name) )) ... https://en.wikipedia.org/wiki/Lambda_calculus#%CE%B2-reduction @@ -160,16 +160,16 @@ [.#ExQ]) {.#Parameter idx} - (maybe.else (panic! ($_ text#composite - "Unknown type parameter" text.new_line - " Index: " (n#encoded idx) text.new_line - "Environment: " (|> env - list.enumeration - (list#each (.function (_ [index type]) - ($_ text#composite - (n#encoded index) - " " (..format type)))) - (text.interposed (text#composite text.new_line " "))))) + (maybe.else (panic! (all text#composite + "Unknown type parameter" text.new_line + " Index: " (n#encoded idx) text.new_line + "Environment: " (|> env + list.enumeration + (list#each (.function (_ [index type]) + (all text#composite + (n#encoded index) + " " (..format type)))) + (text.interposed (text#composite text.new_line " "))))) (list.item idx env)) _ @@ -398,16 +398,16 @@ [location meta.location valueT (meta.type valueN) .let [_ ("lux io log" - ($_ text#composite - (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line - "Expression: " (case valueC - {.#Some valueC} - (code.format valueC) - - {.#None} - (symbol#encoded valueN)) - text.new_line - " Type: " (..format valueT)))]] + (all text#composite + (symbol#encoded (symbol ..log!)) " " (location.format location) text.new_line + "Expression: " (case valueC + {.#Some valueC} + (code.format valueC) + + {.#None} + (symbol#encoded valueN)) + text.new_line + " Type: " (..format valueT)))]] (in (list (code.symbol valueN)))) {.#Right valueC} diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux index 2b60eb1a4..ec8b13b95 100644 --- a/stdlib/source/library/lux/type/abstract.lux +++ b/stdlib/source/library/lux/type/abstract.lux @@ -201,9 +201,9 @@ (def: representation_definition_name (-> Text Text) - (|>> ($_ text#composite - (symbol#encoded (symbol ..#Representation)) - " "))) + (|>> (all text#composite + (symbol#encoded (symbol ..#Representation)) + " "))) (def: declaration (Parser [Text (List Text)]) @@ -213,11 +213,11 @@ (def: abstract (Parser [Code [Text (List Text)] Code (List Code)]) (|export|.parser - ($_ <>.and - ..declaration - <code>.any - (<>.some <code>.any) - ))) + (all <>.and + ..declaration + <code>.any + (<>.some <code>.any) + ))) ... TODO: Make sure the generated code always gets optimized away. ... (This applies to uses of "abstraction" and "representation") @@ -238,9 +238,9 @@ [(~+ type_varsC)]))) (` (type: (~ representation_declaration) (~ representation_type))) - ($_ list#composite - primitives - (list (` ((~! ..pop!))))))))) + (all list#composite + primitives + (list (` ((~! ..pop!))))))))) (type: (Selection a) (Variant diff --git a/stdlib/source/library/lux/type/check.lux b/stdlib/source/library/lux/type/check.lux index 51797be2d..9cd171aaf 100644 --- a/stdlib/source/library/lux/type/check.lux +++ b/stdlib/source/library/lux/type/check.lux @@ -445,18 +445,18 @@ (All (_ a) (-> Var Type (Check a) (-> Type (Check a)) (Check a))) - ($_ either - (do ..monad - [_ (..bind type id)] - then) - (do [! ..monad] - [ring (..ring id) - _ (..assertion "" (n.> 1 (set.size ring))) - _ (monad.each ! (re_bind type) (set.list ring))] - then) - (do ..monad - [?bound (peek id)] - (else (maybe.else {.#Var id} ?bound))))) + (all either + (do ..monad + [_ (..bind type id)] + then) + (do [! ..monad] + [ring (..ring id) + _ (..assertion "" (n.> 1 (set.size ring))) + _ (monad.each ! (re_bind type) (set.list ring))] + then) + (do ..monad + [?bound (peek id)] + (else (maybe.else {.#Var id} ?bound))))) ... TODO: "link/2" can be optimized... (def: (link/2 left right) diff --git a/stdlib/source/library/lux/type/implicit.lux b/stdlib/source/library/lux/type/implicit.lux index 5fde46588..26cc9cdb3 100644 --- a/stdlib/source/library/lux/type/implicit.lux +++ b/stdlib/source/library/lux/type/implicit.lux @@ -256,10 +256,10 @@ (def: (provision sig_type compiler context dep) (-> Type Lux Type_Context Type (Check Instance)) (case (meta.result compiler - ($_ meta.either - (do meta.monad [alts (..local_env sig_type)] (..candidate_provision (provision sig_type) context dep alts)) - (do meta.monad [alts (..local_structs sig_type)] (..candidate_provision (provision sig_type) context dep alts)) - (do meta.monad [alts (..imported_structs sig_type)] (..candidate_provision (provision sig_type) context dep alts)))) + (all meta.either + (do meta.monad [alts (..local_env sig_type)] (..candidate_provision (provision sig_type) context dep alts)) + (do meta.monad [alts (..local_structs sig_type)] (..candidate_provision (provision sig_type) context dep alts)) + (do meta.monad [alts (..imported_structs sig_type)] (..candidate_provision (provision sig_type) context dep alts)))) {.#Left error} (check.failure error) @@ -307,10 +307,10 @@ (def: (alternatives sig_type member_idx input_types output_type) (-> Type Nat (List Type) Type (Meta (List Instance))) (let [test (candidate_alternatives sig_type member_idx input_types output_type)] - ($_ meta.either - (do meta.monad [alts (..local_env sig_type)] (test alts)) - (do meta.monad [alts (..local_structs sig_type)] (test alts)) - (do meta.monad [alts (..imported_structs sig_type)] (test alts))))) + (all meta.either + (do meta.monad [alts (..local_env sig_type)] (test alts)) + (do meta.monad [alts (..local_structs sig_type)] (test alts)) + (do meta.monad [alts (..imported_structs sig_type)] (test alts))))) (def: (var? input) (-> Code Bit) diff --git a/stdlib/source/library/lux/type/poly.lux b/stdlib/source/library/lux/type/poly.lux index 1533e2f3b..53145e4e6 100644 --- a/stdlib/source/library/lux/type/poly.lux +++ b/stdlib/source/library/lux/type/poly.lux @@ -26,9 +26,9 @@ (def: polyP (Parser [Code Text Code]) - (let [private ($_ <>.and - <code>.local - <code>.any)] + (let [private (all <>.and + <code>.local + <code>.any)] (<>.either (<>.and <code>.any private) (<>.and (<>#in (` .private)) private)))) diff --git a/stdlib/source/library/lux/type/unit.lux b/stdlib/source/library/lux/type/unit.lux index dd8430421..99b3e934c 100644 --- a/stdlib/source/library/lux/type/unit.lux +++ b/stdlib/source/library/lux/type/unit.lux @@ -87,9 +87,9 @@ (syntax: .public (unit: [[export_policy type_name unit_name] (|export|.parser - ($_ <>.and - <code>.local - <code>.local))]) + (all <>.and + <code>.local + <code>.local))]) (do meta.monad [@ meta.current_module_name .let [g!type (code.local type_name)]] @@ -116,10 +116,10 @@ (syntax: .public (scale: [[export_policy type_name scale_name ratio] (|export|.parser - ($_ <>.and - <code>.local - <code>.local - ..scaleP))]) + (all <>.and + <code>.local + <code>.local + ..scaleP))]) (do meta.monad [.let [(open "_[0]") ratio] @ meta.current_module_name diff --git a/stdlib/source/library/lux/world/file/watch.lux b/stdlib/source/library/lux/world/file/watch.lux index eca972ca5..6c1331c4d 100644 --- a/stdlib/source/library/lux/world/file/watch.lux +++ b/stdlib/source/library/lux/world/file/watch.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" all} ["@" target] ["[0]" ffi {"+" import:}] [abstract @@ -74,11 +74,11 @@ (def: .public all Concern - ($_ ..also - ..creation - ..modification - ..deletion - )) + (.all ..also + ..creation + ..modification + ..deletion + )) ) (type: .public (Watcher !) @@ -246,14 +246,14 @@ (list#composite deletions all_deletions)]) [(list) (list) (list)] changes)]] - (in ($_ list#composite - (list#each (|>> product.left [..creation]) creations) - (|> modifications - (list.only (function (_ [path previous_modification current_modification]) - (not (instant#= previous_modification current_modification)))) - (list#each (|>> product.left [..modification]))) - (list#each (|>> [..deletion]) deletions) - ))))) + (in (.all list#composite + (list#each (|>> product.left [..creation]) creations) + (|> modifications + (list.only (function (_ [path previous_modification current_modification]) + (not (instant#= previous_modification current_modification)))) + (list#each (|>> product.left [..modification]))) + (list#each (|>> [..deletion]) deletions) + ))))) ))) (def: .public (mock separator) @@ -400,17 +400,17 @@ (def: (watch_events concern) (-> Concern (List Watch_Event)) - ($_ list#composite - (if (..creation? concern) - (list (as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) - (list)) - (if (..modification? concern) - (list (as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) - (list)) - (if (..deletion? concern) - (list (as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) - (list)) - )) + (.all list#composite + (if (..creation? concern) + (list (as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_CREATE))) + (list)) + (if (..modification? concern) + (list (as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_MODIFY))) + (list)) + (if (..deletion? concern) + (list (as Watch_Event (java/nio/file/StandardWatchEventKinds::ENTRY_DELETE))) + (list)) + )) (def: .public default (IO (Try (Watcher Async))) diff --git a/stdlib/source/library/lux/world/input/keyboard.lux b/stdlib/source/library/lux/world/input/keyboard.lux index e79fafa14..539f875e0 100644 --- a/stdlib/source/library/lux/world/input/keyboard.lux +++ b/stdlib/source/library/lux/world/input/keyboard.lux @@ -1,6 +1,6 @@ (.using - [library - [lux "*"]]) + [library + [lux {"-" left right}]]) (type: .public Key Nat) diff --git a/stdlib/source/library/lux/world/net/http/cookie.lux b/stdlib/source/library/lux/world/net/http/cookie.lux index ad721f6ea..b3143c56e 100644 --- a/stdlib/source/library/lux/world/net/http/cookie.lux +++ b/stdlib/source/library/lux/world/net/http/cookie.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - [control - [monad {"+" do}] - ["[0]" try {"+" Try}] - ["p" parser ("[1]#[0]" monad) - ["l" text {"+" Parser}]]] - [data - [number - ["i" int]] - [text - ["%" format {"+" format}]] - [format - ["[0]" context {"+" Context}]] - [collection - ["[0]" dictionary]]] - [time - ["[0]" duration {"+" Duration}]]]] - ["[0]" // {"+" Header} - ["[0]" header]]) + [library + [lux "*" + [control + [monad {"+" do}] + ["[0]" try {"+" Try}] + ["p" parser ("[1]#[0]" monad) + ["l" text {"+" Parser}]]] + [data + [number + ["i" int]] + [text + ["%" format {"+" format}]] + [format + ["[0]" context {"+" Context}]] + [collection + ["[0]" dictionary]]] + [time + ["[0]" duration {"+" Duration}]]]] + ["[0]" // {"+" Header} + ["[0]" header]]) (type: .public Directive (-> Text Text)) @@ -78,12 +78,12 @@ (def: (cookies context) (-> Context (Parser Context)) - ($_ p.either - (do p.monad - [context' (..cookie context) - _ (l.this "; ")] - (cookies context')) - (p#in context))) + (all p.either + (do p.monad + [context' (..cookie context) + _ (l.this "; ")] + (cookies context')) + (p#in context))) (def: .public (get header) (-> Text (Try Context)) diff --git a/stdlib/source/library/lux/world/net/http/query.lux b/stdlib/source/library/lux/world/net/http/query.lux index adc83d961..445e28bfe 100644 --- a/stdlib/source/library/lux/world/net/http/query.lux +++ b/stdlib/source/library/lux/world/net/http/query.lux @@ -1,21 +1,21 @@ (.using - [library - [lux "*" - [control - pipe - [monad {"+" do}] - ["[0]" try {"+" Try}] - ["p" parser - ["l" text {"+" Parser}]]] - [data - [number - ["[0]" nat]] - ["[0]" text - ["%" format {"+" format}]] - [format - ["[0]" context {"+" Context}]] - [collection - ["[0]" dictionary]]]]]) + [library + [lux "*" + [control + pipe + [monad {"+" do}] + ["[0]" try {"+" Try}] + ["p" parser + ["l" text {"+" Parser}]]] + [data + [number + ["[0]" nat]] + ["[0]" text + ["%" format {"+" format}]] + [format + ["[0]" context {"+" Context}]] + [collection + ["[0]" dictionary]]]]]) (def: component (Parser Text) @@ -23,42 +23,42 @@ (function (_ component) (do [! p.monad] [head (l.some (l.none_of "+%&;"))] - ($_ p.either - (p.after (p.either l.end - (l.this "&")) - (in head)) - (do ! - [_ (l.this "+") - tail component] - (in (format head " " tail))) - (do ! - [_ (l.this "%") - code (|> (l.exactly 2 l.hexadecimal) - (p.codec nat.hex) - (# ! each text.from_code)) - tail component] - (in (format head code tail)))))))) + (all p.either + (p.after (p.either l.end + (l.this "&")) + (in head)) + (do ! + [_ (l.this "+") + tail component] + (in (format head " " tail))) + (do ! + [_ (l.this "%") + code (|> (l.exactly 2 l.hexadecimal) + (p.codec nat.hex) + (# ! each text.from_code)) + tail component] + (in (format head code tail)))))))) (def: (form context) (-> Context (Parser Context)) - ($_ p.either - (do p.monad - [_ l.end] - (in context)) - (do [! p.monad] - [key (l.some (l.none_of "=&;")) - key (l.local key ..component)] - (p.either (do ! - [_ (l.this "=") - value ..component] - (form (dictionary.has key value context))) - (do ! - [_ ($_ p.or - (l.one_of "&;") - l.end)] - (form (dictionary.has key "" context))))) - ... if invalid form data, just stop parsing... - (# p.monad in context))) + (all p.either + (do p.monad + [_ l.end] + (in context)) + (do [! p.monad] + [key (l.some (l.none_of "=&;")) + key (l.local key ..component)] + (p.either (do ! + [_ (l.this "=") + value ..component] + (form (dictionary.has key value context))) + (do ! + [_ (all p.or + (l.one_of "&;") + l.end)] + (form (dictionary.has key "" context))))) + ... if invalid form data, just stop parsing... + (# p.monad in context))) (def: .public (parameters raw) (-> Text (Try Context)) diff --git a/stdlib/source/poly/lux/abstract/equivalence.lux b/stdlib/source/poly/lux/abstract/equivalence.lux index 79c85032a..1e95ec091 100644 --- a/stdlib/source/poly/lux/abstract/equivalence.lux +++ b/stdlib/source/poly/lux/abstract/equivalence.lux @@ -49,120 +49,120 @@ .let [@Equivalence (is (-> Type Code) (function (_ type) (` ((~! /.Equivalence) (~ (poly.code *env* type))))))]] - ($_ <>.either - ... Basic types - (~~ (template [<matcher> <eq>] - [(do ! - [_ <matcher>] - (in (` (is (~ (@Equivalence inputT)) - <eq>))))] + (all <>.either + ... Basic types + (~~ (template [<matcher> <eq>] + [(do ! + [_ <matcher>] + (in (` (is (~ (@Equivalence inputT)) + <eq>))))] - [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] - [(<type>.sub Bit) (~! bit.equivalence)] - [(<type>.sub Nat) (~! nat.equivalence)] - [(<type>.sub Int) (~! int.equivalence)] - [(<type>.sub Rev) (~! rev.equivalence)] - [(<type>.sub Frac) (~! frac.equivalence)] - [(<type>.sub Text) (~! text.equivalence)])) - ... Composite types - (~~ (template [<name> <eq>] - [(do ! - [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>) - equivalence))] - (in (` (is (~ (@Equivalence inputT)) - (<eq> (~ argC))))))] + [(<type>.exactly Any) (function ((~ g!_) (~ g!_) (~ g!_)) #1)] + [(<type>.sub Bit) (~! bit.equivalence)] + [(<type>.sub Nat) (~! nat.equivalence)] + [(<type>.sub Int) (~! int.equivalence)] + [(<type>.sub Rev) (~! rev.equivalence)] + [(<type>.sub Frac) (~! frac.equivalence)] + [(<type>.sub Text) (~! text.equivalence)])) + ... Composite types + (~~ (template [<name> <eq>] + [(do ! + [[_ argC] (<type>.applied (<>.and (<type>.exactly <name>) + equivalence))] + (in (` (is (~ (@Equivalence inputT)) + (<eq> (~ argC))))))] - [.Maybe (~! maybe.equivalence)] - [.List (~! list.equivalence)] - [sequence.Sequence (~! sequence.equivalence)] - [array.Array (~! array.equivalence)] - [queue.Queue (~! queue.equivalence)] - [set.Set (~! set.equivalence)] - [tree.Tree (~! tree.equivalence)] - )) - (do ! - [[_ _ valC] (<type>.applied ($_ <>.and - (<type>.exactly dictionary.Dictionary) - <type>.any - equivalence))] - (in (` (is (~ (@Equivalence inputT)) - ((~! dictionary.equivalence) (~ valC)))))) - ... Models - (~~ (template [<type> <eq>] - [(do ! - [_ (<type>.exactly <type>)] - (in (` (is (~ (@Equivalence inputT)) - <eq>))))] + [.Maybe (~! maybe.equivalence)] + [.List (~! list.equivalence)] + [sequence.Sequence (~! sequence.equivalence)] + [array.Array (~! array.equivalence)] + [queue.Queue (~! queue.equivalence)] + [set.Set (~! set.equivalence)] + [tree.Tree (~! tree.equivalence)] + )) + (do ! + [[_ _ valC] (<type>.applied (all <>.and + (<type>.exactly dictionary.Dictionary) + <type>.any + equivalence))] + (in (` (is (~ (@Equivalence inputT)) + ((~! dictionary.equivalence) (~ valC)))))) + ... Models + (~~ (template [<type> <eq>] + [(do ! + [_ (<type>.exactly <type>)] + (in (` (is (~ (@Equivalence inputT)) + <eq>))))] - [duration.Duration duration.equivalence] - [instant.Instant instant.equivalence] - [date.Date date.equivalence] - [day.Day day.equivalence] - [month.Month month.equivalence] - )) - (do ! - [_ (<type>.applied (<>.and (<type>.exactly unit.Qty) - <type>.any))] - (in (` (is (~ (@Equivalence inputT)) - unit.equivalence)))) - ... Variants - (do ! - [members (<type>.variant (<>.many equivalence)) - .let [last (-- (list.size members)) - g!_ (code.local "_____________") - g!left (code.local "_____________left") - g!right (code.local "_____________right")]] - (in (` (is (~ (@Equivalence inputT)) - (function ((~ g!_) (~ g!left) (~ g!right)) - (case [(~ g!left) (~ g!right)] - (~+ (list#conjoint (list#each (function (_ [tag g!eq]) - (if (nat.= last tag) - (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)} - {(~ (code.nat (-- tag))) #1 (~ g!right)}]) - (` ((~ g!eq) (~ g!left) (~ g!right)))) - (list (` [{(~ (code.nat tag)) #0 (~ g!left)} - {(~ (code.nat tag)) #0 (~ g!right)}]) - (` ((~ g!eq) (~ g!left) (~ g!right)))))) - (list.enumeration members)))) - (~ g!_) - #0)))))) - ... Tuples - (do ! - [g!eqs (<type>.tuple (<>.many equivalence)) - .let [g!_ (code.local "_____________") - indices (list.indices (list.size g!eqs)) - g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices) - g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]] - (in (` (is (~ (@Equivalence inputT)) - (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) - (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights) - (list#each (function (_ [g!eq g!left g!right]) - (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) - ... Type recursion - (do ! - [[g!self bodyC] (<type>.recursive equivalence) - .let [g!_ (code.local "_____________")]] - (in (` (is (~ (@Equivalence inputT)) - ((~! /.rec) (.function ((~ g!_) (~ g!self)) - (~ bodyC))))))) - <type>.recursive_self - ... Type applications - (do ! - [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))] - (in (` ((~ funcC) (~+ argsC))))) - ... Parameters - <type>.parameter - ... Polymorphism - (do ! - [[funcC varsC bodyC] (<type>.polymorphic equivalence)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC)) - ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - <type>.recursive_call - ... If all else fails... - (|> <type>.any - (# ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure)) - (# ! conjoint)) - )))) + [duration.Duration duration.equivalence] + [instant.Instant instant.equivalence] + [date.Date date.equivalence] + [day.Day day.equivalence] + [month.Month month.equivalence] + )) + (do ! + [_ (<type>.applied (<>.and (<type>.exactly unit.Qty) + <type>.any))] + (in (` (is (~ (@Equivalence inputT)) + unit.equivalence)))) + ... Variants + (do ! + [members (<type>.variant (<>.many equivalence)) + .let [last (-- (list.size members)) + g!_ (code.local "_____________") + g!left (code.local "_____________left") + g!right (code.local "_____________right")]] + (in (` (is (~ (@Equivalence inputT)) + (function ((~ g!_) (~ g!left) (~ g!right)) + (case [(~ g!left) (~ g!right)] + (~+ (list#conjoint (list#each (function (_ [tag g!eq]) + (if (nat.= last tag) + (list (` [{(~ (code.nat (-- tag))) #1 (~ g!left)} + {(~ (code.nat (-- tag))) #1 (~ g!right)}]) + (` ((~ g!eq) (~ g!left) (~ g!right)))) + (list (` [{(~ (code.nat tag)) #0 (~ g!left)} + {(~ (code.nat tag)) #0 (~ g!right)}]) + (` ((~ g!eq) (~ g!left) (~ g!right)))))) + (list.enumeration members)))) + (~ g!_) + #0)))))) + ... Tuples + (do ! + [g!eqs (<type>.tuple (<>.many equivalence)) + .let [g!_ (code.local "_____________") + indices (list.indices (list.size g!eqs)) + g!lefts (list#each (|>> nat#encoded (text#composite "left") code.local) indices) + g!rights (list#each (|>> nat#encoded (text#composite "right") code.local) indices)]] + (in (` (is (~ (@Equivalence inputT)) + (function ((~ g!_) [(~+ g!lefts)] [(~+ g!rights)]) + (and (~+ (|> (list.zipped_3 g!eqs g!lefts g!rights) + (list#each (function (_ [g!eq g!left g!right]) + (` ((~ g!eq) (~ g!left) (~ g!right))))))))))))) + ... Type recursion + (do ! + [[g!self bodyC] (<type>.recursive equivalence) + .let [g!_ (code.local "_____________")]] + (in (` (is (~ (@Equivalence inputT)) + ((~! /.rec) (.function ((~ g!_) (~ g!self)) + (~ bodyC))))))) + <type>.recursive_self + ... Type applications + (do ! + [[funcC argsC] (<type>.applied (<>.and equivalence (<>.many equivalence)))] + (in (` ((~ funcC) (~+ argsC))))) + ... Parameters + <type>.parameter + ... Polymorphism + (do ! + [[funcC varsC bodyC] (<type>.polymorphic equivalence)] + (in (` (is (All ((~ g!_) (~+ varsC)) + (-> (~+ (list#each (|>> (~) ((~! /.Equivalence)) (`)) varsC)) + ((~! /.Equivalence) ((~ (poly.code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + <type>.recursive_call + ... If all else fails... + (|> <type>.any + (# ! each (|>> %.type (format "Cannot create Equivalence for: ") <>.failure)) + (# ! conjoint)) + )))) diff --git a/stdlib/source/poly/lux/abstract/functor.lux b/stdlib/source/poly/lux/abstract/functor.lux index 80f8d414a..97c900493 100644 --- a/stdlib/source/poly/lux/abstract/functor.lux +++ b/stdlib/source/poly/lux/abstract/functor.lux @@ -44,63 +44,63 @@ ((~! /.Functor) ((~ (poly.code *env* unwrappedT)) (~+ paramsC))))))))) Arg<?> (is (-> Code (<type>.Parser Code)) (function (Arg<?> valueC) - ($_ p.either - ... Type-var - (do p.monad - [.let [varI (|> num_vars (n.* 2) --)] - _ (<type>.this_parameter varI)] - (in (` ((~ funcC) (~ valueC))))) - ... Variants - (do ! - [_ (in []) - membersC (<type>.variant (p.many (Arg<?> valueC))) - .let [last (-- (list.size membersC))]] - (in (` (case (~ valueC) - (~+ (list#conjoint (list#each (function (_ [tag memberC]) - (if (n.= last tag) - (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)}) - (` {(~ (code.nat (-- tag))) #1 (~ memberC)})) - (list (` {(~ (code.nat tag)) #0 (~ valueC)}) - (` {(~ (code.nat tag)) #0 (~ memberC)})))) - (list.enumeration membersC)))))))) - ... Tuples - (do p.monad - [pairsCC (is (<type>.Parser (List [Code Code])) - (<type>.tuple (loop (again [idx 0 - pairsCC (is (List [Code Code]) - (list))]) - (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] - (do ! - [_ (in []) - memberC (Arg<?> slotC)] - (again (++ idx) - (list#composite pairsCC (list [slotC memberC]))))) - (in pairsCC)))))] - (in (` (case (~ valueC) - [(~+ (list#each product.left pairsCC))] - [(~+ (list#each product.right pairsCC))])))) - ... Functions - (do ! - [_ (in []) - .let [g! (code.local "____________") - outL (code.local "____________outL")] - [inT+ outC] (<type>.function (p.many <type>.any) - (Arg<?> outL)) - .let [inC+ (|> (list.size inT+) - list.indices - (list#each (|>> %.nat (format "____________inC") code.local)))]] - (in (` (function ((~ g!) (~+ inC+)) - (let [(~ outL) ((~ valueC) (~+ inC+))] - (~ outC)))))) - ... Recursion - (do p.monad - [_ <type>.recursive_call] - (in (` ((~' each) (~ funcC) (~ valueC))))) - ... Parameters - (do p.monad - [_ <type>.any] - (in valueC)) - )))] + (all p.either + ... Type-var + (do p.monad + [.let [varI (|> num_vars (n.* 2) --)] + _ (<type>.this_parameter varI)] + (in (` ((~ funcC) (~ valueC))))) + ... Variants + (do ! + [_ (in []) + membersC (<type>.variant (p.many (Arg<?> valueC))) + .let [last (-- (list.size membersC))]] + (in (` (case (~ valueC) + (~+ (list#conjoint (list#each (function (_ [tag memberC]) + (if (n.= last tag) + (list (` {(~ (code.nat (-- tag))) #1 (~ valueC)}) + (` {(~ (code.nat (-- tag))) #1 (~ memberC)})) + (list (` {(~ (code.nat tag)) #0 (~ valueC)}) + (` {(~ (code.nat tag)) #0 (~ memberC)})))) + (list.enumeration membersC)))))))) + ... Tuples + (do p.monad + [pairsCC (is (<type>.Parser (List [Code Code])) + (<type>.tuple (loop (again [idx 0 + pairsCC (is (List [Code Code]) + (list))]) + (p.either (let [slotC (|> idx %.nat (format "____________slot") code.local)] + (do ! + [_ (in []) + memberC (Arg<?> slotC)] + (again (++ idx) + (list#composite pairsCC (list [slotC memberC]))))) + (in pairsCC)))))] + (in (` (case (~ valueC) + [(~+ (list#each product.left pairsCC))] + [(~+ (list#each product.right pairsCC))])))) + ... Functions + (do ! + [_ (in []) + .let [g! (code.local "____________") + outL (code.local "____________outL")] + [inT+ outC] (<type>.function (p.many <type>.any) + (Arg<?> outL)) + .let [inC+ (|> (list.size inT+) + list.indices + (list#each (|>> %.nat (format "____________inC") code.local)))]] + (in (` (function ((~ g!) (~+ inC+)) + (let [(~ outL) ((~ valueC) (~+ inC+))] + (~ outC)))))) + ... Recursion + (do p.monad + [_ <type>.recursive_call] + (in (` ((~' each) (~ funcC) (~ valueC))))) + ... Parameters + (do p.monad + [_ <type>.any] + (in valueC)) + )))] [_ _ outputC] (is (<type>.Parser [Code (List Code) Code]) (p.either (<type>.polymorphic (Arg<?> inputC)) diff --git a/stdlib/source/poly/lux/data/format/json.lux b/stdlib/source/poly/lux/data/format/json.lux index e838c73b4..9e4a6a369 100644 --- a/stdlib/source/poly/lux/data/format/json.lux +++ b/stdlib/source/poly/lux/data/format/json.lux @@ -129,97 +129,97 @@ (function (_ type) (` (-> (~ (poly.code *env* type)) /.JSON))))] inputT <type>.next] - ($_ <>.either - <basic> - <time> - (do ! - [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) - <type>.any))] - (in (` (is (~ (@JSON#encoded inputT)) - (# (~! qty_codec) (~' encoded)))))) - (do ! - [.let [g!_ (code.local "_______") - g!key (code.local "_______key") - g!val (code.local "_______val")] - [_ _ =val=] (<type>.applied ($_ <>.and - (<type>.exactly dictionary.Dictionary) - (<type>.exactly .Text) + (all <>.either + <basic> + <time> + (do ! + [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) + <type>.any))] + (in (` (is (~ (@JSON#encoded inputT)) + (# (~! qty_codec) (~' encoded)))))) + (do ! + [.let [g!_ (code.local "_______") + g!key (code.local "_______key") + g!val (code.local "_______val")] + [_ _ =val=] (<type>.applied (all <>.and + (<type>.exactly dictionary.Dictionary) + (<type>.exactly .Text) + encoded))] + (in (` (is (~ (@JSON#encoded inputT)) + (|>> ((~! dictionary.entries)) + ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)]) + [(~ g!key) ((~ =val=) (~ g!val))])) + ((~! dictionary.of_list) (~! text.hash)) + {/.#Object}))))) + (do ! + [[_ =sub=] (<type>.applied (all <>.and + (<type>.exactly .Maybe) encoded))] - (in (` (is (~ (@JSON#encoded inputT)) - (|>> ((~! dictionary.entries)) - ((~! list#each) (function ((~ g!_) [(~ g!key) (~ g!val)]) - [(~ g!key) ((~ =val=) (~ g!val))])) - ((~! dictionary.of_list) (~! text.hash)) - {/.#Object}))))) - (do ! - [[_ =sub=] (<type>.applied ($_ <>.and - (<type>.exactly .Maybe) - encoded))] - (in (` (is (~ (@JSON#encoded inputT)) - ((~! ..nullable) (~ =sub=)))))) - (do ! - [[_ =sub=] (<type>.applied ($_ <>.and - (<type>.exactly .List) - encoded))] - (in (` (is (~ (@JSON#encoded inputT)) - (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array}))))) - (do ! - [.let [g!_ (code.local "_______") - g!input (code.local "_______input")] - members (<type>.variant (<>.many encoded)) - .let [last (-- (list.size members))]] - (in (` (is (~ (@JSON#encoded inputT)) - (function ((~ g!_) (~ g!input)) - (case (~ g!input) - (~+ (list#conjoint (list#each (function (_ [tag g!encoded]) - (if (n.= last tag) - (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)}) - (` ((~! /.json) [(~ (code.frac (..tag (-- tag)))) - #1 - ((~ g!encoded) (~ g!input))]))) - (.list (` {(~ (code.nat tag)) #0 (~ g!input)}) - (` ((~! /.json) [(~ (code.frac (..tag tag))) - #0 - ((~ g!encoded) (~ g!input))]))))) - (list.enumeration members)))))))))) - (do ! - [g!encoders (<type>.tuple (<>.many encoded)) - .let [g!_ (code.local "_______") - g!members (|> (list.size g!encoders) - list.indices - (list#each (|>> n#encoded code.local)))]] - (in (` (is (~ (@JSON#encoded inputT)) - (function ((~ g!_) [(~+ g!members)]) - ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded]) - (` ((~ g!encoded) (~ g!member)))) - (list.zipped_2 g!members g!encoders)))])))))) - ... Type recursion - (do ! - [[selfC non_recC] (<type>.recursive encoded) - .let [g! (code.local "____________")]] - (in (` (is (~ (@JSON#encoded inputT)) - ((~! ..rec_encoded) (.function ((~ g!) (~ selfC)) - (~ non_recC))))))) - <type>.recursive_self - ... Type applications - (do ! - [partsC (<type>.applied (<>.many encoded))] - (in (` ((~+ partsC))))) - ... Polymorphism - (do ! - [[funcC varsC bodyC] (<type>.polymorphic encoded)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON))) - varsC)) - (-> ((~ (poly.code *env* inputT)) (~+ varsC)) - /.JSON))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - <type>.parameter - <type>.recursive_call - ... If all else fails... - (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT))) - )))) + (in (` (is (~ (@JSON#encoded inputT)) + ((~! ..nullable) (~ =sub=)))))) + (do ! + [[_ =sub=] (<type>.applied (all <>.and + (<type>.exactly .List) + encoded))] + (in (` (is (~ (@JSON#encoded inputT)) + (|>> ((~! list#each) (~ =sub=)) ((~! sequence.of_list)) {/.#Array}))))) + (do ! + [.let [g!_ (code.local "_______") + g!input (code.local "_______input")] + members (<type>.variant (<>.many encoded)) + .let [last (-- (list.size members))]] + (in (` (is (~ (@JSON#encoded inputT)) + (function ((~ g!_) (~ g!input)) + (case (~ g!input) + (~+ (list#conjoint (list#each (function (_ [tag g!encoded]) + (if (n.= last tag) + (.list (` {(~ (code.nat (-- tag))) #1 (~ g!input)}) + (` ((~! /.json) [(~ (code.frac (..tag (-- tag)))) + #1 + ((~ g!encoded) (~ g!input))]))) + (.list (` {(~ (code.nat tag)) #0 (~ g!input)}) + (` ((~! /.json) [(~ (code.frac (..tag tag))) + #0 + ((~ g!encoded) (~ g!input))]))))) + (list.enumeration members)))))))))) + (do ! + [g!encoders (<type>.tuple (<>.many encoded)) + .let [g!_ (code.local "_______") + g!members (|> (list.size g!encoders) + list.indices + (list#each (|>> n#encoded code.local)))]] + (in (` (is (~ (@JSON#encoded inputT)) + (function ((~ g!_) [(~+ g!members)]) + ((~! /.json) [(~+ (list#each (function (_ [g!member g!encoded]) + (` ((~ g!encoded) (~ g!member)))) + (list.zipped_2 g!members g!encoders)))])))))) + ... Type recursion + (do ! + [[selfC non_recC] (<type>.recursive encoded) + .let [g! (code.local "____________")]] + (in (` (is (~ (@JSON#encoded inputT)) + ((~! ..rec_encoded) (.function ((~ g!) (~ selfC)) + (~ non_recC))))))) + <type>.recursive_self + ... Type applications + (do ! + [partsC (<type>.applied (<>.many encoded))] + (in (` ((~+ partsC))))) + ... Polymorphism + (do ! + [[funcC varsC bodyC] (<type>.polymorphic encoded)] + (in (` (is (All ((~ g!_) (~+ varsC)) + (-> (~+ (list#each (function (_ varC) (` (-> (~ varC) /.JSON))) + varsC)) + (-> ((~ (poly.code *env* inputT)) (~+ varsC)) + /.JSON))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + <type>.parameter + <type>.recursive_call + ... If all else fails... + (<>.failure (format "Cannot create JSON encoder for: " (type.format inputT))) + )))) (poly: decoded (with_expansions @@ -253,76 +253,76 @@ (function (_ type) (` (</>.Parser (~ (poly.code *env* type))))))] inputT <type>.next] - ($_ <>.either - <basic> - <time> - (do ! - [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) - <type>.any))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) - (do ! - [[_ _ valC] (<type>.applied ($_ <>.and - (<type>.exactly dictionary.Dictionary) - (<type>.exactly .Text) - decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.dictionary) (~ valC)))))) - (do ! - [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) - decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.nullable) (~ subC)))))) - (do ! - [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) + (all <>.either + <basic> + <time> + (do ! + [unitT (<type>.applied (<>.after (<type>.exactly unit.Qty) + <type>.any))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! <>.codec) (~! qty_codec) (~! </>.any)))))) + (do ! + [[_ _ valC] (<type>.applied (all <>.and + (<type>.exactly dictionary.Dictionary) + (<type>.exactly .Text) decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.array) ((~! <>.some) (~ subC))))))) - (do ! - [members (<type>.variant (<>.many decoded)) - .let [last (-- (list.size members))]] - (in (` (is (~ (@JSON#decoded inputT)) - ($_ ((~! <>.or)) - (~+ (list#each (function (_ [tag memberC]) - (if (n.= last tag) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1)))) - ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag)))))) - ((~! </>.array)))) - (` (|> (~ memberC) - ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0)))) - ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag))))) - ((~! </>.array)))))) - (list.enumeration members)))))))) - (do ! - [g!decoders (<type>.tuple (<>.many decoded))] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! </>.array) ($_ ((~! <>.and)) (~+ g!decoders))))))) - ... Type recursion - (do ! - [[selfC bodyC] (<type>.recursive decoded) - .let [g! (code.local "____________")]] - (in (` (is (~ (@JSON#decoded inputT)) - ((~! <>.rec) (.function ((~ g!) (~ selfC)) - (~ bodyC))))))) - <type>.recursive_self - ... Type applications - (do ! - [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))] - (in (` ((~ funcC) (~+ argsC))))) - ... Polymorphism - (do ! - [[funcC varsC bodyC] (<type>.polymorphic decoded)] - (in (` (is (All ((~ g!_) (~+ varsC)) - (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC)) - (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC))))) - (function ((~ funcC) (~+ varsC)) - (~ bodyC)))))) - <type>.parameter - <type>.recursive_call - ... If all else fails... - (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT))) - )))) + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.dictionary) (~ valC)))))) + (do ! + [[_ subC] (<type>.applied (<>.and (<type>.exactly .Maybe) + decoded))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.nullable) (~ subC)))))) + (do ! + [[_ subC] (<type>.applied (<>.and (<type>.exactly .List) + decoded))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.array) ((~! <>.some) (~ subC))))))) + (do ! + [members (<type>.variant (<>.many decoded)) + .let [last (-- (list.size members))]] + (in (` (is (~ (@JSON#decoded inputT)) + (all ((~! <>.or)) + (~+ (list#each (function (_ [tag memberC]) + (if (n.= last tag) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #1)))) + ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag (-- tag)))))) + ((~! </>.array)))) + (` (|> (~ memberC) + ((~! <>.after) ((~! </>.this_boolean) (~ (code.bit #0)))) + ((~! <>.after) ((~! </>.this_number) (~ (code.frac (..tag tag))))) + ((~! </>.array)))))) + (list.enumeration members)))))))) + (do ! + [g!decoders (<type>.tuple (<>.many decoded))] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! </>.array) (all ((~! <>.and)) (~+ g!decoders))))))) + ... Type recursion + (do ! + [[selfC bodyC] (<type>.recursive decoded) + .let [g! (code.local "____________")]] + (in (` (is (~ (@JSON#decoded inputT)) + ((~! <>.rec) (.function ((~ g!) (~ selfC)) + (~ bodyC))))))) + <type>.recursive_self + ... Type applications + (do ! + [[funcC argsC] (<type>.applied (<>.and decoded (<>.many decoded)))] + (in (` ((~ funcC) (~+ argsC))))) + ... Polymorphism + (do ! + [[funcC varsC bodyC] (<type>.polymorphic decoded)] + (in (` (is (All ((~ g!_) (~+ varsC)) + (-> (~+ (list#each (|>> (~) </>.Parser (`)) varsC)) + (</>.Parser ((~ (poly.code *env* inputT)) (~+ varsC))))) + (function ((~ funcC) (~+ varsC)) + (~ bodyC)))))) + <type>.parameter + <type>.recursive_call + ... If all else fails... + (<>.failure (format "Cannot create JSON decoder for: " (type.format inputT))) + )))) (syntax: .public (codec [inputT <code>.any]) (in (.list (` (is (codec.Codec /.JSON (~ inputT)) diff --git a/stdlib/source/program/aedifex/artifact.lux b/stdlib/source/program/aedifex/artifact.lux index cc90d0b78..4d3d9cc87 100644 --- a/stdlib/source/program/aedifex/artifact.lux +++ b/stdlib/source/program/aedifex/artifact.lux @@ -33,11 +33,11 @@ (def: .public hash (Hash Artifact) - ($_ product.hash - text.hash - text.hash - text.hash - )) + (all product.hash + text.hash + text.hash + text.hash + )) (def: .public equivalence (Equivalence Artifact) diff --git a/stdlib/source/program/aedifex/artifact/snapshot.lux b/stdlib/source/program/aedifex/artifact/snapshot.lux index 8f06a3817..db9fa0891 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot.lux @@ -1,19 +1,19 @@ (.using - [library - [lux {"-" Type} - [abstract - [equivalence {"+" Equivalence}] - [monad {"+" do}]] - [control - ["<>" parser - ["<[0]>" xml {"+" Parser}] - ["<[0]>" text]]] - [data - ["[0]" sum] - [format - ["[0]" xml {"+" XML}]]]]] - ["[0]" / "_" - ["[1][0]" stamp {"+" Stamp}]]) + [library + [lux {"-" Type} + [abstract + [equivalence {"+" Equivalence}] + [monad {"+" do}]] + [control + ["<>" parser + ["<[0]>" xml {"+" Parser}] + ["<[0]>" text]]] + [data + ["[0]" sum] + [format + ["[0]" xml {"+" XML}]]]]] + ["[0]" / "_" + ["[1][0]" stamp {"+" Stamp}]]) (type: .public Snapshot (Variant @@ -28,10 +28,10 @@ (def: .public equivalence (Equivalence Snapshot) - ($_ sum.equivalence - ..any_equivalence - /stamp.equivalence - )) + (all sum.equivalence + ..any_equivalence + /stamp.equivalence + )) (template [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] diff --git a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux index f17f27680..55a3957a9 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/stamp.lux @@ -23,10 +23,10 @@ (def: .public equivalence (Equivalence Stamp) - ($_ product.equivalence - //time.equivalence - //build.equivalence - )) + (all product.equivalence + //time.equivalence + //build.equivalence + )) (def: <timestamp> xml.Tag diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version.lux b/stdlib/source/program/aedifex/artifact/snapshot/version.lux index 66923459c..e5053ed73 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/version.lux @@ -25,11 +25,11 @@ (def: .public equivalence (Equivalence Version) - ($_ product.equivalence - text.equivalence - text.equivalence - ///time.equivalence - )) + (all product.equivalence + text.equivalence + text.equivalence + ///time.equivalence + )) (template [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -60,9 +60,9 @@ (def: .public parser (Parser Version) (<| (<xml>.node ..<snapshot_version>) - ($_ <>.and - (<xml>.somewhere (..text ..<extension>)) - (<xml>.somewhere (..text ..<value>)) - (<xml>.somewhere (<text>.then ///time.parser - (..text ..<updated>))) - ))) + (all <>.and + (<xml>.somewhere (..text ..<extension>)) + (<xml>.somewhere (..text ..<value>)) + (<xml>.somewhere (<text>.then ///time.parser + (..text ..<updated>))) + ))) diff --git a/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux b/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux index 65d30acdf..63bed8532 100644 --- a/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux +++ b/stdlib/source/program/aedifex/artifact/snapshot/version/value.lux @@ -18,10 +18,10 @@ (def: .public equivalence (Equivalence Value) - ($_ product.equivalence - text.equivalence - ///.equivalence - )) + (all product.equivalence + text.equivalence + ///.equivalence + )) (def: separator "-") diff --git a/stdlib/source/program/aedifex/artifact/versioning.lux b/stdlib/source/program/aedifex/artifact/versioning.lux index 377e33a67..16789996f 100644 --- a/stdlib/source/program/aedifex/artifact/versioning.lux +++ b/stdlib/source/program/aedifex/artifact/versioning.lux @@ -42,11 +42,11 @@ (def: .public equivalence (Equivalence Versioning) - ($_ product.equivalence - //snapshot.equivalence - //time.equivalence - (list.equivalence //snapshot/version.equivalence) - )) + (all product.equivalence + //snapshot.equivalence + //time.equivalence + (list.equivalence //snapshot/version.equivalence) + )) (template [<definition> <tag>] [(def: <definition> xml.Tag ["" <tag>])] @@ -83,11 +83,11 @@ (def: .public parser (Parser Versioning) (<| (<xml>.node ..<versioning>) - ($_ <>.and - (<>.else {//snapshot.#Local} (<xml>.somewhere //snapshot.parser)) - (<>.else //time.epoch (<xml>.somewhere ..last_updated_parser)) - (<| (<>.else (list)) - <xml>.somewhere - (<xml>.node ..<snapshot_versions>) - (<>.some //snapshot/version.parser)) - ))) + (all <>.and + (<>.else {//snapshot.#Local} (<xml>.somewhere //snapshot.parser)) + (<>.else //time.epoch (<xml>.somewhere ..last_updated_parser)) + (<| (<>.else (list)) + <xml>.somewhere + (<xml>.node ..<snapshot_versions>) + (<>.some //snapshot/version.parser)) + ))) diff --git a/stdlib/source/program/aedifex/cli.lux b/stdlib/source/program/aedifex/cli.lux index 2bcf90338..135aa0c15 100644 --- a/stdlib/source/program/aedifex/cli.lux +++ b/stdlib/source/program/aedifex/cli.lux @@ -1,20 +1,20 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}] - [monad {"+" do}]] - [control - ["<>" parser - ["[0]" cli {"+" Parser}]]] - [data - ["[0]" sum] - ["[0]" product] - ["[0]" text]]]] - [// - [repository - [identity {"+" Identity}]] - ["/" profile {"+" Name}]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}] + [monad {"+" do}]] + [control + ["<>" parser + ["[0]" cli {"+" Parser}]]] + [data + ["[0]" sum] + ["[0]" product] + ["[0]" text]]]] + [// + [repository + [identity {"+" Identity}]] + ["/" profile {"+" Name}]]) (type: .public Compilation (Variant @@ -50,54 +50,54 @@ (def: .public equivalence (Equivalence Command) - ($_ sum.equivalence - ... #Version - ..any_equivalence - ... #Clean - ..any_equivalence - ... #POM - ..any_equivalence - ... #Dependencies - ..any_equivalence - ... #Install - ..any_equivalence - ... #Deploy - ($_ product.equivalence - text.equivalence - text.equivalence - text.equivalence) - ... #Compilation - ..compilation_equivalence - ... #Auto - ..compilation_equivalence)) + (all sum.equivalence + ... #Version + ..any_equivalence + ... #Clean + ..any_equivalence + ... #POM + ..any_equivalence + ... #Dependencies + ..any_equivalence + ... #Install + ..any_equivalence + ... #Deploy + (all product.equivalence + text.equivalence + text.equivalence + text.equivalence) + ... #Compilation + ..compilation_equivalence + ... #Auto + ..compilation_equivalence)) (def: command' (Parser Command) - ($_ <>.or - (cli.this "version") - (cli.this "clean") - (cli.this "pom") - (cli.this "deps") - (cli.this "install") - (<>.after (cli.this "deploy") - (<>.and cli.any - (<>.and cli.any - cli.any))) - ..compilation - (<>.after (cli.this "auto") - ..compilation) - )) + (all <>.or + (cli.this "version") + (cli.this "clean") + (cli.this "pom") + (cli.this "deps") + (cli.this "install") + (<>.after (cli.this "deploy") + (<>.and cli.any + (<>.and cli.any + cli.any))) + ..compilation + (<>.after (cli.this "auto") + ..compilation) + )) (def: .public command (Parser [(List Name) Command]) (<>.rec (function (_ command) - ($_ <>.either - (<>.after (cli.this "with") - (do <>.monad - [head cli.any - [tail command] command] - (in [{.#Item head tail} command]))) - (# <>.monad each (|>> [(list)]) - ..command') - )))) + (all <>.either + (<>.after (cli.this "with") + (do <>.monad + [head cli.any + [tail command] command] + (in [{.#Item head tail} command]))) + (# <>.monad each (|>> [(list)]) + ..command') + )))) diff --git a/stdlib/source/program/aedifex/dependency.lux b/stdlib/source/program/aedifex/dependency.lux index 4027354d9..edeccc15f 100644 --- a/stdlib/source/program/aedifex/dependency.lux +++ b/stdlib/source/program/aedifex/dependency.lux @@ -20,10 +20,10 @@ (def: .public hash (Hash Dependency) - ($_ product.hash - //.hash - text.hash - )) + (all product.hash + //.hash + text.hash + )) (def: .public equivalence (Equivalence Dependency) diff --git a/stdlib/source/program/aedifex/dependency/status.lux b/stdlib/source/program/aedifex/dependency/status.lux index bab454ea6..7c66d0688 100644 --- a/stdlib/source/program/aedifex/dependency/status.lux +++ b/stdlib/source/program/aedifex/dependency/status.lux @@ -1,14 +1,14 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}]] - [data - [binary {"+" Binary}] - ["[0]" sum] - ["[0]" product]]]] - ["[0]" /// "_" - ["[1][0]" hash {"+" Hash SHA-1 MD5}]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}]] + [data + [binary {"+" Binary}] + ["[0]" sum] + ["[0]" product]]]] + ["[0]" /// "_" + ["[1][0]" hash {"+" Hash SHA-1 MD5}]]) (type: .public Status (Variant @@ -25,15 +25,15 @@ (def: .public equivalence (Equivalence Status) - ($_ sum.equivalence - ..any_equivalence - ($_ sum.equivalence - ///hash.equivalence - ///hash.equivalence) - ($_ product.equivalence - ///hash.equivalence - ///hash.equivalence) - )) + (all sum.equivalence + ..any_equivalence + (all sum.equivalence + ///hash.equivalence + ///hash.equivalence) + (all product.equivalence + ///hash.equivalence + ///hash.equivalence) + )) (def: .public (verified payload) (-> Binary Status) diff --git a/stdlib/source/program/aedifex/metadata/artifact.lux b/stdlib/source/program/aedifex/metadata/artifact.lux index b5aef41de..285e1c980 100644 --- a/stdlib/source/program/aedifex/metadata/artifact.lux +++ b/stdlib/source/program/aedifex/metadata/artifact.lux @@ -145,27 +145,27 @@ (def: .public parser (Parser Metadata) (<| (<xml>.node ..<metadata>) - ($_ <>.and - (<xml>.somewhere (..text ..<group>)) - (<xml>.somewhere (..text ..<name>)) - (<| (<xml>.node ..<versioning>) - ... Handle any ignorable tag. - (<>.before (<>.some <xml>.any)) - ($_ <>.and - (<| <xml>.somewhere - (<xml>.node ..<versions>) - (<>.many (..text ..<version>))) - (<xml>.somewhere ..last_updated_parser) - ))))) + (all <>.and + (<xml>.somewhere (..text ..<group>)) + (<xml>.somewhere (..text ..<name>)) + (<| (<xml>.node ..<versioning>) + ... Handle any ignorable tag. + (<>.before (<>.some <xml>.any)) + (all <>.and + (<| <xml>.somewhere + (<xml>.node ..<versions>) + (<>.many (..text ..<version>))) + (<xml>.somewhere ..last_updated_parser) + ))))) (def: .public equivalence (Equivalence Metadata) - ($_ product.equivalence - text.equivalence - text.equivalence - (list.equivalence text.equivalence) - instant.equivalence - )) + (all product.equivalence + text.equivalence + text.equivalence + (list.equivalence text.equivalence) + instant.equivalence + )) (def: .public uri (-> Artifact URI) diff --git a/stdlib/source/program/aedifex/metadata/snapshot.lux b/stdlib/source/program/aedifex/metadata/snapshot.lux index a6552ee00..1a4c73059 100644 --- a/stdlib/source/program/aedifex/metadata/snapshot.lux +++ b/stdlib/source/program/aedifex/metadata/snapshot.lux @@ -115,10 +115,10 @@ (def: .public equivalence (Equivalence Metadata) - ($_ product.equivalence - ///artifact.equivalence - ///artifact/versioning.equivalence - )) + (all product.equivalence + ///artifact.equivalence + ///artifact/versioning.equivalence + )) (def: .public uri (-> Artifact URI) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index fa0fb33af..2f2a4a157 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -78,13 +78,13 @@ (def: .public equivalence (Equivalence Package) - ($_ product.equivalence - //origin.equivalence - ($_ product.equivalence - binary.equivalence - //status.equivalence) - ($_ product.equivalence - xml.equivalence - binary.equivalence - //status.equivalence) - )) + (all product.equivalence + //origin.equivalence + (all product.equivalence + binary.equivalence + //status.equivalence) + (all product.equivalence + xml.equivalence + binary.equivalence + //status.equivalence) + )) diff --git a/stdlib/source/program/aedifex/parser.lux b/stdlib/source/program/aedifex/parser.lux index 09ae15ed5..5cc914193 100644 --- a/stdlib/source/program/aedifex/parser.lux +++ b/stdlib/source/program/aedifex/parser.lux @@ -58,7 +58,7 @@ (def: artifact' (Parser //artifact.Artifact) - ($_ <>.and ..group ..name ..version)) + (all <>.and ..group ..name ..version)) (def: artifact (Parser //artifact.Artifact) @@ -83,13 +83,13 @@ (dictionary.of_list text.hash) (<code>.tuple (<>.some (<>.and <code>.text <code>.any))))] - ($_ <>.and - (..singular input "name" ..name) - (..singular input "url" ..url) - (<>.else {/.#Repo} - (..singular input "type" - (<>.or (<code>.this (' "repo")) - (<code>.this (' "manual")))))))) + (all <>.and + (..singular input "name" ..name) + (..singular input "url" ..url) + (<>.else {/.#Repo} + (..singular input "type" + (<>.or (<code>.this (' "repo")) + (<code>.this (' "manual")))))))) (def: organization (Parser /.Organization) @@ -98,9 +98,9 @@ (dictionary.of_list text.hash) (<code>.tuple (<>.some (<>.and <code>.text <code>.any))))] - ($_ <>.and - (..singular input "name" ..name) - (..singular input "url" ..url)))) + (all <>.and + (..singular input "name" ..name) + (..singular input "url" ..url)))) (def: developer (Parser /.Developer) @@ -109,11 +109,11 @@ (dictionary.of_list text.hash) (<code>.tuple (<>.some (<>.and <code>.text <code>.any))))] - ($_ <>.and - (..singular input "name" ..name) - (..singular input "url" ..url) - (<>.maybe (..singular input "organization" ..organization)) - ))) + (all <>.and + (..singular input "name" ..name) + (..singular input "url" ..url) + (<>.maybe (..singular input "organization" ..organization)) + ))) (def: contributor (Parser /.Contributor) @@ -126,16 +126,16 @@ (dictionary.of_list text.hash) (<code>.tuple (<>.some (<>.and <code>.text <code>.any))))] - ($_ <>.and - (<>.maybe (..singular input "name" ..name)) - (<>.maybe (..singular input "url" ..url)) - (<>.maybe (..singular input "scm" ..scm)) - (<>.maybe (..singular input "description" ..description)) - (<>.else (list) (..plural input "licenses" ..license)) - (<>.maybe (..singular input "organization" ..organization)) - (<>.else (list) (..plural input "developers" ..developer)) - (<>.else (list) (..plural input "contributors" ..contributor)) - ))) + (all <>.and + (<>.maybe (..singular input "name" ..name)) + (<>.maybe (..singular input "url" ..url)) + (<>.maybe (..singular input "scm" ..scm)) + (<>.maybe (..singular input "description" ..description)) + (<>.else (list) (..plural input "licenses" ..license)) + (<>.maybe (..singular input "organization" ..organization)) + (<>.else (list) (..plural input "developers" ..developer)) + (<>.else (list) (..plural input "contributors" ..contributor)) + ))) (def: repository (Parser //repository.Address) @@ -148,18 +148,18 @@ (def: dependency (Parser //dependency.Dependency) (<code>.tuple - ($_ <>.and - ..artifact' - (<>.else //artifact/type.lux_library ..type) - ))) + (all <>.and + ..artifact' + (<>.else //artifact/type.lux_library ..type) + ))) (def: compiler (Parser Compiler) (<code>.tuple - ($_ <>.and - <code>.global - (<>.some <code>.text) - ))) + (all <>.and + <code>.global + (<>.some <code>.text) + ))) (def: source (Parser /.Source) @@ -188,10 +188,10 @@ (let [environment (<>#each (dictionary.of_list text.hash) (<>.some (<code>.tuple (<>.and <code>.text <code>.text))))] (<code>.tuple - ($_ <>.and - environment - <code>.text - (<>.some <code>.text))))) + (all <>.and + environment + <code>.text + (<>.some <code>.text))))) (def: profile (Parser /.Profile) @@ -260,26 +260,26 @@ ^ruby (|> ..runtime (..singular input "ruby") (<>.else //runtime.default_ruby))]] - ($_ <>.and - ^parents - ^identity - ^info - ^repositories - ^dependencies - ^lux - ^compilers - ^sources - ^target - ^program - ^test - ^deploy_repositories - ^configuration - ^java - ^js - ^python - ^lua - ^ruby - ))) + (all <>.and + ^parents + ^identity + ^info + ^repositories + ^dependencies + ^lux + ^compilers + ^sources + ^target + ^program + ^test + ^deploy_repositories + ^configuration + ^java + ^js + ^python + ^lua + ^ruby + ))) (def: .public project (Parser Project) diff --git a/stdlib/source/program/aedifex/pom.lux b/stdlib/source/program/aedifex/pom.lux index 683e1bb6d..2fe4c6de1 100644 --- a/stdlib/source/program/aedifex/pom.lux +++ b/stdlib/source/program/aedifex/pom.lux @@ -128,16 +128,16 @@ (def: (info value) (-> /.Info (List XML)) - ($_ list#composite - (|> value (the /.#name) (maybe#each (..property "name")) maybe.list) - (|> value (the /.#url) (maybe#each (..property ..url_tag)) maybe.list) - (|> value (the /.#description) (maybe#each (..property "description")) maybe.list) - (|> value (the /.#licenses) (list#each ..license) (..group "licenses") list) - (|> value (the /.#scm) (maybe#each ..scm) maybe.list) - (|> value (the /.#organization) (maybe#each ..organization) maybe.list) - (|> value (the /.#developers) (list#each ..developer) (..group "developers") list) - (|> value (the /.#contributors) (list#each ..contributor) (..group "contributors") list) - )) + (all list#composite + (|> value (the /.#name) (maybe#each (..property "name")) maybe.list) + (|> value (the /.#url) (maybe#each (..property ..url_tag)) maybe.list) + (|> value (the /.#description) (maybe#each (..property "description")) maybe.list) + (|> value (the /.#licenses) (list#each ..license) (..group "licenses") list) + (|> value (the /.#scm) (maybe#each ..scm) maybe.list) + (|> value (the /.#organization) (maybe#each ..organization) maybe.list) + (|> value (the /.#developers) (list#each ..developer) (..group "developers") list) + (|> value (the /.#contributors) (list#each ..contributor) (..group "contributors") list) + )) (def: .public (write value) (-> /.Profile (Try XML)) @@ -145,16 +145,16 @@ {.#Some identity} {try.#Success {_.#Node ["" ..project_tag] _.attributes - ($_ list#composite - (list ..version) - (..artifact identity) - (|> value - (the /.#info) - (maybe#each ..info) - (maybe.else (list))) - (|> value (the /.#repositories) set.list (list#each ..repository) (..group "repositories") list) - (|> value (the /.#dependencies) set.list (list#each ..dependency) (..group ..dependencies_tag) list) - )}} + (all list#composite + (list ..version) + (..artifact identity) + (|> value + (the /.#info) + (maybe#each ..info) + (maybe.else (list))) + (|> value (the /.#repositories) set.list (list#each ..repository) (..group "repositories") list) + (|> value (the /.#dependencies) set.list (list#each ..dependency) (..group ..dependencies_tag) list) + )}} _ (exception.except /.no_identity []))) diff --git a/stdlib/source/program/aedifex/profile.lux b/stdlib/source/program/aedifex/profile.lux index 39f788b4b..0c772a641 100644 --- a/stdlib/source/program/aedifex/profile.lux +++ b/stdlib/source/program/aedifex/profile.lux @@ -70,10 +70,10 @@ (def: license_equivalence (Equivalence License) - ($_ product.equivalence - text.equivalence - text.equivalence - ..distribution_equivalence)) + (all product.equivalence + text.equivalence + text.equivalence + ..distribution_equivalence)) (type: .public SCM URL) @@ -84,9 +84,9 @@ (def: organization_equivalence (Equivalence Organization) - ($_ product.equivalence - text.equivalence - text.equivalence)) + (all product.equivalence + text.equivalence + text.equivalence)) (type: .public Email Text) @@ -98,10 +98,10 @@ (def: developer_equivalence (Equivalence Developer) - ($_ product.equivalence - text.equivalence - text.equivalence - (maybe.equivalence ..organization_equivalence))) + (all product.equivalence + text.equivalence + text.equivalence + (maybe.equivalence ..organization_equivalence))) (type: .public Contributor Developer) @@ -119,15 +119,15 @@ (def: info_equivalence (Equivalence Info) - ($_ product.equivalence - (maybe.equivalence text.equivalence) - (maybe.equivalence text.equivalence) - (maybe.equivalence text.equivalence) - (maybe.equivalence text.equivalence) - (list.equivalence ..license_equivalence) - (maybe.equivalence ..organization_equivalence) - (list.equivalence ..developer_equivalence) - (list.equivalence ..developer_equivalence))) + (all product.equivalence + (maybe.equivalence text.equivalence) + (maybe.equivalence text.equivalence) + (maybe.equivalence text.equivalence) + (maybe.equivalence text.equivalence) + (list.equivalence ..license_equivalence) + (maybe.equivalence ..organization_equivalence) + (list.equivalence ..developer_equivalence) + (list.equivalence ..developer_equivalence))) (def: .public default_info Info @@ -188,43 +188,43 @@ (def: .public equivalence (Equivalence Profile) - ($_ product.equivalence - ... #parents - (list.equivalence text.equivalence) - ... #identity - (maybe.equivalence artifact.equivalence) - ... #info - (maybe.equivalence ..info_equivalence) - ... #repositories - set.equivalence - ... #dependencies - set.equivalence - ... #lux - dependency.equivalence - ... #compilers - (list.equivalence compiler.equivalence) - ... #sources - set.equivalence - ... #target - text.equivalence - ... #program - (maybe.equivalence text.equivalence) - ... #test - (maybe.equivalence text.equivalence) - ... #deploy_repositories - (dictionary.equivalence text.equivalence) - ... #configuration - (plist.equivalence text.equivalence) - ... #java - runtime.equivalence - ... #js - runtime.equivalence - ... #python - runtime.equivalence - ... #lua - runtime.equivalence - ... #ruby - runtime.equivalence)) + (all product.equivalence + ... #parents + (list.equivalence text.equivalence) + ... #identity + (maybe.equivalence artifact.equivalence) + ... #info + (maybe.equivalence ..info_equivalence) + ... #repositories + set.equivalence + ... #dependencies + set.equivalence + ... #lux + dependency.equivalence + ... #compilers + (list.equivalence compiler.equivalence) + ... #sources + set.equivalence + ... #target + text.equivalence + ... #program + (maybe.equivalence text.equivalence) + ... #test + (maybe.equivalence text.equivalence) + ... #deploy_repositories + (dictionary.equivalence text.equivalence) + ... #configuration + (plist.equivalence text.equivalence) + ... #java + runtime.equivalence + ... #js + runtime.equivalence + ... #python + runtime.equivalence + ... #lua + runtime.equivalence + ... #ruby + runtime.equivalence)) (implementation: .public monoid (Monoid Profile) diff --git a/stdlib/source/program/aedifex/repository/identity.lux b/stdlib/source/program/aedifex/repository/identity.lux index 6ab4e380d..88664a868 100644 --- a/stdlib/source/program/aedifex/repository/identity.lux +++ b/stdlib/source/program/aedifex/repository/identity.lux @@ -24,10 +24,10 @@ (def: .public equivalence (Equivalence Identity) - ($_ product.equivalence - text.equivalence - text.equivalence - )) + (all product.equivalence + text.equivalence + text.equivalence + )) (import: java/util/Base64$Encoder "[1]::[0]" diff --git a/stdlib/source/program/aedifex/repository/origin.lux b/stdlib/source/program/aedifex/repository/origin.lux index d0b5b3436..624ef1e10 100644 --- a/stdlib/source/program/aedifex/repository/origin.lux +++ b/stdlib/source/program/aedifex/repository/origin.lux @@ -1,14 +1,14 @@ (.using - [library - [lux "*" - [abstract - [equivalence {"+" Equivalence}]] - [data - ["[0]" sum] - ["[0]" text]] - [world - [file {"+" Path}] - [net {"+" URL}]]]]) + [library + [lux "*" + [abstract + [equivalence {"+" Equivalence}]] + [data + ["[0]" sum] + ["[0]" text]] + [world + [file {"+" Path}] + [net {"+" URL}]]]]) (type: .public Origin (Variant @@ -17,7 +17,7 @@ (def: .public equivalence (Equivalence Origin) - ($_ sum.equivalence - text.equivalence - text.equivalence - )) + (all sum.equivalence + text.equivalence + text.equivalence + )) diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux index f03c80ba1..9657affdc 100644 --- a/stdlib/source/program/aedifex/runtime.lux +++ b/stdlib/source/program/aedifex/runtime.lux @@ -23,11 +23,11 @@ (def: .public equivalence (Equivalence Runtime) - ($_ product.equivalence - (dictionary.equivalence text.equivalence) - text.equivalence - (list.equivalence text.equivalence) - )) + (all product.equivalence + (dictionary.equivalence text.equivalence) + text.equivalence + (list.equivalence text.equivalence) + )) (template [<name> <command> <environment> <parameters>] [(def: .public <name> diff --git a/stdlib/source/specification/aedifex/repository.lux b/stdlib/source/specification/aedifex/repository.lux index 9e22c1ac4..3d4fdd69e 100644 --- a/stdlib/source/specification/aedifex/repository.lux +++ b/stdlib/source/specification/aedifex/repository.lux @@ -27,31 +27,31 @@ (-> Artifact Artifact (/.Repository Async) Test) (do random.monad [expected (_binary.random 100)] - (in ($_ _.and' - (do async.monad - [.let [good_uri (/remote.uri (the //artifact.#version valid_artifact) valid_artifact //artifact/extension.lux_library)] - good_upload! (# subject upload good_uri expected) - good_download! (# subject download good_uri) + (in (all _.and' + (do async.monad + [.let [good_uri (/remote.uri (the //artifact.#version valid_artifact) valid_artifact //artifact/extension.lux_library)] + good_upload! (# subject upload good_uri expected) + good_download! (# subject download good_uri) - .let [bad_uri (/remote.uri (the //artifact.#version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] - bad_upload! (# subject upload bad_uri expected) - bad_download! (# subject download bad_uri)] - (_.cover' [/.Repository] - (let [successfull_flow! - (case [good_upload! good_download!] - [{try.#Success _} {try.#Success actual}] - (# binary.equivalence = expected actual) + .let [bad_uri (/remote.uri (the //artifact.#version invalid_artifact) invalid_artifact //artifact/extension.lux_library)] + bad_upload! (# subject upload bad_uri expected) + bad_download! (# subject download bad_uri)] + (_.cover' [/.Repository] + (let [successfull_flow! + (case [good_upload! good_download!] + [{try.#Success _} {try.#Success actual}] + (# binary.equivalence = expected actual) - _ - false) + _ + false) - failed_flow! - (case [bad_upload! bad_download!] - [{try.#Failure _} {try.#Failure _}] - true + failed_flow! + (case [bad_upload! bad_download!] + [{try.#Failure _} {try.#Failure _}] + true - _ - false)] - (and successfull_flow! - failed_flow!)))) - )))) + _ + false)] + (and successfull_flow! + failed_flow!)))) + )))) diff --git a/stdlib/source/specification/compositor.lux b/stdlib/source/specification/compositor.lux index f2af26161..ebf509498 100644 --- a/stdlib/source/specification/compositor.lux +++ b/stdlib/source/specification/compositor.lux @@ -31,15 +31,15 @@ (def: (test runner definer state expander) (-> Runner Definer analysis.State+ Expander Test) - ($_ _.and - (/analysis/type.spec expander state) - (/generation/primitive.spec runner) - (/generation/structure.spec runner) - (/generation/reference.spec runner definer) - (/generation/case.spec runner) - (/generation/function.spec runner) - (/generation/common.spec runner) - )) + (all _.and + (/analysis/type.spec expander state) + (/generation/primitive.spec runner) + (/generation/structure.spec runner) + (/generation/reference.spec runner definer) + (/generation/case.spec runner) + (/generation/function.spec runner) + (/generation/common.spec runner) + )) (def: .public (spec platform bundle expander program) (All (_ anchor expression directive) diff --git a/stdlib/source/specification/compositor/analysis/type.lux b/stdlib/source/specification/compositor/analysis/type.lux index c51f0cced..b84e18888 100644 --- a/stdlib/source/specification/compositor/analysis/type.lux +++ b/stdlib/source/specification/compositor/analysis/type.lux @@ -35,30 +35,30 @@ (def: check (Random [Code Type Code]) - (`` ($_ r.either - (~~ (template [<random> <type> <code>] - [(do r.monad - [value <random>] - (in [(` <type>) - <type> - (<code> value)]))] + (`` (all r.either + (~~ (template [<random> <type> <code>] + [(do r.monad + [value <random>] + (in [(` <type>) + <type> + (<code> value)]))] - [r.bit {0 #0 "#Bit" {0 #0}} code.bit] - [r.nat {0 #0 "#I64" {0 #1 {0 #0 "#Nat" {0 #0}} {0 #0}}} code.nat] - [r.int {0 #0 "#I64" {0 #1 {0 #0 "#Int" {0 #0}} {0 #0}}} code.int] - [r.rev {0 #0 "#I64" {0 #1 {0 #0 "#Rev" {0 #0}} {0 #0}}} code.rev] - [r.safe_frac {0 #0 "#Frac" {0 #0}} code.frac] - [(r.ascii/upper_alpha 5) {0 #0 "#Text" {0 #0}} code.text] - ))))) + [r.bit {0 #0 "#Bit" {0 #0}} code.bit] + [r.nat {0 #0 "#I64" {0 #1 {0 #0 "#Nat" {0 #0}} {0 #0}}} code.nat] + [r.int {0 #0 "#I64" {0 #1 {0 #0 "#Int" {0 #0}} {0 #0}}} code.int] + [r.rev {0 #0 "#I64" {0 #1 {0 #0 "#Rev" {0 #0}} {0 #0}}} code.rev] + [r.safe_frac {0 #0 "#Frac" {0 #0}} code.frac] + [(r.ascii/upper_alpha 5) {0 #0 "#Text" {0 #0}} code.text] + ))))) (def: .public (spec expander state) (-> Expander State+ Test) (do r.monad [[typeC exprT exprC] ..check [other_typeC other_exprT other_exprC] ..check] - ($_ _.and - (_.test "lux check" - (check_success+ expander state "lux check" (list typeC exprC) exprT)) - (_.test "lux coerce" - (check_success+ expander state "lux coerce" (list typeC other_exprC) exprT)) - ))) + (all _.and + (_.test "lux check" + (check_success+ expander state "lux check" (list typeC exprC) exprT)) + (_.test "lux coerce" + (check_success+ expander state "lux coerce" (list typeC other_exprC) exprT)) + ))) diff --git a/stdlib/source/specification/compositor/generation/case.lux b/stdlib/source/specification/compositor/generation/case.lux index 80faa246f..12fa81a14 100644 --- a/stdlib/source/specification/compositor/generation/case.lux +++ b/stdlib/source/specification/compositor/generation/case.lux @@ -50,52 +50,52 @@ (def: case (Random [Synthesis Path]) (<| r.rec (function (_ case)) - (`` ($_ r.either - (do r.monad - [value r.i64] - (in [(synthesis.i64 value) - synthesis.path/pop])) - (~~ (template [<gen> <synth> <path>] - [(do r.monad - [value <gen>] - (in [(<synth> value) - (<path> value)]))] + (`` (all r.either + (do r.monad + [value r.i64] + (in [(synthesis.i64 value) + synthesis.path/pop])) + (~~ (template [<gen> <synth> <path>] + [(do r.monad + [value <gen>] + (in [(<synth> value) + (<path> value)]))] - [r.bit synthesis.bit synthesis.path/bit] - [r.i64 synthesis.i64 synthesis.path/i64] - [r.frac synthesis.f64 synthesis.path/f64] - [(r.unicode 5) synthesis.text synthesis.path/text])) - (do [! r.monad] - [size ..size - idx (|> r.nat (# ! each (n.% size))) - [subS subP] case - .let [unitS (synthesis.text synthesis.unit) - caseS (synthesis.tuple - (list.together (list (list.repeated idx unitS) - (list subS) - (list.repeated (|> size -- (n.- idx)) unitS)))) - caseP ($_ synthesis.path/seq - (if (tail? size idx) - (synthesis.member/right idx) - (synthesis.member/left idx)) - subP)]] - (in [caseS caseP])) - (do [! r.monad] - [size ..size - idx (|> r.nat (# ! each (n.% size))) - [subS subP] case - .let [right? (tail? size idx) - caseS (synthesis.variant - [analysis.#lefts idx - analysis.#right? right? - analysis.#value subS]) - caseP ($_ synthesis.path/seq - (if right? - (synthesis.side/right idx) - (synthesis.side/left idx)) - subP)]] - (in [caseS caseP])) - )))) + [r.bit synthesis.bit synthesis.path/bit] + [r.i64 synthesis.i64 synthesis.path/i64] + [r.frac synthesis.f64 synthesis.path/f64] + [(r.unicode 5) synthesis.text synthesis.path/text])) + (do [! r.monad] + [size ..size + idx (|> r.nat (# ! each (n.% size))) + [subS subP] case + .let [unitS (synthesis.text synthesis.unit) + caseS (synthesis.tuple + (list.together (list (list.repeated idx unitS) + (list subS) + (list.repeated (|> size -- (n.- idx)) unitS)))) + caseP (all synthesis.path/seq + (if (tail? size idx) + (synthesis.member/right idx) + (synthesis.member/left idx)) + subP)]] + (in [caseS caseP])) + (do [! r.monad] + [size ..size + idx (|> r.nat (# ! each (n.% size))) + [subS subP] case + .let [right? (tail? size idx) + caseS (synthesis.variant + [analysis.#lefts idx + analysis.#right? right? + analysis.#value subS]) + caseP (all synthesis.path/seq + (if right? + (synthesis.side/right idx) + (synthesis.side/left idx)) + subP)]] + (in [caseS caseP])) + )))) (def: (let_spec run) (-> Runner Test) @@ -130,11 +130,11 @@ (_.test (%.symbol (symbol synthesis.branch/case)) (|> (synthesis.branch/case [inputS - ($_ synthesis.path/alt - ($_ synthesis.path/seq - pathS - (synthesis.path/then (synthesis.f64 on_success))) - (synthesis.path/then (synthesis.f64 on_failure)))]) + (all synthesis.path/alt + (all synthesis.path/seq + pathS + (synthesis.path/then (synthesis.f64 on_success))) + (synthesis.path/then (synthesis.f64 on_failure)))]) (run "case_spec") (verify on_success))))) @@ -189,24 +189,24 @@ _head_ (synthesis.path/member {.#Left 0}) _tail_ (synthesis.path/member {.#Right 0}) _tuple_ (synthesis.path/side {.#Left 9})] - ($_ synthesis.path/alt - ($_ synthesis.path/seq - _item_ - _head_ - _head_ (synthesis.path/bind 2) synthesis.path/pop - _tail_ _tuple_ _item_ - _head_ (synthesis.path/bind 3) synthesis.path/pop - _tail_ (synthesis.path/bind 4) synthesis.path/pop - synthesis.path/pop synthesis.path/pop synthesis.path/pop synthesis.path/pop - _tail_ _item_ - _head_ (synthesis.path/bind 5) synthesis.path/pop - _tail_ _end_ - ... THEN - (synthesis.path/then (synthesis.bit #1))) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ... THEN - (synthesis.path/then (synthesis.bit #0)))))) + (all synthesis.path/alt + (all synthesis.path/seq + _item_ + _head_ + _head_ (synthesis.path/bind 2) synthesis.path/pop + _tail_ _tuple_ _item_ + _head_ (synthesis.path/bind 3) synthesis.path/pop + _tail_ (synthesis.path/bind 4) synthesis.path/pop + synthesis.path/pop synthesis.path/pop synthesis.path/pop synthesis.path/pop + _tail_ _item_ + _head_ (synthesis.path/bind 5) synthesis.path/pop + _tail_ _end_ + ... THEN + (synthesis.path/then (synthesis.bit #1))) + (all synthesis.path/seq + (synthesis.path/bind 2) + ... THEN + (synthesis.path/then (synthesis.bit #0)))))) (def: special_pattern analysis.Pattern @@ -227,62 +227,62 @@ (def: special_pattern_path Path - ($_ synthesis.path/alt - (<| try.trusted - (phase.result [extension/synthesis.bundle - synthesis.init]) - (case.path phase/synthesis.phase - special_pattern) - (analysis.bit #1)) - ($_ synthesis.path/seq - (synthesis.path/bind 2) - ... THEN - (synthesis.path/then (synthesis.bit #0))))) + (all synthesis.path/alt + (<| try.trusted + (phase.result [extension/synthesis.bundle + synthesis.init]) + (case.path phase/synthesis.phase + special_pattern) + (analysis.bit #1)) + (all synthesis.path/seq + (synthesis.path/bind 2) + ... THEN + (synthesis.path/then (synthesis.bit #0))))) ... TODO: Get rid of this ASAP (def: (special_spec run) (-> Runner Test) - ($_ _.and - (_.test "===" - (and (text#= (synthesis.%path special_path) - (synthesis.%path special_pattern_path)) - (# synthesis.path_equivalence = special_path special_pattern_path))) - (_.test "CODE" - (|> special_input - (run "special_input") - (pipe.case - {try.#Success output} - true - - {try.#Failure _} - false))) - (_.test "PATTERN_MATCHING 0" - (|> (synthesis.branch/case [special_input - special_path]) - (run "special_path") - (pipe.case - {try.#Success output} - true - - {try.#Failure _} - false))) - (_.test "PATTERN_MATCHING 1" - (|> (synthesis.branch/case [special_input - special_pattern_path]) - (run "special_pattern_path") - (pipe.case - {try.#Success output} - true - - {try.#Failure _} - false))) - )) + (all _.and + (_.test "===" + (and (text#= (synthesis.%path special_path) + (synthesis.%path special_pattern_path)) + (# synthesis.path_equivalence = special_path special_pattern_path))) + (_.test "CODE" + (|> special_input + (run "special_input") + (pipe.case + {try.#Success output} + true + + {try.#Failure _} + false))) + (_.test "PATTERN_MATCHING 0" + (|> (synthesis.branch/case [special_input + special_path]) + (run "special_path") + (pipe.case + {try.#Success output} + true + + {try.#Failure _} + false))) + (_.test "PATTERN_MATCHING 1" + (|> (synthesis.branch/case [special_input + special_pattern_path]) + (run "special_pattern_path") + (pipe.case + {try.#Success output} + true + + {try.#Failure _} + false))) + )) (def: .public (spec run) (-> Runner Test) - ($_ _.and - (..special_spec run) - (..let_spec run) - (..if_spec run) - (..case_spec run) - )) + (all _.and + (..special_spec run) + (..let_spec run) + (..if_spec run) + (..case_spec run) + )) diff --git a/stdlib/source/specification/compositor/generation/common.lux b/stdlib/source/specification/compositor/generation/common.lux index dc2bf6ec7..599dae209 100644 --- a/stdlib/source/specification/compositor/generation/common.lux +++ b/stdlib/source/specification/compositor/generation/common.lux @@ -58,69 +58,69 @@ ["lux i64 left-shift" i64.left_shifted (n.% 64 param)] ["lux i64 logical-right-shift" i64.logic_right_shifted (n.% 64 param)] )] - ($_ _.and - <binary> - (_.test "lux i64 arithmetic-right-shift" - (|> {synthesis.#Extension "lux i64 arithmetic-right-shift" - (list (synthesis.i64 subject) - (synthesis.i64 param))} - (run (..safe "lux i64 arithmetic-right-shift")) - (pipe.case - {try.#Success valueT} - ("lux i64 =" - (i64.arithmetic_right_shifted param subject) - (as I64 valueT)) - - {try.#Failure _} - false) - (let [param (n.% 64 param)]))) - )))) + (all _.and + <binary> + (_.test "lux i64 arithmetic-right-shift" + (|> {synthesis.#Extension "lux i64 arithmetic-right-shift" + (list (synthesis.i64 subject) + (synthesis.i64 param))} + (run (..safe "lux i64 arithmetic-right-shift")) + (pipe.case + {try.#Success valueT} + ("lux i64 =" + (i64.arithmetic_right_shifted param subject) + (as I64 valueT)) + + {try.#Failure _} + false) + (let [param (n.% 64 param)]))) + )))) (def: (i64 run) (-> Runner Test) (do r.monad [param (|> r.i64 (r.only (|>> ("lux i64 =" 0) not))) subject r.i64] - (`` ($_ _.and - (~~ (template [<extension> <type> <prepare> <comp> <subject_expr>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.case - {try.#Success valueT} - (<comp> (<prepare> subject) (as <type> valueT)) - - {try.#Failure _} - false) - (let [subject <subject_expr>])))] - - ["lux i64 f64" Frac i.frac f.= subject] - ["lux i64 char" Text (|>> (as Nat) text.from_code) text#= (|> subject - (as Nat) - (n.% (i64.left_shifted 8 1)) - (as Int))] - )) - (~~ (template [<extension> <reference> <outputT> <comp>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.i64 param) - (synthesis.i64 subject))} - (run (..safe <extension>)) - (pipe.case - {try.#Success valueT} - (<comp> (<reference> param subject) (as <outputT> valueT)) - - {try.#Failure _} - false)))] - - ["lux i64 +" i.+ Int i.=] - ["lux i64 -" i.- Int i.=] - ["lux i64 *" i.* Int i.=] - ["lux i64 /" i./ Int i.=] - ["lux i64 %" i.% Int i.=] - ["lux i64 =" i.= Bit bit#=] - ["lux i64 <" i.< Bit bit#=] - )) - )))) + (`` (all _.and + (~~ (template [<extension> <type> <prepare> <comp> <subject_expr>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.i64 subject))} + (run (..safe <extension>)) + (pipe.case + {try.#Success valueT} + (<comp> (<prepare> subject) (as <type> valueT)) + + {try.#Failure _} + false) + (let [subject <subject_expr>])))] + + ["lux i64 f64" Frac i.frac f.= subject] + ["lux i64 char" Text (|>> (as Nat) text.from_code) text#= (|> subject + (as Nat) + (n.% (i64.left_shifted 8 1)) + (as Int))] + )) + (~~ (template [<extension> <reference> <outputT> <comp>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.i64 param) + (synthesis.i64 subject))} + (run (..safe <extension>)) + (pipe.case + {try.#Success valueT} + (<comp> (<reference> param subject) (as <outputT> valueT)) + + {try.#Failure _} + false)))] + + ["lux i64 +" i.+ Int i.=] + ["lux i64 -" i.- Int i.=] + ["lux i64 *" i.* Int i.=] + ["lux i64 /" i./ Int i.=] + ["lux i64 %" i.% Int i.=] + ["lux i64 =" i.= Bit bit#=] + ["lux i64 <" i.< Bit bit#=] + )) + )))) (def: simple_frac (Random Frac) @@ -131,53 +131,53 @@ (do r.monad [param (|> ..simple_frac (r.only (|>> (f.= +0.0) not))) subject ..simple_frac] - (`` ($_ _.and - (~~ (template [<extension> <reference> <comp>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) - (synthesis.f64 subject))} - (run (..safe <extension>)) - (//case.verify (<reference> param subject))))] - - ["lux f64 +" f.+ f.=] - ["lux f64 -" f.- f.=] - ["lux f64 *" f.* f.=] - ["lux f64 /" f./ f.=] - ["lux f64 %" f.% f.=] - )) - (~~ (template [<extension> <text>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) - (synthesis.f64 subject))} - (run (..safe <extension>)) - (pipe.case - {try.#Success valueV} - (bit#= (<text> param subject) - (as Bit valueV)) - - _ - false)))] - - ["lux f64 =" f.=] - ["lux f64 <" f.<] - )) - (~~ (template [<extension> <reference>] - [(_.test <extension> - (|> {synthesis.#Extension <extension> (list)} - (run (..safe <extension>)) - (//case.verify <reference>)))] - - ["lux f64 min" ("lux f64 min")] - ["lux f64 max" ("lux f64 max")] - ["lux f64 smallest" ("lux f64 smallest")] - )) - (_.test "'lux f64 i64 && 'lux i64 f64'" - (|> (run (..safe "lux f64 i64") - (|> subject synthesis.f64 - (list) {synthesis.#Extension "lux f64 i64"} - (list) {synthesis.#Extension "lux i64 f64"})) - (//case.verify subject))) - )))) + (`` (all _.and + (~~ (template [<extension> <reference> <comp>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) + (synthesis.f64 subject))} + (run (..safe <extension>)) + (//case.verify (<reference> param subject))))] + + ["lux f64 +" f.+ f.=] + ["lux f64 -" f.- f.=] + ["lux f64 *" f.* f.=] + ["lux f64 /" f./ f.=] + ["lux f64 %" f.% f.=] + )) + (~~ (template [<extension> <text>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list (synthesis.f64 param) + (synthesis.f64 subject))} + (run (..safe <extension>)) + (pipe.case + {try.#Success valueV} + (bit#= (<text> param subject) + (as Bit valueV)) + + _ + false)))] + + ["lux f64 =" f.=] + ["lux f64 <" f.<] + )) + (~~ (template [<extension> <reference>] + [(_.test <extension> + (|> {synthesis.#Extension <extension> (list)} + (run (..safe <extension>)) + (//case.verify <reference>)))] + + ["lux f64 min" ("lux f64 min")] + ["lux f64 max" ("lux f64 max")] + ["lux f64 smallest" ("lux f64 smallest")] + )) + (_.test "'lux f64 i64 && 'lux i64 f64'" + (|> (run (..safe "lux f64 i64") + (|> subject synthesis.f64 + (list) {synthesis.#Extension "lux f64 i64"} + (list) {synthesis.#Extension "lux i64 f64"})) + (//case.verify subject))) + )))) (def: (text run) (-> Runner Test) @@ -196,174 +196,174 @@ post_rep_once (format sample_lower sample_alpha) pre_rep_all (|> sample_lower (list.repeated sample_size) (text.interposed sample_upper)) post_rep_all (|> sample_lower (list.repeated sample_size) (text.interposed sample_alpha))]] - ($_ _.and - (_.test "Can compare texts for equality." - (and (|> {synthesis.#Extension "lux text =" (list sample_lowerS sample_lowerS)} - (run (..safe "lux text =")) - (pipe.case - {try.#Success valueV} - (as Bit valueV) - - _ - false)) - (|> {synthesis.#Extension "lux text =" (list sample_upperS sample_lowerS)} - (run (..safe "lux text =")) - (pipe.case - {try.#Success valueV} - (not (as Bit valueV)) - - _ - false)))) - (_.test "Can compare texts for order." - (|> {synthesis.#Extension "lux text <" (list sample_lowerS sample_upperS)} - (run (..safe "lux text <")) - (pipe.case - {try.#Success valueV} - (as Bit valueV) - - {try.#Failure _} - false))) - (_.test "Can get length of text." - (|> {synthesis.#Extension "lux text size" (list sample_lowerS)} - (run (..safe "lux text size")) - (pipe.case - {try.#Success valueV} - (n.= sample_size (as Nat valueV)) - - _ - false))) - (_.test "Can concatenate text." - (|> {synthesis.#Extension "lux text size" (list concatenatedS)} - (run (..safe "lux text size")) - (pipe.case - {try.#Success valueV} - (n.= (n.* 2 sample_size) (as Nat valueV)) - - _ - false))) - (_.test "Can find index of sub-text." - (and (|> {synthesis.#Extension "lux text index" - (list concatenatedS sample_lowerS - (synthesis.i64 +0))} - (run (..safe "lux text index")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Maybe Nat) valueV) - {.#Some valueV}]) - (n.= 0 valueV) - - _ - false)) - (|> {synthesis.#Extension "lux text index" - (list concatenatedS sample_upperS - (synthesis.i64 +0))} - (run (..safe "lux text index")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Maybe Nat) valueV) - {.#Some valueV}]) - (n.= sample_size valueV) - - _ - false)))) - (let [test_clip (is (-> (I64 Any) (I64 Any) Text Bit) - (function (_ offset length expected) - (|> {synthesis.#Extension "lux text clip" - (list concatenatedS - (synthesis.i64 offset) - (synthesis.i64 length))} - (run (..safe "lux text clip")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Maybe Text) valueV) - {.#Some valueV}]) - (text#= expected valueV) - - _ - false))))] - (_.test "Can clip text to extract sub-text." - (and (test_clip 0 sample_size sample_lower) - (test_clip sample_size sample_size sample_upper)))) - (_.test "Can extract individual characters from text." - (|> {synthesis.#Extension "lux text char" - (list sample_lowerS - (synthesis.i64 char_idx))} - (run (..safe "lux text char")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Maybe Int) valueV) - {.#Some valueV}]) - (text.contains? ("lux i64 char" valueV) - sample_lower) - - _ - false))) - ))) + (all _.and + (_.test "Can compare texts for equality." + (and (|> {synthesis.#Extension "lux text =" (list sample_lowerS sample_lowerS)} + (run (..safe "lux text =")) + (pipe.case + {try.#Success valueV} + (as Bit valueV) + + _ + false)) + (|> {synthesis.#Extension "lux text =" (list sample_upperS sample_lowerS)} + (run (..safe "lux text =")) + (pipe.case + {try.#Success valueV} + (not (as Bit valueV)) + + _ + false)))) + (_.test "Can compare texts for order." + (|> {synthesis.#Extension "lux text <" (list sample_lowerS sample_upperS)} + (run (..safe "lux text <")) + (pipe.case + {try.#Success valueV} + (as Bit valueV) + + {try.#Failure _} + false))) + (_.test "Can get length of text." + (|> {synthesis.#Extension "lux text size" (list sample_lowerS)} + (run (..safe "lux text size")) + (pipe.case + {try.#Success valueV} + (n.= sample_size (as Nat valueV)) + + _ + false))) + (_.test "Can concatenate text." + (|> {synthesis.#Extension "lux text size" (list concatenatedS)} + (run (..safe "lux text size")) + (pipe.case + {try.#Success valueV} + (n.= (n.* 2 sample_size) (as Nat valueV)) + + _ + false))) + (_.test "Can find index of sub-text." + (and (|> {synthesis.#Extension "lux text index" + (list concatenatedS sample_lowerS + (synthesis.i64 +0))} + (run (..safe "lux text index")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Maybe Nat) valueV) + {.#Some valueV}]) + (n.= 0 valueV) + + _ + false)) + (|> {synthesis.#Extension "lux text index" + (list concatenatedS sample_upperS + (synthesis.i64 +0))} + (run (..safe "lux text index")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Maybe Nat) valueV) + {.#Some valueV}]) + (n.= sample_size valueV) + + _ + false)))) + (let [test_clip (is (-> (I64 Any) (I64 Any) Text Bit) + (function (_ offset length expected) + (|> {synthesis.#Extension "lux text clip" + (list concatenatedS + (synthesis.i64 offset) + (synthesis.i64 length))} + (run (..safe "lux text clip")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Maybe Text) valueV) + {.#Some valueV}]) + (text#= expected valueV) + + _ + false))))] + (_.test "Can clip text to extract sub-text." + (and (test_clip 0 sample_size sample_lower) + (test_clip sample_size sample_size sample_upper)))) + (_.test "Can extract individual characters from text." + (|> {synthesis.#Extension "lux text char" + (list sample_lowerS + (synthesis.i64 char_idx))} + (run (..safe "lux text char")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Maybe Int) valueV) + {.#Some valueV}]) + (text.contains? ("lux i64 char" valueV) + sample_lower) + + _ + false))) + ))) (def: (io run) (-> Runner Test) (do r.monad [message (r.ascii/alpha 5)] - ($_ _.and - (_.test "Can log messages." - (|> {synthesis.#Extension "lux io log" - (list (synthesis.text (format "LOG: " message)))} - (run (..safe "lux io log")) - (pipe.case - {try.#Success valueV} - true - - {try.#Failure _} - false))) - (_.test "Can throw runtime errors." - (and (|> {synthesis.#Extension "lux try" - (list (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity 1 - synthesis.#body {synthesis.#Extension "lux io error" - (list (synthesis.text message))}]))} - (run (..safe "lux try")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Try Text) valueV) - {try.#Failure error}]) - (text.contains? message error) - - _ - false)) - (|> {synthesis.#Extension "lux try" - (list (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity 1 - synthesis.#body (synthesis.text message)]))} - (run (..safe "lux try")) - (pipe.case - (^.multi {try.#Success valueV} - [(as (Try Text) valueV) - {try.#Success valueV}]) - (text#= message valueV) - - _ - false)))) - (_.test "Can obtain current time in milli-seconds." - (|> (synthesis.tuple (list {synthesis.#Extension "lux io current-time" (list)} - {synthesis.#Extension "lux io current-time" (list)})) - (run (..safe "lux io current-time")) - (pipe.case - {try.#Success valueV} - (let [[pre post] (as [Nat Nat] valueV)] - (n.>= pre post)) - - {try.#Failure _} - false))) - ))) + (all _.and + (_.test "Can log messages." + (|> {synthesis.#Extension "lux io log" + (list (synthesis.text (format "LOG: " message)))} + (run (..safe "lux io log")) + (pipe.case + {try.#Success valueV} + true + + {try.#Failure _} + false))) + (_.test "Can throw runtime errors." + (and (|> {synthesis.#Extension "lux try" + (list (synthesis.function/abstraction + [synthesis.#environment (list) + synthesis.#arity 1 + synthesis.#body {synthesis.#Extension "lux io error" + (list (synthesis.text message))}]))} + (run (..safe "lux try")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Try Text) valueV) + {try.#Failure error}]) + (text.contains? message error) + + _ + false)) + (|> {synthesis.#Extension "lux try" + (list (synthesis.function/abstraction + [synthesis.#environment (list) + synthesis.#arity 1 + synthesis.#body (synthesis.text message)]))} + (run (..safe "lux try")) + (pipe.case + (^.multi {try.#Success valueV} + [(as (Try Text) valueV) + {try.#Success valueV}]) + (text#= message valueV) + + _ + false)))) + (_.test "Can obtain current time in milli-seconds." + (|> (synthesis.tuple (list {synthesis.#Extension "lux io current-time" (list)} + {synthesis.#Extension "lux io current-time" (list)})) + (run (..safe "lux io current-time")) + (pipe.case + {try.#Success valueV} + (let [[pre post] (as [Nat Nat] valueV)] + (n.>= pre post)) + + {try.#Failure _} + false))) + ))) (def: .public (spec runner) (-> Runner Test) - ($_ _.and - (..bit runner) - (..i64 runner) - (..f64 runner) - (..text runner) - (..io runner) - )) + (all _.and + (..bit runner) + (..i64 runner) + (..f64 runner) + (..text runner) + (..io runner) + )) diff --git a/stdlib/source/specification/compositor/generation/function.lux b/stdlib/source/specification/compositor/generation/function.lux index e6bdf79c0..6cc0d14b5 100644 --- a/stdlib/source/specification/compositor/generation/function.lux +++ b/stdlib/source/specification/compositor/generation/function.lux @@ -1,27 +1,27 @@ (.using - [lux {"-" function} - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - ["[0]" enum]] - [control - ["[0]" maybe]] - [data - [number - ["n" nat]] - [collection - ["[0]" list ("[1]#[0]" functor)]]] - [math - ["r" random {"+" Random} ("[1]#[0]" monad)]] - [tool - [compiler - [analysis {"+" Arity}] - ["[0]" reference {"+" Register}] - ["[0]" synthesis {"+" Synthesis}]]]] - ["[0]" // "_" - ["[1][0]" case] - [// - [common {"+" Runner}]]]) + [lux {"-" function} + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + ["[0]" enum]] + [control + ["[0]" maybe]] + [data + [number + ["n" nat]] + [collection + ["[0]" list ("[1]#[0]" functor)]]] + [math + ["r" random {"+" Random} ("[1]#[0]" monad)]] + [tool + [compiler + [analysis {"+" Arity}] + ["[0]" reference {"+" Register}] + ["[0]" synthesis {"+" Synthesis}]]]] + ["[0]" // "_" + ["[1][0]" case] + [// + [common {"+" Runner}]]]) (def: max_arity Arity @@ -54,41 +54,41 @@ inputs (r.list arity r.safe_frac) .let [expectation (maybe.trusted (list.item (-- local) inputs)) inputsS (list#each (|>> synthesis.f64) inputs)]] - ($_ _.and - (_.test "Can read arguments." - (|> (synthesis.function/apply [synthesis.#function functionS - synthesis.#arguments inputsS]) - (run "with_local") - (//case.verify expectation))) - (_.test "Can partially apply functions." - (or (n.= 1 arity) - (let [preS (list.first partial_arity inputsS) - postS (list.after partial_arity inputsS) - partialS (synthesis.function/apply [synthesis.#function functionS - synthesis.#arguments preS])] - (|> (synthesis.function/apply [synthesis.#function partialS - synthesis.#arguments postS]) - (run "partial_application") - (//case.verify expectation))))) - (_.test "Can read environment." - (or (n.= 1 arity) - (let [environment (|> partial_arity - (enum.range n.enum 1) - (list#each (|>> {reference.#Local}))) - variableS (if (n.<= partial_arity local) - (synthesis.variable/foreign (-- local)) - (synthesis.variable/local (|> local (n.- partial_arity)))) - inner_arity (n.- partial_arity arity) - innerS (synthesis.function/abstraction - [synthesis.#environment environment - synthesis.#arity inner_arity - synthesis.#body variableS]) - outerS (synthesis.function/abstraction - [synthesis.#environment (list) - synthesis.#arity partial_arity - synthesis.#body innerS])] - (|> (synthesis.function/apply [synthesis.#function outerS - synthesis.#arguments inputsS]) - (run "with_foreign") - (//case.verify expectation))))) - ))) + (all _.and + (_.test "Can read arguments." + (|> (synthesis.function/apply [synthesis.#function functionS + synthesis.#arguments inputsS]) + (run "with_local") + (//case.verify expectation))) + (_.test "Can partially apply functions." + (or (n.= 1 arity) + (let [preS (list.first partial_arity inputsS) + postS (list.after partial_arity inputsS) + partialS (synthesis.function/apply [synthesis.#function functionS + synthesis.#arguments preS])] + (|> (synthesis.function/apply [synthesis.#function partialS + synthesis.#arguments postS]) + (run "partial_application") + (//case.verify expectation))))) + (_.test "Can read environment." + (or (n.= 1 arity) + (let [environment (|> partial_arity + (enum.range n.enum 1) + (list#each (|>> {reference.#Local}))) + variableS (if (n.<= partial_arity local) + (synthesis.variable/foreign (-- local)) + (synthesis.variable/local (|> local (n.- partial_arity)))) + inner_arity (n.- partial_arity arity) + innerS (synthesis.function/abstraction + [synthesis.#environment environment + synthesis.#arity inner_arity + synthesis.#body variableS]) + outerS (synthesis.function/abstraction + [synthesis.#environment (list) + synthesis.#arity partial_arity + synthesis.#body innerS])] + (|> (synthesis.function/apply [synthesis.#function outerS + synthesis.#arguments inputsS]) + (run "with_foreign") + (//case.verify expectation))))) + ))) diff --git a/stdlib/source/specification/compositor/generation/primitive.lux b/stdlib/source/specification/compositor/generation/primitive.lux index db50dc185..46ba10d00 100644 --- a/stdlib/source/specification/compositor/generation/primitive.lux +++ b/stdlib/source/specification/compositor/generation/primitive.lux @@ -28,22 +28,22 @@ (def: .public (spec run) (-> Runner Test) - (`` ($_ _.and - (~~ (template [<evaluation_name> <synthesis> <gen> <test>] - [(do r.monad - [expected <gen>] - (_.test (%.symbol (symbol <synthesis>)) - (|> (run <evaluation_name> (<synthesis> expected)) - (pipe.case - {try.#Success actual} - (<test> expected (as_expected actual)) + (`` (all _.and + (~~ (template [<evaluation_name> <synthesis> <gen> <test>] + [(do r.monad + [expected <gen>] + (_.test (%.symbol (symbol <synthesis>)) + (|> (run <evaluation_name> (<synthesis> expected)) + (pipe.case + {try.#Success actual} + (<test> expected (as_expected actual)) - {try.#Failure _} - false))))] + {try.#Failure _} + false))))] - ["bit" synthesis.bit r.bit bit#=] - ["i64" synthesis.i64 r.i64 "lux i64 ="] - ["f64" synthesis.f64 r.frac f.='] - ["text" synthesis.text (r.ascii 5) text#=] - )) - ))) + ["bit" synthesis.bit r.bit bit#=] + ["i64" synthesis.i64 r.i64 "lux i64 ="] + ["f64" synthesis.f64 r.frac f.='] + ["text" synthesis.text (r.ascii 5) text#=] + )) + ))) diff --git a/stdlib/source/specification/compositor/generation/reference.lux b/stdlib/source/specification/compositor/generation/reference.lux index 687c3ef88..f9d5e3ec9 100644 --- a/stdlib/source/specification/compositor/generation/reference.lux +++ b/stdlib/source/specification/compositor/generation/reference.lux @@ -57,6 +57,6 @@ (def: .public (spec runner definer) (-> Runner Definer Test) - ($_ _.and - (..definition definer) - (..variable runner))) + (all _.and + (..definition definer) + (..variable runner))) diff --git a/stdlib/source/specification/compositor/generation/structure.lux b/stdlib/source/specification/compositor/generation/structure.lux index b7cf6423d..4423a85bf 100644 --- a/stdlib/source/specification/compositor/generation/structure.lux +++ b/stdlib/source/specification/compositor/generation/structure.lux @@ -85,7 +85,7 @@ (def: .public (spec runner) (-> Runner Test) - ($_ _.and - (..variant runner) - (..tuple runner) - )) + (all _.and + (..variant runner) + (..tuple runner) + )) diff --git a/stdlib/source/specification/lux/abstract/apply.lux b/stdlib/source/specification/lux/abstract/apply.lux index fb4ddd758..461f304c3 100644 --- a/stdlib/source/specification/lux/abstract/apply.lux +++ b/stdlib/source/specification/lux/abstract/apply.lux @@ -69,9 +69,9 @@ (def: .public (spec injection comparison apply) (All (_ f) (-> (Injection f) (Comparison f) (Apply f) Test)) (_.for [/.Apply] - ($_ _.and - (..identity injection comparison apply) - (..homomorphism injection comparison apply) - (..interchange injection comparison apply) - (..composition injection comparison apply) - ))) + (all _.and + (..identity injection comparison apply) + (..homomorphism injection comparison apply) + (..interchange injection comparison apply) + (..composition injection comparison apply) + ))) diff --git a/stdlib/source/specification/lux/abstract/comonad.lux b/stdlib/source/specification/lux/abstract/comonad.lux index 6147cff90..dca713ac2 100644 --- a/stdlib/source/specification/lux/abstract/comonad.lux +++ b/stdlib/source/specification/lux/abstract/comonad.lux @@ -54,8 +54,8 @@ (def: .public (spec injection comparison subject) (All (_ f) (-> (Injection f) (Comparison f) (CoMonad f) Test)) (<| (_.for [/.CoMonad]) - ($_ _.and - (..left_identity injection subject) - (..right_identity injection comparison subject) - (..associativity injection comparison subject) - ))) + (all _.and + (..left_identity injection subject) + (..right_identity injection comparison subject) + (..associativity injection comparison subject) + ))) diff --git a/stdlib/source/specification/lux/abstract/enum.lux b/stdlib/source/specification/lux/abstract/enum.lux index c2feb2a3f..bff39db70 100644 --- a/stdlib/source/specification/lux/abstract/enum.lux +++ b/stdlib/source/specification/lux/abstract/enum.lux @@ -14,14 +14,14 @@ (do random.monad [sample gen_sample] (<| (_.for [/.Enum]) - ($_ _.and - (_.test "Successor and predecessor are inverse functions." - (and (_#= (|> sample _#succ _#pred) - sample) - (_#= (|> sample _#pred _#succ) - sample) - (not (_#= (_#succ sample) - sample)) - (not (_#= (_#pred sample) - sample)))) - )))) + (all _.and + (_.test "Successor and predecessor are inverse functions." + (and (_#= (|> sample _#succ _#pred) + sample) + (_#= (|> sample _#pred _#succ) + sample) + (not (_#= (_#succ sample) + sample)) + (not (_#= (_#pred sample) + sample)))) + )))) diff --git a/stdlib/source/specification/lux/abstract/equivalence.lux b/stdlib/source/specification/lux/abstract/equivalence.lux index 386fafc8d..892d77524 100644 --- a/stdlib/source/specification/lux/abstract/equivalence.lux +++ b/stdlib/source/specification/lux/abstract/equivalence.lux @@ -17,8 +17,8 @@ [left random right random] (<| (_.for [/.Equivalence]) - ($_ _.and - (_.test "Reflexivity" - (/#= left left)) - (_.test "Symmetry" - (bit#= (/#= left right) (/#= right left))))))) + (all _.and + (_.test "Reflexivity" + (/#= left left)) + (_.test "Symmetry" + (bit#= (/#= left right) (/#= right left))))))) diff --git a/stdlib/source/specification/lux/abstract/functor.lux b/stdlib/source/specification/lux/abstract/functor.lux index b82a0c83d..f5b3a6205 100644 --- a/stdlib/source/specification/lux/abstract/functor.lux +++ b/stdlib/source/specification/lux/abstract/functor.lux @@ -55,8 +55,8 @@ (def: .public (spec injection comparison functor) (All (_ f) (-> (Injection f) (Comparison f) (Functor f) Test)) (<| (_.for [/.Functor]) - ($_ _.and - (..identity injection comparison functor) - (..homomorphism injection comparison functor) - (..composition injection comparison functor) - ))) + (all _.and + (..identity injection comparison functor) + (..homomorphism injection comparison functor) + (..composition injection comparison functor) + ))) diff --git a/stdlib/source/specification/lux/abstract/functor/contravariant.lux b/stdlib/source/specification/lux/abstract/functor/contravariant.lux index 8f379472e..0fca98448 100644 --- a/stdlib/source/specification/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/specification/lux/abstract/functor/contravariant.lux @@ -26,6 +26,6 @@ (do random.monad [sample random.nat] (<| (_.for [/.Functor]) - ($_ _.and - (..identity equivalence value functor) - )))) + (all _.and + (..identity equivalence value functor) + )))) diff --git a/stdlib/source/specification/lux/abstract/interval.lux b/stdlib/source/specification/lux/abstract/interval.lux index 3fada2cf8..4ea7ca50e 100644 --- a/stdlib/source/specification/lux/abstract/interval.lux +++ b/stdlib/source/specification/lux/abstract/interval.lux @@ -15,9 +15,9 @@ (<| (_.for [/.Interval]) (do random.monad [sample gen_sample] - ($_ _.and - (_.test "No value is bigger than the top." - (@//< @//top sample)) - (_.test "No value is smaller than the bottom." - (order.> @//order @//bottom sample)) - )))) + (all _.and + (_.test "No value is bigger than the top." + (@//< @//top sample)) + (_.test "No value is smaller than the bottom." + (order.> @//order @//bottom sample)) + )))) diff --git a/stdlib/source/specification/lux/abstract/monad.lux b/stdlib/source/specification/lux/abstract/monad.lux index fe14440fd..e42b0dbdf 100644 --- a/stdlib/source/specification/lux/abstract/monad.lux +++ b/stdlib/source/specification/lux/abstract/monad.lux @@ -50,8 +50,8 @@ (def: .public (spec injection comparison monad) (All (_ f) (-> (Injection f) (Comparison f) (/.Monad f) Test)) (<| (_.for [/.Monad]) - ($_ _.and - (..left_identity injection comparison monad) - (..right_identity injection comparison monad) - (..associativity injection comparison monad) - ))) + (all _.and + (..left_identity injection comparison monad) + (..right_identity injection comparison monad) + (..associativity injection comparison monad) + ))) diff --git a/stdlib/source/specification/lux/abstract/monoid.lux b/stdlib/source/specification/lux/abstract/monoid.lux index 6d5ab67fc..f6daaa867 100644 --- a/stdlib/source/specification/lux/abstract/monoid.lux +++ b/stdlib/source/specification/lux/abstract/monoid.lux @@ -19,14 +19,14 @@ mid gen_sample right gen_sample] (<| (_.for [/.Monoid]) - ($_ _.and - (_.test "Left identity." - (_#= sample - (_#composite _#identity sample))) - (_.test "Right identity." - (_#= sample - (_#composite sample _#identity))) - (_.test "Associativity." - (_#= (_#composite left (_#composite mid right)) - (_#composite (_#composite left mid) right))) - )))) + (all _.and + (_.test "Left identity." + (_#= sample + (_#composite _#identity sample))) + (_.test "Right identity." + (_#= sample + (_#composite sample _#identity))) + (_.test "Associativity." + (_#= (_#composite left (_#composite mid right)) + (_#composite (_#composite left mid) right))) + )))) diff --git a/stdlib/source/specification/lux/abstract/order.lux b/stdlib/source/specification/lux/abstract/order.lux index 1c77ffc3b..e6e85a1e8 100644 --- a/stdlib/source/specification/lux/abstract/order.lux +++ b/stdlib/source/specification/lux/abstract/order.lux @@ -12,47 +12,47 @@ (def: .public (spec (open "@//[0]") generator) (All (_ a) (-> (/.Order a) (Random a) Test)) (<| (_.for [/.Order]) - ($_ _.and - (do random.monad - [parameter generator - subject generator] - (_.test "Values are either ordered, or they are equal. All options(_ are mutually exclusive." - (cond (@//< parameter subject) - (not (or (@//< subject parameter) - (@//= parameter subject))) + (all _.and + (do random.monad + [parameter generator + subject generator] + (_.test "Values are either ordered, or they are equal. All options(_ are mutually exclusive." + (cond (@//< parameter subject) + (not (or (@//< subject parameter) + (@//= parameter subject))) - (@//< subject parameter) - (not (@//= parameter subject)) + (@//< subject parameter) + (not (@//= parameter subject)) - ... else - (@//= parameter subject)))) - (do random.monad - [parameter generator - subject (random.only (|>> (@//= parameter) not) - generator) - extra (random.only (function (_ value) - (not (or (@//= parameter value) - (@//= subject value)))) - generator)] - (_.test "Transitive property." - (if (@//< parameter subject) - (let [greater? (and (@//< subject extra) - (@//< parameter extra)) - lesser? (and (@//< extra parameter) - (@//< extra subject)) - in_between? (and (@//< parameter extra) - (@//< extra subject))] - (or greater? - lesser? - in_between?)) - ... (@//< subject parameter) - (let [greater? (and (@//< extra subject) - (@//< extra parameter)) - lesser? (and (@//< parameter extra) - (@//< subject extra)) - in_between? (and (@//< subject extra) - (@//< extra parameter))] - (or greater? - lesser? - in_between?))))) - ))) + ... else + (@//= parameter subject)))) + (do random.monad + [parameter generator + subject (random.only (|>> (@//= parameter) not) + generator) + extra (random.only (function (_ value) + (not (or (@//= parameter value) + (@//= subject value)))) + generator)] + (_.test "Transitive property." + (if (@//< parameter subject) + (let [greater? (and (@//< subject extra) + (@//< parameter extra)) + lesser? (and (@//< extra parameter) + (@//< extra subject)) + in_between? (and (@//< parameter extra) + (@//< extra subject))] + (or greater? + lesser? + in_between?)) + ... (@//< subject parameter) + (let [greater? (and (@//< extra subject) + (@//< extra parameter)) + lesser? (and (@//< parameter extra) + (@//< subject extra)) + in_between? (and (@//< subject extra) + (@//< extra parameter))] + (or greater? + lesser? + in_between?))))) + ))) diff --git a/stdlib/source/specification/lux/world/file.lux b/stdlib/source/specification/lux/world/file.lux index 1e1d5f557..d4a0e591d 100644 --- a/stdlib/source/specification/lux/world/file.lux +++ b/stdlib/source/specification/lux/world/file.lux @@ -39,21 +39,21 @@ in (do async.monad [fs (async.future fs)] - ($_ _.and' - (_.cover' [/.rooted] - (let [path (/.rooted fs parent child)] - (and (text.starts_with? parent path) - (text.ends_with? child path)))) - (_.cover' [/.parent] - (|> (/.rooted fs parent child) - (/.parent fs) - (maybe#each (text#= parent)) - (maybe.else false))) - (_.cover' [/.name] - (|> (/.rooted fs parent child) - (/.name fs) - (text#= child))) - )))) + (all _.and' + (_.cover' [/.rooted] + (let [path (/.rooted fs parent child)] + (and (text.starts_with? parent path) + (text.ends_with? child path)))) + (_.cover' [/.parent] + (|> (/.rooted fs parent child) + (/.parent fs) + (maybe#each (text#= parent)) + (maybe.else false))) + (_.cover' [/.name] + (|> (/.rooted fs parent child) + (/.name fs) + (text#= child))) + )))) (def: (directory?&make_directory fs parent) (-> (/.System Async) /.Path (Async Bit)) @@ -226,31 +226,31 @@ cannot_make_directory!/0 (/.make_directories ! fs "") cannot_make_directory!/1 (/.make_directories ! fs (# fs separator))]) - ($_ _.and' - (_.cover' [/.make_directories] - (and (not pre_dir/0) - (not pre_dir/1) - (not pre_dir/2) - (case made? - {try.#Success _} true - {try.#Failure _} false) - post_dir/0 - post_dir/1 - post_dir/2)) - (_.cover' [/.cannot_make_directory] - (and (case cannot_make_directory!/0 - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_make_directory error)) - (case cannot_make_directory!/1 - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_make_directory error)))) - ))) + (all _.and' + (_.cover' [/.make_directories] + (and (not pre_dir/0) + (not pre_dir/1) + (not pre_dir/2) + (case made? + {try.#Success _} true + {try.#Failure _} false) + post_dir/0 + post_dir/1 + post_dir/2)) + (_.cover' [/.cannot_make_directory] + (and (case cannot_make_directory!/0 + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_make_directory error)) + (case cannot_make_directory!/1 + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_make_directory error)))) + ))) (def: (make_file&cannot_make_file fs) (-> (IO (/.System Async)) Test) @@ -261,26 +261,26 @@ [fs (async.future fs) make_file!/0 (/.make_file ! fs (utf8#encoded file/0) file/0) make_file!/1 (/.make_file ! fs (utf8#encoded file/0) file/0)]) - ($_ _.and' - (_.cover' [/.make_file] - (case make_file!/0 - {try.#Success _} true - {try.#Failure error} false)) - (_.cover' [/.cannot_make_file] - (case make_file!/1 - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_make_file error))) - ))) + (all _.and' + (_.cover' [/.make_file] + (case make_file!/0 + {try.#Success _} true + {try.#Failure error} false)) + (_.cover' [/.cannot_make_file] + (case make_file!/1 + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_make_file error))) + ))) (def: (for_utilities fs) (-> (IO (/.System Async)) Test) - ($_ _.and - (..make_directories&cannot_make_directory fs) - (..make_file&cannot_make_file fs) - )) + (all _.and + (..make_directories&cannot_make_directory fs) + (..make_file&cannot_make_file fs) + )) (def: (exists? fs) (-> (IO (/.System Async)) Test) @@ -324,9 +324,9 @@ (def: .public (spec fs) (-> (IO (/.System Async)) Test) - ($_ _.and - (..for_path fs) - (..for_utilities fs) - (..for_system fs) - (..exists? fs) - )) + (all _.and + (..for_path fs) + (..for_utilities fs) + (..for_system fs) + (..exists? fs) + )) diff --git a/stdlib/source/specification/lux/world/shell.lux b/stdlib/source/specification/lux/world/shell.lux index 9d18afee2..30c061ca3 100644 --- a/stdlib/source/specification/lux/world/shell.lux +++ b/stdlib/source/specification/lux/world/shell.lux @@ -80,12 +80,12 @@ (do ! [can_read! (..can_read! message echo) can_destroy! (..can_destroy! sleep)] - ($_ _.and' - (_.cover' <shell_coverage> - (and can_read! - can_destroy!)) - (..can_wait! echo) - )) + (all _.and' + (_.cover' <shell_coverage> + (and can_read! + can_destroy!)) + (..can_wait! echo) + )) _ (_.cover' <shell_coverage> diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 2c30c2a37..ed891d815 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -1,58 +1,58 @@ (.using - [library - [lux "*" - [program {"+" program:}] - ["_" test {"+" Test}] - [control - ["[0]" io]]]] - ["[0]" / "_" - ["[1][0]" artifact] - ["[1][0]" cli] - ["[1][0]" command] - ["[1][0]" dependency - ["[1]/[0]" deployment] - ["[1]/[0]" resolution] - ["[1]/[0]" status]] - ["[1][0]" hash] - ["[1][0]" input] - ["[1][0]" local] - ["[1][0]" metadata] - ["[1][0]" package] - ["[1][0]" parser] - ["[1][0]" pom] - ["[1][0]" profile] - ["[1][0]" project] - ["[1][0]" repository] - ["[1][0]" runtime]]) + [library + [lux "*" + [program {"+" program:}] + ["_" test {"+" Test}] + [control + ["[0]" io]]]] + ["[0]" / "_" + ["[1][0]" artifact] + ["[1][0]" cli] + ["[1][0]" command] + ["[1][0]" dependency + ["[1]/[0]" deployment] + ["[1]/[0]" resolution] + ["[1]/[0]" status]] + ["[1][0]" hash] + ["[1][0]" input] + ["[1][0]" local] + ["[1][0]" metadata] + ["[1][0]" package] + ["[1][0]" parser] + ["[1][0]" pom] + ["[1][0]" profile] + ["[1][0]" project] + ["[1][0]" repository] + ["[1][0]" runtime]]) (def: dependency Test - ($_ _.and - /dependency.test - /dependency/deployment.test - /dependency/resolution.test - /dependency/status.test - )) + (all _.and + /dependency.test + /dependency/deployment.test + /dependency/resolution.test + /dependency/status.test + )) (def: test Test - ($_ _.and - /artifact.test - /cli.test - /command.test - ..dependency - /hash.test - /input.test - /local.test - /metadata.test - /package.test - /parser.test - /pom.test - /profile.test - /project.test - /repository.test - /runtime.test - )) + (all _.and + /artifact.test + /cli.test + /command.test + ..dependency + /hash.test + /input.test + /local.test + /metadata.test + /package.test + /parser.test + /pom.test + /profile.test + /project.test + /repository.test + /runtime.test + )) (program: args (<| io.io diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 11ff833da..1a0c7cb29 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -1,38 +1,38 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [hash {"+" Hash}] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" hash]]] - [data - ["[0]" text ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}]] - [world - ["[0]" file] - [net - ["[0]" uri]]]]] - ["[0]" / "_" - ["[1][0]" extension] - ["[1][0]" snapshot] - ["[1][0]" time] - ["[1][0]" type] - ["[1][0]" versioning]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [hash {"+" Hash}] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" hash]]] + [data + ["[0]" text ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}]] + [world + ["[0]" file] + [net + ["[0]" uri]]]]] + ["[0]" / "_" + ["[1][0]" extension] + ["[1][0]" snapshot] + ["[1][0]" time] + ["[1][0]" type] + ["[1][0]" versioning]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Artifact) (let [size 4] - ($_ random.and - (random.ascii/lower size) - (random.ascii/lower size) - (random.ascii/lower size)))) + (all random.and + (random.ascii/lower size) + (random.ascii/lower size) + (random.ascii/lower size)))) (def: .public test Test @@ -41,21 +41,21 @@ [sample ..random]) (_.for [/.Group /.Name /.Version /.Artifact] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) - (_.cover [/.format /.identity] - (and (text.ends_with? (/.identity sample) (/.format sample)) - (not (text#= (/.identity sample) (/.format sample))))) - - /extension.test - /snapshot.test - /time.test - /type.test - /versioning.test - )))) + (_.cover [/.format /.identity] + (and (text.ends_with? (/.identity sample) (/.format sample)) + (not (text#= (/.identity sample) (/.format sample))))) + + /extension.test + /snapshot.test + /time.test + /type.test + /versioning.test + )))) diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux index d1f1c4dea..b71b0c001 100644 --- a/stdlib/source/test/aedifex/artifact/extension.lux +++ b/stdlib/source/test/aedifex/artifact/extension.lux @@ -1,43 +1,43 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" text ("[1]#[0]" equivalence)] - [collection - ["[0]" set] - ["[0]" list]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\program - ["[0]" / - ["/[1]" // "_" - ["[1]" type]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" set] + ["[0]" list]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\program + ["[0]" / + ["/[1]" // "_" + ["[1]" type]]]]) (def: .public test Test (<| (_.covering /._) (_.for [/.Extension] - ($_ _.and - (_.cover [/.lux_library /.jvm_library /.pom - /.sha-1 /.md5] - (let [options (list /.lux_library /.jvm_library /.pom /.sha-1 /.md5) - uniques (set.of_list text.hash options)] - (n.= (list.size options) - (set.size uniques)))) - (_.cover [/.extension /.type] - (`` (and (~~ (template [<type> <extension>] - [(and (text#= <extension> - (/.extension <type>)) - (text#= <type> - (/.type (/.extension <type>))))] + (all _.and + (_.cover [/.lux_library /.jvm_library /.pom + /.sha-1 /.md5] + (let [options (list /.lux_library /.jvm_library /.pom /.sha-1 /.md5) + uniques (set.of_list text.hash options)] + (n.= (list.size options) + (set.size uniques)))) + (_.cover [/.extension /.type] + (`` (and (~~ (template [<type> <extension>] + [(and (text#= <extension> + (/.extension <type>)) + (text#= <type> + (/.type (/.extension <type>))))] - [//.lux_library /.lux_library] - [//.jvm_library /.jvm_library] - [//.pom /.pom] - ))))) - )))) + [//.lux_library /.lux_library] + [//.jvm_library /.jvm_library] + [//.pom /.pom] + ))))) + )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index b2c6417b1..cea873a6e 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] - ["$[0]" / "_" - ["[1][0]" build] - ["[1][0]" stamp] - ["[1][0]" time] - ["[1][0]" version]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" xml]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] + ["$[0]" / "_" + ["[1][0]" build] + ["[1][0]" stamp] + ["[1][0]" time] + ["[1][0]" version]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Snapshot) @@ -29,22 +29,22 @@ Test (<| (_.covering /._) (_.for [/.Snapshot] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) - $/build.test - $/stamp.test - $/time.test - $/version.test - )))) + $/build.test + $/stamp.test + $/time.test + $/version.test + )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/build.lux b/stdlib/source/test/aedifex/artifact/snapshot/build.lux index 0f3ca9799..b03fe7f10 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/build.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/build.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] - [math - ["[0]" random {"+" Random}]]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" xml]]] + [math + ["[0]" random {"+" Random}]]]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Build) @@ -23,17 +23,17 @@ Test (<| (_.covering /._) (_.for [/.Build] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + )))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux index 3fa32fe46..181e39523 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -1,46 +1,46 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] - [math - ["[0]" random {"+" Random}]] - [time - ["[0]" instant]]]] - [\\program - ["[0]" /]] - ["$[0]" // "_" - ["[1][0]" time] - ["[1][0]" build]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" xml]]] + [math + ["[0]" random {"+" Random}]] + [time + ["[0]" instant]]]] + [\\program + ["[0]" /]] + ["$[0]" // "_" + ["[1][0]" time] + ["[1][0]" build]]) (def: .public random (Random /.Stamp) - ($_ random.and - $//time.random - $//build.random - )) + (all random.and + $//time.random + $//build.random + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Stamp]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - ))) + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/time.lux b/stdlib/source/test/aedifex/artifact/snapshot/time.lux index b48a8265f..4e8a63fe5 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/time.lux @@ -1,21 +1,21 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" text]]] - [math - ["[0]" random {"+" Random}]]]] - [\\program - ["[0]" /]] - ["$[0]" /// "_" - ["[1][0]" time]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" text]]] + [math + ["[0]" random {"+" Random}]]]] + [\\program + ["[0]" /]] + ["$[0]" /// "_" + ["[1][0]" time]]) (def: .public random (Random /.Time) @@ -25,18 +25,18 @@ Test (<| (_.covering /._) (_.for [/.Time]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - ($_ _.and - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) - )) - ))) + (do random.monad + [expected ..random] + (all _.and + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false))) + )) + ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version.lux b/stdlib/source/test/aedifex/artifact/snapshot/version.lux index 1f83c119d..1d32ff734 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -1,50 +1,50 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] - [math - ["[0]" random {"+" Random}]]]] - [\\program - ["[0]" /]] - ["[0]" / "_" - ["[1][0]" value]] - ["$[0]" /// "_" - ["[1][0]" type] - ["[1][0]" time]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" xml]]] + [math + ["[0]" random {"+" Random}]]]] + [\\program + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" value]] + ["$[0]" /// "_" + ["[1][0]" type] + ["[1][0]" time]]) (def: .public random (Random /.Version) - ($_ random.and - $///type.random - (random.ascii/alpha 1) - $///time.random - )) + (all random.and + $///type.random + (random.ascii/alpha 1) + $///time.random + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Version]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) - /value.test - ))) + /value.test + ))) diff --git a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux index fba89a430..7967e935f 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux @@ -30,37 +30,37 @@ (def: .public random (Random /.Value) - ($_ random.and - (random.ascii/alpha 5) - (random.or (random#in []) - $///stamp.random) - )) + (all random.and + (random.ascii/alpha 5) + (random.or (random#in []) + $///stamp.random) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Value]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [sample random - stamp $///stamp.random] - (let [version (the /.#version sample) + (do random.monad + [sample random + stamp $///stamp.random] + (let [version (the /.#version sample) - local! - (text#= version - (/.format (has /.#snapshot {///.#Local} sample))) + local! + (text#= version + (/.format (has /.#snapshot {///.#Local} sample))) - remote_format (/.format [/.#version (format version /.snapshot) - /.#snapshot {///.#Remote stamp}]) - remote! - (and (text.starts_with? (format version (///time.format (the ///stamp.#time stamp))) - remote_format) - (text.ends_with? (%.nat (the ///stamp.#build stamp)) - remote_format))] - (_.cover [/.snapshot /.format] - (and local! - remote!)))) - ))) + remote_format (/.format [/.#version (format version /.snapshot) + /.#snapshot {///.#Remote stamp}]) + remote! + (and (text.starts_with? (format version (///time.format (the ///stamp.#time stamp))) + remote_format) + (text.ends_with? (%.nat (the ///stamp.#build stamp)) + remote_format))] + (_.cover [/.snapshot /.format] + (and local! + remote!)))) + ))) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index 671fbfdfa..d8f67e45a 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -1,26 +1,26 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" text]]] - [time - ["[0]" instant ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["i" int]]]]] - [\\program - ["[0]" /]] - ["[0]" / "_" - ["[1][0]" date] - ["[1][0]" time]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" text]]] + [time + ["[0]" instant ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["i" int]]]]] + [\\program + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" date] + ["[1][0]" time]]) (def: .public random (Random /.Time) @@ -33,29 +33,29 @@ Test (<| (_.covering /._) (_.for [/.Time]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - (do random.monad - [expected ..random] - (_.cover [/.instant /.of_instant] - (|> expected - /.instant - /.of_instant - (try#each (# /.equivalence = expected)) - (try.else false)))) - (_.cover [/.epoch] - (instant#= instant.epoch (/.instant /.epoch))) + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + (do random.monad + [expected ..random] + (_.cover [/.instant /.of_instant] + (|> expected + /.instant + /.of_instant + (try#each (# /.equivalence = expected)) + (try.else false)))) + (_.cover [/.epoch] + (instant#= instant.epoch (/.instant /.epoch))) - /date.test - /time.test - ))) + /date.test + /time.test + ))) diff --git a/stdlib/source/test/aedifex/artifact/time/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index dfca44e0d..9f5169d78 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -1,26 +1,26 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - ["[0]" exception] - [parser - ["<[0]>" text]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat] - ["i" int]]] - [time - ["[0]" date ("[1]#[0]" equivalence)] - ["[0]" year]]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception] + [parser + ["<[0]>" text]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat] + ["i" int]]] + [time + ["[0]" date ("[1]#[0]" equivalence)] + ["[0]" year]]]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Date) @@ -41,29 +41,29 @@ (do random.monad [expected ..random candidate random.date] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.value /.date] - (|> expected - /.value - /.date - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.year_is_out_of_range] - (case (/.date candidate) - {try.#Success date} - (same? candidate (/.value date)) - - {try.#Failure error} - (exception.match? /.year_is_out_of_range error))) - (_.cover [/.epoch] - (date#= date.epoch (/.value /.epoch))) - )))) + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.value /.date] + (|> expected + /.value + /.date + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.year_is_out_of_range] + (case (/.date candidate) + {try.#Success date} + (same? candidate (/.value date)) + + {try.#Failure error} + (exception.match? /.year_is_out_of_range error))) + (_.cover [/.epoch] + (date#= date.epoch (/.value /.epoch))) + )))) diff --git a/stdlib/source/test/aedifex/artifact/time/time.lux b/stdlib/source/test/aedifex/artifact/time/time.lux index 64155f029..da0589d93 100644 --- a/stdlib/source/test/aedifex/artifact/time/time.lux +++ b/stdlib/source/test/aedifex/artifact/time/time.lux @@ -28,13 +28,13 @@ Test (<| (_.covering /._) (_.for [/.Time]) - ($_ _.and - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# time.equivalence = expected)) - (try.else false)))) - ))) + (all _.and + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.result /.parser) + (try#each (# time.equivalence = expected)) + (try.else false)))) + ))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index 41f3510e7..a5592e3ef 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -1,43 +1,43 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" text] - [collection - ["[0]" set] - ["[0]" list]]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)] - [number - ["n" nat]]]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" text] + [collection + ["[0]" set] + ["[0]" list]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["n" nat]]]]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Type) - ($_ random.either - ($_ random.either - (random#in /.lux_library) - (random#in /.jvm_library)) - ($_ random.either - (random#in /.pom) - (random#in /.md5) - (random#in /.sha-1)) - )) + (all random.either + (all random.either + (random#in /.lux_library) + (random#in /.jvm_library)) + (all random.either + (random#in /.pom) + (random#in /.md5) + (random#in /.sha-1)) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Type] - ($_ _.and - (_.cover [/.lux_library /.jvm_library /.js_library - /.pom /.md5 /.sha-1] - (let [options (list /.lux_library /.jvm_library /.js_library - /.pom /.md5 /.sha-1) - uniques (set.of_list text.hash options)] - (n.= (list.size options) - (set.size uniques)))) - )))) + (all _.and + (_.cover [/.lux_library /.jvm_library /.js_library + /.pom /.md5 /.sha-1] + (let [options (list /.lux_library /.jvm_library /.js_library + /.pom /.md5 /.sha-1) + uniques (set.of_list text.hash options)] + (n.= (list.size options) + (set.size uniques)))) + )))) diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index 5a14e9638..bc029a46a 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -1,54 +1,54 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" xml]]] - [math - ["[0]" random {"+" Random}]]]] - [\\program - ["[0]" /]] - ["$[0]" // "_" - ["[1][0]" time] - ["[1][0]" snapshot - ["[1]/[0]" version]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" xml]]] + [math + ["[0]" random {"+" Random}]]]] + [\\program + ["[0]" /]] + ["$[0]" // "_" + ["[1][0]" time] + ["[1][0]" snapshot + ["[1]/[0]" version]]]) (def: .public random (Random /.Versioning) - ($_ random.and - $//snapshot.random - $//time.random - (random.list 5 $//snapshot/version.random) - )) + (all random.and + $//snapshot.random + $//time.random + (random.list 5 $//snapshot/version.random) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Versioning]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - (_.cover [/.init] - (|> /.init - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = /.init)) - (try.else false))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + (_.cover [/.init] + (|> /.init + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = /.init)) + (try.else false))) + ))) diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 06b33d138..ca247f3f0 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -47,9 +47,9 @@ (def: type (Random Type) - ($_ random.either - (random#in //artifact/type.lux_library) - (random#in //artifact/type.jvm_library))) + (all random.either + (random#in //artifact/type.lux_library) + (random#in //artifact/type.jvm_library))) (def: profile (Random [Artifact Profile XML]) @@ -145,7 +145,7 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..singular - ..plural - ))) + (all _.and + ..singular + ..plural + ))) diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index 3f3f79b1c..4d577e737 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -29,26 +29,26 @@ (def: command (Random /.Command) - ($_ random.or - ... #Version - (random#in []) - ... #Clean - (random#in []) - ... #POM - (random#in []) - ... #Dependencies - (random#in []) - ... #Install - (random#in []) - ... #Deploy - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.ascii/alpha 1)) - ... #Compilation - ..compilation - ... #Auto - ..compilation)) + (all random.or + ... #Version + (random#in []) + ... #Clean + (random#in []) + ... #POM + (random#in []) + ... #Dependencies + (random#in []) + ... #Install + (random#in []) + ... #Deploy + (all random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.ascii/alpha 1)) + ... #Compilation + ..compilation + ... #Auto + ..compilation)) (def: (compilation_format value) (-> /.Compilation (List Text)) @@ -106,12 +106,12 @@ Test (<| (_.covering /._) (_.for [/.Compilation /.Command] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..command)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..command)) - (_.for [/.command] - ($_ _.and - ..without_profile - ..with_profile - )))))) + (_.for [/.command] + (all _.and + ..without_profile + ..with_profile + )))))) diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux index a6b1324bb..496e1cd78 100644 --- a/stdlib/source/test/aedifex/command.lux +++ b/stdlib/source/test/aedifex/command.lux @@ -1,38 +1,38 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}]]] - ["[0]" / "_" - ["[1][0]" version] - ["[1][0]" pom] + [library + [lux "*" + ["_" test {"+" Test}]]] + ["[0]" / "_" + ["[1][0]" version] + ["[1][0]" pom] - ["[1][0]" clean] - ["[1][0]" install] + ["[1][0]" clean] + ["[1][0]" install] - ["[1][0]" deps] - ["[1][0]" deploy] + ["[1][0]" deps] + ["[1][0]" deploy] - ["[1][0]" build] - ["[1][0]" test] - ["[1][0]" auto]] - [\\program - ["[0]" /]]) + ["[1][0]" build] + ["[1][0]" test] + ["[1][0]" auto]] + [\\program + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) (_.for [/.Command]) - ($_ _.and - /version.test - /pom.test - - /clean.test - /install.test + (all _.and + /version.test + /pom.test + + /clean.test + /install.test - /deps.test - /deploy.test + /deps.test + /deploy.test - /build.test - /test.test - /auto.test - ))) + /build.test + /test.test + /auto.test + ))) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index e8d5ca1ac..1cad922f7 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -90,36 +90,36 @@ expected_runs (# ! each (|>> (n.% 10) (n.max 2)) random.nat) dummy_path (# ! each (|>> (format source /)) (random.ascii/alpha 5)) [compiler resolution] $build.resolution] - ($_ _.and - (_.cover [/.delay] - (n.> 0 /.delay)) - (in (do async.monad - [verdict (do ///action.monad - [_ (# fs make_directory source) - _ (# fs write dummy_path (binary.empty 0)) - .let [[@runs command] (..command expected_runs end_signal fs dummy_path)] - _ (# watcher poll [])] - (do [! async.monad] - [no_dangling_process! (|> profile - (has ///.#lux compiler) - ((/.do! 1 watcher command) - ($version.echo "") - (program.async (program.mock environment.empty home working_directory)) - fs - (shell.async ($build.good_shell [])) - resolution) - (# ! each (|>> (pipe.case - {try.#Failure error} - (same? end_signal error) + (all _.and + (_.cover [/.delay] + (n.> 0 /.delay)) + (in (do async.monad + [verdict (do ///action.monad + [_ (# fs make_directory source) + _ (# fs write dummy_path (binary.empty 0)) + .let [[@runs command] (..command expected_runs end_signal fs dummy_path)] + _ (# watcher poll [])] + (do [! async.monad] + [no_dangling_process! (|> profile + (has ///.#lux compiler) + ((/.do! 1 watcher command) + ($version.echo "") + (program.async (program.mock environment.empty home working_directory)) + fs + (shell.async ($build.good_shell [])) + resolution) + (# ! each (|>> (pipe.case + {try.#Failure error} + (same? end_signal error) - {try.#Success _} - false)))) - correct_number_of_runs! (|> @runs - atom.read! - async.future - (# ! each (n.= expected_runs)))] - (in {try.#Success (and correct_number_of_runs! - no_dangling_process!)})))] - (_.cover' [/.do!] - (try.else false verdict)))) - )))) + {try.#Success _} + false)))) + correct_number_of_runs! (|> @runs + atom.read! + async.future + (# ! each (n.= expected_runs)))] + (in {try.#Success (and correct_number_of_runs! + no_dangling_process!)})))] + (_.cover' [/.do!] + (try.else false verdict)))) + )))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index a7cd30b1c..86dc41f93 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -113,19 +113,19 @@ ///artifact.#name /.js_lux_name ///artifact.#version lux_version] ///dependency.#type ///artifact/type.js_library]]] - (`` ($_ random.either - (in js_compiler) - (~~ (template [<compiler>] - [(in [///dependency.#artifact [///artifact.#group /.lux_group - ///artifact.#name <compiler> - ///artifact.#version lux_version] - ///dependency.#type ///artifact/type.lux_library])] + (`` (all random.either + (in js_compiler) + (~~ (template [<compiler>] + [(in [///dependency.#artifact [///artifact.#group /.lux_group + ///artifact.#name <compiler> + ///artifact.#version lux_version] + ///dependency.#type ///artifact/type.lux_library])] - [/.jvm_lux_name] - [/.python_lux_name] - [/.lua_lux_name] - [/.ruby_lux_name] - )))))) + [/.jvm_lux_name] + [/.python_lux_name] + [/.lua_lux_name] + [/.ruby_lux_name] + )))))) (def: .public resolution (Random [Dependency Resolution]) @@ -158,96 +158,96 @@ profile (|> empty_profile with_program with_target)]] - ($_ _.and - (in (do async.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty - (with_target empty_profile))] - (_.cover' [/.no_specified_program] - (case outcome - {try.#Success _} - false + (all _.and + (in (do async.monad + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty + (with_target empty_profile))] + (_.cover' [/.no_specified_program] + (case outcome + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.no_specified_program error))))) - (in (do async.monad - [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty profile)] - (_.cover' [/.Lux /.no_available_lux] - (case outcome - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.no_specified_program error))))) + (in (do async.monad + [outcome (/.do! (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs shell ///dependency/resolution.empty profile)] + (_.cover' [/.Lux /.no_available_lux] + (case outcome + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.no_available_lux error))))) - (do ! - [.let [console (@version.echo "")] - [compiler resolution] ..resolution] - (in (do async.monad - [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs shell resolution - (has ///.#lux compiler profile)) - start (# console read_line []) - end (# console read_line [])] - (in (and (text#= /.start start) - (text#= /.success end))))] - (_.cover' [/.do! - /.lux_group - /.jvm_lux_name - /.js_lux_name - /.python_lux_name - /.lua_lux_name - /.ruby_lux_name - /.start - /.success] - (try.else false verdict))))) - (do ! - [.let [console (@version.echo "")] - [compiler resolution] ..resolution] - (in (do async.monad - [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs (shell.async (..bad_shell [])) resolution - (has ///.#lux compiler profile)) - start (# console read_line []) - end (# console read_line [])] - (in (and (text#= /.start start) - (text#= /.failure end))))] - (_.cover' [/.failure] - (try.else false verdict))))) - (do ! - [expected/0 (random.ascii/alpha 5) - expected/1 (random.ascii/alpha 5) - expected/2 (random.ascii/alpha 5)] - (`` ($_ _.and - (~~ (template [<error?> <log!>] - [(let [console (@version.echo "") - shell (|> (list expected/0 expected/1 expected/2) - (..reader_shell <error?>) - shell.async)] - (in (do [! async.monad] - [verdict (do ///action.monad - [process (shell [environment.empty working_directory "" (list "")]) - _ (<log!> console process) - actual/0 (# console read_line []) - actual/1 (# console read_line []) - actual/2 (# console read_line []) - end! (|> (# console read_line []) - (# ! each (|>> (pipe.case - {try.#Failure error} - true - - {try.#Success _} - false) - {try.#Success})))] - (in (and (text#= expected/0 actual/0) - (text#= expected/1 actual/1) - (text#= expected/2 actual/2) - end!)))] - (_.cover' [<log!>] - (try.else false verdict)))))] + {try.#Failure error} + (exception.match? /.no_available_lux error))))) + (do ! + [.let [console (@version.echo "")] + [compiler resolution] ..resolution] + (in (do async.monad + [verdict (do ///action.monad + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs shell resolution + (has ///.#lux compiler profile)) + start (# console read_line []) + end (# console read_line [])] + (in (and (text#= /.start start) + (text#= /.success end))))] + (_.cover' [/.do! + /.lux_group + /.jvm_lux_name + /.js_lux_name + /.python_lux_name + /.lua_lux_name + /.ruby_lux_name + /.start + /.success] + (try.else false verdict))))) + (do ! + [.let [console (@version.echo "")] + [compiler resolution] ..resolution] + (in (do async.monad + [verdict (do ///action.monad + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs (shell.async (..bad_shell [])) resolution + (has ///.#lux compiler profile)) + start (# console read_line []) + end (# console read_line [])] + (in (and (text#= /.start start) + (text#= /.failure end))))] + (_.cover' [/.failure] + (try.else false verdict))))) + (do ! + [expected/0 (random.ascii/alpha 5) + expected/1 (random.ascii/alpha 5) + expected/2 (random.ascii/alpha 5)] + (`` (all _.and + (~~ (template [<error?> <log!>] + [(let [console (@version.echo "") + shell (|> (list expected/0 expected/1 expected/2) + (..reader_shell <error?>) + shell.async)] + (in (do [! async.monad] + [verdict (do ///action.monad + [process (shell [environment.empty working_directory "" (list "")]) + _ (<log!> console process) + actual/0 (# console read_line []) + actual/1 (# console read_line []) + actual/2 (# console read_line []) + end! (|> (# console read_line []) + (# ! each (|>> (pipe.case + {try.#Failure error} + true + + {try.#Success _} + false) + {try.#Success})))] + (in (and (text#= expected/0 actual/0) + (text#= expected/1 actual/1) + (text#= expected/2 actual/2) + end!)))] + (_.cover' [<log!>] + (try.else false verdict)))))] - [#0 /.log_output!] - [#1 /.log_error!] - )) - ))) - )))) + [#0 /.log_output!] + [#1 /.log_error!] + )) + ))) + )))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 414d104d8..d4244bfcf 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -70,36 +70,36 @@ home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) .let [/ (# file.default separator)]] - ($_ _.and - (in (do [! async.monad] - [.let [fs (file.mock /) - program (program.async (program.mock environment.empty home working_directory)) + (all _.and + (in (do [! async.monad] + [.let [fs (file.mock /) + program (program.async (program.mock environment.empty home working_directory)) - artifact_path (///local.uri (the ///artifact.#version identity) identity) - library_path (format artifact_path ///artifact/extension.lux_library) - pom_path (format artifact_path ///artifact/extension.pom)] - verdict (do [! ///action.monad] - [succeeded! (# ! each (text#= /.success) - (..execute! program fs sample)) - library_exists! (|> library_path - (format home /) - (# fs file?) - (# async.monad each (|>> {try.#Success}))) - pom_exists! (|> pom_path - (format home /) - (# fs file?) - (# async.monad each (|>> {try.#Success})))] - (in (and succeeded! - library_exists! - pom_exists!)))] - (_.cover' [/.do! /.success] - (try.else false verdict)))) - (in (do [! async.monad] - [.let [fs (file.mock /) - program (program.async (program.mock environment.empty home working_directory))] - logging (..execute! program fs (has ///.#identity {.#None} sample))] - (_.cover' [/.failure] - (|> logging - (try#each (text#= /.failure)) - (try.else false))))) - )))) + artifact_path (///local.uri (the ///artifact.#version identity) identity) + library_path (format artifact_path ///artifact/extension.lux_library) + pom_path (format artifact_path ///artifact/extension.pom)] + verdict (do [! ///action.monad] + [succeeded! (# ! each (text#= /.success) + (..execute! program fs sample)) + library_exists! (|> library_path + (format home /) + (# fs file?) + (# async.monad each (|>> {try.#Success}))) + pom_exists! (|> pom_path + (format home /) + (# fs file?) + (# async.monad each (|>> {try.#Success})))] + (in (and succeeded! + library_exists! + pom_exists!)))] + (_.cover' [/.do! /.success] + (try.else false verdict)))) + (in (do [! async.monad] + [.let [fs (file.mock /) + program (program.async (program.mock environment.empty home working_directory))] + logging (..execute! program fs (has ///.#identity {.#None} sample))] + (_.cover' [/.failure] + (|> logging + (try#each (text#= /.failure)) + (try.else false))))) + )))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 4109c99ee..34bd05c36 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -58,58 +58,58 @@ with_test with_target)] [compiler resolution] @build.resolution] - ($_ _.and - (let [fs (file.mock (# file.default separator)) - console (@version.echo "")] - (in (do async.monad - [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs (shell.async (@build.good_shell [])) resolution - (has ///.#lux compiler profile)) - build_start (# console read_line []) - build_end (# console read_line []) - test_start (# console read_line []) - test_end (# console read_line [])] - (in (and (and (text#= //build.start build_start) - (text#= //build.success build_end)) - (and (text#= /.start test_start) - (text#= /.success test_end)))))] - (_.cover' [/.do! - /.start /.success] - (try.else false verdict))))) - (let [fs (file.mock (# file.default separator)) - console (@version.echo "")] - (in (do async.monad - [verdict (do ///action.monad - [.let [bad_shell (shell.mock - (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) - {try.#Success - (is (shell.Mock []) - (implementation - (def: (on_read state) - (exception.except shell.no_more_output [])) - (def: (on_fail state) - (exception.except shell.no_more_output [])) - (def: (on_write input state) - {try.#Failure "on_write"}) - (def: (on_destroy state) - {try.#Failure "on_destroy"}) - (def: (on_await state) - {try.#Success [state (if (list.any? (text#= "build") actual_arguments) - shell.normal - shell.error)]})))}) - [])] - _ (/.do! console (program.async (program.mock environment.empty home working_directory)) - fs (shell.async bad_shell) resolution - (has ///.#lux compiler profile)) - build_start (# console read_line []) - build_end (# console read_line []) - test_start (# console read_line []) - test_end (# console read_line [])] - (in (and (and (text#= //build.start build_start) - (text#= //build.success build_end)) - (and (text#= /.start test_start) - (text#= /.failure test_end)))))] - (_.cover' [/.failure] - (try.else false verdict))))) - )))) + (all _.and + (let [fs (file.mock (# file.default separator)) + console (@version.echo "")] + (in (do async.monad + [verdict (do ///action.monad + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs (shell.async (@build.good_shell [])) resolution + (has ///.#lux compiler profile)) + build_start (# console read_line []) + build_end (# console read_line []) + test_start (# console read_line []) + test_end (# console read_line [])] + (in (and (and (text#= //build.start build_start) + (text#= //build.success build_end)) + (and (text#= /.start test_start) + (text#= /.success test_end)))))] + (_.cover' [/.do! + /.start /.success] + (try.else false verdict))))) + (let [fs (file.mock (# file.default separator)) + console (@version.echo "")] + (in (do async.monad + [verdict (do ///action.monad + [.let [bad_shell (shell.mock + (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) + {try.#Success + (is (shell.Mock []) + (implementation + (def: (on_read state) + (exception.except shell.no_more_output [])) + (def: (on_fail state) + (exception.except shell.no_more_output [])) + (def: (on_write input state) + {try.#Failure "on_write"}) + (def: (on_destroy state) + {try.#Failure "on_destroy"}) + (def: (on_await state) + {try.#Success [state (if (list.any? (text#= "build") actual_arguments) + shell.normal + shell.error)]})))}) + [])] + _ (/.do! console (program.async (program.mock environment.empty home working_directory)) + fs (shell.async bad_shell) resolution + (has ///.#lux compiler profile)) + build_start (# console read_line []) + build_end (# console read_line []) + test_start (# console read_line []) + test_end (# console read_line [])] + (in (and (and (text#= //build.start build_start) + (text#= //build.success build_end)) + (and (text#= /.start test_start) + (text#= /.failure test_end)))))] + (_.cover' [/.failure] + (try.else false verdict))))) + )))) diff --git a/stdlib/source/test/aedifex/dependency.lux b/stdlib/source/test/aedifex/dependency.lux index b664d70ac..21e90f754 100644 --- a/stdlib/source/test/aedifex/dependency.lux +++ b/stdlib/source/test/aedifex/dependency.lux @@ -1,35 +1,35 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" hash]]] - [math - ["[0]" random {"+" Random}]]]] - [// - ["@[0]" artifact]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" hash]]] + [math + ["[0]" random {"+" Random}]]]] + [// + ["@[0]" artifact]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Dependency) - ($_ random.and - @artifact.random - (random.ascii/alpha 1))) + (all random.and + @artifact.random + (random.ascii/alpha 1))) (def: .public test Test (<| (_.covering /._) (_.for [/.Dependency] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + )))) diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux index ed834c759..c52ff5f21 100644 --- a/stdlib/source/test/aedifex/dependency/deployment.lux +++ b/stdlib/source/test/aedifex/dependency/deployment.lux @@ -149,56 +149,56 @@ (do [! random.monad] [address (# ! each (text.suffix uri.separator) (random.ascii/upper 10))] - ($_ _.and - (do [! random.monad] - [[dependency expected_artifact package] ..bundle - .let [cache (is Cache - (atom.atom (dictionary.empty text.hash))) - http (..http cache) - repository (repository.async (remote.repository http {.#None} address))]] - (in (do async.monad - [?outcome (/.one repository dependency package) - cache (async.future (atom.read! cache))] - (_.cover' [/.one] - (|> ?outcome - (try#each (verify_one 1 address package cache expected_artifact)) - (try.else false)))))) - (do [! random.monad] - [.let [hash (is (Hash [Dependency Artifact Package]) - (# hash.functor each (|>> product.right product.left product.left) - text.hash))] - num_bundles (# ! each (n.% 10) random.nat) - bundles (|> ..bundle - (random.set hash num_bundles) - (# ! each set.list)) - .let [resolution (list#mix (function (_ [dependency expected_artifact package] resolution) - (dictionary.has dependency package resolution)) - resolution.empty - bundles) - cache (is Cache - (atom.atom (dictionary.empty text.hash))) - http (..http cache) - repository (repository.async (remote.repository http {.#None} address))]] - (in (do async.monad - [?outcome (/.all repository resolution) - cache (async.future (atom.read! cache))] - (_.cover' [/.all] - (|> ?outcome - (try#each (function (_ actual_artifacts) - (let [expected_deployments! - (n.= num_bundles (set.size actual_artifacts)) + (all _.and + (do [! random.monad] + [[dependency expected_artifact package] ..bundle + .let [cache (is Cache + (atom.atom (dictionary.empty text.hash))) + http (..http cache) + repository (repository.async (remote.repository http {.#None} address))]] + (in (do async.monad + [?outcome (/.one repository dependency package) + cache (async.future (atom.read! cache))] + (_.cover' [/.one] + (|> ?outcome + (try#each (verify_one 1 address package cache expected_artifact)) + (try.else false)))))) + (do [! random.monad] + [.let [hash (is (Hash [Dependency Artifact Package]) + (# hash.functor each (|>> product.right product.left product.left) + text.hash))] + num_bundles (# ! each (n.% 10) random.nat) + bundles (|> ..bundle + (random.set hash num_bundles) + (# ! each set.list)) + .let [resolution (list#mix (function (_ [dependency expected_artifact package] resolution) + (dictionary.has dependency package resolution)) + resolution.empty + bundles) + cache (is Cache + (atom.atom (dictionary.empty text.hash))) + http (..http cache) + repository (repository.async (remote.repository http {.#None} address))]] + (in (do async.monad + [?outcome (/.all repository resolution) + cache (async.future (atom.read! cache))] + (_.cover' [/.all] + (|> ?outcome + (try#each (function (_ actual_artifacts) + (let [expected_deployments! + (n.= num_bundles (set.size actual_artifacts)) - every_deployment_was_correct! - (list.every? (function (_ [dependency expected_artifact package]) - (let [deployed! - (set.member? actual_artifacts expected_artifact) + every_deployment_was_correct! + (list.every? (function (_ [dependency expected_artifact package]) + (let [deployed! + (set.member? actual_artifacts expected_artifact) - deployed_correctly! - (verify_one num_bundles address package cache expected_artifact expected_artifact)] - (and deployed! - deployed_correctly!))) - bundles)] - (and expected_deployments! - every_deployment_was_correct!)))) - (try.else false)))))) - )))) + deployed_correctly! + (verify_one num_bundles address package cache expected_artifact expected_artifact)] + (and deployed! + deployed_correctly!))) + bundles)] + (and expected_deployments! + every_deployment_was_correct!)))) + (try.else false)))))) + )))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index c7f81d3c3..bb2411590 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -257,37 +257,37 @@ .let [good (..single expected_artifact expected_package) bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package) bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]] - (`` ($_ _.and - (in (do async.monad - [actual_package (/.one (///repository.mock good []) - [///dependency.#artifact expected_artifact - ///dependency.#type ///artifact/type.lux_library])] - (_.cover' [/.one] - (case actual_package - {try.#Success actual_package} - (# ///package.equivalence = - (has ///package.#origin {///repository/origin.#Remote ""} expected_package) - actual_package) - - {try.#Failure _} - false)))) - (~~ (template [<exception> <bad>] - [(in (do async.monad - [actual_package (/.one (///repository.mock <bad> []) - [///dependency.#artifact expected_artifact - ///dependency.#type ///artifact/type.lux_library])] - (_.cover' [<exception>] - (case actual_package - {try.#Failure error} - (exception.match? <exception> error) - - {try.#Success _} - false))))] - - [/.sha-1_does_not_match bad_sha-1] - [/.md5_does_not_match bad_md5] - )) - )))) + (`` (all _.and + (in (do async.monad + [actual_package (/.one (///repository.mock good []) + [///dependency.#artifact expected_artifact + ///dependency.#type ///artifact/type.lux_library])] + (_.cover' [/.one] + (case actual_package + {try.#Success actual_package} + (# ///package.equivalence = + (has ///package.#origin {///repository/origin.#Remote ""} expected_package) + actual_package) + + {try.#Failure _} + false)))) + (~~ (template [<exception> <bad>] + [(in (do async.monad + [actual_package (/.one (///repository.mock <bad> []) + [///dependency.#artifact expected_artifact + ///dependency.#type ///artifact/type.lux_library])] + (_.cover' [<exception>] + (case actual_package + {try.#Failure error} + (exception.match? <exception> error) + + {try.#Success _} + false))))] + + [/.sha-1_does_not_match bad_sha-1] + [/.md5_does_not_match bad_md5] + )) + )))) (def: any Test @@ -302,39 +302,39 @@ .let [good (..single expected_artifact expected_package) bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package) bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]] - ($_ _.and - (in (do async.monad - [.let [console ($///version.echo "")] - actual_package (/.any console - (list (///repository.mock bad_sha-1 []) - (///repository.mock bad_md5 []) - (///repository.mock good [])) - [///dependency.#artifact expected_artifact - ///dependency.#type ///artifact/type.lux_library])] - (_.cover' [/.any] - (case actual_package - {try.#Success actual_package} - (# ///package.equivalence = - (has ///package.#origin {///repository/origin.#Remote ""} expected_package) - actual_package) - - {try.#Failure _} - false)))) - (in (do async.monad - [.let [console ($///version.echo "")] - actual_package (/.any console - (list (///repository.mock bad_sha-1 []) - (///repository.mock bad_md5 [])) - [///dependency.#artifact expected_artifact - ///dependency.#type ///artifact/type.lux_library])] - (_.cover' [/.cannot_resolve] - (case actual_package - {try.#Failure error} - (exception.match? /.cannot_resolve error) - - {try.#Success _} - false)))) - ))) + (all _.and + (in (do async.monad + [.let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) + (///repository.mock bad_md5 []) + (///repository.mock good [])) + [///dependency.#artifact expected_artifact + ///dependency.#type ///artifact/type.lux_library])] + (_.cover' [/.any] + (case actual_package + {try.#Success actual_package} + (# ///package.equivalence = + (has ///package.#origin {///repository/origin.#Remote ""} expected_package) + actual_package) + + {try.#Failure _} + false)))) + (in (do async.monad + [.let [console ($///version.echo "")] + actual_package (/.any console + (list (///repository.mock bad_sha-1 []) + (///repository.mock bad_md5 [])) + [///dependency.#artifact expected_artifact + ///dependency.#type ///artifact/type.lux_library])] + (_.cover' [/.cannot_resolve] + (case actual_package + {try.#Failure error} + (exception.match? /.cannot_resolve error) + + {try.#Success _} + false)))) + ))) (def: artifacts (Random [Artifact Artifact Artifact]) @@ -405,40 +405,40 @@ [[dependee depender ignored] [dependee_package depender_package ignored_package]] (..packages [dependee_artifact depender_artifact ignored_artifact])] - ($_ _.and - (in (do async.monad - [.let [console ($///version.echo "")] - [successes failures resolution] (/.all console - (list (///repository.mock (..single dependee_artifact dependee_package) []) - (///repository.mock (..single depender_artifact depender_package) []) - (///repository.mock (..single ignored_artifact ignored_package) [])) - (function (_ url) - (///repository.mock ..nope [])) - (list depender) - /.empty)] - (_.cover' [/.all] - (and (dictionary.key? resolution depender) - (list.any? (///dependency#= depender) successes) - - (dictionary.key? resolution dependee) - (list.any? (///dependency#= dependee) successes) - - (list.empty? failures) - (not (dictionary.key? resolution ignored)))))) - ))) + (all _.and + (in (do async.monad + [.let [console ($///version.echo "")] + [successes failures resolution] (/.all console + (list (///repository.mock (..single dependee_artifact dependee_package) []) + (///repository.mock (..single depender_artifact depender_package) []) + (///repository.mock (..single ignored_artifact ignored_package) [])) + (function (_ url) + (///repository.mock ..nope [])) + (list depender) + /.empty)] + (_.cover' [/.all] + (and (dictionary.key? resolution depender) + (list.any? (///dependency#= depender) successes) + + (dictionary.key? resolution dependee) + (list.any? (///dependency#= dependee) successes) + + (list.empty? failures) + (not (dictionary.key? resolution ignored)))))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Resolution]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (_.cover [/.empty] - (dictionary.empty? /.empty)) + (_.cover [/.empty] + (dictionary.empty? /.empty)) - ..one - ..any - ..all - ))) + ..one + ..any + ..all + ))) diff --git a/stdlib/source/test/aedifex/dependency/status.lux b/stdlib/source/test/aedifex/dependency/status.lux index 5008cbb9a..948de489f 100644 --- a/stdlib/source/test/aedifex/dependency/status.lux +++ b/stdlib/source/test/aedifex/dependency/status.lux @@ -1,48 +1,48 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [data - ["[0]" binary "_" - ["[1]T" \\test]]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] - ["$[0]" /// "_" - ["[1][0]" hash]] - [\\program - ["[0]" / - ["//[1]" /// "_" - ["[1][0]" hash]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [data + ["[0]" binary "_" + ["[1]T" \\test]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] + ["$[0]" /// "_" + ["[1][0]" hash]] + [\\program + ["[0]" / + ["//[1]" /// "_" + ["[1][0]" hash]]]]) (def: .public random (Random /.Status) - ($_ random.or - (random#in []) - (random.or ($///hash.random ///hash.sha-1) - ($///hash.random ///hash.md5)) - (random.and ($///hash.random ///hash.sha-1) + (all random.or + (random#in []) + (random.or ($///hash.random ///hash.sha-1) ($///hash.random ///hash.md5)) - )) + (random.and ($///hash.random ///hash.sha-1) + ($///hash.random ///hash.md5)) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Status] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [payload (binaryT.random 1)] - (_.cover [/.verified] - (case (/.verified payload) - {/.#Verified sha1 md5} - true + (do random.monad + [payload (binaryT.random 1)] + (_.cover [/.verified] + (case (/.verified payload) + {/.#Verified sha1 md5} + true - _ - false))) - )))) + _ + false))) + )))) diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index 8f6558cb5..804708085 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -1,29 +1,29 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" codec]]] - [control - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" binary {"+" Binary}] - [text - ["%" format {"+" format}]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\program - ["[0]" /]] - [test - [lux - [data - ["_[0]" binary]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" codec]]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" binary {"+" Binary}] + [text + ["%" format {"+" format}]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\program + ["[0]" /]] + [test + [lux + [data + ["_[0]" binary]]]]) (def: .public (random hash) (All (_ h) @@ -37,59 +37,59 @@ Test (<| (_.covering /._) (_.for [/.Hash /.SHA-1 /.MD5]) - (`` ($_ _.and - (_.for [/.equivalence] - ($_ _.and - ($equivalence.spec /.equivalence (..random /.sha-1)) - ($equivalence.spec /.equivalence (..random /.md5)) - )) - (_.for [/.data] - ($_ _.and - (~~ (template [<hash> <constructor> <exception>] - [(do random.monad - [expected (..random <hash>)] - (_.cover [<hash> <constructor> <exception>] - (and (case (<constructor> (/.data expected)) - {try.#Success actual} - (# /.equivalence = expected actual) + (`` (all _.and + (_.for [/.equivalence] + (all _.and + ($equivalence.spec /.equivalence (..random /.sha-1)) + ($equivalence.spec /.equivalence (..random /.md5)) + )) + (_.for [/.data] + (all _.and + (~~ (template [<hash> <constructor> <exception>] + [(do random.monad + [expected (..random <hash>)] + (_.cover [<hash> <constructor> <exception>] + (and (case (<constructor> (/.data expected)) + {try.#Success actual} + (# /.equivalence = expected actual) - {try.#Failure error} - false) - (case (<constructor> (# binary.monoid composite - (/.data expected) - (/.data expected))) - {try.#Success actual} - false + {try.#Failure error} + false) + (case (<constructor> (# binary.monoid composite + (/.data expected) + (/.data expected))) + {try.#Success actual} + false - {try.#Failure error} - (exception.match? <exception> error)))))] + {try.#Failure error} + (exception.match? <exception> error)))))] - [/.sha-1 /.as_sha-1 /.not_a_sha-1] - [/.md5 /.as_md5 /.not_a_md5] - )))) - (~~ (template [<codec> <hash>] - [(_.for [<codec>] - ($codec.spec /.equivalence <codec> (..random <hash>)))] - - [/.sha-1_codec /.sha-1] - [/.md5_codec /.md5] - )) - (_.for [/.not_a_hash] - ($_ _.and - (~~ (template [<codec> <hash>] - [(do random.monad - [expected (..random <hash>)] - (_.cover [<codec>] - (case (# <codec> decoded - (format (# <codec> encoded expected) - "AABBCC")) - {try.#Success actual} - false + [/.sha-1 /.as_sha-1 /.not_a_sha-1] + [/.md5 /.as_md5 /.not_a_md5] + )))) + (~~ (template [<codec> <hash>] + [(_.for [<codec>] + ($codec.spec /.equivalence <codec> (..random <hash>)))] + + [/.sha-1_codec /.sha-1] + [/.md5_codec /.md5] + )) + (_.for [/.not_a_hash] + (all _.and + (~~ (template [<codec> <hash>] + [(do random.monad + [expected (..random <hash>)] + (_.cover [<codec>] + (case (# <codec> decoded + (format (# <codec> encoded expected) + "AABBCC")) + {try.#Success actual} + false - {try.#Failure error} - (exception.match? /.not_a_hash error))))] + {try.#Failure error} + (exception.match? /.not_a_hash error))))] - [/.sha-1_codec /.sha-1] - [/.md5_codec /.md5] - )))) - )))) + [/.sha-1_codec /.sha-1] + [/.md5_codec /.md5] + )))) + )))) diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index 241915579..c46a1679d 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -20,8 +20,8 @@ (<| (_.covering /._) (do [! random.monad] [sample @artifact.random] - ($_ _.and - (_.cover [/.repository /.uri] - (text.starts_with? /.repository - (/.uri (the //artifact.#version sample) sample))) - )))) + (all _.and + (_.cover [/.repository /.uri] + (text.starts_with? /.repository + (/.uri (the //artifact.#version sample) sample))) + )))) diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index b3176a5c7..5ff5988ee 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -1,51 +1,51 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" text ("[1]#[0]" equivalence)]] - [math - ["[0]" random]]]] - ["[0]" / "_" - ["[1][0]" artifact] - ["[1][0]" snapshot] - [// - ["$[0]" artifact]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" equivalence)]] + [math + ["[0]" random]]]] + ["[0]" / "_" + ["[1][0]" artifact] + ["[1][0]" snapshot] + [// + ["$[0]" artifact]]] + [\\program + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [sample $artifact.random] - ($_ _.and - (_.cover [/.remote_artifact_uri /.remote_project_uri] - (not (text#= (/.remote_artifact_uri sample) - (/.remote_project_uri sample)))) - (_.cover [/.local_uri] - (let [remote_artifact_uri (/.remote_artifact_uri sample) - remote_project_uri (/.remote_project_uri sample)] - (and (not (text#= remote_artifact_uri (/.local_uri remote_artifact_uri))) - (not (text#= remote_project_uri (/.local_uri remote_project_uri)))))) - (_.cover [/.remote_uri] - (let [remote_artifact_uri (/.remote_artifact_uri sample) - remote_project_uri (/.remote_project_uri sample)] - (and (text#= remote_artifact_uri (/.remote_uri remote_artifact_uri)) - (text#= remote_project_uri (/.remote_uri remote_project_uri)) - (|> remote_artifact_uri - /.local_uri - /.remote_uri - (text#= remote_artifact_uri)) - (|> remote_project_uri - /.local_uri - /.remote_uri - (text#= remote_project_uri))))) - )) - - /artifact.test - /snapshot.test - ))) + (all _.and + (do random.monad + [sample $artifact.random] + (all _.and + (_.cover [/.remote_artifact_uri /.remote_project_uri] + (not (text#= (/.remote_artifact_uri sample) + (/.remote_project_uri sample)))) + (_.cover [/.local_uri] + (let [remote_artifact_uri (/.remote_artifact_uri sample) + remote_project_uri (/.remote_project_uri sample)] + (and (not (text#= remote_artifact_uri (/.local_uri remote_artifact_uri))) + (not (text#= remote_project_uri (/.local_uri remote_project_uri)))))) + (_.cover [/.remote_uri] + (let [remote_artifact_uri (/.remote_artifact_uri sample) + remote_project_uri (/.remote_project_uri sample)] + (and (text#= remote_artifact_uri (/.remote_uri remote_artifact_uri)) + (text#= remote_project_uri (/.remote_uri remote_project_uri)) + (|> remote_artifact_uri + /.local_uri + /.remote_uri + (text#= remote_artifact_uri)) + (|> remote_project_uri + /.local_uri + /.remote_uri + (text#= remote_project_uri))))) + )) + + /artifact.test + /snapshot.test + ))) diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index bf94bf600..1459a88e5 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -43,28 +43,28 @@ (def: .public random (Random /.Metadata) - ($_ random.and - (random.ascii/alpha 5) - (random.ascii/alpha 5) - (random.list 5 (random.ascii/alpha 5)) - (do [! random.monad] - [year (# ! each (|>> (n.% 9,000) (n.+ 1,000) .int) random.nat) - month (# ! each (|>> (n.% 12) (n.+ 1)) random.nat) - day_of_month (# ! each (|>> (n.% 28) (n.+ 1)) random.nat) - hour (# ! each (n.% 24) random.nat) - minute (# ! each (n.% 60) random.nat) - second (# ! each (n.% 60) random.nat)] - (in (try.trusted - (do try.monad - [year (year.year year) - month (month.by_number month) - date (date.date year month day_of_month) - time (time.time - [time.#hour hour - time.#minute minute - time.#second second - time.#milli_second 0])] - (in (instant.of_date_time date time)))))))) + (all random.and + (random.ascii/alpha 5) + (random.ascii/alpha 5) + (random.list 5 (random.ascii/alpha 5)) + (do [! random.monad] + [year (# ! each (|>> (n.% 9,000) (n.+ 1,000) .int) random.nat) + month (# ! each (|>> (n.% 12) (n.+ 1)) random.nat) + day_of_month (# ! each (|>> (n.% 28) (n.+ 1)) random.nat) + hour (# ! each (n.% 24) random.nat) + minute (# ! each (n.% 60) random.nat) + second (# ! each (n.% 60) random.nat)] + (in (try.trusted + (do try.monad + [year (year.year year) + month (month.by_number month) + date (date.date year month day_of_month) + time (time.time + [time.#hour hour + time.#minute minute + time.#second second + time.#milli_second 0])] + (in (instant.of_date_time date time)))))))) (def: .public test Test @@ -78,39 +78,39 @@ (the /.#versions) list.head (maybe.else ""))]]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - (_.cover [/.uri] - (text#= (//.remote_project_uri artifact) - (/.uri artifact))) - (do random.monad - [home (random.ascii/lower 5) - working_directory (random.ascii/lower 5) - .let [program (program.async (program.mock environment.empty home working_directory)) - fs (file.mock (# file.default separator)) - repository (///repository/local.repository program fs)]] - (in (do async.monad - [wrote? (/.write repository artifact expected) - actual (/.read repository artifact)] - (_.cover' [/.write /.read] - (and (case wrote? - {try.#Success _} true - {try.#Failure _} false) - (case actual - {try.#Success actual} - (# /.equivalence = expected actual) - - {try.#Failure _} - false)))))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + (_.cover [/.uri] + (text#= (//.remote_project_uri artifact) + (/.uri artifact))) + (do random.monad + [home (random.ascii/lower 5) + working_directory (random.ascii/lower 5) + .let [program (program.async (program.mock environment.empty home working_directory)) + fs (file.mock (# file.default separator)) + repository (///repository/local.repository program fs)]] + (in (do async.monad + [wrote? (/.write repository artifact expected) + actual (/.read repository artifact)] + (_.cover' [/.write /.read] + (and (case wrote? + {try.#Success _} true + {try.#Failure _} false) + (case actual + {try.#Success actual} + (# /.equivalence = expected actual) + + {try.#Failure _} + false)))))) + )))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index 4735a6994..bb862dca2 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -72,18 +72,18 @@ (def: random_versioning (Random Versioning) - ($_ random.and - (random#in {///snapshot.#Local}) - $///artifact/time.random - (random.list 5 $///artifact/snapshot/version.random) - )) + (all random.and + (random#in {///snapshot.#Local}) + $///artifact/time.random + (random.list 5 $///artifact/snapshot/version.random) + )) (def: .public random (Random /.Metadata) - ($_ random.and - $///artifact.random - ..random_versioning - )) + (all random.and + $///artifact.random + ..random_versioning + )) (def: .public test Test @@ -92,37 +92,37 @@ (do random.monad [expected ..random .let [artifact (the /.#artifact expected)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.format /.parser] - (|> expected - /.format - list - (<xml>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.uri] - (text#= (//.remote_artifact_uri artifact) - (/.uri artifact))) - (do random.monad - [home (random.ascii/lower 5) - working_directory (random.ascii/lower 5) - .let [program (program.async (program.mock environment.empty home working_directory)) - fs (file.mock (# file.default separator)) - repository (///repository/local.repository program fs)]] - (in (do async.monad - [wrote? (/.write repository artifact expected) - actual (/.read repository artifact)] - (_.cover' [/.write /.read] - (and (case wrote? - {try.#Success _} true - {try.#Failure _} false) - (case actual - {try.#Success actual} - (# /.equivalence = expected actual) - - {try.#Failure _} - false)))))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.format /.parser] + (|> expected + /.format + list + (<xml>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.uri] + (text#= (//.remote_artifact_uri artifact) + (/.uri artifact))) + (do random.monad + [home (random.ascii/lower 5) + working_directory (random.ascii/lower 5) + .let [program (program.async (program.mock environment.empty home working_directory)) + fs (file.mock (# file.default separator)) + repository (///repository/local.repository program fs)]] + (in (do async.monad + [wrote? (/.write repository artifact expected) + actual (/.read repository artifact)] + (_.cover' [/.write /.read] + (and (case wrote? + {try.#Success _} true + {try.#Failure _} false) + (case actual + {try.#Success actual} + (# /.equivalence = expected actual) + + {try.#Failure _} + false)))))) + )))) diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index af51453dd..28d763e4c 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -59,64 +59,64 @@ (_.for [/.Package]) (do [! random.monad] [[profile package] ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (# ! each product.right ..random))) - - (_.cover [/.local?] - (/.local? (has /.#origin {//origin.#Local "~/yolo"} package))) - (_.cover [/.remote?] - (/.remote? (has /.#origin {//origin.#Remote "https://example.com"} package))) - (_.cover [/.local] - (let [expected_pom (|> package (the /.#pom) product.left) - expected_library (|> package (the /.#library) product.left) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (# ! each product.right ..random))) + + (_.cover [/.local?] + (/.local? (has /.#origin {//origin.#Local "~/yolo"} package))) + (_.cover [/.remote?] + (/.remote? (has /.#origin {//origin.#Remote "https://example.com"} package))) + (_.cover [/.local] + (let [expected_pom (|> package (the /.#pom) product.left) + expected_library (|> package (the /.#library) product.left) - local (/.local expected_pom expected_library) + local (/.local expected_pom expected_library) - [actual_pom binary_pom pom_status] (the /.#pom local) - [actual_library library_status] (the /.#library local)] - (and (case (the /.#origin local) - {//origin.#Local ""} true - _ false) - (let [expected_sha1 (//hash.sha-1 expected_library) - expected_md5 (//hash.md5 expected_library)] - (and (same? expected_library actual_library) - (case library_status - {//status.#Verified actual_sha1 expected_md5} - (and (//hash#= expected_sha1 actual_sha1) - (//hash#= expected_md5 expected_md5)) - - _ - false))) - (let [expected_sha1 (//hash.sha-1 binary_pom) - expected_md5 (//hash.md5 binary_pom)] - (and (same? expected_pom actual_pom) - (|> (do try.monad - [xml_pom (# utf8.codec decoded binary_pom) - decoded_pom (# xml.codec decoded xml_pom)] - (in (# xml.equivalence = actual_pom decoded_pom))) - (try.else false)) - (case pom_status - {//status.#Verified actual_sha1 expected_md5} - (and (//hash#= expected_sha1 actual_sha1) - (//hash#= expected_md5 expected_md5)) - - _ - false)))))) - (_.cover [/.dependencies] - (let [expected (the //.#dependencies profile)] - (case (/.dependencies package) - {try.#Success actual} - (# set.equivalence = expected actual) - - {try.#Failure error} - false))) - (_.cover [/.repositories] - (let [expected (the //.#repositories profile)] - (case (/.repositories package) - {try.#Success actual} - (# set.equivalence = expected actual) - - {try.#Failure error} - false))) - )))) + [actual_pom binary_pom pom_status] (the /.#pom local) + [actual_library library_status] (the /.#library local)] + (and (case (the /.#origin local) + {//origin.#Local ""} true + _ false) + (let [expected_sha1 (//hash.sha-1 expected_library) + expected_md5 (//hash.md5 expected_library)] + (and (same? expected_library actual_library) + (case library_status + {//status.#Verified actual_sha1 expected_md5} + (and (//hash#= expected_sha1 actual_sha1) + (//hash#= expected_md5 expected_md5)) + + _ + false))) + (let [expected_sha1 (//hash.sha-1 binary_pom) + expected_md5 (//hash.md5 binary_pom)] + (and (same? expected_pom actual_pom) + (|> (do try.monad + [xml_pom (# utf8.codec decoded binary_pom) + decoded_pom (# xml.codec decoded xml_pom)] + (in (# xml.equivalence = actual_pom decoded_pom))) + (try.else false)) + (case pom_status + {//status.#Verified actual_sha1 expected_md5} + (and (//hash#= expected_sha1 actual_sha1) + (//hash#= expected_md5 expected_md5)) + + _ + false)))))) + (_.cover [/.dependencies] + (let [expected (the //.#dependencies profile)] + (case (/.dependencies package) + {try.#Success actual} + (# set.equivalence = expected actual) + + {try.#Failure error} + false))) + (_.cover [/.repositories] + (let [expected (the //.#repositories profile)] + (case (/.repositories package) + {try.#Success actual} + (# set.equivalence = expected actual) + + {try.#Failure error} + false))) + )))) diff --git a/stdlib/source/test/aedifex/pom.lux b/stdlib/source/test/aedifex/pom.lux index e6d5340e2..bf29cfeb5 100644 --- a/stdlib/source/test/aedifex/pom.lux +++ b/stdlib/source/test/aedifex/pom.lux @@ -25,33 +25,33 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.file] - (|> /.file - (text#= "") - not)) - (do random.monad - [expected @profile.random] - (_.cover [/.write /.parser] - (case [(/.write expected) - (the //.#identity expected)] - [{try.#Success pom} - {.#Some _}] - (case (<xml>.result /.parser (list pom)) - {try.#Success actual} - (# //.equivalence = - (|> (# //.monoid identity) - (has //.#dependencies (the //.#dependencies expected)) - (has //.#repositories (the //.#repositories expected))) - actual) + (all _.and + (_.cover [/.file] + (|> /.file + (text#= "") + not)) + (do random.monad + [expected @profile.random] + (_.cover [/.write /.parser] + (case [(/.write expected) + (the //.#identity expected)] + [{try.#Success pom} + {.#Some _}] + (case (<xml>.result /.parser (list pom)) + {try.#Success actual} + (# //.equivalence = + (|> (# //.monoid identity) + (has //.#dependencies (the //.#dependencies expected)) + (has //.#repositories (the //.#repositories expected))) + actual) - {try.#Failure error} - false) + {try.#Failure error} + false) - [{try.#Failure error} - {.#None}] - (exception.match? //.no_identity error) + [{try.#Failure error} + {.#None}] + (exception.match? //.no_identity error) - _ - false))) - ))) + _ + false))) + ))) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index e674942e0..246492587 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -46,10 +46,10 @@ (def: license (Random /.License) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - ..distribution)) + (all random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + ..distribution)) (def: scm (Random /.SCM) @@ -57,9 +57,9 @@ (def: organization (Random /.Organization) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1))) + (all random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1))) (def: email (Random /.Email) @@ -67,10 +67,10 @@ (def: developer (Random /.Developer) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.maybe organization))) + (all random.and + (random.ascii/alpha 1) + (random.ascii/alpha 1) + (random.maybe organization))) (def: contributor (Random /.Contributor) @@ -96,16 +96,16 @@ (def: info (Random /.Info) - ($_ random.and - (random.maybe (random.ascii/alpha 1)) - (random.maybe (random.ascii/alpha 2)) - (random.maybe ..scm) - (random.maybe (random.ascii/alpha 3)) - (..list_of ..license) - (random.maybe ..organization) - (..list_of ..developer) - (..list_of ..contributor) - )) + (all random.and + (random.maybe (random.ascii/alpha 1)) + (random.maybe (random.ascii/alpha 2)) + (random.maybe ..scm) + (random.maybe (random.ascii/alpha 3)) + (..list_of ..license) + (random.maybe ..organization) + (..list_of ..developer) + (..list_of ..contributor) + )) (def: name (Random /.Name) @@ -125,27 +125,27 @@ (def: .public random (Random /.Profile) - ($_ random.and - (..list_of ..name) - (random.maybe @artifact.random) - (random.maybe ..info) - (..set_of text.hash ..repository) - (..set_of //dependency.hash @dependency.random) - @dependency.random - (..list_of $compiler.random) - (..set_of text.hash ..source) - ..target - (random.maybe (random.ascii/alpha 1)) - (random.maybe (random.ascii/alpha 2)) - (..dictionary_of text.hash (random.ascii/alpha 3) ..repository) - (..list_of (random.and (random.ascii/alpha 4) - (random.ascii/alpha 5))) - (random#in //runtime.default_java) - (random#in //runtime.default_js) - (random#in //runtime.default_python) - (random#in //runtime.default_lua) - (random#in //runtime.default_ruby) - )) + (all random.and + (..list_of ..name) + (random.maybe @artifact.random) + (random.maybe ..info) + (..set_of text.hash ..repository) + (..set_of //dependency.hash @dependency.random) + @dependency.random + (..list_of $compiler.random) + (..set_of text.hash ..source) + ..target + (random.maybe (random.ascii/alpha 1)) + (random.maybe (random.ascii/alpha 2)) + (..dictionary_of text.hash (random.ascii/alpha 3) ..repository) + (..list_of (random.and (random.ascii/alpha 4) + (random.ascii/alpha 5))) + (random#in //runtime.default_java) + (random#in //runtime.default_js) + (random#in //runtime.default_python) + (random#in //runtime.default_lua) + (random#in //runtime.default_ruby) + )) (def: .public test Test @@ -153,20 +153,20 @@ (_.for [/.Distribution /.License /.SCM /.Organization /.Email /.Developer /.Contributor /.Info /.Source /.Target /.Name /.Profile] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid ..random)) - - (_.cover [/.default] - (text#= "" /.default)) - (_.cover [/.default_lux] - (|> (# /.monoid identity) - (the /.#lux) - (same? /.default_lux))) - (_.cover [/.default_target] - (|> (# /.monoid identity) - (the /.#target) - (same? /.default_target))) - ))))) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + + (_.cover [/.default] + (text#= "" /.default)) + (_.cover [/.default_lux] + (|> (# /.monoid identity) + (the /.#lux) + (same? /.default_lux))) + (_.cover [/.default_target] + (|> (# /.monoid identity) + (the /.#target) + (same? /.default_target))) + ))))) diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index c7bbe62c0..cf3a93e52 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -40,61 +40,61 @@ Test (<| (_.covering /._) (_.for [/.Project /.project] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) - (_.cover [/.file] - (|> /.file - (text#= "") - not)) - (do random.monad - [[super_name super_profile] ..profile - [dummy_name dummy_profile] (random.only (|>> product.left (text#= super_name) not) - ..profile) - [sub_name sub_profile] (random.only (function (_ [name profile]) - (and (not (text#= super_name name)) - (not (text#= dummy_name name)))) - ..profile) - fake_name (random.only (function (_ name) - (and (not (text#= super_name name)) - (not (text#= dummy_name name)) - (not (text#= sub_name name)))) - (random.ascii/alpha 1)) - .let [project ($_ (# /.monoid composite) - (/.project super_name super_profile) - (/.project dummy_name dummy_profile) - (/.project sub_name (has //.#parents (list super_name) sub_profile))) - circular ($_ (# /.monoid composite) - (/.project super_name (has //.#parents (list sub_name) super_profile)) - (/.project dummy_name dummy_profile) - (/.project sub_name (has //.#parents (list super_name) sub_profile)))]] - ($_ _.and - (_.cover [/.profile] - (and (|> (/.profile project super_name) - (try#each (# //.equivalence = super_profile)) - (try.else false)) - (|> (/.profile project dummy_name) - (try#each (# //.equivalence = dummy_profile)) - (try.else false)) - (|> (/.profile project sub_name) - (try#each (# //.equivalence = (# //.monoid composite sub_profile super_profile))) - (try.else false)))) - (_.cover [/.unknown_profile] - (case (/.profile project fake_name) - {try.#Success _} - false + (_.cover [/.file] + (|> /.file + (text#= "") + not)) + (do random.monad + [[super_name super_profile] ..profile + [dummy_name dummy_profile] (random.only (|>> product.left (text#= super_name) not) + ..profile) + [sub_name sub_profile] (random.only (function (_ [name profile]) + (and (not (text#= super_name name)) + (not (text#= dummy_name name)))) + ..profile) + fake_name (random.only (function (_ name) + (and (not (text#= super_name name)) + (not (text#= dummy_name name)) + (not (text#= sub_name name)))) + (random.ascii/alpha 1)) + .let [project (all (# /.monoid composite) + (/.project super_name super_profile) + (/.project dummy_name dummy_profile) + (/.project sub_name (has //.#parents (list super_name) sub_profile))) + circular (all (# /.monoid composite) + (/.project super_name (has //.#parents (list sub_name) super_profile)) + (/.project dummy_name dummy_profile) + (/.project sub_name (has //.#parents (list super_name) sub_profile)))]] + (all _.and + (_.cover [/.profile] + (and (|> (/.profile project super_name) + (try#each (# //.equivalence = super_profile)) + (try.else false)) + (|> (/.profile project dummy_name) + (try#each (# //.equivalence = dummy_profile)) + (try.else false)) + (|> (/.profile project sub_name) + (try#each (# //.equivalence = (# //.monoid composite sub_profile super_profile))) + (try.else false)))) + (_.cover [/.unknown_profile] + (case (/.profile project fake_name) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.unknown_profile error))) - (_.cover [/.circular_dependency] - (case (/.profile circular sub_name) - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.unknown_profile error))) + (_.cover [/.circular_dependency] + (case (/.profile circular sub_name) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.circular_dependency error))) - )) - )))) + {try.#Failure error} + (exception.match? /.circular_dependency error))) + )) + )))) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index b4009cea9..80d3f43e9 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -87,21 +87,21 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.mock /.Mock] - (do random.monad - [_ (in [])] - ($/.spec (..artifact ..valid_version) - (..artifact ..invalid_version) - (/.mock ..mock - (|> ..empty - (dictionary.has (remote.uri ..invalid_version - (..artifact ..invalid_version) - //artifact/extension.lux_library) - (binary.empty 0))))))) + (all _.and + (_.for [/.mock /.Mock] + (do random.monad + [_ (in [])] + ($/.spec (..artifact ..valid_version) + (..artifact ..invalid_version) + (/.mock ..mock + (|> ..empty + (dictionary.has (remote.uri ..invalid_version + (..artifact ..invalid_version) + //artifact/extension.lux_library) + (binary.empty 0))))))) - /identity.test - /origin.test - /local.test - /remote.test - ))) + /identity.test + /origin.test + /local.test + /remote.test + ))) diff --git a/stdlib/source/test/aedifex/repository/identity.lux b/stdlib/source/test/aedifex/repository/identity.lux index 90a2e1681..5e357ecca 100644 --- a/stdlib/source/test/aedifex/repository/identity.lux +++ b/stdlib/source/test/aedifex/repository/identity.lux @@ -1,27 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}]]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}]]]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Identity) - ($_ random.and - (random.ascii/alpha 10) - (random.ascii/alpha 10) - )) + (all random.and + (random.ascii/alpha 10) + (random.ascii/alpha 10) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.User /.Password /.Identity] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + )))) diff --git a/stdlib/source/test/aedifex/repository/local.lux b/stdlib/source/test/aedifex/repository/local.lux index f3b8fed6b..c5da9011d 100644 --- a/stdlib/source/test/aedifex/repository/local.lux +++ b/stdlib/source/test/aedifex/repository/local.lux @@ -1,27 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["[0]" environment]] - [concurrency - ["[0]" async]]] - [data - ["[0]" binary ("[1]#[0]" equivalence)] - [text - [encoding - ["[0]" utf8]]]] - [math - ["[0]" random]] - [world - ["[0]" file] - ["[0]" program]]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["[0]" environment]] + [concurrency + ["[0]" async]]] + [data + ["[0]" binary ("[1]#[0]" equivalence)] + [text + [encoding + ["[0]" utf8]]]] + [math + ["[0]" random]] + [world + ["[0]" file] + ["[0]" program]]]] + [\\program + ["[0]" /]]) (def: .public test Test @@ -37,16 +37,16 @@ uri (random.ascii/lower 10) expected (# ! each (# utf8.codec encoded) (random.ascii/lower 10))] - ($_ _.and - (in (do async.monad - [before_upload (# repo download uri) - _ (# repo upload uri expected) - actual (# repo download uri)] - (_.cover' [/.repository] - (and (case before_upload - {try.#Success _} false - {try.#Failure _} true) - (|> actual - (try#each (binary#= expected)) - (try.else false)))))) - )))) + (all _.and + (in (do async.monad + [before_upload (# repo download uri) + _ (# repo upload uri expected) + actual (# repo download uri)] + (_.cover' [/.repository] + (and (case before_upload + {try.#Success _} false + {try.#Failure _} true) + (|> actual + (try#each (binary#= expected)) + (try.else false)))))) + )))) diff --git a/stdlib/source/test/aedifex/repository/origin.lux b/stdlib/source/test/aedifex/repository/origin.lux index cabea3904..a0bcff68d 100644 --- a/stdlib/source/test/aedifex/repository/origin.lux +++ b/stdlib/source/test/aedifex/repository/origin.lux @@ -1,27 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}]]]] - [\\program - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}]]]] + [\\program + ["[0]" /]]) (def: .public random (Random /.Origin) - ($_ random.or - (random.ascii/alpha 10) - (random.ascii/alpha 10) - )) + (all random.or + (random.ascii/alpha 10) + (random.ascii/alpha 10) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Origin] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + )))) diff --git a/stdlib/source/test/aedifex/repository/remote.lux b/stdlib/source/test/aedifex/repository/remote.lux index bd2e68612..abf123f4b 100644 --- a/stdlib/source/test/aedifex/repository/remote.lux +++ b/stdlib/source/test/aedifex/repository/remote.lux @@ -92,40 +92,40 @@ content (# ! each (# utf8.codec encoded) (random.ascii/lower 10))] - ($_ _.and - (_.cover [/.repository /.user_agent /.Address] - (let [repo (/.repository (..good_http user password) - {.#Some [//identity.#user user - //identity.#password password]} - address)] - (and (|> (# repo download uri) - io.run! - (try#each (# utf8.codec decoded)) - try#conjoint - (try#each (text#= (format address uri))) - (try.else false)) - (|> (# repo upload uri content) - io.run! - (try#each (function.constant true)) - (try.else false))))) - (_.cover [/.upload_failure] - (let [repo (/.repository (..good_http user password) - {.#None} - address)] - (case (io.run! (# repo upload uri content)) - {try.#Failure error} - (exception.match? /.upload_failure error) - - {try.#Success _} - false))) - (_.cover [/.download_failure] - (let [repo (/.repository ..bad_http - {.#None} - address)] - (case (io.run! (# repo download uri)) - {try.#Failure error} - (exception.match? /.download_failure error) - - {try.#Success _} - false))) - )))) + (all _.and + (_.cover [/.repository /.user_agent /.Address] + (let [repo (/.repository (..good_http user password) + {.#Some [//identity.#user user + //identity.#password password]} + address)] + (and (|> (# repo download uri) + io.run! + (try#each (# utf8.codec decoded)) + try#conjoint + (try#each (text#= (format address uri))) + (try.else false)) + (|> (# repo upload uri content) + io.run! + (try#each (function.constant true)) + (try.else false))))) + (_.cover [/.upload_failure] + (let [repo (/.repository (..good_http user password) + {.#None} + address)] + (case (io.run! (# repo upload uri content)) + {try.#Failure error} + (exception.match? /.upload_failure error) + + {try.#Success _} + false))) + (_.cover [/.download_failure] + (let [repo (/.repository ..bad_http + {.#None} + address)] + (case (io.run! (# repo download uri)) + {try.#Failure error} + (exception.match? /.download_failure error) + + {try.#Success _} + false))) + )))) diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux index 99c1bd92d..5166968f3 100644 --- a/stdlib/source/test/aedifex/runtime.lux +++ b/stdlib/source/test/aedifex/runtime.lux @@ -22,13 +22,13 @@ (def: .public random (Random /.Runtime) - ($_ random.either - (random#in /.default_java) - (random#in /.default_js) - (random#in /.default_python) - (random#in /.default_lua) - (random#in /.default_ruby) - )) + (all random.either + (random#in /.default_java) + (random#in /.default_js) + (random#in /.default_python) + (random#in /.default_lua) + (random#in /.default_ruby) + )) (def: .public test Test @@ -37,31 +37,31 @@ (do random.monad [path (random.ascii/alpha 5) runtime ..random] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (~~ (template [<command>] - [(_.cover [/.default_java /.default_js /.default_python /.default_lua /.default_ruby] - (let [listing (|> (list /.default_java /.default_js /.default_python /.default_lua /.default_ruby) - (list#each (the /.#program))) - unique (set.of_list text.hash listing)] - (n.= (list.size listing) - (set.size unique))))] + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (~~ (template [<command>] + [(_.cover [/.default_java /.default_js /.default_python /.default_lua /.default_ruby] + (let [listing (|> (list /.default_java /.default_js /.default_python /.default_lua /.default_ruby) + (list#each (the /.#program))) + unique (set.of_list text.hash listing)] + (n.= (list.size listing) + (set.size unique))))] - [/.default_java] - [/.default_js] - [/.default_python] - [/.default_lua] - [/.default_ruby] - )) - (_.cover [/.for] - (let [runtime' (/.for runtime path)] - (and (text#= (the /.#program runtime) - (the /.#program runtime')) - (|> runtime' - (the /.#parameters) - list.last - (maybe#each (text#= path)) - (maybe.else false))))) - ))))) + [/.default_java] + [/.default_js] + [/.default_python] + [/.default_lua] + [/.default_ruby] + )) + (_.cover [/.for] + (let [runtime' (/.for runtime path)] + (and (text#= (the /.#program runtime) + (the /.#program runtime')) + (|> runtime' + (the /.#parameters) + list.last + (maybe#each (text#= path)) + (maybe.else false))))) + ))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index e0798b844..0dc505bb0 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -77,91 +77,91 @@ [expected random.nat dummy random.nat] (_.for [/.Bit /.if] - ($_ _.and - (_.cover [/.false] - (n.= expected - (/.if /.false - dummy - expected))) - (_.cover [/.true] - (n.= expected - (/.if /.true - expected - dummy))) - (_.cover [/.or] - (and (not (/.or /.false /.false)) - (/.or /.false /.true) - (/.or /.true /.false) - (/.or /.true /.true))) - (_.cover [/.and] - (and (not (/.and /.false /.false)) - (not (/.and /.false /.true)) - (not (/.and /.true /.false)) - (/.and /.true /.true))) - (_.cover [/.not] - (and (bit#= /.true (/.not /.false)) - (bit#= /.false (/.not /.true)))) - (_.cover [/.cond] - (and (n.= expected - (/.cond /.true - expected - - ... else - dummy)) - (n.= expected - (/.cond /.false - dummy - - ... else - expected)) - (n.= expected - (/.cond /.true - expected - - /.false - dummy - - ... else - dummy)) - (n.= expected - (/.cond /.false - dummy - - /.true - expected - - ... else - dummy)))) - )))) + (all _.and + (_.cover [/.false] + (n.= expected + (/.if /.false + dummy + expected))) + (_.cover [/.true] + (n.= expected + (/.if /.true + expected + dummy))) + (_.cover [/.or] + (and (not (/.or /.false /.false)) + (/.or /.false /.true) + (/.or /.true /.false) + (/.or /.true /.true))) + (_.cover [/.and] + (and (not (/.and /.false /.false)) + (not (/.and /.false /.true)) + (not (/.and /.true /.false)) + (/.and /.true /.true))) + (_.cover [/.not] + (and (bit#= /.true (/.not /.false)) + (bit#= /.false (/.not /.true)))) + (_.cover [/.cond] + (and (n.= expected + (/.cond /.true + expected + + ... else + dummy)) + (n.= expected + (/.cond /.false + dummy + + ... else + expected)) + (n.= expected + (/.cond /.true + expected + + /.false + dummy + + ... else + dummy)) + (n.= expected + (/.cond /.false + dummy + + /.true + expected + + ... else + dummy)))) + )))) (def: for_try Test (do random.monad [expected_error (random.ascii/lower 5) expected random.nat] - ($_ _.and - (_.cover [/.try] - (case (/.try expected) - {.#Left _} - false - - {.#Right actual} - (n.= expected actual))) - (_.cover [/.undefined] - (case (/.try (/.undefined)) - {.#Left _} - true - - {.#Right _} - false)) - (_.cover [/.panic!] - (case (/.try (/.panic! expected_error)) - {.#Left actual_error} - (text.contains? expected_error actual_error) - - {.#Right _} - false)) - ))) + (all _.and + (_.cover [/.try] + (case (/.try expected) + {.#Left _} + false + + {.#Right actual} + (n.= expected actual))) + (_.cover [/.undefined] + (case (/.try (/.undefined)) + {.#Left _} + true + + {.#Right _} + false)) + (_.cover [/.panic!] + (case (/.try (/.panic! expected_error)) + {.#Left actual_error} + (text.contains? expected_error actual_error) + + {.#Right _} + false)) + ))) (def: for_list Test @@ -170,26 +170,26 @@ e/1 random.nat e/2 random.nat e/3 random.nat] - ($_ _.and - (_.cover [/.list] - (case (/.list e/0 e/1) - (pattern (/.list a/0 a/1)) - (and (n.= e/0 a/0) - (n.= e/1 a/1)) - - _ - false)) - (_.cover [/.partial_list] - (case (/.partial_list e/0 e/1 (/.list e/2 e/3)) - (pattern (/.partial_list a/0 a/1 (/.list a/2 a/3))) - (and (n.= e/0 a/0) - (n.= e/1 a/1) - (n.= e/2 a/2) - (n.= e/3 a/3)) - - _ - false)) - ))) + (all _.and + (_.cover [/.list] + (case (/.list e/0 e/1) + (pattern (/.list a/0 a/1)) + (and (n.= e/0 a/0) + (n.= e/1 a/1)) + + _ + false)) + (_.cover [/.partial_list] + (case (/.partial_list e/0 e/1 (/.list e/2 e/3)) + (pattern (/.partial_list a/0 a/1 (/.list a/2 a/3))) + (and (n.= e/0 a/0) + (n.= e/1 a/1) + (n.= e/2 a/2) + (n.= e/3 a/3)) + + _ + false)) + ))) (type: (Returner a) (/.Interface @@ -215,32 +215,32 @@ (def: (return _) expected)))]] (_.for [/.Interface] - ($_ _.and - (_.cover [/.implementation:] - (n.= expected (# (global_returner expected) return []))) - (_.cover [/.implementation] - (n.= expected (# local_returner return []))) - (_.cover [/.open:] - (n.= static_return (global#return []))) - (_.cover [/.open] - (let [(/.open "local#[0]") local_returner] - (n.= expected (local#return [])))) - (_.cover [/.#] - (n.= expected (/.# local_returner return []))) - )))) + (all _.and + (_.cover [/.implementation:] + (n.= expected (# (global_returner expected) return []))) + (_.cover [/.implementation] + (n.= expected (# local_returner return []))) + (_.cover [/.open:] + (n.= static_return (global#return []))) + (_.cover [/.open] + (let [(/.open "local#[0]") local_returner] + (n.= expected (local#return [])))) + (_.cover [/.#] + (n.= expected (/.# local_returner return []))) + )))) (def: for_module Test - ($_ _.and - (let [[module short] (/.symbol .example)] - (_.cover [/.symbol /.prelude_module] - (and (text#= /.prelude_module module) - (text#= short "example")))) - (let [[module short] (/.symbol ..example)] - (_.cover [/.module_separator] - (and (text.contains? /.module_separator module) - (not (text.contains? /.module_separator short))))) - )) + (all _.and + (let [[module short] (/.symbol .example)] + (_.cover [/.symbol /.prelude_module] + (and (text#= /.prelude_module module) + (text#= short "example")))) + (let [[module short] (/.symbol ..example)] + (_.cover [/.module_separator] + (and (text.contains? /.module_separator module) + (not (text.contains? /.module_separator short))))) + )) (def: for_pipe Test @@ -248,20 +248,20 @@ [start random.nat factor random.nat .let [expected (n.* factor (++ start))]] - ($_ _.and - (_.cover [/.|>] - (n.= expected - (/.|> start ++ (n.* factor)))) - (_.cover [/.|>>] - (n.= expected - ((/.|>> ++ (n.* factor)) start))) - (_.cover [/.<|] - (n.= expected - (/.<| (n.* factor) ++ start))) - (_.cover [/.<<|] - (n.= expected - ((/.<<| (n.* factor) ++) start))) - ))) + (all _.and + (_.cover [/.|>] + (n.= expected + (/.|> start ++ (n.* factor)))) + (_.cover [/.|>>] + (n.= expected + ((/.|>> ++ (n.* factor)) start))) + (_.cover [/.<|] + (n.= expected + (/.<| (n.* factor) ++ start))) + (_.cover [/.<<|] + (n.= expected + ((/.<<| (n.* factor) ++) start))) + ))) (def: example_symbol "YOLO") (def: i8 8) @@ -363,18 +363,18 @@ Test (do [! random.monad] [example (# ! each code.nat random.nat)] - ($_ _.and - (_.for [/.Code /.Code'] - ($_ _.and - ..for_code/' - ..for_code/` - ..for_code/`' - )) - (_.cover [/.Ann] - (|> example - (the /.#meta) - (location#= location.dummy))) - ))) + (all _.and + (_.for [/.Code /.Code'] + (all _.and + ..for_code/' + ..for_code/` + ..for_code/`' + )) + (_.cover [/.Ann] + (|> example + (the /.#meta) + (location#= location.dummy))) + ))) (/.macro: (identity_macro tokens) (# meta.monad in tokens)) @@ -409,132 +409,132 @@ {.#Right [lux (list)]}))] (do random.monad [expected random.nat] - (`` (`` ($_ _.and - (_.cover [/.Macro'] - (|> macro - (is /.Macro') - (same? macro))) - (_.cover [/.Macro] - (|> macro - "lux macro" - (is /.Macro) - (is Any) - (same? (is Any macro)))) - (_.cover [/.macro:] - (same? expected (..identity_macro expected))) - (~~ (for @.old (~~ (these)) - (_.cover [/.Source] - (..found_crosshair?)))) - (_.cover [/.macro] - (with_expansions [n/0 (static.random_nat) - n/1 (static.random_nat) - n/1 (static.random_nat)] - (n.= (..sum n/0 n/1 n/1) - (..sum' n/0 n/1 n/1)))) - (_.cover [/.using] - (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer) - <alias> (static.random code.text (random.ascii/lower 1)) - <definition> (static.random code.local (random.ascii/lower 1)) - <module/0> (static.random code.text (random.ascii/lower 2)) - <module/0>' (template.symbol [<module/0>]) - <module/1> (static.random code.text (random.ascii/lower 3)) - <module/1>' (template.symbol [<module/1>]) - <module/2> (static.random code.text (random.ascii/lower 4)) - <module/2>' (template.symbol [<module/2>]) - <m0/1> (template.text [<module/0> "/" <module/1>]) - <//> (template.text [// <module/2>']) - <//>' (template.symbol [<//>]) - <\\> (template.text [\\ <module/2>']) - <\\>' (template.symbol [<\\>]) - <m0/2> (template.text [<module/0> "/" <module/2>]) - <m2/1> (template.text [<module/2> "/" <module/1>]) - <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) - <open/0> (template.text [<module/0> "#[0]"])] - (and (~~ (template [<input> <module> <referrals>] - [(with_expansions [<input>' (macro.final <input>)] - (let [scenario (is (-> Any Bit) - (function (_ _) - ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. - (`` (for @.python (case (' [<input>']) - (^.` [<module> - ("lux def" (~ [_ {.#Symbol ["" _]}]) [] #0) - (~~ (template.spliced <referrals>))]) - true - - _ - false) - (case (' [<input>']) - (^.` [<module> (~~ (template.spliced <referrals>))]) - true - - _ - false)))))] - (scenario [])))] - - [(.using [<module/0>']) - ("lux def module" []) - []] - - [(.using [<alias> <module/0>' "*"]) - ("lux def module" [[<module/0> <alias>]]) - [(<referral> <module/0> "*")]] - - [(.using [<alias> <module/0>' {"+" <definition>}]) - ("lux def module" [[<module/0> <alias>]]) - [(<referral> <module/0> {"+" <definition>})]] - - [(.using [<alias> <module/0>' {"-" <definition>}]) - ("lux def module" [[<module/0> <alias>]]) - [(<referral> <module/0> {"-" <definition>})]] - - [(.using [<alias> <module/0>' "_"]) - ("lux def module" []) - []] - - [(.using [<module/0>' - [<alias> <module/1>']]) - ("lux def module" [[<m0/1> <alias>]]) - [(<referral> <m0/1>)]] - - [(.using ["[0]" <module/0>' - ["[0]" <module/1>']]) - ("lux def module" [[<module/0> <module/0>] - [<m0/1> <module/1>]]) - [(<referral> <module/0>) - (<referral> <m0/1>)]] - - [(.using ["[0]" <module/0>' "_" - ["[1]" <module/1>']]) - ("lux def module" [[<m0/1> <module/0>]]) - [(<referral> <m0/1>)]] - - [(.using ["[0]" <module/0>' "_" - ["[1]" <module/1>' "_" - ["[2]" <module/2>']]]) - ("lux def module" [[<m0/1/2> <module/0>]]) - [(<referral> <m0/1/2>)]] - - [(.using [<module/0>' - ["[0]" <module/1>' - ["[0]" <//>']]]) - ("lux def module" [[<m0/1> <module/1>] - [<m0/2> <//>]]) - [(<referral> <m0/1>) - (<referral> <m0/2>)]] - - [(.using ["[0]" <module/0>' - [<module/1>' - ["[0]" <\\>']]]) - ("lux def module" [[<module/0> <module/0>] - [<m2/1> <\\>]]) - [(<referral> <module/0>) - (<referral> <m2/1>)]] - - [(.using ["[0]" <module/0>' ("[1]#[0]" <definition>)]) - ("lux def module" [[<module/0> <module/0>]]) - [(<referral> <module/0> (<open/0> <definition>))]] - )))))) - )))))) + (`` (`` (all _.and + (_.cover [/.Macro'] + (|> macro + (is /.Macro') + (same? macro))) + (_.cover [/.Macro] + (|> macro + "lux macro" + (is /.Macro) + (is Any) + (same? (is Any macro)))) + (_.cover [/.macro:] + (same? expected (..identity_macro expected))) + (~~ (for @.old (~~ (these)) + (_.cover [/.Source] + (..found_crosshair?)))) + (_.cover [/.macro] + (with_expansions [n/0 (static.random_nat) + n/1 (static.random_nat) + n/1 (static.random_nat)] + (n.= (..sum n/0 n/1 n/1) + (..sum' n/0 n/1 n/1)))) + (_.cover [/.using] + (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer) + <alias> (static.random code.text (random.ascii/lower 1)) + <definition> (static.random code.local (random.ascii/lower 1)) + <module/0> (static.random code.text (random.ascii/lower 2)) + <module/0>' (template.symbol [<module/0>]) + <module/1> (static.random code.text (random.ascii/lower 3)) + <module/1>' (template.symbol [<module/1>]) + <module/2> (static.random code.text (random.ascii/lower 4)) + <module/2>' (template.symbol [<module/2>]) + <m0/1> (template.text [<module/0> "/" <module/1>]) + <//> (template.text [// <module/2>']) + <//>' (template.symbol [<//>]) + <\\> (template.text [\\ <module/2>']) + <\\>' (template.symbol [<\\>]) + <m0/2> (template.text [<module/0> "/" <module/2>]) + <m2/1> (template.text [<module/2> "/" <module/1>]) + <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) + <open/0> (template.text [<module/0> "#[0]"])] + (and (~~ (template [<input> <module> <referrals>] + [(with_expansions [<input>' (macro.final <input>)] + (let [scenario (is (-> Any Bit) + (function (_ _) + ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. + (`` (for @.python (case (' [<input>']) + (^.` [<module> + ("lux def" (~ [_ {.#Symbol ["" _]}]) [] #0) + (~~ (template.spliced <referrals>))]) + true + + _ + false) + (case (' [<input>']) + (^.` [<module> (~~ (template.spliced <referrals>))]) + true + + _ + false)))))] + (scenario [])))] + + [(.using [<module/0>']) + ("lux def module" []) + []] + + [(.using [<alias> <module/0>' "*"]) + ("lux def module" [[<module/0> <alias>]]) + [(<referral> <module/0> "*")]] + + [(.using [<alias> <module/0>' {"+" <definition>}]) + ("lux def module" [[<module/0> <alias>]]) + [(<referral> <module/0> {"+" <definition>})]] + + [(.using [<alias> <module/0>' {"-" <definition>}]) + ("lux def module" [[<module/0> <alias>]]) + [(<referral> <module/0> {"-" <definition>})]] + + [(.using [<alias> <module/0>' "_"]) + ("lux def module" []) + []] + + [(.using [<module/0>' + [<alias> <module/1>']]) + ("lux def module" [[<m0/1> <alias>]]) + [(<referral> <m0/1>)]] + + [(.using ["[0]" <module/0>' + ["[0]" <module/1>']]) + ("lux def module" [[<module/0> <module/0>] + [<m0/1> <module/1>]]) + [(<referral> <module/0>) + (<referral> <m0/1>)]] + + [(.using ["[0]" <module/0>' "_" + ["[1]" <module/1>']]) + ("lux def module" [[<m0/1> <module/0>]]) + [(<referral> <m0/1>)]] + + [(.using ["[0]" <module/0>' "_" + ["[1]" <module/1>' "_" + ["[2]" <module/2>']]]) + ("lux def module" [[<m0/1/2> <module/0>]]) + [(<referral> <m0/1/2>)]] + + [(.using [<module/0>' + ["[0]" <module/1>' + ["[0]" <//>']]]) + ("lux def module" [[<m0/1> <module/1>] + [<m0/2> <//>]]) + [(<referral> <m0/1>) + (<referral> <m0/2>)]] + + [(.using ["[0]" <module/0>' + [<module/1>' + ["[0]" <\\>']]]) + ("lux def module" [[<module/0> <module/0>] + [<m2/1> <\\>]]) + [(<referral> <module/0>) + (<referral> <m2/1>)]] + + [(.using ["[0]" <module/0>' ("[1]#[0]" <definition>)]) + ("lux def module" [[<module/0> <module/0>]]) + [(<referral> <module/0> (<open/0> <definition>))]] + )))))) + )))))) (/.type: for_type/variant (Variant @@ -562,104 +562,104 @@ expected/0 existential_type expected/1 existential_type] (<| (_.for [/.Type]) - ($_ _.and - (_.cover [/.is] - (|> expected - (/.is Any) - (same? (/.is Any expected)))) - (_.cover [/.as] - (|> expected - (/.is Any) - (/.as /.Nat) - (same? expected))) - (_.cover [/.as_expected] - (|> expected - (/.is Any) - /.as_expected - (/.is /.Nat) - (same? expected))) - (_.cover [/.type_of] - (same? /.Nat (/.type_of expected))) - (_.cover [/.Primitive] - (case (/.Primitive "foo" [expected/0 expected/1]) - (pattern {.#Primitive "foo" (list actual/0 actual/1)}) - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false)) - (_.cover [/.type] - (and (case (/.type [expected/0 expected/1]) - {.#Product actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (case (/.type (/.Or expected/0 expected/1)) - {.#Sum actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (case (/.type (-> expected/0 expected/1)) - {.#Function actual/0 actual/1} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false) - (case (/.type (expected/0 expected/1)) - {.#Apply actual/1 actual/0} - (and (same? expected/0 actual/0) - (same? expected/1 actual/1)) - - _ - false))) - (_.cover [/.type:] - (exec - (is /.Type ..for_type/variant) - (is /.Type ..for_type/record) - (is /.Type ..for_type/all) - true)) - (_.cover [/.Variant] - (exec - (is for_type/variant - {#Case/1 expected_left}) - true)) - (_.cover [/.Record] - (exec - (is for_type/record - [#slot/0 (n.= expected_left expected_right) - #slot/1 (.rev expected_right)]) - true)) - )))) + (all _.and + (_.cover [/.is] + (|> expected + (/.is Any) + (same? (/.is Any expected)))) + (_.cover [/.as] + (|> expected + (/.is Any) + (/.as /.Nat) + (same? expected))) + (_.cover [/.as_expected] + (|> expected + (/.is Any) + /.as_expected + (/.is /.Nat) + (same? expected))) + (_.cover [/.type_of] + (same? /.Nat (/.type_of expected))) + (_.cover [/.Primitive] + (case (/.Primitive "foo" [expected/0 expected/1]) + (pattern {.#Primitive "foo" (list actual/0 actual/1)}) + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false)) + (_.cover [/.type] + (and (case (/.type [expected/0 expected/1]) + {.#Product actual/0 actual/1} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false) + (case (/.type (/.Or expected/0 expected/1)) + {.#Sum actual/0 actual/1} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false) + (case (/.type (-> expected/0 expected/1)) + {.#Function actual/0 actual/1} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false) + (case (/.type (expected/0 expected/1)) + {.#Apply actual/1 actual/0} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false))) + (_.cover [/.type:] + (exec + (is /.Type ..for_type/variant) + (is /.Type ..for_type/record) + (is /.Type ..for_type/all) + true)) + (_.cover [/.Variant] + (exec + (is for_type/variant + {#Case/1 expected_left}) + true)) + (_.cover [/.Record] + (exec + (is for_type/record + [#slot/0 (n.= expected_left expected_right) + #slot/1 (.rev expected_right)]) + true)) + )))) (def: for_i64 Test (do random.monad [expected random.i64] - ($_ _.and - (_.cover [/.i64] - (same? (is Any expected) - (is Any (/.i64 expected)))) - (_.cover [/.nat] - (same? (is Any expected) - (is Any (/.nat expected)))) - (_.cover [/.int] - (same? (is Any expected) - (is Any (/.int expected)))) - (_.cover [/.rev] - (same? (is Any expected) - (is Any (/.rev expected)))) - (_.cover [/.++] - (n.= 1 (n.- expected - (/.++ expected)))) - (_.cover [/.--] - (n.= 1 (n.- (/.-- expected) - expected))) - ))) + (all _.and + (_.cover [/.i64] + (same? (is Any expected) + (is Any (/.i64 expected)))) + (_.cover [/.nat] + (same? (is Any expected) + (is Any (/.nat expected)))) + (_.cover [/.int] + (same? (is Any expected) + (is Any (/.int expected)))) + (_.cover [/.rev] + (same? (is Any expected) + (is Any (/.rev expected)))) + (_.cover [/.++] + (n.= 1 (n.- expected + (/.++ expected)))) + (_.cover [/.--] + (n.= 1 (n.- (/.-- expected) + expected))) + ))) (def: for_function Test @@ -683,22 +683,22 @@ (def: for_template Test - (`` ($_ _.and - (_.cover [/.template] - (let [bits (list (~~ (/.template [_] - [true] - - [0] [1] [2] - )))] - (and (n.= 3 (list.size bits)) - (list.every? (bit#= true) bits)))) - (do random.monad - [left random.nat - right random.nat] - (_.cover [/.template:] - (n.= (n.+ left right) - (!n/+ left right)))) - ))) + (`` (all _.and + (_.cover [/.template] + (let [bits (list (~~ (/.template [_] + [true] + + [0] [1] [2] + )))] + (and (n.= 3 (list.size bits)) + (list.every? (bit#= true) bits)))) + (do random.monad + [left random.nat + right random.nat] + (_.cover [/.template:] + (n.= (n.+ left right) + (!n/+ left right)))) + ))) (def: option/0 "0") (def: option/1 "1") @@ -709,17 +709,17 @@ (do random.monad [sample (random.either (in option/0) (in option/1))] - ($_ _.and - (_.cover [/.static] - (case sample - (pattern (/.static option/0)) true - (pattern (/.static option/1)) true - _ false)) - (_.cover [/.char] - (|> (`` (/.char (~~ (/.static static_char)))) - text.of_char - (text#= static_char))) - ))) + (all _.and + (_.cover [/.static] + (case sample + (pattern (/.static option/0)) true + (pattern (/.static option/1)) true + _ false)) + (_.cover [/.char] + (|> (`` (/.char (~~ (/.static static_char)))) + text.of_char + (text#= static_char))) + ))) (type: Small (Record @@ -745,75 +745,75 @@ sample [#big_left start/b #big_right [#small_left start/s #small_right text]]]] - ($_ _.and - (_.cover [/.the] - (and (and (|> sample - (/.the #big_left) - (same? start/b)) - (|> sample - ((/.the #big_left)) - (same? start/b))) - (and (|> sample - (/.the [#big_right #small_left]) - (same? start/s)) - (|> sample - ((/.the [#big_right #small_left])) - (same? start/s))))) - (_.cover [/.has] - (and (and (|> sample - (/.has #big_left shift/b) - (/.the #big_left) - (same? shift/b)) - (|> sample - ((/.has #big_left shift/b)) - (/.the #big_left) - (same? shift/b)) - (|> sample - ((/.has #big_left) shift/b) - (/.the #big_left) - (same? shift/b))) - (and (|> sample - (/.has [#big_right #small_left] shift/s) - (/.the [#big_right #small_left]) - (same? shift/s)) - (|> sample - ((/.has [#big_right #small_left] shift/s)) - (/.the [#big_right #small_left]) - (same? shift/s)) - (|> sample - ((/.has [#big_right #small_left]) shift/s) - (/.the [#big_right #small_left]) - (same? shift/s))))) - (_.cover [/.revised] - (and (and (|> sample - (/.revised #big_left (n.+ shift/b)) - (/.the #big_left) - (n.= expected/b)) - (|> sample - ((/.revised #big_left (n.+ shift/b))) - (/.the #big_left) - (n.= expected/b)) - (|> sample - ((is (-> (-> Nat Nat) (-> Big Big)) - (/.revised #big_left)) - (n.+ shift/b)) - (/.the #big_left) - (n.= expected/b))) - (and (|> sample - (/.revised [#big_right #small_left] (n.+ shift/s)) - (/.the [#big_right #small_left]) - (n.= expected/s)) - (|> sample - ((/.revised [#big_right #small_left] (n.+ shift/s))) - (/.the [#big_right #small_left]) - (n.= expected/s)) - (|> sample - ((is (-> (-> Nat Nat) (-> Big Big)) - (/.revised [#big_right #small_left])) - (n.+ shift/s)) - (/.the [#big_right #small_left]) - (n.= expected/s))))) - ))) + (all _.and + (_.cover [/.the] + (and (and (|> sample + (/.the #big_left) + (same? start/b)) + (|> sample + ((/.the #big_left)) + (same? start/b))) + (and (|> sample + (/.the [#big_right #small_left]) + (same? start/s)) + (|> sample + ((/.the [#big_right #small_left])) + (same? start/s))))) + (_.cover [/.has] + (and (and (|> sample + (/.has #big_left shift/b) + (/.the #big_left) + (same? shift/b)) + (|> sample + ((/.has #big_left shift/b)) + (/.the #big_left) + (same? shift/b)) + (|> sample + ((/.has #big_left) shift/b) + (/.the #big_left) + (same? shift/b))) + (and (|> sample + (/.has [#big_right #small_left] shift/s) + (/.the [#big_right #small_left]) + (same? shift/s)) + (|> sample + ((/.has [#big_right #small_left] shift/s)) + (/.the [#big_right #small_left]) + (same? shift/s)) + (|> sample + ((/.has [#big_right #small_left]) shift/s) + (/.the [#big_right #small_left]) + (same? shift/s))))) + (_.cover [/.revised] + (and (and (|> sample + (/.revised #big_left (n.+ shift/b)) + (/.the #big_left) + (n.= expected/b)) + (|> sample + ((/.revised #big_left (n.+ shift/b))) + (/.the #big_left) + (n.= expected/b)) + (|> sample + ((is (-> (-> Nat Nat) (-> Big Big)) + (/.revised #big_left)) + (n.+ shift/b)) + (/.the #big_left) + (n.= expected/b))) + (and (|> sample + (/.revised [#big_right #small_left] (n.+ shift/s)) + (/.the [#big_right #small_left]) + (n.= expected/s)) + (|> sample + ((/.revised [#big_right #small_left] (n.+ shift/s))) + (/.the [#big_right #small_left]) + (n.= expected/s)) + (|> sample + ((is (-> (-> Nat Nat) (-> Big Big)) + (/.revised [#big_right #small_left])) + (n.+ shift/s)) + (/.the [#big_right #small_left]) + (n.= expected/s))))) + ))) (def: for_associative Test @@ -822,15 +822,15 @@ mid (random.ascii/lower 1) right (random.ascii/lower 1) .let [expected (text.interposed "" (list left mid right))]] - (_.cover [/.$_ /._$] - (with_expansions [<left_association> (/._$ format - left - mid - right) - <right_association> (/.$_ format - left - mid - right)] + (_.cover [/.all /.left] + (with_expansions [<left_association> (/.left format + left + mid + right) + <right_association> (/.all format + left + mid + right)] (and (text#= <left_association> <right_association>) (not (code#= (' <left_association>) @@ -843,39 +843,39 @@ right random.nat dummy random.nat .let [expected (n.+ left right)]] - ($_ _.and - (_.cover [/.these] - (`` (and (~~ (these true - true - true))))) - (_.cover [/.with_expansions] - (/.with_expansions [<operands> (these left right)] - (n.= expected - (n.+ <operands>)))) - (_.cover [/.comment] - (/.with_expansions [<dummy> (/.comment dummy) - <operands> (these left right)] - (n.= expected - ($_ n.+ <operands> <dummy>)))) - (_.cover [/.``] - (n.= expected - (/.`` ($_ n.+ - (~~ (these left right)) - (~~ (/.comment dummy)))))) - (_.cover [/.for] - (and (n.= expected - (/.for "fake host" dummy - expected)) - (n.= expected - (/.for @.old expected - @.jvm expected - @.js expected - @.python expected - @.lua expected - @.ruby expected - @.php expected - dummy)))) - ))) + (all _.and + (_.cover [/.these] + (`` (and (~~ (these true + true + true))))) + (_.cover [/.with_expansions] + (/.with_expansions [<operands> (these left right)] + (n.= expected + (n.+ <operands>)))) + (_.cover [/.comment] + (/.with_expansions [<dummy> (/.comment dummy) + <operands> (these left right)] + (n.= expected + (all n.+ <operands> <dummy>)))) + (_.cover [/.``] + (n.= expected + (/.`` (all n.+ + (~~ (these left right)) + (~~ (/.comment dummy)))))) + (_.cover [/.for] + (and (n.= expected + (/.for "fake host" dummy + expected)) + (n.= expected + (/.for @.old expected + @.jvm expected + @.js expected + @.python expected + @.lua expected + @.ruby expected + @.php expected + dummy)))) + ))) (def: for_value Test @@ -886,78 +886,78 @@ item/0 random.nat item/1 random.nat item/2 random.nat] - ($_ _.and - (_.cover [/.Either] - (and (exec - (is (/.Either Nat Text) - {.#Left left}) - true) - (exec - (is (/.Either Nat Text) - {.#Right right}) - true))) - (_.cover [/.Any] - (and (exec - (is /.Any - left) - true) - (exec - (is /.Any - right) - true))) - (_.cover [/.Nothing] - (and (exec - (is (-> /.Any /.Nothing) - (function (_ _) - (undefined))) - true) - (exec - (is (-> /.Any /.Int) - (function (_ _) - (is /.Int (undefined)))) - true))) - (_.for [/.__adjusted_quantified_type__] - ($_ _.and - (_.cover [/.All] - (let [identity (is (/.All (_ a) (-> a a)) - (|>>))] - (and (exec - (is Nat - (identity left)) - true) - (exec - (is Text - (identity right)) - true)))) - (_.cover [/.Ex] - (let [hide (is (/.Ex (_ a) (-> Nat a)) - (|>>))] - (exec - (is /.Any - (hide left)) - true))))) - (_.cover [/.same?] - (let [not_left (atom.atom left) - left (atom.atom left)] - (and (/.same? left left) - (/.same? not_left not_left) - (not (/.same? left not_left))))) - (_.cover [/.Rec] - (let [list (is (/.Rec NList - (Maybe [Nat NList])) - {.#Some [item/0 - {.#Some [item/1 - {.#Some [item/2 - {.#None}]}]}]})] - (case list - {.#Some [actual/0 {.#Some [actual/1 {.#Some [actual/2 {.#None}]}]}]} - (and (same? item/0 actual/0) - (same? item/1 actual/1) - (same? item/2 actual/2)) - - _ - false))) - ))) + (all _.and + (_.cover [/.Either] + (and (exec + (is (/.Either Nat Text) + {.#Left left}) + true) + (exec + (is (/.Either Nat Text) + {.#Right right}) + true))) + (_.cover [/.Any] + (and (exec + (is /.Any + left) + true) + (exec + (is /.Any + right) + true))) + (_.cover [/.Nothing] + (and (exec + (is (-> /.Any /.Nothing) + (function (_ _) + (undefined))) + true) + (exec + (is (-> /.Any /.Int) + (function (_ _) + (is /.Int (undefined)))) + true))) + (_.for [/.__adjusted_quantified_type__] + (all _.and + (_.cover [/.All] + (let [identity (is (/.All (_ a) (-> a a)) + (|>>))] + (and (exec + (is Nat + (identity left)) + true) + (exec + (is Text + (identity right)) + true)))) + (_.cover [/.Ex] + (let [hide (is (/.Ex (_ a) (-> Nat a)) + (|>>))] + (exec + (is /.Any + (hide left)) + true))))) + (_.cover [/.same?] + (let [not_left (atom.atom left) + left (atom.atom left)] + (and (/.same? left left) + (/.same? not_left not_left) + (not (/.same? left not_left))))) + (_.cover [/.Rec] + (let [list (is (/.Rec NList + (Maybe [Nat NList])) + {.#Some [item/0 + {.#Some [item/1 + {.#Some [item/2 + {.#None}]}]}]})] + (case list + {.#Some [actual/0 {.#Some [actual/1 {.#Some [actual/2 {.#None}]}]}]} + (and (same? item/0 actual/0) + (same? item/1 actual/1) + (same? item/2 actual/2)) + + _ + false))) + ))) (type: (Pair l r) (Record @@ -979,75 +979,75 @@ (in +1.25)) expected_text (random.either (in "+0.5") (in "+1.25"))] - ($_ _.and - (_.cover [/.case] - (and (/.case expected_nat - 0 true - _ false) - (/.case expected_int - +0 true - _ false) - (/.case expected_rev - .5 true - .25 true - _ false) - (/.case expected_frac - +0.5 true - +1.25 true - _ false) - (/.case expected_text - "+0.5" true - "+1.25" true - _ false) - (/.case [expected_nat expected_int] - [0 +0] true - _ false) - (/.case [..#left expected_nat ..#right expected_int] - [..#left 0 ..#right +0] true - _ false) - (/.case (is (Either Nat Int) {.#Left expected_nat}) - {.#Left 0} true - _ false) - (/.case (is (Either Nat Int) {.#Right expected_int}) - {.#Right +0} true - _ false) - )) - (_.cover [/.pattern] - (/.case [..#left expected_nat ..#right expected_int] - (/.pattern (!pair 0 +0)) true - _ false)) - (_.cover [/.let] - (and (/.let [actual_nat expected_nat] - (/.same? expected_nat actual_nat)) - (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] - (and (/.same? expected_nat actual_left) - (/.same? expected_int actual_right))))) - ))) + (all _.and + (_.cover [/.case] + (and (/.case expected_nat + 0 true + _ false) + (/.case expected_int + +0 true + _ false) + (/.case expected_rev + .5 true + .25 true + _ false) + (/.case expected_frac + +0.5 true + +1.25 true + _ false) + (/.case expected_text + "+0.5" true + "+1.25" true + _ false) + (/.case [expected_nat expected_int] + [0 +0] true + _ false) + (/.case [..#left expected_nat ..#right expected_int] + [..#left 0 ..#right +0] true + _ false) + (/.case (is (Either Nat Int) {.#Left expected_nat}) + {.#Left 0} true + _ false) + (/.case (is (Either Nat Int) {.#Right expected_int}) + {.#Right +0} true + _ false) + )) + (_.cover [/.pattern] + (/.case [..#left expected_nat ..#right expected_int] + (/.pattern (!pair 0 +0)) true + _ false)) + (_.cover [/.let] + (and (/.let [actual_nat expected_nat] + (/.same? expected_nat actual_nat)) + (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] + (and (/.same? expected_nat actual_left) + (/.same? expected_int actual_right))))) + ))) (def: for_control_flow Test - ($_ _.and - (do random.monad - [factor (random#each (|>> (n.% 10) (n.max 1)) random.nat) - iterations (random#each (n.% 10) random.nat) - .let [expected (n.* factor iterations)]] - (_.cover [/.loop] - (n.= expected - (/.loop (again [counter 0 - value 0]) - (if (n.< iterations counter) - (again (++ counter) (n.+ factor value)) - value))))) - (do random.monad - [pre random.nat - post (random.only (|>> (n.= pre) not) random.nat) - .let [box (atom.atom pre)]] - (_.cover [/.exec] - (and (same? pre (io.run! (atom.read! box))) - (/.exec - (io.run! (atom.write! post box)) - (same? post (io.run! (atom.read! box))))))) - )) + (all _.and + (do random.monad + [factor (random#each (|>> (n.% 10) (n.max 1)) random.nat) + iterations (random#each (n.% 10) random.nat) + .let [expected (n.* factor iterations)]] + (_.cover [/.loop] + (n.= expected + (/.loop (again [counter 0 + value 0]) + (if (n.< iterations counter) + (again (++ counter) (n.+ factor value)) + value))))) + (do random.monad + [pre random.nat + post (random.only (|>> (n.= pre) not) random.nat) + .let [box (atom.atom pre)]] + (_.cover [/.exec] + (and (same? pre (io.run! (atom.read! box))) + (/.exec + (io.run! (atom.write! post box)) + (same? post (io.run! (atom.read! box))))))) + )) (def: identity/constant (All (_ a) (-> a a)) @@ -1099,22 +1099,22 @@ (def: for_meta Test - ($_ _.and - (_.cover [/.Mode /.Info] - (for_meta|Info)) - (_.cover [/.Module_State] - (for_meta|Module_State)) - )) + (all _.and + (_.cover [/.Mode /.Info] + (for_meta|Info)) + (_.cover [/.Module_State] + (for_meta|Module_State)) + )) (def: for_export Test - ($_ _.and - (_.cover [/.public /.private] - (and /.public (not /.private))) - (_.cover [/.global /.local] - (and (bit#= /.public /.global) - (bit#= /.private /.local))) - )) + (all _.and + (_.cover [/.public /.private] + (and /.public (not /.private))) + (_.cover [/.global /.local] + (and (bit#= /.public /.global) + (bit#= /.private /.local))) + )) (for @.old (these) (these (syntax: (for_bindings|test [fn/0 <code>.local @@ -1198,32 +1198,32 @@ (def: test|lux Test - (`` (`` ($_ _.and - ..for_bit - ..for_try - ..for_list - ..for_interface - ..for_module - ..for_pipe - ..for_code - ..for_macro - ..for_type - ..for_i64 - ..for_function - ..for_template - ..for_static - ..for_slot - ..for_associative - ..for_expansion - ..for_value - ..for_case - ..for_control_flow - ..for_def: - ..for_meta - ..for_export - (~~ (for @.old (~~ (these)) - (~~ (these ..for_bindings)))) - )))) + (`` (`` (all _.and + ..for_bit + ..for_try + ..for_list + ..for_interface + ..for_module + ..for_pipe + ..for_code + ..for_macro + ..for_type + ..for_i64 + ..for_function + ..for_template + ..for_static + ..for_slot + ..for_associative + ..for_expansion + ..for_value + ..for_case + ..for_control_flow + ..for_def: + ..for_meta + ..for_export + (~~ (for @.old (~~ (these)) + (~~ (these ..for_bindings)))) + )))) (def: test Test diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 9d44f0e96..bd6cd3e03 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -22,39 +22,39 @@ (def: functor Test - ($_ _.and - /functor.test - /functor/contravariant.test - )) + (all _.and + /functor.test + /functor/contravariant.test + )) (def: monad Test - ($_ _.and - /monad.test - /monad/free.test - )) + (all _.and + /monad.test + /monad/free.test + )) (def: comonad Test - ($_ _.and - /comonad.test - /comonad/cofree.test - )) + (all _.and + /comonad.test + /comonad/cofree.test + )) (def: .public test Test - ($_ _.and - /apply.test - /codec.test - /enum.test - /equivalence.test - /hash.test - /mix.test - /interval.test - /monoid.test - /order.test - /predicate.test - ..functor - ..monad - ..comonad - )) + (all _.and + /apply.test + /codec.test + /enum.test + /equivalence.test + /hash.test + /mix.test + /interval.test + /monoid.test + /order.test + /predicate.test + ..functor + ..monad + ..comonad + )) diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index ad0bb0250..a11786fd8 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -22,15 +22,15 @@ [left random.nat right random.nat] (<| (_.covering /._) - ($_ _.and - (_.cover [/.composite] - (let [expected (n.+ left right)] - (case (# (/.composite maybe.monad maybe.apply list.apply) on - {.#Some (list right)} - {.#Some (list (n.+ left))}) - (pattern {.#Some (list actual)}) - (n.= expected actual) + (all _.and + (_.cover [/.composite] + (let [expected (n.+ left right)] + (case (# (/.composite maybe.monad maybe.apply list.apply) on + {.#Some (list right)} + {.#Some (list (n.+ left))}) + (pattern {.#Some (list actual)}) + (n.= expected actual) - _ - false))) - )))) + _ + false))) + )))) diff --git a/stdlib/source/test/lux/abstract/comonad.lux b/stdlib/source/test/lux/abstract/comonad.lux index 5d5cb6857..349988e4c 100644 --- a/stdlib/source/test/lux/abstract/comonad.lux +++ b/stdlib/source/test/lux/abstract/comonad.lux @@ -18,11 +18,11 @@ (do random.monad [sample random.nat] (<| (_.covering /._) - ($_ _.and - (_.cover [/.be] - (n.= (++ sample) - (is (Identity Nat) - (/.be identity.comonad - [value (out sample)] - (out (++ value)))))) - )))) + (all _.and + (_.cover [/.be] + (n.= (++ sample) + (is (Identity Nat) + (/.be identity.comonad + [value (out sample)] + (out (++ value)))))) + )))) diff --git a/stdlib/source/test/lux/abstract/comonad/cofree.lux b/stdlib/source/test/lux/abstract/comonad/cofree.lux index eb748e87b..32b6b2fa2 100644 --- a/stdlib/source/test/lux/abstract/comonad/cofree.lux +++ b/stdlib/source/test/lux/abstract/comonad/cofree.lux @@ -41,11 +41,11 @@ Test (<| (_.covering /._) (_.for [/.CoFree]) - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison (is (Functor (/.CoFree Stream)) - (/.functor stream.functor)))) - (_.for [/.comonad] - ($comonad.spec ..injection ..comparison (is (CoMonad (/.CoFree Stream)) - (/.comonad stream.functor)))) - ))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison (is (Functor (/.CoFree Stream)) + (/.functor stream.functor)))) + (_.for [/.comonad] + ($comonad.spec ..injection ..comparison (is (CoMonad (/.CoFree Stream)) + (/.comonad stream.functor)))) + ))) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux index a4910e4c3..31b90aacb 100644 --- a/stdlib/source/test/lux/abstract/enum.lux +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -29,29 +29,29 @@ [end start]) range (/.range n.enum start end)]] (<| (_.covering /._) - ($_ _.and - (_.cover [/.range] - (let [expected_size (|> end (n.- start) ++) - expected_start? (|> range list.head (maybe#each (n.= start)) (maybe.else false)) - expected_end? (|> range list.last (maybe#each (n.= end)) (maybe.else false)) - can_be_backwards? (# (list.equivalence n.equivalence) = - (/.range n.enum start end) - (list.reversed (/.range n.enum end start))) - every_element_is_a_successor? (case range - {.#Item head tail} - (|> (list#mix (function (_ next [verdict prev]) - [(and verdict - (n.= next (# n.enum succ prev))) - next]) - [true head] - tail) - product.left) - - {.#End} - false)] - (and (n.= expected_size (list.size range)) - expected_start? - expected_end? - can_be_backwards? - every_element_is_a_successor?))) - ))))) + (all _.and + (_.cover [/.range] + (let [expected_size (|> end (n.- start) ++) + expected_start? (|> range list.head (maybe#each (n.= start)) (maybe.else false)) + expected_end? (|> range list.last (maybe#each (n.= end)) (maybe.else false)) + can_be_backwards? (# (list.equivalence n.equivalence) = + (/.range n.enum start end) + (list.reversed (/.range n.enum end start))) + every_element_is_a_successor? (case range + {.#Item head tail} + (|> (list#mix (function (_ next [verdict prev]) + [(and verdict + (n.= next (# n.enum succ prev))) + next]) + [true head] + tail) + product.left) + + {.#End} + false)] + (and (n.= expected_size (list.size range)) + expected_start? + expected_end? + can_be_backwards? + every_element_is_a_successor?))) + ))))) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index 649d7a96b..501791b08 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -36,25 +36,25 @@ (bit#= (# left = leftN rightN) (# right = leftN rightN))))))]] (<| (_.covering /._) - ($_ _.and - (_.for [/.functor] - ($contravariant.spec equivalence n.equivalence /.functor)) - (_.cover [/.rec] - (let [equivalence (is (Equivalence (List Nat)) - (/.rec (function (_ equivalence) - (implementation - (def: (= left right) - (case [left right] - [{.#End} {.#End}] - true + (all _.and + (_.for [/.functor] + ($contravariant.spec equivalence n.equivalence /.functor)) + (_.cover [/.rec] + (let [equivalence (is (Equivalence (List Nat)) + (/.rec (function (_ equivalence) + (implementation + (def: (= left right) + (case [left right] + [{.#End} {.#End}] + true - [{.#Item leftH lefT} {.#Item rightH rightT}] - (and (n.= leftH rightH) - (# equivalence = lefT rightT)) + [{.#Item leftH lefT} {.#Item rightH rightT}] + (and (n.= leftH rightH) + (# equivalence = lefT rightT)) - _ - false))))))] - (and (# equivalence = (list sample sample) (list sample sample)) - (not (# equivalence = (list sample sample) (list sample))) - (not (# equivalence = (list sample sample) (list different different)))))) - )))) + _ + false))))))] + (and (# equivalence = (list sample sample) (list sample sample)) + (not (# equivalence = (list sample sample) (list sample))) + (not (# equivalence = (list sample sample) (list different different)))))) + )))) diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 541c88971..3e4a62db0 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -23,41 +23,41 @@ right random.nat shift random.nat] (<| (_.covering /._) - ($_ _.and - (_.cover [/.Or /.sum] - (and (case (# (/.sum maybe.functor list.functor) each - (n.+ shift) - {.#Left {.#Some left}}) - {.#Left {.#Some actual}} - (n.= (n.+ shift left) actual) + (all _.and + (_.cover [/.Or /.sum] + (and (case (# (/.sum maybe.functor list.functor) each + (n.+ shift) + {.#Left {.#Some left}}) + {.#Left {.#Some actual}} + (n.= (n.+ shift left) actual) - _ - false) - (case (# (/.sum maybe.functor list.functor) each - (n.+ shift) - {.#Right (list right)}) - (pattern {.#Right (list actual)}) - (n.= (n.+ shift right) actual) + _ + false) + (case (# (/.sum maybe.functor list.functor) each + (n.+ shift) + {.#Right (list right)}) + (pattern {.#Right (list actual)}) + (n.= (n.+ shift right) actual) - _ - false))) - (_.cover [/.And /.product] - (case (# (/.product maybe.functor list.functor) each - (n.+ shift) - [{.#Some left} (list right)]) - (pattern [{.#Some actualL} (list actualR)]) - (and (n.= (n.+ shift left) actualL) - (n.= (n.+ shift right) actualR)) + _ + false))) + (_.cover [/.And /.product] + (case (# (/.product maybe.functor list.functor) each + (n.+ shift) + [{.#Some left} (list right)]) + (pattern [{.#Some actualL} (list actualR)]) + (and (n.= (n.+ shift left) actualL) + (n.= (n.+ shift right) actualR)) - _ - false)) - (_.cover [/.Then /.composite] - (case (# (/.composite maybe.functor list.functor) each - (n.+ shift) - {.#Some (list left)}) - (pattern {.#Some (list actual)}) - (n.= (n.+ shift left) actual) + _ + false)) + (_.cover [/.Then /.composite] + (case (# (/.composite maybe.functor list.functor) each + (n.+ shift) + {.#Some (list left)}) + (pattern {.#Some (list actual)}) + (n.= (n.+ shift left) actual) - _ - false)) - )))) + _ + false)) + )))) diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux index dd0fd6732..7b8f549ae 100644 --- a/stdlib/source/test/lux/abstract/hash.lux +++ b/stdlib/source/test/lux/abstract/hash.lux @@ -33,7 +33,7 @@ (bit#= (left#= (left#hash leftN) (left#hash rightN)) (right#= (right#hash leftN) (right#hash rightN)))))))]] (<| (_.covering /._) - ($_ _.and - (_.for [/.functor] - ($contravariant.spec hash nat.hash /.functor)) - )))) + (all _.and + (_.for [/.functor] + ($contravariant.spec hash nat.hash /.functor)) + )))) diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index f2b0d2713..9e475fe11 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -43,10 +43,10 @@ (def: .public interval (Random (Interval Nat)) - ($_ random.either - ..inner - ..outer - ..singleton)) + (all random.either + ..inner + ..outer + ..singleton)) (def: types Test @@ -54,14 +54,14 @@ [inner ..inner outer ..outer singleton ..singleton] - ($_ _.and - (_.cover [/.inner?] - (/.inner? inner)) - (_.cover [/.outer?] - (/.outer? outer)) - (_.cover [/.singleton /.singleton?] - (/.singleton? singleton)) - ))) + (all _.and + (_.cover [/.inner?] + (/.inner? inner)) + (_.cover [/.outer?] + (/.outer? outer)) + (_.cover [/.singleton /.singleton?] + (/.singleton? singleton)) + ))) (def: boundaries Test @@ -69,18 +69,18 @@ [bottom random.nat top random.nat .let [interval (/.between n.enum bottom top)]] - ($_ _.and - (_.cover [/.between /.within?] - (and (/.within? interval bottom) - (/.within? interval top))) - (_.cover [/.starts_with?] - (/.starts_with? bottom interval)) - (_.cover [/.ends_with?] - (/.ends_with? top interval)) - (_.cover [/.borders?] - (and (/.borders? interval bottom) - (/.borders? interval top))) - ))) + (all _.and + (_.cover [/.between /.within?] + (and (/.within? interval bottom) + (/.within? interval top))) + (_.cover [/.starts_with?] + (/.starts_with? bottom interval)) + (_.cover [/.ends_with?] + (/.ends_with? top interval)) + (_.cover [/.borders?] + (and (/.borders? interval bottom) + (/.borders? interval top))) + ))) (def: union Test @@ -92,16 +92,16 @@ right_singleton ..singleton left_outer ..outer right_outer ..outer] - ($_ _.and - (_.test "The union of an interval to itself yields the same interval." - (#= some_interval (/.union some_interval some_interval))) - (_.test "The union of 2 inner intervals is another inner interval." - (/.inner? (/.union left_inner right_inner))) - (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." - (if (/.overlaps? (/.complement left_outer) (/.complement right_outer)) - (/.outer? (/.union left_outer right_outer)) - (/.inner? (/.union left_outer right_outer)))) - ))) + (all _.and + (_.test "The union of an interval to itself yields the same interval." + (#= some_interval (/.union some_interval some_interval))) + (_.test "The union of 2 inner intervals is another inner interval." + (/.inner? (/.union left_inner right_inner))) + (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." + (if (/.overlaps? (/.complement left_outer) (/.complement right_outer)) + (/.outer? (/.union left_outer right_outer)) + (/.inner? (/.union left_outer right_outer)))) + ))) (def: intersection Test @@ -113,27 +113,27 @@ right_singleton ..singleton left_outer ..outer right_outer ..outer] - ($_ _.and - (_.test "The intersection of an interval to itself yields the same interval." - (#= some_interval (/.intersection some_interval some_interval))) - (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." - (if (/.overlaps? left_inner right_inner) - (/.inner? (/.intersection left_inner right_inner)) - (/.outer? (/.intersection left_inner right_inner)))) - (_.test "The intersection of 2 outer intervals is another outer interval." - (/.outer? (/.intersection left_outer right_outer))) - ))) + (all _.and + (_.test "The intersection of an interval to itself yields the same interval." + (#= some_interval (/.intersection some_interval some_interval))) + (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." + (if (/.overlaps? left_inner right_inner) + (/.inner? (/.intersection left_inner right_inner)) + (/.outer? (/.intersection left_inner right_inner)))) + (_.test "The intersection of 2 outer intervals is another outer interval." + (/.outer? (/.intersection left_outer right_outer))) + ))) (def: complement Test (do random.monad [some_interval ..interval] - ($_ _.and - (_.test "The complement of a complement is the same as the original." - (#= some_interval (|> some_interval /.complement /.complement))) - (_.test "The complement of an interval does not overlap it." - (not (/.overlaps? some_interval (/.complement some_interval)))) - ))) + (all _.and + (_.test "The complement of a complement is the same as the original." + (#= some_interval (|> some_interval /.complement /.complement))) + (_.test "The complement of an interval does not overlap it." + (not (/.overlaps? some_interval (/.complement some_interval)))) + ))) (def: location Test @@ -149,14 +149,14 @@ (undefined))))) .let [left (/.singleton n.enum l) right (/.singleton n.enum r)]] - ($_ _.and - (_.cover [/.precedes? /.succeeds?] - (and (/.precedes? right left) - (/.succeeds? left right))) - (_.cover [/.before? /.after?] - (and (/.before? m left) - (/.after? m right))) - ))) + (all _.and + (_.cover [/.precedes? /.succeeds?] + (and (/.precedes? right left) + (/.succeeds? left right))) + (_.cover [/.before? /.after?] + (and (/.before? m left) + (/.after? m right))) + ))) (def: touch Test @@ -172,18 +172,18 @@ (undefined))))) .let [int_left (/.between n.enum t1 t2) int_right (/.between n.enum b t1)]] - ($_ _.and - (_.cover [/.meets?] - (/.meets? int_left int_right)) - (_.cover [/.touches?] - (/.touches? int_left int_right)) - (_.cover [/.starts?] - (/.starts? (/.between n.enum b t2) - (/.between n.enum b t1))) - (_.cover [/.finishes?] - (/.finishes? (/.between n.enum b t2) - (/.between n.enum t1 t2))) - ))) + (all _.and + (_.cover [/.meets?] + (/.meets? int_left int_right)) + (_.cover [/.touches?] + (/.touches? int_left int_right)) + (_.cover [/.starts?] + (/.starts? (/.between n.enum b t2) + (/.between n.enum b t1))) + (_.cover [/.finishes?] + (/.finishes? (/.between n.enum b t2) + (/.between n.enum t1 t2))) + ))) (def: nested Test @@ -198,26 +198,26 @@ _ (undefined)))))] - ($_ _.and - (_.test "Every interval is nested into itself." - (/.nested? some_interval some_interval)) - (let [small_inner (/.between n.enum x1 x2) - large_inner (/.between n.enum x0 x3)] - (_.test "Inner intervals can be nested inside one another." - (and (/.nested? large_inner small_inner) - (not (/.nested? small_inner large_inner))))) - (let [small_outer (/.between n.enum x2 x1) - large_outer (/.between n.enum x3 x0)] - (_.test "Outer intervals can be nested inside one another." - (and (/.nested? small_outer large_outer) - (not (/.nested? large_outer small_outer))))) - (let [left_inner (/.between n.enum x0 x1) - right_inner (/.between n.enum x2 x3) - outer (/.between n.enum x0 x3)] - (_.test "Inners can be nested inside outers." - (and (/.nested? outer left_inner) - (/.nested? outer right_inner)))) - ))) + (all _.and + (_.test "Every interval is nested into itself." + (/.nested? some_interval some_interval)) + (let [small_inner (/.between n.enum x1 x2) + large_inner (/.between n.enum x0 x3)] + (_.test "Inner intervals can be nested inside one another." + (and (/.nested? large_inner small_inner) + (not (/.nested? small_inner large_inner))))) + (let [small_outer (/.between n.enum x2 x1) + large_outer (/.between n.enum x3 x0)] + (_.test "Outer intervals can be nested inside one another." + (and (/.nested? small_outer large_outer) + (not (/.nested? large_outer small_outer))))) + (let [left_inner (/.between n.enum x0 x1) + right_inner (/.between n.enum x2 x3) + outer (/.between n.enum x0 x3)] + (_.test "Inners can be nested inside outers." + (and (/.nested? outer left_inner) + (/.nested? outer right_inner)))) + ))) (def: overlap Test @@ -232,41 +232,41 @@ _ (undefined)))))] - ($_ _.and - (_.test "No interval overlaps with itself." - (not (/.overlaps? some_interval some_interval))) - (let [left_inner (/.between n.enum x0 x2) - right_inner (/.between n.enum x1 x3)] - (_.test "Inner intervals can overlap one another." - (and (/.overlaps? left_inner right_inner) - (/.overlaps? right_inner left_inner)))) - (let [left_inner (/.between n.enum x0 x2) - right_inner (/.between n.enum x1 x3) - outer (/.between n.enum x1 x2)] - (_.test "Inners can overlap outers." - (and (/.overlaps? outer left_inner) - (/.overlaps? outer right_inner)))) - ))) + (all _.and + (_.test "No interval overlaps with itself." + (not (/.overlaps? some_interval some_interval))) + (let [left_inner (/.between n.enum x0 x2) + right_inner (/.between n.enum x1 x3)] + (_.test "Inner intervals can overlap one another." + (and (/.overlaps? left_inner right_inner) + (/.overlaps? right_inner left_inner)))) + (let [left_inner (/.between n.enum x0 x2) + right_inner (/.between n.enum x1 x3) + outer (/.between n.enum x1 x2)] + (_.test "Inners can overlap outers." + (and (/.overlaps? outer left_inner) + (/.overlaps? outer right_inner)))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..interval)) - - ..types - ..boundaries - (_.for [/.union] - ..union) - (_.for [/.intersection] - ..intersection) - (_.for [/.complement] - ..complement) - ..location - ..touch - (_.for [/.nested?] - ..nested) - (_.for [/.overlaps?] - ..overlap) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..interval)) + + ..types + ..boundaries + (_.for [/.union] + ..union) + (_.for [/.intersection] + ..intersection) + (_.for [/.complement] + ..complement) + ..location + ..touch + (_.for [/.nested?] + ..nested) + (_.for [/.overlaps?] + ..overlap) + ))) diff --git a/stdlib/source/test/lux/abstract/mix.lux b/stdlib/source/test/lux/abstract/mix.lux index 34b87733c..c07fc0036 100644 --- a/stdlib/source/test/lux/abstract/mix.lux +++ b/stdlib/source/test/lux/abstract/mix.lux @@ -1,26 +1,26 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - [collection - ["[0]" list]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Mix}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + [collection + ["[0]" list]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" Mix}]]) (def: .public test Test (do random.monad [samples (random.list 10 random.nat)] (<| (_.covering /._) - ($_ _.and - (_.cover [/.with_monoid] - (n.= (# list.mix mix (# n.addition composite) (# n.addition identity) samples) - (/.with_monoid n.addition list.mix samples))) - )))) + (all _.and + (_.cover [/.with_monoid] + (n.= (# list.mix mix (# n.addition composite) (# n.addition identity) samples) + (/.with_monoid n.addition list.mix samples))) + )))) diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index 93d060041..dbd7cf10e 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -19,46 +19,46 @@ [mono random.nat poly (random.list 10 random.nat)] (<| (_.covering /._) - ($_ _.and - (_.cover [/.do] - (n.= (++ mono) - (is (Identity Nat) - (/.do identity.monad - [sample (in mono)] - (in (++ sample)))))) - (_.cover [/.then] - (n.= (++ mono) - (is (Identity Nat) - (/.then identity.monad - (|>> ++ (# identity.monad in)) - (# identity.monad in mono))))) - (_.cover [/.all] - (# (list.equivalence n.equivalence) = - (list#each ++ poly) - (|> poly - (list#each (|>> ++ (# identity.monad in))) - (is (List (Identity Nat))) - (/.all identity.monad) - (is (Identity (List Nat)))))) - (_.cover [/.each] - (# (list.equivalence n.equivalence) = - (list#each ++ poly) - (|> poly - (/.each identity.monad (|>> ++ (# identity.monad in))) - (is (Identity (List Nat)))))) - (_.cover [/.only] - (# (list.equivalence n.equivalence) = - (list.only n.even? poly) - (|> poly - (/.only identity.monad (|>> n.even? (# identity.monad in))) - (is (Identity (List Nat)))))) - (_.cover [/.mix] - (n.= (list#mix n.+ 0 poly) - (|> poly - (/.mix identity.monad - (function (_ part whole) - (# identity.monad in - (n.+ part whole))) - 0) - (is (Identity Nat))))) - )))) + (all _.and + (_.cover [/.do] + (n.= (++ mono) + (is (Identity Nat) + (/.do identity.monad + [sample (in mono)] + (in (++ sample)))))) + (_.cover [/.then] + (n.= (++ mono) + (is (Identity Nat) + (/.then identity.monad + (|>> ++ (# identity.monad in)) + (# identity.monad in mono))))) + (_.cover [/.all] + (# (list.equivalence n.equivalence) = + (list#each ++ poly) + (|> poly + (list#each (|>> ++ (# identity.monad in))) + (is (List (Identity Nat))) + (/.all identity.monad) + (is (Identity (List Nat)))))) + (_.cover [/.each] + (# (list.equivalence n.equivalence) = + (list#each ++ poly) + (|> poly + (/.each identity.monad (|>> ++ (# identity.monad in))) + (is (Identity (List Nat)))))) + (_.cover [/.only] + (# (list.equivalence n.equivalence) = + (list.only n.even? poly) + (|> poly + (/.only identity.monad (|>> n.even? (# identity.monad in))) + (is (Identity (List Nat)))))) + (_.cover [/.mix] + (n.= (list#mix n.+ 0 poly) + (|> poly + (/.mix identity.monad + (function (_ part whole) + (# identity.monad in + (n.+ part whole))) + 0) + (is (Identity Nat))))) + )))) diff --git a/stdlib/source/test/lux/abstract/monad/free.lux b/stdlib/source/test/lux/abstract/monad/free.lux index 82bd8e2df..9f53dfe2e 100644 --- a/stdlib/source/test/lux/abstract/monad/free.lux +++ b/stdlib/source/test/lux/abstract/monad/free.lux @@ -44,14 +44,14 @@ Test (<| (_.covering /._) (_.for [/.Free]) - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison (is (Functor (/.Free List)) - (/.functor list.functor)))) - (_.for [/.apply] - ($apply.spec ..injection ..comparison (is (Apply (/.Free List)) - (/.apply list.functor)))) - (_.for [/.monad] - ($monad.spec ..injection ..comparison (is (Monad (/.Free List)) - (/.monad list.functor)))) - ))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison (is (Functor (/.Free List)) + (/.functor list.functor)))) + (_.for [/.apply] + ($apply.spec ..injection ..comparison (is (Apply (/.Free List)) + (/.apply list.functor)))) + (_.for [/.monad] + ($monad.spec ..injection ..comparison (is (Monad (/.Free List)) + (/.monad list.functor)))) + ))) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index 219d92000..4f48cd643 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [math - ["[0]" random {"+" Random}] - [number - ["[0]" nat] - ["[0]" int]]]]] - [\\library - ["[0]" / - [// - [equivalence {"+" Equivalence}]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [math + ["[0]" random {"+" Random}] + [number + ["[0]" nat] + ["[0]" int]]]]] + [\\library + ["[0]" / + [// + [equivalence {"+" Equivalence}]]]]) (def: .public test Test @@ -22,12 +22,12 @@ intL random.int intR random.int] (<| (_.covering /._) - ($_ _.and - (_.cover [/.and] - (let [[natLR intLR] (# (/.and nat.addition int.multiplication) composite - [natL intL] [natR intR])] - (and (nat.= (# nat.addition composite natL natR) - natLR) - (int.= (# int.multiplication composite intL intR) - intLR)))) - )))) + (all _.and + (_.cover [/.and] + (let [[natLR intLR] (# (/.and nat.addition int.multiplication) composite + [natL intL] [natR intR])] + (and (nat.= (# nat.addition composite natL natR) + natLR) + (int.= (# int.multiplication composite intL intR) + intLR)))) + )))) diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux index 0092ab8bb..a4a500370 100644 --- a/stdlib/source/test/lux/abstract/order.lux +++ b/stdlib/source/test/lux/abstract/order.lux @@ -33,23 +33,23 @@ (# rightO < right right)) (bit#= (# leftO < left right) (# rightO < left right))))))]]) - ($_ _.and - (_.for [/.functor] - ($contravariant.spec equivalence n.order /.functor)) - (_.cover [/.Choice /.min /.max] - (n.< (/.max n.order left right) - (/.min n.order left right))) - (_.cover [/.Comparison /.>] - (not (bit#= (n.< left right) - (/.> n.order left right)))) - (_.cover [/.<=] - (and (/.<= n.order left left) - (/.<= n.order right right) - (bit#= (# n.order < left right) - (/.<= n.order left right)))) - (_.cover [/.>=] - (and (/.>= n.order left left) - (/.>= n.order right right) - (bit#= (/.> n.order left right) - (/.>= n.order left right)))) - ))) + (all _.and + (_.for [/.functor] + ($contravariant.spec equivalence n.order /.functor)) + (_.cover [/.Choice /.min /.max] + (n.< (/.max n.order left right) + (/.min n.order left right))) + (_.cover [/.Comparison /.>] + (not (bit#= (n.< left right) + (/.> n.order left right)))) + (_.cover [/.<=] + (and (/.<= n.order left left) + (/.<= n.order right right) + (bit#= (# n.order < left right) + (/.<= n.order left right)))) + (_.cover [/.>=] + (and (/.>= n.order left left) + (/.>= n.order right right) + (bit#= (/.> n.order left right) + (/.>= n.order left right)))) + ))) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index e61708ed4..d918d5fe7 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -40,52 +40,52 @@ (bit#= (left sample) (right sample)))))]]) (_.for [/.Predicate]) - ($_ _.and - (_.for [/.functor] - ($contravariant.spec equivalence (multiple? 2) /.functor)) - (let [generator (is (Random (/.Predicate Nat)) - (|> random.nat - (random.only (|>> (n.= 0) not)) - (# ! each multiple?)))] - ($_ _.and - (_.for [/.union] - ($monoid.spec equivalence /.union generator)) - (_.for [/.intersection] - ($monoid.spec equivalence /.intersection generator)))) - - (_.cover [/.none] - (bit#= false (/.none sample))) - (_.cover [/.all] - (bit#= true (/.all sample))) - (_.cover [/.or] - (bit#= (/.all sample) - ((/.or /.none /.all) sample))) - (_.cover [/.and] - (bit#= (/.none sample) - ((/.and /.none /.all) sample))) - (_.cover [/.complement] - (and (not (bit#= (/.none sample) - ((/.complement /.none) sample))) - (not (bit#= (/.all sample) - ((/.complement /.all) sample))))) - (_.cover [/.difference] - (let [/2? (multiple? 2) - /3? (multiple? 3)] - (bit#= (and (/2? sample) - (not (/3? sample))) - ((/.difference /3? /2?) sample)))) - (_.cover [/.rec] - (let [even? (multiple? 2) - any_even? (is (/.Predicate (List Nat)) - (/.rec (function (_ again) - (function (_ values) - (case values - {.#End} - false + (all _.and + (_.for [/.functor] + ($contravariant.spec equivalence (multiple? 2) /.functor)) + (let [generator (is (Random (/.Predicate Nat)) + (|> random.nat + (random.only (|>> (n.= 0) not)) + (# ! each multiple?)))] + (all _.and + (_.for [/.union] + ($monoid.spec equivalence /.union generator)) + (_.for [/.intersection] + ($monoid.spec equivalence /.intersection generator)))) + + (_.cover [/.none] + (bit#= false (/.none sample))) + (_.cover [/.all] + (bit#= true (/.all sample))) + (_.cover [/.or] + (bit#= (/.all sample) + ((/.or /.none /.all) sample))) + (_.cover [/.and] + (bit#= (/.none sample) + ((/.and /.none /.all) sample))) + (_.cover [/.complement] + (and (not (bit#= (/.none sample) + ((/.complement /.none) sample))) + (not (bit#= (/.all sample) + ((/.complement /.all) sample))))) + (_.cover [/.difference] + (let [/2? (multiple? 2) + /3? (multiple? 3)] + (bit#= (and (/2? sample) + (not (/3? sample))) + ((/.difference /3? /2?) sample)))) + (_.cover [/.rec] + (let [even? (multiple? 2) + any_even? (is (/.Predicate (List Nat)) + (/.rec (function (_ again) + (function (_ values) + (case values + {.#End} + false - {.#Item head tail} - (or (even? head) - (again tail)))))))] - (bit#= (list.any? even? samples) - (any_even? samples)))) - ))) + {.#Item head tail} + (or (even? head) + (again tail)))))))] + (bit#= (list.any? even? samples) + (any_even? samples)))) + ))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 1530b5dc9..bbb3d869d 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -1,74 +1,74 @@ (.using - [library - [lux {"-" function} - ["_" test {"+" Test}]]] - ["[0]" / "_" - ["[1][0]" concatenative] - ["[1][0]" concurrency "_" - ["[1]/[0]" actor] - ["[1]/[0]" atom] - ["[1]/[0]" frp] - ["[1]/[0]" thread] - ["[1]/[0]" async] - ["[1]/[0]" semaphore] - ["[1]/[0]" stm]] - ["[1][0]" continuation] - ["[1][0]" exception] - ["[1][0]" function] - ["[1][0]" io] - ["[1][0]" lazy] - ["[1][0]" maybe] - ["[1][0]" parser] - ["[1][0]" pipe] - ["[1][0]" reader] - ["[1][0]" region] - ["[1][0]" remember] - [security - ["[1][0]" policy] - ["[1][0]" capability]] - ["[1][0]" state] - ["[1][0]" thread] - ["[1][0]" try] - ["[1][0]" writer]]) + [library + [lux {"-" function} + ["_" test {"+" Test}]]] + ["[0]" / "_" + ["[1][0]" concatenative] + ["[1][0]" concurrency "_" + ["[1]/[0]" actor] + ["[1]/[0]" atom] + ["[1]/[0]" frp] + ["[1]/[0]" thread] + ["[1]/[0]" async] + ["[1]/[0]" semaphore] + ["[1]/[0]" stm]] + ["[1][0]" continuation] + ["[1][0]" exception] + ["[1][0]" function] + ["[1][0]" io] + ["[1][0]" lazy] + ["[1][0]" maybe] + ["[1][0]" parser] + ["[1][0]" pipe] + ["[1][0]" reader] + ["[1][0]" region] + ["[1][0]" remember] + [security + ["[1][0]" policy] + ["[1][0]" capability]] + ["[1][0]" state] + ["[1][0]" thread] + ["[1][0]" try] + ["[1][0]" writer]]) (def: concurrency Test - ($_ _.and - /concurrency/actor.test - /concurrency/atom.test - /concurrency/frp.test - /concurrency/thread.test - /concurrency/async.test - /concurrency/semaphore.test - /concurrency/stm.test - )) + (all _.and + /concurrency/actor.test + /concurrency/atom.test + /concurrency/frp.test + /concurrency/thread.test + /concurrency/async.test + /concurrency/semaphore.test + /concurrency/stm.test + )) (def: security Test - ($_ _.and - /policy.test - /capability.test - )) + (all _.and + /policy.test + /capability.test + )) (def: .public test Test - ($_ _.and - /concatenative.test - ..concurrency - /continuation.test - /exception.test - /function.test - /io.test - /lazy.test - /maybe.test - /parser.test - /pipe.test - /reader.test - /region.test - /remember.test - ..security - /state.test - /thread.test - /try.test - /writer.test - )) + (all _.and + /concatenative.test + ..concurrency + /continuation.test + /exception.test + /function.test + /io.test + /lazy.test + /maybe.test + /parser.test + /pipe.test + /reader.test + /region.test + /remember.test + ..security + /state.test + /thread.test + /try.test + /writer.test + )) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index f4fe24af4..8484cd1b8 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -24,72 +24,72 @@ (do random.monad [sample random.nat dummy random.nat] - (`` ($_ _.and - (_.cover [/.push] - (n.= sample - (||> (/.push sample)))) - (_.cover [/.drop] - (n.= sample - (||> (/.push sample) - (/.push dummy) - /.drop))) - (_.cover [/.nip] - (n.= sample - (||> (/.push dummy) - (/.push sample) - /.nip))) - (_.cover [/.dup] - (||> (/.push sample) - /.dup - /.n/=)) - (_.cover [/.swap] - (n.= sample - (||> (/.push sample) - (/.push dummy) - /.swap))) - (_.cover [/.rotL] - (n.= sample - (||> (/.push sample) - (/.push dummy) - (/.push dummy) - /.rotL))) - (_.cover [/.rotR] - (n.= sample - (||> (/.push dummy) - (/.push sample) - (/.push dummy) - /.rotR))) - (_.cover [/.&&] - (let [[left right] (||> (/.push sample) - (/.push dummy) - /.&&)] - (and (n.= sample left) - (n.= dummy right)))) - (~~ (template [<function> <tag>] - [(_.cover [<function>] - ((sum.equivalence n.= n.=) - {<tag> sample} - (||> (/.push sample) - <function>)))] + (`` (all _.and + (_.cover [/.push] + (n.= sample + (||> (/.push sample)))) + (_.cover [/.drop] + (n.= sample + (||> (/.push sample) + (/.push dummy) + /.drop))) + (_.cover [/.nip] + (n.= sample + (||> (/.push dummy) + (/.push sample) + /.nip))) + (_.cover [/.dup] + (||> (/.push sample) + /.dup + /.n/=)) + (_.cover [/.swap] + (n.= sample + (||> (/.push sample) + (/.push dummy) + /.swap))) + (_.cover [/.rotL] + (n.= sample + (||> (/.push sample) + (/.push dummy) + (/.push dummy) + /.rotL))) + (_.cover [/.rotR] + (n.= sample + (||> (/.push dummy) + (/.push sample) + (/.push dummy) + /.rotR))) + (_.cover [/.&&] + (let [[left right] (||> (/.push sample) + (/.push dummy) + /.&&)] + (and (n.= sample left) + (n.= dummy right)))) + (~~ (template [<function> <tag>] + [(_.cover [<function>] + ((sum.equivalence n.= n.=) + {<tag> sample} + (||> (/.push sample) + <function>)))] - [/.||L .#Left] - [/.||R .#Right])) - (_.cover [/.dip] - (n.= (++ sample) - (||> (/.push sample) - (/.push dummy) - (/.push (/.apply_1 ++)) - /.dip - /.drop))) - (_.cover [/.dip_2] - (n.= (++ sample) - (||> (/.push sample) - (/.push dummy) - (/.push dummy) - (/.push (/.apply_1 ++)) - /.dip_2 - /.drop /.drop))) - )))) + [/.||L .#Left] + [/.||R .#Right])) + (_.cover [/.dip] + (n.= (++ sample) + (||> (/.push sample) + (/.push dummy) + (/.push (/.apply_1 ++)) + /.dip + /.drop))) + (_.cover [/.dip_2] + (n.= (++ sample) + (||> (/.push sample) + (/.push dummy) + (/.push dummy) + (/.push (/.apply_1 ++)) + /.dip_2 + /.drop /.drop))) + )))) (template: (!numerical <=> <generator> <only> <arithmetic> <order>) [(is Test @@ -98,41 +98,41 @@ (do random.monad [parameter (|> <generator> (random.only <only>)) subject <generator>] - (`` ($_ _.and - (~~ (template [<concatenative> <functional>] - [(_.cover [<concatenative>] - (<=> (<functional> parameter subject) - (||> (/.push subject) - (/.push parameter) - <concatenative>)))] + (`` (all _.and + (~~ (template [<concatenative> <functional>] + [(_.cover [<concatenative>] + (<=> (<functional> parameter subject) + (||> (/.push subject) + (/.push parameter) + <concatenative>)))] - <arithmetic>')) - (~~ (template [<concatenative> <functional>] - [(_.cover [<concatenative>] - (bit#= (<functional> parameter subject) - (||> (/.push subject) - (/.push parameter) - <concatenative>)))] + <arithmetic>')) + (~~ (template [<concatenative> <functional>] + [(_.cover [<concatenative>] + (bit#= (<functional> parameter subject) + (||> (/.push subject) + (/.push parameter) + <concatenative>)))] - <order>')) - )))))]) + <order>')) + )))))]) (def: numerical Test - ($_ _.and - (!numerical n.= random.nat (|>> (n.= 0) not) - [[/.n/+ n.+] [/.n/- n.-] [/.n/* n.*] [/.n// n./] [/.n/% n.%]] - [[/.n/= n.=] [/.n/< n.<] [/.n/<= n.<=] [/.n/> n.>] [/.n/>= n.>=]]) - (!numerical i.= random.int (|>> (i.= +0) not) - [[/.i/+ i.+] [/.i/- i.-] [/.i/* i.*] [/.i// i./] [/.i/% i.%]] - [[/.i/= i.=] [/.i/< i.<] [/.i/<= i.<=] [/.i/> i.>] [/.i/>= i.>=]]) - (!numerical r.= random.rev (|>> (r.= .0) not) - [[/.r/+ r.+] [/.r/- r.-] [/.r/* r.*] [/.r// r./] [/.r/% r.%]] - [[/.r/= r.=] [/.r/< r.<] [/.r/<= r.<=] [/.r/> r.>] [/.r/>= r.>=]]) - (!numerical f.= random.safe_frac (|>> (f.= +0.0) not) - [[/.f/+ f.+] [/.f/- f.-] [/.f/* f.*] [/.f// f./] [/.f/% f.%]] - [[/.f/= f.=] [/.f/< f.<] [/.f/<= f.<=] [/.f/> f.>] [/.f/>= f.>=]]) - )) + (all _.and + (!numerical n.= random.nat (|>> (n.= 0) not) + [[/.n/+ n.+] [/.n/- n.-] [/.n/* n.*] [/.n// n./] [/.n/% n.%]] + [[/.n/= n.=] [/.n/< n.<] [/.n/<= n.<=] [/.n/> n.>] [/.n/>= n.>=]]) + (!numerical i.= random.int (|>> (i.= +0) not) + [[/.i/+ i.+] [/.i/- i.-] [/.i/* i.*] [/.i// i./] [/.i/% i.%]] + [[/.i/= i.=] [/.i/< i.<] [/.i/<= i.<=] [/.i/> i.>] [/.i/>= i.>=]]) + (!numerical r.= random.rev (|>> (r.= .0) not) + [[/.r/+ r.+] [/.r/- r.-] [/.r/* r.*] [/.r// r./] [/.r/% r.%]] + [[/.r/= r.=] [/.r/< r.<] [/.r/<= r.<=] [/.r/> r.>] [/.r/>= r.>=]]) + (!numerical f.= random.safe_frac (|>> (f.= +0.0) not) + [[/.f/+ f.+] [/.f/- f.-] [/.f/* f.*] [/.f// f./] [/.f/% f.%]] + [[/.f/= f.=] [/.f/< f.<] [/.f/<= f.<=] [/.f/> f.>] [/.f/>= f.>=]]) + )) (def: control_flow Test @@ -145,155 +145,155 @@ (/.apply_1 ++)) |test| (is (/.=> [Nat] [Bit]) (/.apply_1 (|>> (n.- start) (n.< distance))))]] - ($_ _.and - (_.cover [/.call /.apply_1] - (n.= (++ sample) - (||> (/.push sample) - (/.push (/.apply_1 ++)) - /.call))) - (_.cover [/.apply_2] - (n.= (n.+ sample sample) - (||> (/.push sample) - (/.push sample) - (/.push (/.apply_2 n.+)) - /.call))) - (_.cover [/.apply_3] - (n.= ($_ n.+ sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push (/.apply_3 (function (_ i0 i1 i2) - ($_ n.+ i0 i1 i2)))) - /.call))) - (_.cover [/.apply_4] - (n.= ($_ n.+ sample sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push (/.apply_4 (function (_ i0 i1 i2 i3) - ($_ n.+ i0 i1 i2 i3)))) - /.call))) - (_.cover [/.apply_5] - (n.= ($_ n.+ sample sample sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push (/.apply_5 (function (_ i0 i1 i2 i3 i4) - ($_ n.+ i0 i1 i2 i3 i4)))) - /.call))) - (_.cover [/.apply_6] - (n.= ($_ n.+ sample sample sample sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push (/.apply_6 (function (_ i0 i1 i2 i3 i4 i5) - ($_ n.+ i0 i1 i2 i3 i4 i5)))) - /.call))) - (_.cover [/.apply_7] - (n.= ($_ n.+ sample sample sample sample sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push (/.apply_7 (function (_ i0 i1 i2 i3 i4 i5 i6) - ($_ n.+ i0 i1 i2 i3 i4 i5 i6)))) - /.call))) - (_.cover [/.apply_8] - (n.= ($_ n.+ sample sample sample sample sample sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push (/.apply_8 (function (_ i0 i1 i2 i3 i4 i5 i6 i7) - ($_ n.+ i0 i1 i2 i3 i4 i5 i6 i7)))) - /.call))) - (_.cover [/.apply] - (n.= ($_ n.+ sample sample sample sample sample sample sample sample sample) - (||> (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push sample) - (/.push ((/.apply 9) (function (_ i0 i1 i2 i3 i4 i5 i6 i7 i8) - ($_ n.+ i0 i1 i2 i3 i4 i5 i6 i7 i8)))) - /.call))) - (_.cover [/.if] - (n.= (if choice - (++ sample) - (-- sample)) - (||> (/.push sample) - (/.push choice) - (/.push (/.apply_1 ++)) - (/.push (/.apply_1 --)) - /.if))) - (_.cover [/.loop] - (n.= (n.+ distance start) - (||> (/.push start) - (/.push (is (/.=> [Nat] [Nat Bit]) - (|>> |++| /.dup |test|))) - /.loop))) - (_.cover [/.while] - (n.= (n.+ distance start) - (||> (/.push start) - (/.push (is (/.=> [Nat] [Nat Bit]) - (|>> /.dup |test|))) - (/.push |++|) - /.while))) - (_.cover [/.do] - (n.= (++ sample) - (||> (/.push sample) - (/.push (is (/.=> [] [Bit]) - (|>> (/.push false)))) - (/.push |++|) - /.do /.while))) - (_.cover [/.compose] - (n.= (++ (++ sample)) - (||> (/.push sample) - (/.push |++|) - (/.push |++|) - /.compose - /.call))) - (_.cover [/.partial] - (n.= (n.+ sample sample) - (||> (/.push sample) - (/.push sample) - (/.push (/.apply_2 n.+)) - /.partial - /.call))) - (_.cover [/.when] - (n.= (if choice - (++ sample) - sample) - (||> (/.push sample) - (/.push choice) - (/.push (/.apply_1 ++)) - /.when))) - (_.cover [/.?] - (n.= (if choice - (++ sample) - (-- sample)) - (||> (/.push choice) - (/.push (++ sample)) - (/.push (-- sample)) - /.?))) - ))) + (all _.and + (_.cover [/.call /.apply_1] + (n.= (++ sample) + (||> (/.push sample) + (/.push (/.apply_1 ++)) + /.call))) + (_.cover [/.apply_2] + (n.= (n.+ sample sample) + (||> (/.push sample) + (/.push sample) + (/.push (/.apply_2 n.+)) + /.call))) + (_.cover [/.apply_3] + (n.= (all n.+ sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push (/.apply_3 (function (_ i0 i1 i2) + (all n.+ i0 i1 i2)))) + /.call))) + (_.cover [/.apply_4] + (n.= (all n.+ sample sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push (/.apply_4 (function (_ i0 i1 i2 i3) + (all n.+ i0 i1 i2 i3)))) + /.call))) + (_.cover [/.apply_5] + (n.= (all n.+ sample sample sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push (/.apply_5 (function (_ i0 i1 i2 i3 i4) + (all n.+ i0 i1 i2 i3 i4)))) + /.call))) + (_.cover [/.apply_6] + (n.= (all n.+ sample sample sample sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push (/.apply_6 (function (_ i0 i1 i2 i3 i4 i5) + (all n.+ i0 i1 i2 i3 i4 i5)))) + /.call))) + (_.cover [/.apply_7] + (n.= (all n.+ sample sample sample sample sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push (/.apply_7 (function (_ i0 i1 i2 i3 i4 i5 i6) + (all n.+ i0 i1 i2 i3 i4 i5 i6)))) + /.call))) + (_.cover [/.apply_8] + (n.= (all n.+ sample sample sample sample sample sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push (/.apply_8 (function (_ i0 i1 i2 i3 i4 i5 i6 i7) + (all n.+ i0 i1 i2 i3 i4 i5 i6 i7)))) + /.call))) + (_.cover [/.apply] + (n.= (all n.+ sample sample sample sample sample sample sample sample sample) + (||> (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push sample) + (/.push ((/.apply 9) (function (_ i0 i1 i2 i3 i4 i5 i6 i7 i8) + (all n.+ i0 i1 i2 i3 i4 i5 i6 i7 i8)))) + /.call))) + (_.cover [/.if] + (n.= (if choice + (++ sample) + (-- sample)) + (||> (/.push sample) + (/.push choice) + (/.push (/.apply_1 ++)) + (/.push (/.apply_1 --)) + /.if))) + (_.cover [/.loop] + (n.= (n.+ distance start) + (||> (/.push start) + (/.push (is (/.=> [Nat] [Nat Bit]) + (|>> |++| /.dup |test|))) + /.loop))) + (_.cover [/.while] + (n.= (n.+ distance start) + (||> (/.push start) + (/.push (is (/.=> [Nat] [Nat Bit]) + (|>> /.dup |test|))) + (/.push |++|) + /.while))) + (_.cover [/.do] + (n.= (++ sample) + (||> (/.push sample) + (/.push (is (/.=> [] [Bit]) + (|>> (/.push false)))) + (/.push |++|) + /.do /.while))) + (_.cover [/.compose] + (n.= (++ (++ sample)) + (||> (/.push sample) + (/.push |++|) + (/.push |++|) + /.compose + /.call))) + (_.cover [/.partial] + (n.= (n.+ sample sample) + (||> (/.push sample) + (/.push sample) + (/.push (/.apply_2 n.+)) + /.partial + /.call))) + (_.cover [/.when] + (n.= (if choice + (++ sample) + sample) + (||> (/.push sample) + (/.push choice) + (/.push (/.apply_1 ++)) + /.when))) + (_.cover [/.?] + (n.= (if choice + (++ sample) + (-- sample)) + (||> (/.push choice) + (/.push (++ sample)) + (/.push (-- sample)) + /.?))) + ))) (word: square (=> [Nat] [Nat]) @@ -313,9 +313,9 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..stack_shuffling - ..numerical - ..control_flow - ..definition - ))) + (all _.and + ..stack_shuffling + ..numerical + ..control_flow + ..definition + ))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 73ff15702..f76e6a41d 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -57,172 +57,172 @@ --! (is (/.Mail Nat) (as_mail --))]] (<| (_.covering /._) (_.for [/.Actor]) - ($_ _.and - (_.cover [/.alive?] - (io.run! (do io.monad - [actor (/.spawn! /.default 0)] - (/.alive? actor)))) - - (_.cover [/.poison!] - (let [poisoned_actors_die! - (io.run! (do io.monad - [actor (/.spawn! /.default 0) - poisoned? (/.poison! actor) - alive? (/.alive? actor)] - (in (and (..mailed? poisoned?) - (not alive?))))) - - cannot_poison_more_than_once! - (io.run! (do io.monad - [actor (/.spawn! /.default 0) - first_time? (/.poison! actor) - second_time? (/.poison! actor)] - (in (and (..mailed? first_time?) - (not (..mailed? second_time?))))))] - (and poisoned_actors_die! - cannot_poison_more_than_once!))) - - (let [[read write] (is [(Async Text) (Resolver Text)] - (async.async []))] - (in (do async.monad - [_ (async.future (do io.monad - [actor (/.spawn! (is (/.Behavior Any Any) - [/.#on_init (|>>) - /.#on_mail (function (_ message state self) - (do [! async.monad] - [outcome (message state self)] - (case outcome - {try.#Failure cause} - (do ! - [_ (async.future (write cause))] - (in outcome)) - - {try.#Success _} - (in outcome))))]) - [])] - (/.poison! actor))) - _ (async.delay 100) - result (async.future (async.value read))] - (_.cover' [/.poisoned] - (case result - {.#Some error} - (exception.match? /.poisoned error) - - {.#None} - false))))) - - (in (do async.monad - [sent? (async.future (do io.monad - [actor (/.spawn! /.default 0) - sent? (/.mail! ++! actor)] - (in (..mailed? sent?))))] - (_.cover' [/.Behavior /.Mail - /.default /.spawn! /.mail!] - sent?))) - - (in (do async.monad - [result (async.future (do io.monad - [counter (/.spawn! /.default 0) - _ (/.poison! counter)] - (/.mail! ++! counter)))] - (_.cover' [/.dead] - (case result - {try.#Success outcome} - false - - {try.#Failure error} - (exception.match? /.dead error))))) - - (let [die! (is (/.Mail Nat) - (function (_ state actor) - (async#in (exception.except ..got_wrecked []))))] - (in (do async.monad - [result (async.future (do io.monad - [actor (/.spawn! /.default initial_state) - sent? (/.mail! die! actor) - alive? (/.alive? actor) - obituary (/.obituary' actor)] - (in {try.#Success [actor sent? alive? obituary]})))] - (_.cover' [/.Obituary /.obituary'] - (case result - (pattern {try.#Success [actor sent? alive? {.#Some [error state (list single_pending_message)]}]}) - (and (..mailed? sent?) - (not alive?) - (exception.match? ..got_wrecked error) - (n.= initial_state state) - (same? die! single_pending_message)) - - _ - false))))) - - (in (do async.monad - [counter (async.future (/.spawn! ..counter 0)) - result (do (try.with async.monad) - [output_1 (/.tell! (count! 1) counter) - output_2 (/.tell! (count! 1) counter) - output_3 (/.tell! (count! 1) counter)] - (in (and (n.= 1 output_1) - (n.= 2 output_2) - (n.= 3 output_3))))] - (_.cover' [/.Message /.actor: /.message: /.tell!] - (case result - {try.#Success outcome} - outcome - - {try.#Failure error} - false)))) - - (in (do async.monad - [verdict (async.future - (do io.monad - [anonymous (/.actor [Nat - initial_state] - ((on_mail message state self) - (message (++ state) self))) - sent/++? (/.mail! ++! anonymous) - sent/--? (/.mail! --! anonymous) - poisoned? (/.poison! anonymous) - obituary (/.obituary' anonymous)] - (in (and (..mailed? sent/++?) - (..mailed? sent/--?) - (..mailed? poisoned?) - (case obituary - (pattern {.#Some [error final_state (list poison_pill)]}) - (and (exception.match? /.poisoned error) - (n.= (++ (++ initial_state)) - final_state)) - - _ - false)))))] - (_.cover' [/.actor] - verdict))) - - (do ! - [num_events (# ! each (|>> (n.% 10) ++) random.nat) - events (random.list num_events random.nat) - num_observations (# ! each (n.% num_events) random.nat) - .let [expected (list.first num_observations events) - sink (is (Atom (Sequence Nat)) - (atom.atom sequence.empty))]] - (in (do async.monad - [agent (async.future - (do [! io.monad] - [agent (/.actor [Nat 0]) - _ (/.observe! (function (_ event stop) - (function (_ events_seen self) - (async.future - (if (n.< num_observations events_seen) - (do ! - [_ (atom.update! (sequence.suffix event) sink)] - (in {try.#Success (++ events_seen)})) - (do ! - [_ stop] - (in {try.#Failure "YOLO"})))))) - (frp.sequential 0 events) - agent)] - (in agent))) - _ (/.obituary agent) - actual (async.future (atom.read! sink))] - (_.cover' [/.Stop /.observe! /.obituary] - (# (list.equivalence n.equivalence) = expected (sequence.list actual)))))) - )))) + (all _.and + (_.cover [/.alive?] + (io.run! (do io.monad + [actor (/.spawn! /.default 0)] + (/.alive? actor)))) + + (_.cover [/.poison!] + (let [poisoned_actors_die! + (io.run! (do io.monad + [actor (/.spawn! /.default 0) + poisoned? (/.poison! actor) + alive? (/.alive? actor)] + (in (and (..mailed? poisoned?) + (not alive?))))) + + cannot_poison_more_than_once! + (io.run! (do io.monad + [actor (/.spawn! /.default 0) + first_time? (/.poison! actor) + second_time? (/.poison! actor)] + (in (and (..mailed? first_time?) + (not (..mailed? second_time?))))))] + (and poisoned_actors_die! + cannot_poison_more_than_once!))) + + (let [[read write] (is [(Async Text) (Resolver Text)] + (async.async []))] + (in (do async.monad + [_ (async.future (do io.monad + [actor (/.spawn! (is (/.Behavior Any Any) + [/.#on_init (|>>) + /.#on_mail (function (_ message state self) + (do [! async.monad] + [outcome (message state self)] + (case outcome + {try.#Failure cause} + (do ! + [_ (async.future (write cause))] + (in outcome)) + + {try.#Success _} + (in outcome))))]) + [])] + (/.poison! actor))) + _ (async.delay 100) + result (async.future (async.value read))] + (_.cover' [/.poisoned] + (case result + {.#Some error} + (exception.match? /.poisoned error) + + {.#None} + false))))) + + (in (do async.monad + [sent? (async.future (do io.monad + [actor (/.spawn! /.default 0) + sent? (/.mail! ++! actor)] + (in (..mailed? sent?))))] + (_.cover' [/.Behavior /.Mail + /.default /.spawn! /.mail!] + sent?))) + + (in (do async.monad + [result (async.future (do io.monad + [counter (/.spawn! /.default 0) + _ (/.poison! counter)] + (/.mail! ++! counter)))] + (_.cover' [/.dead] + (case result + {try.#Success outcome} + false + + {try.#Failure error} + (exception.match? /.dead error))))) + + (let [die! (is (/.Mail Nat) + (function (_ state actor) + (async#in (exception.except ..got_wrecked []))))] + (in (do async.monad + [result (async.future (do io.monad + [actor (/.spawn! /.default initial_state) + sent? (/.mail! die! actor) + alive? (/.alive? actor) + obituary (/.obituary' actor)] + (in {try.#Success [actor sent? alive? obituary]})))] + (_.cover' [/.Obituary /.obituary'] + (case result + (pattern {try.#Success [actor sent? alive? {.#Some [error state (list single_pending_message)]}]}) + (and (..mailed? sent?) + (not alive?) + (exception.match? ..got_wrecked error) + (n.= initial_state state) + (same? die! single_pending_message)) + + _ + false))))) + + (in (do async.monad + [counter (async.future (/.spawn! ..counter 0)) + result (do (try.with async.monad) + [output_1 (/.tell! (count! 1) counter) + output_2 (/.tell! (count! 1) counter) + output_3 (/.tell! (count! 1) counter)] + (in (and (n.= 1 output_1) + (n.= 2 output_2) + (n.= 3 output_3))))] + (_.cover' [/.Message /.actor: /.message: /.tell!] + (case result + {try.#Success outcome} + outcome + + {try.#Failure error} + false)))) + + (in (do async.monad + [verdict (async.future + (do io.monad + [anonymous (/.actor [Nat + initial_state] + ((on_mail message state self) + (message (++ state) self))) + sent/++? (/.mail! ++! anonymous) + sent/--? (/.mail! --! anonymous) + poisoned? (/.poison! anonymous) + obituary (/.obituary' anonymous)] + (in (and (..mailed? sent/++?) + (..mailed? sent/--?) + (..mailed? poisoned?) + (case obituary + (pattern {.#Some [error final_state (list poison_pill)]}) + (and (exception.match? /.poisoned error) + (n.= (++ (++ initial_state)) + final_state)) + + _ + false)))))] + (_.cover' [/.actor] + verdict))) + + (do ! + [num_events (# ! each (|>> (n.% 10) ++) random.nat) + events (random.list num_events random.nat) + num_observations (# ! each (n.% num_events) random.nat) + .let [expected (list.first num_observations events) + sink (is (Atom (Sequence Nat)) + (atom.atom sequence.empty))]] + (in (do async.monad + [agent (async.future + (do [! io.monad] + [agent (/.actor [Nat 0]) + _ (/.observe! (function (_ event stop) + (function (_ events_seen self) + (async.future + (if (n.< num_observations events_seen) + (do ! + [_ (atom.update! (sequence.suffix event) sink)] + (in {try.#Success (++ events_seen)})) + (do ! + [_ stop] + (in {try.#Failure "YOLO"})))))) + (frp.sequential 0 events) + agent)] + (in agent))) + _ (/.obituary agent) + actual (async.future (atom.read! sink))] + (_.cover' [/.Stop /.observe! /.obituary] + (# (list.equivalence n.equivalence) = expected (sequence.list actual)))))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux index 7a61769b8..e43619f2c 100644 --- a/stdlib/source/test/lux/control/concurrency/async.lux +++ b/stdlib/source/test/lux/control/concurrency/async.lux @@ -58,117 +58,117 @@ .let [not_dummy (|> random.nat (random.only (|>> (n.= dummy) not)))] leftE not_dummy rightE not_dummy] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) - - (in (do /.monad - [.let [[async resolver] (is [(/.Async Nat) (/.Resolver Nat)] - (/.async []))] - resolved? (/.future (resolver expected)) - actual async] - (_.cover' [/.Async /.Resolver /.async] - (and resolved? - (n.= expected actual))))) - (in (do /.monad - [actual (/.resolved expected)] - (_.cover' [/.resolved] - (n.= expected actual)))) - (in (do /.monad - [actual (/.future (io.io expected))] - (_.cover' [/.future] - (n.= expected actual)))) - (in (do /.monad - [pre (/.future instant.now) - actual (/.schedule! waiting_time (io.io expected)) - post (/.future instant.now)] - (_.cover' [/.schedule!] - (and (n.= expected actual) - (i.>= (.int waiting_time) - (duration.millis (instant.span pre post))))))) - (in (do /.monad - [pre (/.future instant.now) - _ (/.delay waiting_time) - post (/.future instant.now)] - (_.cover' [/.delay] - (i.>= (.int waiting_time) - (duration.millis (instant.span pre post)))))) - (in (do /.monad - [[leftA rightA] (/.and (/.future (io.io leftE)) - (/.future (io.io rightE)))] - (_.cover' [/.and] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) - (in (do /.monad - [pre (/.future instant.now) - actual (/.after waiting_time expected) - post (/.future instant.now)] - (_.cover' [/.after] - (and (n.= expected actual) - (i.>= (.int waiting_time) - (duration.millis (instant.span pre post))))))) - (in (do /.monad - [?left (/.or (in leftE) - (/.after waiting_time dummy)) - ?right (/.or (/.after waiting_time dummy) - (in rightE))] - (_.cover' [/.or] - (case [?left ?right] - [{.#Left leftA} {.#Right rightA}] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + + (in (do /.monad + [.let [[async resolver] (is [(/.Async Nat) (/.Resolver Nat)] + (/.async []))] + resolved? (/.future (resolver expected)) + actual async] + (_.cover' [/.Async /.Resolver /.async] + (and resolved? + (n.= expected actual))))) + (in (do /.monad + [actual (/.resolved expected)] + (_.cover' [/.resolved] + (n.= expected actual)))) + (in (do /.monad + [actual (/.future (io.io expected))] + (_.cover' [/.future] + (n.= expected actual)))) + (in (do /.monad + [pre (/.future instant.now) + actual (/.schedule! waiting_time (io.io expected)) + post (/.future instant.now)] + (_.cover' [/.schedule!] + (and (n.= expected actual) + (i.>= (.int waiting_time) + (duration.millis (instant.span pre post))))))) + (in (do /.monad + [pre (/.future instant.now) + _ (/.delay waiting_time) + post (/.future instant.now)] + (_.cover' [/.delay] + (i.>= (.int waiting_time) + (duration.millis (instant.span pre post)))))) + (in (do /.monad + [[leftA rightA] (/.and (/.future (io.io leftE)) + (/.future (io.io rightE)))] + (_.cover' [/.and] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (in (do /.monad + [pre (/.future instant.now) + actual (/.after waiting_time expected) + post (/.future instant.now)] + (_.cover' [/.after] + (and (n.= expected actual) + (i.>= (.int waiting_time) + (duration.millis (instant.span pre post))))))) + (in (do /.monad + [?left (/.or (in leftE) + (/.after waiting_time dummy)) + ?right (/.or (/.after waiting_time dummy) + (in rightE))] + (_.cover' [/.or] + (case [?left ?right] + [{.#Left leftA} {.#Right rightA}] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA)) - _ - false)))) - (in (do /.monad - [leftA (/.either (in leftE) - (/.after waiting_time dummy)) - rightA (/.either (/.after waiting_time dummy) - (in rightE))] - (_.cover' [/.either] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) - (in (do /.monad - [?actual (/.future (/.value (/.resolved expected))) - .let [[async resolver] (is [(/.Async Nat) (/.Resolver Nat)] - (/.async []))] - ?never (/.future (/.value async))] - (_.cover' [/.value] - (case [?actual ?never] - [{.#Some actual} {.#None}] - (n.= expected actual) + _ + false)))) + (in (do /.monad + [leftA (/.either (in leftE) + (/.after waiting_time dummy)) + rightA (/.either (/.after waiting_time dummy) + (in rightE))] + (_.cover' [/.either] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (in (do /.monad + [?actual (/.future (/.value (/.resolved expected))) + .let [[async resolver] (is [(/.Async Nat) (/.Resolver Nat)] + (/.async []))] + ?never (/.future (/.value async))] + (_.cover' [/.value] + (case [?actual ?never] + [{.#Some actual} {.#None}] + (n.= expected actual) - _ - false)))) - (in (do /.monad - [yep (/.future (/.resolved? (/.resolved expected))) - .let [[async resolver] (is [(/.Async Nat) (/.Resolver Nat)] - (/.async []))] - nope (/.future (/.resolved? async))] - (_.cover' [/.resolved?] - (and yep - (not nope))))) - (in (do /.monad - [?none (/.within 0 (/.after waiting_time dummy)) - ?actual (/.within waiting_time (in expected))] - (_.cover' [/.within] - (case [?none ?actual] - [{.#None} {.#Some actual}] - (n.= expected actual) + _ + false)))) + (in (do /.monad + [yep (/.future (/.resolved? (/.resolved expected))) + .let [[async resolver] (is [(/.Async Nat) (/.Resolver Nat)] + (/.async []))] + nope (/.future (/.resolved? async))] + (_.cover' [/.resolved?] + (and yep + (not nope))))) + (in (do /.monad + [?none (/.within 0 (/.after waiting_time dummy)) + ?actual (/.within waiting_time (in expected))] + (_.cover' [/.within] + (case [?none ?actual] + [{.#None} {.#Some actual}] + (n.= expected actual) - _ - false)))) - (in (do /.monad - [.let [box (is (Atom Nat) - (atom.atom dummy))] - _ (/.future (/.upon! (function (_ value) - (atom.write! value box)) - (/.resolved expected))) - actual (/.future (atom.read! box))] - (_.cover' [/.upon!] - (n.= expected actual)))) - )))) + _ + false)))) + (in (do /.monad + [.let [box (is (Atom Nat) + (atom.atom dummy))] + _ (/.future (/.upon! (function (_ value) + (atom.write! value box)) + (/.resolved expected))) + actual (/.future (atom.read! box))] + (_.cover' [/.upon!] + (n.= expected actual)))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index f711fb141..cda6a0737 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -1,64 +1,64 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" io]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [expected random.nat - .let [box (/.atom expected)]] - (_.cover [/.Atom /.atom /.read!] - (io.run! - (do io.monad - [actual (/.read! box)] - (in (same? expected actual)))))) - (do random.monad - [target random.nat - unknown (random.only (|>> (same? target) not) random.nat) - expected random.nat - .let [box (/.atom target)]] - (_.cover [/.compare_and_swap!] - (io.run! - (do io.monad - [swapped_unknown? (/.compare_and_swap! unknown expected box) - swapped_target? (/.compare_and_swap! target expected box) - actual (/.read! box)] - (in (and (not swapped_unknown?) - swapped_target? - (same? expected actual))))))) - (do random.monad - [init random.nat - shift random.nat - .let [box (/.atom init)]] - (_.cover [/.update!] - (io.run! - (do io.monad - [[pre post] (/.update! (n.+ shift) box)] - (in (and (same? init pre) - (n.= (n.+ shift init) - post))))))) - (do random.monad - [pre random.nat - post random.nat - .let [box (/.atom pre)]] - (_.cover [/.write!] - (io.run! - (do io.monad - [old (/.write! post box) - new (/.read! box)] - (in (and (same? pre old) - (same? post new))))))) - ))) + (all _.and + (do random.monad + [expected random.nat + .let [box (/.atom expected)]] + (_.cover [/.Atom /.atom /.read!] + (io.run! + (do io.monad + [actual (/.read! box)] + (in (same? expected actual)))))) + (do random.monad + [target random.nat + unknown (random.only (|>> (same? target) not) random.nat) + expected random.nat + .let [box (/.atom target)]] + (_.cover [/.compare_and_swap!] + (io.run! + (do io.monad + [swapped_unknown? (/.compare_and_swap! unknown expected box) + swapped_target? (/.compare_and_swap! target expected box) + actual (/.read! box)] + (in (and (not swapped_unknown?) + swapped_target? + (same? expected actual))))))) + (do random.monad + [init random.nat + shift random.nat + .let [box (/.atom init)]] + (_.cover [/.update!] + (io.run! + (do io.monad + [[pre post] (/.update! (n.+ shift) box)] + (in (and (same? init pre) + (n.= (n.+ shift init) + post))))))) + (do random.monad + [pre random.nat + post random.nat + .let [box (/.atom pre)]] + (_.cover [/.write!] + (io.run! + (do io.monad + [old (/.write! post box) + new (/.read! box)] + (in (and (same? pre old) + (same? post new))))))) + ))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 90d5f17fe..67255c72d 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -77,151 +77,151 @@ (not (or (n.= distinct/0 value) (n.= distinct/1 value)))))) shift random.nat] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.Channel /.Sink /.channel] - (case (io.run! - (do (try.with io.monad) - [.let [[channel sink] (is [(/.Channel Nat) (/.Sink Nat)] - (/.channel []))] - _ (# sink feed sample) - _ (# sink close)] - (in channel))) - {try.#Success channel} - (io.run! - (do io.monad - [?actual (async.value channel)] - (in (case ?actual - {.#Some {.#Some [actual _]}} - (n.= sample (variance.read actual)) - - _ - false)))) - - {try.#Failure error} - false)) - (_.cover [/.channel_is_already_closed] - (case (io.run! - (do (try.with io.monad) - [.let [[channel sink] (is [(/.Channel Nat) (/.Sink Nat)] - (/.channel []))] - _ (# sink close)] - (# sink feed sample))) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.channel_is_already_closed error))) - (in (do async.monad - [output (|> sample - async.resolved - /.of_async - /.list)] - (_.cover' [/.of_async /.list] - (list#= (list sample) - output)))) - (in (do async.monad - [output (|> inputs - (/.sequential 0) - /.list)] - (_.cover' [/.sequential] - (list#= inputs - output)))) - (in (do async.monad - [output (|> inputs - (/.sequential 0) - (/.only n.even?) - /.list)] - (_.cover' [/.only] - (list#= (list.only n.even? inputs) - output)))) - (in (do [! async.monad] - [.let [[?signal !signal] (is [(async.Async Any) (async.Resolver Any)] - (async.async [])) - sink (is (Atom (Sequence Nat)) - (atom.atom sequence.empty))] - _ (async.future (/.subscribe! (function (_ value) - (do [! io.monad] - [current (atom.read! sink) - _ (atom.update! (sequence.suffix value) sink)] - (if (n.< (list.size inputs) - (++ (sequence.size current))) - (in {.#Some []}) - (do ! - [_ (!signal [])] - (in {.#None}))))) - (/.sequential 0 (list#composite inputs inputs)))) - _ ?signal - listened (|> sink - atom.read! - async.future - (# ! each sequence.list))] - (_.cover' [/.Subscriber /.subscribe!] - (list#= inputs listened)))) - (in (do async.monad - [actual (/.mix (function (_ input total) - (async.resolved (n.+ input total))) - 0 - (/.sequential 0 inputs))] - (_.cover' [/.mix] - (n.= (list#mix n.+ 0 inputs) - actual)))) - (in (do async.monad - [actual (|> inputs - (/.sequential 0) - (/.mixes (function (_ input total) - (async.resolved (n.+ input total))) - 0) - /.list)] - (_.cover' [/.mixes] - (list#= (list.mixes n.+ 0 inputs) - actual)))) - (in (do async.monad - [actual (|> (list distinct/0 distinct/0 distinct/0 - distinct/1 - distinct/2 distinct/2) - (/.sequential 0) - (/.distinct n.equivalence) - /.list)] - (_.cover' [/.distinct] - (list#= (list distinct/0 distinct/1 distinct/2) - actual)))) - (do ! - [polling_delay (# ! each (|>> (n.% 10) ++) random.nat) - amount_of_polls (# ! each (|>> (n.% 10) ++) random.nat)] - ($_ _.and - (in (do [! async.monad] - [actual (..take_amount amount_of_polls (/.poll polling_delay (is (IO Nat) (io.io sample)))) - .let [correct_values! - (list.every? (n.= sample) actual) - - enough_polls! - (n.= amount_of_polls (list.size actual))]] - (_.cover' [/.poll] - (and correct_values! - enough_polls!)))) - (in (do [! async.monad] - [actual (..take_amount amount_of_polls (/.periodic polling_delay))] - (_.cover' [/.periodic] - (n.= amount_of_polls (list.size actual))))))) - (in (do async.monad - [.let [max_iterations 10] - actual (|> [0 sample] - (/.iterations (function (_ [iterations current]) - (async.resolved - (if (n.< max_iterations iterations) - {.#Some [[(++ iterations) (n.+ shift current)] - current]} - {.#None})))) - /.list)] - (_.cover' [/.iterations] - (and (n.= max_iterations (list.size actual)) - (list#= (list.mixes n.+ sample (list.repeated (-- max_iterations) shift)) - actual))))) - ))))) + (_.cover [/.Channel /.Sink /.channel] + (case (io.run! + (do (try.with io.monad) + [.let [[channel sink] (is [(/.Channel Nat) (/.Sink Nat)] + (/.channel []))] + _ (# sink feed sample) + _ (# sink close)] + (in channel))) + {try.#Success channel} + (io.run! + (do io.monad + [?actual (async.value channel)] + (in (case ?actual + {.#Some {.#Some [actual _]}} + (n.= sample (variance.read actual)) + + _ + false)))) + + {try.#Failure error} + false)) + (_.cover [/.channel_is_already_closed] + (case (io.run! + (do (try.with io.monad) + [.let [[channel sink] (is [(/.Channel Nat) (/.Sink Nat)] + (/.channel []))] + _ (# sink close)] + (# sink feed sample))) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.channel_is_already_closed error))) + (in (do async.monad + [output (|> sample + async.resolved + /.of_async + /.list)] + (_.cover' [/.of_async /.list] + (list#= (list sample) + output)))) + (in (do async.monad + [output (|> inputs + (/.sequential 0) + /.list)] + (_.cover' [/.sequential] + (list#= inputs + output)))) + (in (do async.monad + [output (|> inputs + (/.sequential 0) + (/.only n.even?) + /.list)] + (_.cover' [/.only] + (list#= (list.only n.even? inputs) + output)))) + (in (do [! async.monad] + [.let [[?signal !signal] (is [(async.Async Any) (async.Resolver Any)] + (async.async [])) + sink (is (Atom (Sequence Nat)) + (atom.atom sequence.empty))] + _ (async.future (/.subscribe! (function (_ value) + (do [! io.monad] + [current (atom.read! sink) + _ (atom.update! (sequence.suffix value) sink)] + (if (n.< (list.size inputs) + (++ (sequence.size current))) + (in {.#Some []}) + (do ! + [_ (!signal [])] + (in {.#None}))))) + (/.sequential 0 (list#composite inputs inputs)))) + _ ?signal + listened (|> sink + atom.read! + async.future + (# ! each sequence.list))] + (_.cover' [/.Subscriber /.subscribe!] + (list#= inputs listened)))) + (in (do async.monad + [actual (/.mix (function (_ input total) + (async.resolved (n.+ input total))) + 0 + (/.sequential 0 inputs))] + (_.cover' [/.mix] + (n.= (list#mix n.+ 0 inputs) + actual)))) + (in (do async.monad + [actual (|> inputs + (/.sequential 0) + (/.mixes (function (_ input total) + (async.resolved (n.+ input total))) + 0) + /.list)] + (_.cover' [/.mixes] + (list#= (list.mixes n.+ 0 inputs) + actual)))) + (in (do async.monad + [actual (|> (list distinct/0 distinct/0 distinct/0 + distinct/1 + distinct/2 distinct/2) + (/.sequential 0) + (/.distinct n.equivalence) + /.list)] + (_.cover' [/.distinct] + (list#= (list distinct/0 distinct/1 distinct/2) + actual)))) + (do ! + [polling_delay (# ! each (|>> (n.% 10) ++) random.nat) + amount_of_polls (# ! each (|>> (n.% 10) ++) random.nat)] + (all _.and + (in (do [! async.monad] + [actual (..take_amount amount_of_polls (/.poll polling_delay (is (IO Nat) (io.io sample)))) + .let [correct_values! + (list.every? (n.= sample) actual) + + enough_polls! + (n.= amount_of_polls (list.size actual))]] + (_.cover' [/.poll] + (and correct_values! + enough_polls!)))) + (in (do [! async.monad] + [actual (..take_amount amount_of_polls (/.periodic polling_delay))] + (_.cover' [/.periodic] + (n.= amount_of_polls (list.size actual))))))) + (in (do async.monad + [.let [max_iterations 10] + actual (|> [0 sample] + (/.iterations (function (_ [iterations current]) + (async.resolved + (if (n.< max_iterations iterations) + {.#Some [[(++ iterations) (n.+ shift current)] + current]} + {.#None})))) + /.list)] + (_.cover' [/.iterations] + (and (n.= max_iterations (list.size actual)) + (list#= (list.mixes n.+ sample (list.repeated (-- max_iterations) shift)) + actual))))) + ))))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index 1b07c0e65..252f557b9 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -36,98 +36,98 @@ (def: semaphore Test (_.for [/.Semaphore] - ($_ _.and - (do [! random.monad] - [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) - .let [semaphore (/.semaphore initial_open_positions)]] - (in (do async.monad - [result (async.within ..delay (/.wait! semaphore))] - (_.cover' [/.semaphore] - (case result - {.#Some _} - true + (all _.and + (do [! random.monad] + [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) + .let [semaphore (/.semaphore initial_open_positions)]] + (in (do async.monad + [result (async.within ..delay (/.wait! semaphore))] + (_.cover' [/.semaphore] + (case result + {.#Some _} + true - {.#None} - false))))) - (do [! random.monad] - [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) - .let [semaphore (/.semaphore initial_open_positions)]] - (in (do [! async.monad] - [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore)) - result (async.within ..delay (/.wait! semaphore))] - (_.cover' [/.wait!] - (case result - {.#Some _} - false + {.#None} + false))))) + (do [! random.monad] + [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) + .let [semaphore (/.semaphore initial_open_positions)]] + (in (do [! async.monad] + [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore)) + result (async.within ..delay (/.wait! semaphore))] + (_.cover' [/.wait!] + (case result + {.#Some _} + false - {.#None} - true))))) - (do [! random.monad] - [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) - .let [semaphore (/.semaphore initial_open_positions)]] - (in (do [! async.monad] - [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore)) - .let [block (/.wait! semaphore)] - result/0 (async.within ..delay block) - open_positions (/.signal! semaphore) - result/1 (async.within ..delay block)] - (_.cover' [/.signal!] - (case [result/0 result/1 open_positions] - [{.#None} {.#Some _} {try.#Success +0}] - true + {.#None} + true))))) + (do [! random.monad] + [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) + .let [semaphore (/.semaphore initial_open_positions)]] + (in (do [! async.monad] + [_ (monad.each ! /.wait! (list.repeated initial_open_positions semaphore)) + .let [block (/.wait! semaphore)] + result/0 (async.within ..delay block) + open_positions (/.signal! semaphore) + result/1 (async.within ..delay block)] + (_.cover' [/.signal!] + (case [result/0 result/1 open_positions] + [{.#None} {.#Some _} {try.#Success +0}] + true - _ - false))))) - (do [! random.monad] - [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) - .let [semaphore (/.semaphore initial_open_positions)]] - (in (do async.monad - [outcome (/.signal! semaphore)] - (_.cover' [/.semaphore_is_maxed_out] - (case outcome - {try.#Failure error} - (exception.match? /.semaphore_is_maxed_out error) + _ + false))))) + (do [! random.monad] + [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) + .let [semaphore (/.semaphore initial_open_positions)]] + (in (do async.monad + [outcome (/.signal! semaphore)] + (_.cover' [/.semaphore_is_maxed_out] + (case outcome + {try.#Failure error} + (exception.match? /.semaphore_is_maxed_out error) - _ - false))))) - ))) + _ + false))))) + ))) (def: mutex Test (_.for [/.Mutex] - ($_ _.and - (do [! random.monad] - [repetitions (|> random.nat (# ! each (|>> (n.% 100) (n.max 10)))) - .let [resource (atom.atom "") - expected_As (text.together (list.repeated repetitions "A")) - expected_Bs (text.together (list.repeated repetitions "B")) - mutex (/.mutex []) - processA (<| (/.synchronize! mutex) - io.io - async.future - (do [! io.monad] - [_ (<| (monad.all !) - (list.repeated repetitions) - (atom.update! (|>> (format "A")) resource))] - (in []))) - processB (<| (/.synchronize! mutex) - io.io - async.future - (do [! io.monad] - [_ (<| (monad.all !) - (list.repeated repetitions) - (atom.update! (|>> (format "B")) resource))] - (in [])))]] - (in (do async.monad - [_ processA - _ processB - .let [outcome (io.run! (atom.read! resource))]] - (_.cover' [/.mutex /.synchronize!] - (or (text#= (format expected_As expected_Bs) - outcome) - (text#= (format expected_Bs expected_As) - outcome)))))) - ))) + (all _.and + (do [! random.monad] + [repetitions (|> random.nat (# ! each (|>> (n.% 100) (n.max 10)))) + .let [resource (atom.atom "") + expected_As (text.together (list.repeated repetitions "A")) + expected_Bs (text.together (list.repeated repetitions "B")) + mutex (/.mutex []) + processA (<| (/.synchronize! mutex) + io.io + async.future + (do [! io.monad] + [_ (<| (monad.all !) + (list.repeated repetitions) + (atom.update! (|>> (format "A")) resource))] + (in []))) + processB (<| (/.synchronize! mutex) + io.io + async.future + (do [! io.monad] + [_ (<| (monad.all !) + (list.repeated repetitions) + (atom.update! (|>> (format "B")) resource))] + (in [])))]] + (in (do async.monad + [_ processA + _ processB + .let [outcome (io.run! (atom.read! resource))]] + (_.cover' [/.mutex /.synchronize!] + (or (text#= (format expected_As expected_Bs) + outcome) + (text#= (format expected_Bs expected_As) + outcome)))))) + ))) (def: (waiter resource barrier id) (-> (Atom Text) /.Barrier Nat (Async Any)) @@ -139,49 +139,49 @@ (def: barrier Test (_.for [/.Barrier] - ($_ _.and - (do random.monad - [raw random.nat] - (_.cover [/.Limit /.limit] - (case [raw (/.limit raw)] - [0 {.#None}] - true - - [_ {.#Some limit}] - (and (n.> 0 raw) - (n.= raw (refinement.value limit))) + (all _.and + (do random.monad + [raw random.nat] + (_.cover [/.Limit /.limit] + (case [raw (/.limit raw)] + [0 {.#None}] + true + + [_ {.#Some limit}] + (and (n.> 0 raw) + (n.= raw (refinement.value limit))) - _ - false))) - (do [! random.monad] - [limit (# ! each (|>> (n.% 9) ++) random.nat) - .let [barrier (/.barrier (maybe.trusted (/.limit limit))) - resource (atom.atom "")]] - (in (do [! async.monad] - [.let [suffix "_" - expected_ending (|> suffix - (list.repeated limit) - text.together) - expected_ids (enum.range n.enum 0 (-- limit))] - _ (|> expected_ids - (list#each (function (_ id) - (exec - (io.run! (atom.update! (|>> (format suffix)) resource)) - (waiter resource barrier id)))) - (monad.all !)) - .let [outcome (io.run! (atom.read! resource))]] - (_.cover' [/.barrier /.block!] - (and (text.ends_with? expected_ending outcome) - (list.every? (function (_ id) - (text.contains? (%.nat id) outcome)) - expected_ids)))))) - ))) + _ + false))) + (do [! random.monad] + [limit (# ! each (|>> (n.% 9) ++) random.nat) + .let [barrier (/.barrier (maybe.trusted (/.limit limit))) + resource (atom.atom "")]] + (in (do [! async.monad] + [.let [suffix "_" + expected_ending (|> suffix + (list.repeated limit) + text.together) + expected_ids (enum.range n.enum 0 (-- limit))] + _ (|> expected_ids + (list#each (function (_ id) + (exec + (io.run! (atom.update! (|>> (format suffix)) resource)) + (waiter resource barrier id)))) + (monad.all !)) + .let [outcome (io.run! (atom.read! resource))]] + (_.cover' [/.barrier /.block!] + (and (text.ends_with? expected_ending outcome) + (list.every? (function (_ id) + (text.contains? (%.nat id) outcome)) + expected_ids)))))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..semaphore - ..mutex - ..barrier - ))) + (all _.and + ..semaphore + ..mutex + ..barrier + ))) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index ca55f2364..2e1f9586f 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -42,62 +42,62 @@ [dummy random.nat expected random.nat iterations_per_process (|> random.nat (# ! each (n.% 100)))] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (in (do async.monad - [actual (/.commit! (# /.monad in expected))] - (_.cover' [/.commit!] - (n.= expected actual)))) - (in (do async.monad - [actual (/.commit! (/.read (/.var expected)))] - (_.cover' [/.Var /.var /.read] - (n.= expected actual)))) - (in (do async.monad - [actual (let [box (/.var dummy)] - (/.commit! (do /.monad - [_ (/.write expected box)] - (/.read box)))) - verdict (let [box (/.var dummy)] + (in (do async.monad + [actual (/.commit! (# /.monad in expected))] + (_.cover' [/.commit!] + (n.= expected actual)))) + (in (do async.monad + [actual (/.commit! (/.read (/.var expected)))] + (_.cover' [/.Var /.var /.read] + (n.= expected actual)))) + (in (do async.monad + [actual (let [box (/.var dummy)] (/.commit! (do /.monad - [_ (/.write expected box) - actual (/.read box)] - (in (n.= expected actual)))))] - (_.cover' [/.write] - (and (n.= expected actual) - verdict)))) - (in (do async.monad - [.let [box (/.var dummy)] - output (/.commit! (do /.monad - [_ (/.update (n.+ expected) box)] - (/.read box)))] - (_.cover' [/.update] - (n.= (n.+ expected dummy) - output)))) - (in (do async.monad - [.let [box (/.var dummy) - [follower sink] (io.run! (/.changes box))] - _ (/.commit! (/.write expected box)) - _ (/.commit! (/.update (n.* 2) box)) - _ (async.future (# sink close)) - _ (/.commit! (/.update (n.* 3) box)) - changes (frp.list follower)] - (_.cover' [/.changes] - (# (list.equivalence n.equivalence) = - (list expected (n.* 2 expected)) - changes)))) - (in (let [var (/.var 0)] - (do [! async.monad] - [_ (|> (list.repeated iterations_per_process []) - (list#each (function (_ _) (/.commit! (/.update ++ var)))) - (monad.all !)) - cummulative (/.commit! (/.read var))] - (_.cover' [/.STM] - (n.= iterations_per_process - cummulative))))) - )))) + [_ (/.write expected box)] + (/.read box)))) + verdict (let [box (/.var dummy)] + (/.commit! (do /.monad + [_ (/.write expected box) + actual (/.read box)] + (in (n.= expected actual)))))] + (_.cover' [/.write] + (and (n.= expected actual) + verdict)))) + (in (do async.monad + [.let [box (/.var dummy)] + output (/.commit! (do /.monad + [_ (/.update (n.+ expected) box)] + (/.read box)))] + (_.cover' [/.update] + (n.= (n.+ expected dummy) + output)))) + (in (do async.monad + [.let [box (/.var dummy) + [follower sink] (io.run! (/.changes box))] + _ (/.commit! (/.write expected box)) + _ (/.commit! (/.update (n.* 2) box)) + _ (async.future (# sink close)) + _ (/.commit! (/.update (n.* 3) box)) + changes (frp.list follower)] + (_.cover' [/.changes] + (# (list.equivalence n.equivalence) = + (list expected (n.* 2 expected)) + changes)))) + (in (let [var (/.var 0)] + (do [! async.monad] + [_ (|> (list.repeated iterations_per_process []) + (list#each (function (_ _) (/.commit! (/.update ++ var)))) + (monad.all !)) + cummulative (/.commit! (/.read var))] + (_.cover' [/.STM] + (n.= iterations_per_process + cummulative))))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index ac4a3ed15..4b3e41c37 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io]] - [time - ["[0]" instant {"+" Instant}] - ["[0]" duration]] - [math - ["[0]" random] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" / - [// - ["[0]" atom {"+" Atom}] - ["[0]" async]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" io]] + [time + ["[0]" instant {"+" Instant}] + ["[0]" duration]] + [math + ["[0]" random] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" / + [// + ["[0]" atom {"+" Atom}] + ["[0]" async]]]]) (def: .public test Test @@ -28,25 +28,25 @@ expected random.nat delay (# ! each (|>> (n.% 5) (n.+ 5)) random.nat)] - ($_ _.and - (_.cover [/.parallelism] - (n.> 0 /.parallelism)) - (in (do async.monad - [reference_time (async.future instant.now) - .let [box (atom.atom [reference_time dummy])] - _ (async.future - (/.schedule! delay (do io.monad - [execution_time instant.now] - (atom.write! [execution_time expected] box)))) - _ (async.delay (n.* 2 delay)) - [execution_time actual] (async.future (atom.read! box))] - (_.cover' [/.schedule!] - (let [expected_delay! - (i.>= (.int delay) - (duration.millis (instant.span reference_time execution_time))) + (all _.and + (_.cover [/.parallelism] + (n.> 0 /.parallelism)) + (in (do async.monad + [reference_time (async.future instant.now) + .let [box (atom.atom [reference_time dummy])] + _ (async.future + (/.schedule! delay (do io.monad + [execution_time instant.now] + (atom.write! [execution_time expected] box)))) + _ (async.delay (n.* 2 delay)) + [execution_time actual] (async.future (atom.read! box))] + (_.cover' [/.schedule!] + (let [expected_delay! + (i.>= (.int delay) + (duration.millis (instant.span reference_time execution_time))) - correct_value! - (n.= expected actual)] - (and expected_delay! - correct_value!))))) - )))) + correct_value! + (n.= expected actual)] + (and expected_delay! + correct_value!))))) + )))) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index bcf401329..77dffb213 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -36,61 +36,61 @@ (open "_#[0]") /.monad] elems (random.list 3 random.nat)]) (_.for [/.Cont]) - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.result] - (n.= sample (/.result (_#in sample)))) - (_.cover [/.with_current] - (n.= (n.* 2 sample) - (/.result (do [! /.monad] - [value (/.with_current - (function (_ k) - (do ! - [temp (k sample)] - ... If this code where to run, - ... the output would be - ... (n.* 4 sample) - (k temp))))] - (in (n.* 2 value)))))) - (_.cover [/.portal] - (n.= (n.+ 100 sample) - (/.result (do /.monad - [[restart [output idx]] (/.portal [sample 0])] - (if (n.< 10 idx) - (restart [(n.+ 10 output) (++ idx)]) - (in output)))))) - (_.cover [/.shift /.reset] - (let [(open "_#[0]") /.monad - (open "list#[0]") (list.equivalence n.equivalence) - visit (is (-> (List Nat) - (/.Cont (List Nat) (List Nat))) - (function (visit xs) - (case xs - {.#End} - (_#in {.#End}) + (_.cover [/.result] + (n.= sample (/.result (_#in sample)))) + (_.cover [/.with_current] + (n.= (n.* 2 sample) + (/.result (do [! /.monad] + [value (/.with_current + (function (_ k) + (do ! + [temp (k sample)] + ... If this code where to run, + ... the output would be + ... (n.* 4 sample) + (k temp))))] + (in (n.* 2 value)))))) + (_.cover [/.portal] + (n.= (n.+ 100 sample) + (/.result (do /.monad + [[restart [output idx]] (/.portal [sample 0])] + (if (n.< 10 idx) + (restart [(n.+ 10 output) (++ idx)]) + (in output)))))) + (_.cover [/.shift /.reset] + (let [(open "_#[0]") /.monad + (open "list#[0]") (list.equivalence n.equivalence) + visit (is (-> (List Nat) + (/.Cont (List Nat) (List Nat))) + (function (visit xs) + (case xs + {.#End} + (_#in {.#End}) - {.#Item x xs'} - (do [! /.monad] - [output (/.shift (function (_ k) - (do ! - [tail (k xs')] - (in {.#Item x tail}))))] - (visit output)))))] - (list#= elems - (/.result (/.reset (visit elems)))))) - (_.cover [/.continued] - (/.continued (same? sample) - (is (/.Cont Nat Bit) - (function (_ next) - (next sample))))) - (_.cover [/.pending] - (/.continued (same? sample) - (is (/.Cont Nat Bit) - (/.pending sample)))) - ))) + {.#Item x xs'} + (do [! /.monad] + [output (/.shift (function (_ k) + (do ! + [tail (k xs')] + (in {.#Item x tail}))))] + (visit output)))))] + (list#= elems + (/.result (/.reset (visit elems)))))) + (_.cover [/.continued] + (/.continued (same? sample) + (is (/.Cont Nat Bit) + (function (_ next) + (next sample))))) + (_.cover [/.pending] + (/.continued (same? sample) + (is (/.Cont Nat Bit) + (/.pending sample)))) + ))) diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index ad9ef59fb..f003e854d 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -36,79 +36,79 @@ value1 report_element] (<| (_.covering /._) (_.for [/.Exception]) - ($_ _.and - (_.cover [/.except] - (case (/.except ..an_exception []) - {try.#Success _} false - {try.#Failure _} true)) - (_.cover [/.error] - (case (/.except ..an_exception []) - {try.#Success _} - false - - {try.#Failure message} - (text#= message (/.error ..an_exception [])))) - (_.cover [/.match?] - (/.match? ..an_exception - (/.error ..an_exception []))) - (_.cover [/.assertion] - (case (/.assertion ..an_exception [] assertion_succeeded?) - {try.#Success _} - assertion_succeeded? - - {try.#Failure message} - (and (not assertion_succeeded?) - (text#= message (/.error ..an_exception []))))) - (_.cover [/.when] - (and (n.= expected - (|> (/.except ..an_exception []) - (/.when ..an_exception (function (_ ex) expected)) - (/.otherwise (function (_ ex) wrong)))) - (n.= expected - (|> (/.except ..another_exception []) - (/.when ..an_exception (function (_ ex) wrong)) - (/.when ..another_exception (function (_ ex) expected)) - (/.otherwise (function (_ ex) wrong)))))) - (_.cover [/.otherwise] - (n.= expected - (|> (/.except ..another_exception []) - (/.when ..an_exception (function (_ ex) wrong)) - (/.otherwise (function (_ ex) expected))))) - (_.cover [/.report] - (let [report (/.report field0 value0 - field1 value1)] - (and (text.contains? field0 report) - (text.contains? value0 report) - (text.contains? field1 report) - (text.contains? value1 report)))) - (_.cover [/.listing] - (let [enumeration (/.listing %.text (list field0 value0 field1 value1))] - (and (text.contains? field0 enumeration) - (text.contains? value0 enumeration) - (text.contains? field1 enumeration) - (text.contains? value1 enumeration)))) - (_.cover [/.with] - (and (case (/.with ..an_exception [] {try.#Success expected}) - {try.#Success actual} (n.= expected actual) - {try.#Failure _} false) - (case (/.with ..an_exception [] {try.#Failure ""}) - {try.#Success _} false - {try.#Failure message} (text#= message (/.error ..an_exception []))) - (case (/.with ..an_exception [] - (is (Try Nat) - (/.except ..another_exception []))) - {try.#Success _} - false - - {try.#Failure message} - (and (text.contains? (/.error ..an_exception []) message) - (text.contains? (/.error ..another_exception []) message))))) - (_.cover [/.exception:] - (case (/.except ..custom_exception [expected]) - {try.#Success _} - false - - {try.#Failure message} - (and (text.contains? ..label message) - (text.contains? (%.nat expected) message)))) - )))) + (all _.and + (_.cover [/.except] + (case (/.except ..an_exception []) + {try.#Success _} false + {try.#Failure _} true)) + (_.cover [/.error] + (case (/.except ..an_exception []) + {try.#Success _} + false + + {try.#Failure message} + (text#= message (/.error ..an_exception [])))) + (_.cover [/.match?] + (/.match? ..an_exception + (/.error ..an_exception []))) + (_.cover [/.assertion] + (case (/.assertion ..an_exception [] assertion_succeeded?) + {try.#Success _} + assertion_succeeded? + + {try.#Failure message} + (and (not assertion_succeeded?) + (text#= message (/.error ..an_exception []))))) + (_.cover [/.when] + (and (n.= expected + (|> (/.except ..an_exception []) + (/.when ..an_exception (function (_ ex) expected)) + (/.otherwise (function (_ ex) wrong)))) + (n.= expected + (|> (/.except ..another_exception []) + (/.when ..an_exception (function (_ ex) wrong)) + (/.when ..another_exception (function (_ ex) expected)) + (/.otherwise (function (_ ex) wrong)))))) + (_.cover [/.otherwise] + (n.= expected + (|> (/.except ..another_exception []) + (/.when ..an_exception (function (_ ex) wrong)) + (/.otherwise (function (_ ex) expected))))) + (_.cover [/.report] + (let [report (/.report field0 value0 + field1 value1)] + (and (text.contains? field0 report) + (text.contains? value0 report) + (text.contains? field1 report) + (text.contains? value1 report)))) + (_.cover [/.listing] + (let [enumeration (/.listing %.text (list field0 value0 field1 value1))] + (and (text.contains? field0 enumeration) + (text.contains? value0 enumeration) + (text.contains? field1 enumeration) + (text.contains? value1 enumeration)))) + (_.cover [/.with] + (and (case (/.with ..an_exception [] {try.#Success expected}) + {try.#Success actual} (n.= expected actual) + {try.#Failure _} false) + (case (/.with ..an_exception [] {try.#Failure ""}) + {try.#Success _} false + {try.#Failure message} (text#= message (/.error ..an_exception []))) + (case (/.with ..an_exception [] + (is (Try Nat) + (/.except ..another_exception []))) + {try.#Success _} + false + + {try.#Failure message} + (and (text.contains? (/.error ..an_exception []) message) + (text.contains? (/.error ..another_exception []) message))))) + (_.cover [/.exception:] + (case (/.except ..custom_exception [expected]) + {try.#Success _} + false + + {try.#Failure message} + (and (text.contains? ..label message) + (text.contains? (%.nat expected) message)))) + )))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index b1e00106a..0b9c4a3e7 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -29,39 +29,39 @@ dummy random.nat extra (|> random.nat (random.only (|>> (n.= expected) not)))] (<| (_.covering /._) - ($_ _.and - (let [equivalence (is (Equivalence (-> Nat Nat)) - (implementation - (def: (= left right) - (n.= (left extra) - (right extra))))) - generator (is (Random (-> Nat Nat)) - (# ! each n.- random.nat))] - (_.for [/.monoid] - ($monoid.spec equivalence /.monoid generator))) - - (_.cover [/.identity] - (n.= expected - (/.identity expected))) - (_.cover [/.composite] - (n.= (f0 (f1 expected)) - ((/.composite f0 f1) expected))) - (_.cover [/.constant] - (n.= expected - ((/.constant expected) dummy))) - (_.cover [/.flipped] - (let [outcome ((/.flipped n.-) expected extra)] - (and (n.= (n.- extra expected) - outcome) - (not (n.= (n.- expected extra) - outcome))))) - (_.cover [/.on] - (n.= (f0 extra) - (/.on extra f0))) + (all _.and + (let [equivalence (is (Equivalence (-> Nat Nat)) + (implementation + (def: (= left right) + (n.= (left extra) + (right extra))))) + generator (is (Random (-> Nat Nat)) + (# ! each n.- random.nat))] + (_.for [/.monoid] + ($monoid.spec equivalence /.monoid generator))) + + (_.cover [/.identity] + (n.= expected + (/.identity expected))) + (_.cover [/.composite] + (n.= (f0 (f1 expected)) + ((/.composite f0 f1) expected))) + (_.cover [/.constant] + (n.= expected + ((/.constant expected) dummy))) + (_.cover [/.flipped] + (let [outcome ((/.flipped n.-) expected extra)] + (and (n.= (n.- extra expected) + outcome) + (not (n.= (n.- expected extra) + outcome))))) + (_.cover [/.on] + (n.= (f0 extra) + (/.on extra f0))) - /contract.test - /memo.test - /mixin.test - /mutual.test - /inline.test - )))) + /contract.test + /memo.test + /mixin.test + /mutual.test + /inline.test + )))) diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux index 21c152053..def434469 100644 --- a/stdlib/source/test/lux/control/function/contract.lux +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -21,25 +21,25 @@ (<| (_.covering /._) (do [! random.monad] [expected random.nat]) - ($_ _.and - (_.cover [/.pre /.pre_condition_failed] - (case (try (/.pre (n.even? expected) - true)) - {try.#Success output} - output - - {try.#Failure error} - (and (text.contains? (the exception.#label /.pre_condition_failed) - error) - (not (n.even? expected))))) - (_.cover [/.post /.post_condition_failed] - (case (try (/.post n.odd? - expected)) - {try.#Success actual} - (same? expected actual) - - {try.#Failure error} - (and (text.contains? (the exception.#label /.post_condition_failed) - error) - (not (n.odd? expected))))) - ))) + (all _.and + (_.cover [/.pre /.pre_condition_failed] + (case (try (/.pre (n.even? expected) + true)) + {try.#Success output} + output + + {try.#Failure error} + (and (text.contains? (the exception.#label /.pre_condition_failed) + error) + (not (n.even? expected))))) + (_.cover [/.post /.post_condition_failed] + (case (try (/.post n.odd? + expected)) + {try.#Success actual} + (same? expected actual) + + {try.#Failure error} + (and (text.contains? (the exception.#label /.post_condition_failed) + error) + (not (n.odd? expected))))) + ))) diff --git a/stdlib/source/test/lux/control/function/inline.lux b/stdlib/source/test/lux/control/function/inline.lux index 7c05e39e0..09cbff8c5 100644 --- a/stdlib/source/test/lux/control/function/inline.lux +++ b/stdlib/source/test/lux/control/function/inline.lux @@ -25,8 +25,8 @@ [.let [measurement (# ! each (i.% +1000) random.int)] m0 measurement m1 measurement]) - ($_ _.and - (_.cover [/.inline:] - (i.= (..!quadrance/2 m0 m1) - (..quadrance/2 m0 m1))) - ))) + (all _.and + (_.cover [/.inline:] + (i.= (..!quadrance/2 m0 m1) + (..quadrance/2 m0 m1))) + ))) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index d1be1c598..96c401be0 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -62,61 +62,61 @@ (do [! random.monad] [input (|> random.nat (# ! each (|>> (n.% 5) (n.+ 21))))]) (_.for [/.Memo]) - ($_ _.and - (_.cover [/.closed /.none] - (io.run! - (do io.monad - [.let [slow (/.none n.hash ..fibonacci) - fast (/.closed n.hash fibonacci)] - [slow_time slow_output] (..time slow input) - [fast_time fast_output] (..time fast input) - .let [same_output! - (n.= slow_output - fast_output) + (all _.and + (_.cover [/.closed /.none] + (io.run! + (do io.monad + [.let [slow (/.none n.hash ..fibonacci) + fast (/.closed n.hash fibonacci)] + [slow_time slow_output] (..time slow input) + [fast_time fast_output] (..time fast input) + .let [same_output! + (n.= slow_output + fast_output) - memo_is_faster! - (n.< (n.+ ..wiggle_room (milli_seconds slow_time)) - (milli_seconds fast_time))]] - (in (and same_output! - memo_is_faster!))))) - (_.cover [/.open] - (io.run! - (do io.monad - [.let [none (/.none n.hash ..fibonacci) - memory (dictionary.empty n.hash) - open (/.open fibonacci)] - [none_time none_output] (..time none input) - [open_time [memory open_output]] (..time open [memory input]) - [open_time/+1 _] (..time open [memory (++ input)]) - .let [same_output! - (n.= none_output - open_output) + memo_is_faster! + (n.< (n.+ ..wiggle_room (milli_seconds slow_time)) + (milli_seconds fast_time))]] + (in (and same_output! + memo_is_faster!))))) + (_.cover [/.open] + (io.run! + (do io.monad + [.let [none (/.none n.hash ..fibonacci) + memory (dictionary.empty n.hash) + open (/.open fibonacci)] + [none_time none_output] (..time none input) + [open_time [memory open_output]] (..time open [memory input]) + [open_time/+1 _] (..time open [memory (++ input)]) + .let [same_output! + (n.= none_output + open_output) - memo_is_faster! - (n.< (n.+ ..wiggle_room (milli_seconds none_time)) - (milli_seconds open_time)) + memo_is_faster! + (n.< (n.+ ..wiggle_room (milli_seconds none_time)) + (milli_seconds open_time)) - incrementalism_is_faster! - (n.< (n.+ ..wiggle_room (milli_seconds open_time)) - (milli_seconds open_time/+1))]] - (in (and same_output! - memo_is_faster! - incrementalism_is_faster!))))) - (_.cover [/.memoization] - (let [memo (<| //.fixed - (//.mixed /.memoization) - (is (//.Mixin Nat (State (Dictionary Nat Nat) Nat)) - (function (factorial delegate again input) - (case input - (^.or 0 1) (# state.monad in 1) - _ (do state.monad - [output' (again (-- input))] - (in (n.* input output'))))))) - expected (|> (list.indices input) - (list#each ++) - (list#mix n.* 1)) - actual (|> (memo input) - (state.result (dictionary.empty n.hash)) - product.right)] - (n.= expected actual))) - ))) + incrementalism_is_faster! + (n.< (n.+ ..wiggle_room (milli_seconds open_time)) + (milli_seconds open_time/+1))]] + (in (and same_output! + memo_is_faster! + incrementalism_is_faster!))))) + (_.cover [/.memoization] + (let [memo (<| //.fixed + (//.mixed /.memoization) + (is (//.Mixin Nat (State (Dictionary Nat Nat) Nat)) + (function (factorial delegate again input) + (case input + (^.or 0 1) (# state.monad in 1) + _ (do state.monad + [output' (again (-- input))] + (in (n.* input output'))))))) + expected (|> (list.indices input) + (list#each ++) + (list#mix n.* 1)) + actual (|> (memo input) + (state.result (dictionary.empty n.hash)) + product.right)] + (n.= expected actual))) + ))) diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index 9dd982afd..7e41c7be7 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -43,95 +43,95 @@ expected (|> (list.indices input) (list#each ++) (list#mix n.* 1))]]) - ($_ _.and - (_.for [/.Mixin] - ($_ _.and - (_.for [/.monoid] - ($monoid.spec equivalence /.monoid generator)) - - (_.cover [/.fixed] - (let [factorial (/.fixed + (all _.and + (_.for [/.Mixin] + (all _.and + (_.for [/.monoid] + ($monoid.spec equivalence /.monoid generator)) + + (_.cover [/.fixed] + (let [factorial (/.fixed + (function (_ delegate again input) + (case input + (^.or 0 1) 1 + _ (n.* input (again (-- input))))))] + (n.= expected + (factorial input)))) + (_.cover [/.mixed] + (let [bottom (is (/.Mixin Nat Nat) + (function (_ delegate again input) + (case input + (^.or 0 1) 1 + _ (delegate input)))) + multiplication (is (/.Mixin Nat Nat) + (function (_ delegate again input) + (n.* input (again (-- input))))) + factorial (/.fixed (/.mixed bottom multiplication))] + (n.= expected + (factorial input)))) + (_.cover [/.nothing] + (let [loop (is (/.Mixin Nat Nat) (function (_ delegate again input) (case input (^.or 0 1) 1 - _ (n.* input (again (-- input))))))] - (n.= expected - (factorial input)))) - (_.cover [/.mixed] - (let [bottom (is (/.Mixin Nat Nat) + _ (n.* input (delegate (-- input)))))) + left (/.fixed (/.mixed /.nothing loop)) + right (/.fixed (/.mixed loop /.nothing))] + (and (n.= expected + (left input)) + (n.= expected + (right input))))) + (_.cover [/.advice] + (let [bottom (is (/.Mixin Nat Nat) + (function (_ delegate again input) + 1)) + bottom? (is (Predicate Nat) + (function (_ input) + (case input + (^.or 0 1) true + _ false))) + multiplication (is (/.Mixin Nat Nat) + (function (_ delegate again input) + (n.* input (again (-- input))))) + factorial (/.fixed (/.mixed (/.advice bottom? bottom) + multiplication))] + (n.= expected + (factorial input)))) + (_.cover [/.before] + (let [implant (is (-> Nat (State Nat [])) + (function (_ input) + (function (_ state) + [shift []]))) + meld (is (/.Mixin Nat (State Nat Nat)) (function (_ delegate again input) - (case input - (^.or 0 1) 1 - _ (delegate input)))) - multiplication (is (/.Mixin Nat Nat) - (function (_ delegate again input) - (n.* input (again (-- input))))) - factorial (/.fixed (/.mixed bottom multiplication))] - (n.= expected - (factorial input)))) - (_.cover [/.nothing] - (let [loop (is (/.Mixin Nat Nat) - (function (_ delegate again input) + (function (_ state) + [state (n.+ state input)]))) + function (/.fixed (/.mixed (/.before state.monad implant) + meld))] + (n.= (n.+ shift input) + (|> input function (state.result dummy) product.right)))) + (_.cover [/.after] + (let [implant (is (-> Nat Nat (State Nat [])) + (function (_ input output) + (function (_ state) + [shift []]))) + meld (is (/.Mixin Nat (State Nat Nat)) + (function (_ delegate again input) + (function (_ state) + [state (n.+ state input)]))) + function (/.fixed (/.mixed (/.after state.monad implant) + meld))] + (n.= (n.+ dummy input) + (|> input function (state.result dummy) product.right)))) + )) + (_.for [/.Recursive] + (_.cover [/.of_recursive] + (let [factorial (/.fixed + (/.of_recursive + (function (_ again input) (case input (^.or 0 1) 1 - _ (n.* input (delegate (-- input)))))) - left (/.fixed (/.mixed /.nothing loop)) - right (/.fixed (/.mixed loop /.nothing))] - (and (n.= expected - (left input)) - (n.= expected - (right input))))) - (_.cover [/.advice] - (let [bottom (is (/.Mixin Nat Nat) - (function (_ delegate again input) - 1)) - bottom? (is (Predicate Nat) - (function (_ input) - (case input - (^.or 0 1) true - _ false))) - multiplication (is (/.Mixin Nat Nat) - (function (_ delegate again input) - (n.* input (again (-- input))))) - factorial (/.fixed (/.mixed (/.advice bottom? bottom) - multiplication))] - (n.= expected - (factorial input)))) - (_.cover [/.before] - (let [implant (is (-> Nat (State Nat [])) - (function (_ input) - (function (_ state) - [shift []]))) - meld (is (/.Mixin Nat (State Nat Nat)) - (function (_ delegate again input) - (function (_ state) - [state (n.+ state input)]))) - function (/.fixed (/.mixed (/.before state.monad implant) - meld))] - (n.= (n.+ shift input) - (|> input function (state.result dummy) product.right)))) - (_.cover [/.after] - (let [implant (is (-> Nat Nat (State Nat [])) - (function (_ input output) - (function (_ state) - [shift []]))) - meld (is (/.Mixin Nat (State Nat Nat)) - (function (_ delegate again input) - (function (_ state) - [state (n.+ state input)]))) - function (/.fixed (/.mixed (/.after state.monad implant) - meld))] - (n.= (n.+ dummy input) - (|> input function (state.result dummy) product.right)))) - )) - (_.for [/.Recursive] - (_.cover [/.of_recursive] - (let [factorial (/.fixed - (/.of_recursive - (function (_ again input) - (case input - (^.or 0 1) 1 - _ (n.* input (again (-- input)))))))] - (n.= expected - (factorial input))))) - ))) + _ (n.* input (again (-- input)))))))] + (n.= expected + (factorial input))))) + ))) diff --git a/stdlib/source/test/lux/control/function/mutual.lux b/stdlib/source/test/lux/control/function/mutual.lux index 6c50f1918..161cb954b 100644 --- a/stdlib/source/test/lux/control/function/mutual.lux +++ b/stdlib/source/test/lux/control/function/mutual.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - [text - ["%" format {"+" format}]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + [text + ["%" format {"+" format}]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: test_let Test @@ -60,7 +60,7 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..test_let - ..test_def - ))) + (all _.and + ..test_let + ..test_def + ))) diff --git a/stdlib/source/test/lux/control/io.lux b/stdlib/source/test/lux/control/io.lux index 87491ac6c..028684c05 100644 --- a/stdlib/source/test/lux/control/io.lux +++ b/stdlib/source/test/lux/control/io.lux @@ -1,21 +1,21 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" IO} - [// - ["[0]" function]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" IO} + [// + ["[0]" function]]]]) (def: injection (Injection IO) @@ -33,15 +33,15 @@ (do random.monad [sample random.nat exit_code random.int] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.run! /.io] - (n.= sample - (/.run! (/.io sample)))) - )))) + (_.cover [/.run! /.io] + (n.= sample + (/.run! (/.io sample)))) + )))) diff --git a/stdlib/source/test/lux/control/lazy.lux b/stdlib/source/test/lux/control/lazy.lux index 1f1a9f0e1..c3a74c42c 100644 --- a/stdlib/source/test/lux/control/lazy.lux +++ b/stdlib/source/test/lux/control/lazy.lux @@ -42,26 +42,26 @@ right random.nat .let [expected <eager>]] (_.for [/.Lazy] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..lazy random.nat))) + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.lazy] - (let [lazy (/.lazy <eager>) - (open "_#=") (product.equivalence n.equivalence n.equivalence)] - (_#= expected - (/.value lazy)))) + (_.cover [/.lazy] + (let [lazy (/.lazy <eager>) + (open "_#=") (product.equivalence n.equivalence n.equivalence)] + (_#= expected + (/.value lazy)))) - (_.cover [/.value] - (let [lazy (/.lazy <eager>)] - (and (not (same? expected - (/.value lazy))) - (same? (/.value lazy) - (/.value lazy))))) - )))))) + (_.cover [/.value] + (let [lazy (/.lazy <eager>)] + (and (not (same? expected + (/.value lazy))) + (same? (/.value lazy) + (/.value lazy))))) + )))))) diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux index 665577be9..471173834 100644 --- a/stdlib/source/test/lux/control/maybe.lux +++ b/stdlib/source/test/lux/control/maybe.lux @@ -29,62 +29,62 @@ Test (<| (_.covering /._) (_.for [.Maybe]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) - (_.for [/.hash] - (|> random.nat - (# random.monad each (|>> {.#Some})) - ($hash.spec (/.hash n.hash)))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) - (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /#in /.equivalence /.monad)) - - (do random.monad - [left random.nat - right random.nat - .let [expected (n.+ left right)]] - (let [lifted (/.lifted io.monad)] - (_.cover [/.with /.lifted] - (|> (io.run! (do (/.with io.monad) - [a (lifted (io#in left)) - b (in right)] - (in (n.+ a b)))) - (pipe.case - {.#Some actual} - (n.= expected actual) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) + (_.for [/.hash] + (|> random.nat + (# random.monad each (|>> {.#Some})) + ($hash.spec (/.hash n.hash)))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.maybe random.nat))) + (_.for [/.functor] + ($functor.spec /#in /.equivalence /.functor)) + (_.for [/.apply] + ($apply.spec /#in /.equivalence /.apply)) + (_.for [/.monad] + ($monad.spec /#in /.equivalence /.monad)) + + (do random.monad + [left random.nat + right random.nat + .let [expected (n.+ left right)]] + (let [lifted (/.lifted io.monad)] + (_.cover [/.with /.lifted] + (|> (io.run! (do (/.with io.monad) + [a (lifted (io#in left)) + b (in right)] + (in (n.+ a b)))) + (pipe.case + {.#Some actual} + (n.= expected actual) - _ - false))))) - (do random.monad - [default random.nat - value random.nat] - (_.cover [/.else] - (and (same? default (/.else default - (is (Maybe Nat) - {.#None}))) + _ + false))))) + (do random.monad + [default random.nat + value random.nat] + (_.cover [/.else] + (and (same? default (/.else default + (is (Maybe Nat) + {.#None}))) - (same? value (/.else default - {.#Some value}))))) - (do random.monad - [value random.nat] - (_.cover [/.trusted] - (same? value (/.trusted {.#Some value})))) - (do random.monad - [value random.nat] - (_.cover [/.list] - (# (list.equivalence n.equivalence) = - (list value) - (/.list {.#Some value})))) - (do random.monad - [expected random.nat - .let [(open "/#[0]") (/.equivalence n.equivalence)]] - (_.cover [/.when] - (and (/#= {.#Some expected} (/.when true {.#Some expected})) - (/#= {.#None} (/.when false {.#Some expected}))))) - ))) + (same? value (/.else default + {.#Some value}))))) + (do random.monad + [value random.nat] + (_.cover [/.trusted] + (same? value (/.trusted {.#Some value})))) + (do random.monad + [value random.nat] + (_.cover [/.list] + (# (list.equivalence n.equivalence) = + (list value) + (/.list {.#Some value})))) + (do random.monad + [expected random.nat + .let [(open "/#[0]") (/.equivalence n.equivalence)]] + (_.cover [/.when] + (and (/#= {.#Some expected} (/.when true {.#Some expected})) + (/#= {.#None} (/.when false {.#Some expected}))))) + ))) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 5733b780c..4694be281 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -95,87 +95,87 @@ even0 (random.only n.even? random.nat) odd0 (random.only n.odd? random.nat) not0 random.bit] - ($_ _.and - (_.cover [/.maybe] - (and (|> (list (code.nat expected0)) - (/.result (/.maybe <code>.nat)) - (match {.#Some actual} - (n.= expected0 actual))) - (|> (list (code.int (.int expected0))) - (/.result (/.maybe <code>.nat)) - (match {.#None} - #1)))) - (_.cover [/.some] - (and (|> (list#each code.nat expected+) - (/.result (/.some <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = expected+ actual))) - (|> (list#each (|>> .int code.int) expected+) - (/.result (/.some <code>.nat)) - (match {.#End} - #1)))) - (_.cover [/.many] - (and (|> (list#each code.nat expected+) - (/.result (/.many <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = expected+ actual))) - (|> (list (code.nat expected0)) - (/.result (/.many <code>.nat)) - (match (list actual) - (n.= expected0 actual))) - (|> (list#each (|>> .int code.int) expected+) - (/.result (/.many <code>.nat)) - fails?))) - (_.cover [/.only] - (and (|> (list (code.nat even0)) - (/.result (/.only n.even? <code>.nat)) - (match actual (n.= even0 actual))) - (|> (list (code.nat odd0)) - (/.result (/.only n.even? <code>.nat)) - fails?))) - (_.cover [/.and] - (let [even (/.only n.even? <code>.nat) - odd (/.only n.odd? <code>.nat)] - (and (|> (list (code.nat even0) (code.nat odd0)) - (/.result (/.and even odd)) - (match [left right] - (and (n.= even0 left) - (n.= odd0 right)))) - (|> (list (code.nat odd0) (code.nat even0)) - (/.result (/.and even odd)) - fails?)))) - (_.cover [/.or] - (let [even (/.only n.even? <code>.nat) - odd (/.only n.odd? <code>.nat)] - (and (|> (list (code.nat even0)) - (/.result (/.or even odd)) - (match {.#Left actual} (n.= even0 actual))) - (|> (list (code.nat odd0)) - (/.result (/.or even odd)) - (match {.#Right actual} (n.= odd0 actual))) - (|> (list (code.bit not0)) - (/.result (/.or even odd)) - fails?)))) - (_.cover [/.either] - (let [even (/.only n.even? <code>.nat) - odd (/.only n.odd? <code>.nat)] - (and (|> (list (code.nat even0)) - (/.result (/.either even odd)) - (match actual (n.= even0 actual))) - (|> (list (code.nat odd0)) - (/.result (/.either even odd)) - (match actual (n.= odd0 actual))) - (|> (list (code.bit not0)) - (/.result (/.either even odd)) - fails?)))) - (_.cover [/.not] - (and (|> (list (code.nat expected0)) - (/.result (/.not <code>.nat)) - fails?) - (|> (list (code.bit not0)) - (/.result (/.not <code>.nat)) - (match [] #1)))) - ))) + (all _.and + (_.cover [/.maybe] + (and (|> (list (code.nat expected0)) + (/.result (/.maybe <code>.nat)) + (match {.#Some actual} + (n.= expected0 actual))) + (|> (list (code.int (.int expected0))) + (/.result (/.maybe <code>.nat)) + (match {.#None} + #1)))) + (_.cover [/.some] + (and (|> (list#each code.nat expected+) + (/.result (/.some <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = expected+ actual))) + (|> (list#each (|>> .int code.int) expected+) + (/.result (/.some <code>.nat)) + (match {.#End} + #1)))) + (_.cover [/.many] + (and (|> (list#each code.nat expected+) + (/.result (/.many <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = expected+ actual))) + (|> (list (code.nat expected0)) + (/.result (/.many <code>.nat)) + (match (list actual) + (n.= expected0 actual))) + (|> (list#each (|>> .int code.int) expected+) + (/.result (/.many <code>.nat)) + fails?))) + (_.cover [/.only] + (and (|> (list (code.nat even0)) + (/.result (/.only n.even? <code>.nat)) + (match actual (n.= even0 actual))) + (|> (list (code.nat odd0)) + (/.result (/.only n.even? <code>.nat)) + fails?))) + (_.cover [/.and] + (let [even (/.only n.even? <code>.nat) + odd (/.only n.odd? <code>.nat)] + (and (|> (list (code.nat even0) (code.nat odd0)) + (/.result (/.and even odd)) + (match [left right] + (and (n.= even0 left) + (n.= odd0 right)))) + (|> (list (code.nat odd0) (code.nat even0)) + (/.result (/.and even odd)) + fails?)))) + (_.cover [/.or] + (let [even (/.only n.even? <code>.nat) + odd (/.only n.odd? <code>.nat)] + (and (|> (list (code.nat even0)) + (/.result (/.or even odd)) + (match {.#Left actual} (n.= even0 actual))) + (|> (list (code.nat odd0)) + (/.result (/.or even odd)) + (match {.#Right actual} (n.= odd0 actual))) + (|> (list (code.bit not0)) + (/.result (/.or even odd)) + fails?)))) + (_.cover [/.either] + (let [even (/.only n.even? <code>.nat) + odd (/.only n.odd? <code>.nat)] + (and (|> (list (code.nat even0)) + (/.result (/.either even odd)) + (match actual (n.= even0 actual))) + (|> (list (code.nat odd0)) + (/.result (/.either even odd)) + (match actual (n.= odd0 actual))) + (|> (list (code.bit not0)) + (/.result (/.either even odd)) + fails?)))) + (_.cover [/.not] + (and (|> (list (code.nat expected0)) + (/.result (/.not <code>.nat)) + fails?) + (|> (list (code.bit not0)) + (/.result (/.not <code>.nat)) + (match [] #1)))) + ))) (def: combinators_1 Test @@ -186,75 +186,75 @@ wrong (|> random.nat (random.only (|>> (n.= expected) not))) expected+ (random.list variadic random.nat) separator (random.ascii 1)] - ($_ _.and - (_.cover [/.exactly] - (and (|> (list#each code.nat expected+) - (/.result (/.exactly times <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - (list.first times expected+) - actual))) - (|> (list#each code.nat expected+) - (/.result (/.exactly (++ variadic) <code>.nat)) - fails?))) - (_.cover [/.at_least] - (and (|> (list#each code.nat expected+) - (/.result (/.at_least times <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - expected+ - actual))) - (|> (list#each code.nat expected+) - (/.result (/.at_least (++ variadic) <code>.nat)) - fails?))) - (_.cover [/.at_most] - (and (|> (list#each code.nat expected+) - (/.result (/.at_most times <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - (list.first times expected+) - actual))) - (|> (list#each code.nat expected+) - (/.result (/.at_most (++ variadic) <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - expected+ - actual))))) - (_.cover [/.between] - (and (|> (list#each code.nat expected+) - (/.result (/.between times (n.- times variadic) <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - expected+ - actual))) - (|> (list#each code.nat (list.first times expected+)) - (/.result (/.between times (n.- times variadic) <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - (list.first times expected+) - actual))))) - (_.cover [/.separated_by] - (|> (list.interposed (code.text separator) (list#each code.nat expected+)) - (/.result (/.separated_by (<code>.this (code.text separator)) <code>.nat)) - (match actual - (# (list.equivalence n.equivalence) = - expected+ - actual)))) - (_.cover [/.remaining] - (|> (list#each code.nat expected+) - (/.result /.remaining) - (match actual - (# (list.equivalence code.equivalence) = - (list#each code.nat expected+) - actual)))) - (_.cover [/.else] - (and (|> (/.result (/.else wrong (# /.monad in expected)) (list)) - (match actual (n.= expected actual))) - (|> (/.result (/.else expected (/.failure "yolo")) - (list)) - (match actual (n.= expected actual))) - )) - ))) + (all _.and + (_.cover [/.exactly] + (and (|> (list#each code.nat expected+) + (/.result (/.exactly times <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + (list.first times expected+) + actual))) + (|> (list#each code.nat expected+) + (/.result (/.exactly (++ variadic) <code>.nat)) + fails?))) + (_.cover [/.at_least] + (and (|> (list#each code.nat expected+) + (/.result (/.at_least times <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + expected+ + actual))) + (|> (list#each code.nat expected+) + (/.result (/.at_least (++ variadic) <code>.nat)) + fails?))) + (_.cover [/.at_most] + (and (|> (list#each code.nat expected+) + (/.result (/.at_most times <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + (list.first times expected+) + actual))) + (|> (list#each code.nat expected+) + (/.result (/.at_most (++ variadic) <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + expected+ + actual))))) + (_.cover [/.between] + (and (|> (list#each code.nat expected+) + (/.result (/.between times (n.- times variadic) <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + expected+ + actual))) + (|> (list#each code.nat (list.first times expected+)) + (/.result (/.between times (n.- times variadic) <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + (list.first times expected+) + actual))))) + (_.cover [/.separated_by] + (|> (list.interposed (code.text separator) (list#each code.nat expected+)) + (/.result (/.separated_by (<code>.this (code.text separator)) <code>.nat)) + (match actual + (# (list.equivalence n.equivalence) = + expected+ + actual)))) + (_.cover [/.remaining] + (|> (list#each code.nat expected+) + (/.result /.remaining) + (match actual + (# (list.equivalence code.equivalence) = + (list#each code.nat expected+) + actual)))) + (_.cover [/.else] + (and (|> (/.result (/.else wrong (# /.monad in expected)) (list)) + (match actual (n.= expected actual))) + (|> (/.result (/.else expected (/.failure "yolo")) + (list)) + (match actual (n.= expected actual))) + )) + ))) (def: combinators_2 Test @@ -265,70 +265,70 @@ .let [nat^ <code>.nat even^ (/.only n.even? <code>.nat) odd^ (/.only n.odd? <code>.nat)]] - ($_ _.and - (_.cover [/.rec] - (let [parser (/.rec (function (_ self) - (/.either <code>.nat - (<code>.tuple self)))) - level_0 (code.nat expected) - level_up (is (-> Code Code) - (|>> list code.tuple))] - (and (|> (list level_0) - (/.result parser) - (match actual (n.= expected actual))) - (|> (list (level_up level_0)) - (/.result parser) - (match actual (n.= expected actual))) - (|> (list (level_up (level_up level_0))) - (/.result parser) - (match actual (n.= expected actual)))))) - (_.cover [/.after] - (and (|> (/.result (/.after even^ <code>.nat) - (list (code.nat even) (code.nat expected))) - (match actual (n.= expected actual))) - (|> (/.result (/.after even^ <code>.nat) - (list (code.nat odd) (code.nat expected))) - fails?))) - (_.cover [/.before] - (and (|> (/.result (/.before even^ <code>.nat) - (list (code.nat expected) (code.nat even))) - (match actual (n.= expected actual))) - (|> (/.result (/.before even^ <code>.nat) - (list (code.nat expected) (code.nat odd))) - fails?))) - (_.cover [/.parses?] - (and (|> (/.result (/.parses? even^) - (list (code.nat even))) - (match verdict verdict)) - (|> (/.result (/.parses? even^) - (list (code.nat odd))) - (match verdict (not verdict))))) - (_.cover [/.parses] - (and (|> (/.result (/.parses even^) - (list (code.nat even))) - (match [] true)) - (|> (/.result (/.parses even^) - (list (code.nat odd))) - fails?))) - (_.cover [/.speculative] - (let [happy_path! - (|> (/.result (/.and (/.speculative even^) nat^) + (all _.and + (_.cover [/.rec] + (let [parser (/.rec (function (_ self) + (/.either <code>.nat + (<code>.tuple self)))) + level_0 (code.nat expected) + level_up (is (-> Code Code) + (|>> list code.tuple))] + (and (|> (list level_0) + (/.result parser) + (match actual (n.= expected actual))) + (|> (list (level_up level_0)) + (/.result parser) + (match actual (n.= expected actual))) + (|> (list (level_up (level_up level_0))) + (/.result parser) + (match actual (n.= expected actual)))))) + (_.cover [/.after] + (and (|> (/.result (/.after even^ <code>.nat) + (list (code.nat even) (code.nat expected))) + (match actual (n.= expected actual))) + (|> (/.result (/.after even^ <code>.nat) + (list (code.nat odd) (code.nat expected))) + fails?))) + (_.cover [/.before] + (and (|> (/.result (/.before even^ <code>.nat) + (list (code.nat expected) (code.nat even))) + (match actual (n.= expected actual))) + (|> (/.result (/.before even^ <code>.nat) + (list (code.nat expected) (code.nat odd))) + fails?))) + (_.cover [/.parses?] + (and (|> (/.result (/.parses? even^) (list (code.nat even))) - (match [speculation actual] - (and (n.= speculation actual) - (n.= even actual)))) - - sad_path! - (|> (/.result (/.and (/.speculative even^) nat^) + (match verdict verdict)) + (|> (/.result (/.parses? even^) + (list (code.nat odd))) + (match verdict (not verdict))))) + (_.cover [/.parses] + (and (|> (/.result (/.parses even^) + (list (code.nat even))) + (match [] true)) + (|> (/.result (/.parses even^) (list (code.nat odd))) - fails?)] - (and happy_path! - sad_path!))) - (_.cover [/.codec] - (|> (/.result (/.codec n.decimal <code>.text) - (list (code.text (%.nat expected)))) - (match actual (n.= expected actual)))) - ))) + fails?))) + (_.cover [/.speculative] + (let [happy_path! + (|> (/.result (/.and (/.speculative even^) nat^) + (list (code.nat even))) + (match [speculation actual] + (and (n.= speculation actual) + (n.= even actual)))) + + sad_path! + (|> (/.result (/.and (/.speculative even^) nat^) + (list (code.nat odd))) + fails?)] + (and happy_path! + sad_path!))) + (_.cover [/.codec] + (|> (/.result (/.codec n.decimal <code>.text) + (list (code.text (%.nat expected)))) + (match actual (n.= expected actual)))) + ))) (def: injection (Injection (All (_ a i) (Parser i a))) @@ -352,48 +352,48 @@ assertion (random.ascii 1)] (<| (_.covering /._) (_.for [/.Parser]) - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.result] - (|> (/.result (# /.monad in expected) (list)) - (match actual (n.= expected actual)))) - (_.cover [/.failure] - (|> (list) - (/.result (/.failure failure)) - (should_fail failure))) - (_.cover [/.lifted] - (and (|> (list) - (/.result (/.lifted {try.#Success expected})) - (match actual (n.= expected actual))) - (|> (list) - (/.result (/.lifted {try.#Failure failure})) - (should_fail failure)))) - (_.cover [/.assertion] - (and (|> (list (code.bit #1) (code.int +123)) - (/.result (/.assertion assertion #1)) - (match [] true)) - (|> (list (code.bit #1) (code.int +123)) - (/.result (/.assertion assertion #0)) - fails?))) - ..combinators_0 - ..combinators_1 - ..combinators_2 + (_.cover [/.result] + (|> (/.result (# /.monad in expected) (list)) + (match actual (n.= expected actual)))) + (_.cover [/.failure] + (|> (list) + (/.result (/.failure failure)) + (should_fail failure))) + (_.cover [/.lifted] + (and (|> (list) + (/.result (/.lifted {try.#Success expected})) + (match actual (n.= expected actual))) + (|> (list) + (/.result (/.lifted {try.#Failure failure})) + (should_fail failure)))) + (_.cover [/.assertion] + (and (|> (list (code.bit #1) (code.int +123)) + (/.result (/.assertion assertion #1)) + (match [] true)) + (|> (list (code.bit #1) (code.int +123)) + (/.result (/.assertion assertion #0)) + fails?))) + ..combinators_0 + ..combinators_1 + ..combinators_2 - /analysis.test - /binary.test - /cli.test - /code.test - /environment.test - /json.test - /synthesis.test - /text.test - /tree.test - /type.test - /xml.test - )))) + /analysis.test + /binary.test + /cli.test + /code.test + /environment.test + /json.test + /synthesis.test + /text.test + /tree.test + /type.test + /xml.test + )))) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 32d758505..365696b14 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -52,104 +52,104 @@ (_.for [/.Parser]) (do [! random.monad] [] - (`` ($_ _.and - (do [! random.monad] - [expected (# ! each (|>> analysis.bit) random.bit)] - (_.cover [/.result /.any] - (|> (list expected) - (/.result /.any) - (pipe.case - {try.#Success actual} - (# analysis.equivalence = expected actual) + (`` (all _.and + (do [! random.monad] + [expected (# ! each (|>> analysis.bit) random.bit)] + (_.cover [/.result /.any] + (|> (list expected) + (/.result /.any) + (pipe.case + {try.#Success actual} + (# analysis.equivalence = expected actual) - {try.#Failure _} - false)))) - (~~ (template [<query> <check> <random> <analysis> <=>] - [(do [! random.monad] - [expected <random>] - (_.cover [<query>] - (|> (list (<analysis> expected)) - (/.result <query>) - (pipe.case - {try.#Success actual} - (<=> expected actual) + {try.#Failure _} + false)))) + (~~ (template [<query> <check> <random> <analysis> <=>] + [(do [! random.monad] + [expected <random>] + (_.cover [<query>] + (|> (list (<analysis> expected)) + (/.result <query>) + (pipe.case + {try.#Success actual} + (<=> expected actual) - {try.#Failure _} - false)))) - (do [! random.monad] - [expected <random>] - (_.cover [<check>] - (|> (list (<analysis> expected)) - (/.result (<check> expected)) - (!expect {try.#Success _}))))] - - [/.bit /.this_bit random.bit analysis.bit bit#=] - [/.nat /.this_nat random.nat analysis.nat n.=] - [/.int /.this_int random.int analysis.int i.=] - [/.frac /.this_frac random.safe_frac analysis.frac f.=] - [/.rev /.this_rev random.rev analysis.rev r.=] - [/.text /.this_text (random.unicode 10) analysis.text text#=] - [/.local /.this_local random.nat analysis.local n.=] - [/.foreign /.this_foreign random.nat analysis.foreign n.=] - [/.constant /.this_constant ..constant analysis.constant symbol#=] - )) - (do [! random.monad] - [expected random.bit] - (_.cover [/.tuple] - (|> (list (analysis.tuple (list (analysis.bit expected)))) - (/.result (/.tuple /.bit)) - (pipe.case - {try.#Success actual} - (bit#= expected actual) + {try.#Failure _} + false)))) + (do [! random.monad] + [expected <random>] + (_.cover [<check>] + (|> (list (<analysis> expected)) + (/.result (<check> expected)) + (!expect {try.#Success _}))))] + + [/.bit /.this_bit random.bit analysis.bit bit#=] + [/.nat /.this_nat random.nat analysis.nat n.=] + [/.int /.this_int random.int analysis.int i.=] + [/.frac /.this_frac random.safe_frac analysis.frac f.=] + [/.rev /.this_rev random.rev analysis.rev r.=] + [/.text /.this_text (random.unicode 10) analysis.text text#=] + [/.local /.this_local random.nat analysis.local n.=] + [/.foreign /.this_foreign random.nat analysis.foreign n.=] + [/.constant /.this_constant ..constant analysis.constant symbol#=] + )) + (do [! random.monad] + [expected random.bit] + (_.cover [/.tuple] + (|> (list (analysis.tuple (list (analysis.bit expected)))) + (/.result (/.tuple /.bit)) + (pipe.case + {try.#Success actual} + (bit#= expected actual) - {try.#Failure _} - false)))) - (do [! random.monad] - [dummy random.bit] - (_.cover [/.end?] - (and (|> (/.result /.end? (list)) - (!expect {try.#Success #1})) - (|> (/.result (do <>.monad - [verdict /.end? - _ /.bit] - (in verdict)) - (list (analysis.bit dummy))) - (!expect {try.#Success #0}))))) - (do [! random.monad] - [dummy random.bit] - (_.cover [/.end] - (and (|> (/.result /.end (list)) - (!expect {try.#Success _})) - (|> (/.result /.end (list (analysis.bit dummy))) - (!expect {try.#Failure _}))))) - (do [! random.monad] - [expected random.bit] - (_.cover [/.cannot_parse] - (and (|> (list (analysis.bit expected)) - (/.result /.nat) - (pipe.case - {try.#Success _} - false + {try.#Failure _} + false)))) + (do [! random.monad] + [dummy random.bit] + (_.cover [/.end?] + (and (|> (/.result /.end? (list)) + (!expect {try.#Success #1})) + (|> (/.result (do <>.monad + [verdict /.end? + _ /.bit] + (in verdict)) + (list (analysis.bit dummy))) + (!expect {try.#Success #0}))))) + (do [! random.monad] + [dummy random.bit] + (_.cover [/.end] + (and (|> (/.result /.end (list)) + (!expect {try.#Success _})) + (|> (/.result /.end (list (analysis.bit dummy))) + (!expect {try.#Failure _}))))) + (do [! random.monad] + [expected random.bit] + (_.cover [/.cannot_parse] + (and (|> (list (analysis.bit expected)) + (/.result /.nat) + (pipe.case + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.cannot_parse error))) - (|> (list) - (/.result /.bit) - (pipe.case - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.cannot_parse error))) + (|> (list) + (/.result /.bit) + (pipe.case + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.cannot_parse error)))))) - (do [! random.monad] - [expected random.bit] - (_.cover [/.unconsumed_input] - (|> (list (analysis.bit expected) (analysis.bit expected)) - (/.result /.bit) - (pipe.case - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.cannot_parse error)))))) + (do [! random.monad] + [expected random.bit] + (_.cover [/.unconsumed_input] + (|> (list (analysis.bit expected) (analysis.bit expected)) + (/.result /.bit) + (pipe.case + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.unconsumed_input error))))) - ))))) + {try.#Failure error} + (exception.match? /.unconsumed_input error))))) + ))))) diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index 7546bcf81..2a7284c1d 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -85,10 +85,10 @@ (def: random_location (Random Location) - ($_ random.and - ..random_text - random.nat - random.nat)) + (all random.and + ..random_text + random.nat + random.nat)) (def: random_code (Random Code) @@ -97,296 +97,296 @@ (let [random_sequence (do [! random.monad] [size (# ! each (n.% 2) random.nat)] (random.list size again))] - ($_ random.and - ..random_location - (is (Random (Code' (Ann Location))) - ($_ random.or - random.bit - random.nat - random.int - random.rev - random.safe_frac - ..random_text - ..random_symbol - random_sequence - random_sequence - random_sequence - ))))))) + (all random.and + ..random_location + (is (Random (Code' (Ann Location))) + (all random.or + random.bit + random.nat + random.int + random.rev + random.safe_frac + ..random_text + ..random_symbol + random_sequence + random_sequence + random_sequence + ))))))) (def: random_type (Random Type) (let [(open "[0]") random.monad] - ($_ random.either - (in .Nat) - (in .List) - (in .Code) - (in .Type)))) + (all random.either + (in .Nat) + (in .List) + (in .Code) + (in .Type)))) (def: size Test (<| (_.for [/.Size]) - (`` ($_ _.and - (~~ (template [<size> <parser> <format>] - [(do [! random.monad] - [expected (# ! each (i64.and (i64.mask <size>)) - random.nat)] - (_.cover [<size> <parser> <format>] - (|> (format.result <format> expected) - (/.result <parser>) - (!expect (^.multi {try.#Success actual} - (n.= (.nat expected) - (.nat actual)))))))] + (`` (all _.and + (~~ (template [<size> <parser> <format>] + [(do [! random.monad] + [expected (# ! each (i64.and (i64.mask <size>)) + random.nat)] + (_.cover [<size> <parser> <format>] + (|> (format.result <format> expected) + (/.result <parser>) + (!expect (^.multi {try.#Success actual} + (n.= (.nat expected) + (.nat actual)))))))] - [/.size_8 /.bits_8 format.bits_8] - [/.size_16 /.bits_16 format.bits_16] - [/.size_32 /.bits_32 format.bits_32] - [/.size_64 /.bits_64 format.bits_64] - )))))) + [/.size_8 /.bits_8 format.bits_8] + [/.size_16 /.bits_16 format.bits_16] + [/.size_32 /.bits_32 format.bits_32] + [/.size_64 /.bits_64 format.bits_64] + )))))) (def: binary Test - (`` ($_ _.and - (~~ (template [<parser> <format>] - [(do [! random.monad] - [expected (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] - (_.cover [<parser> <format>] - (|> (format.result <format> expected) - (/.result <parser>) - (!expect (^.multi {try.#Success actual} - (# binary.equivalence = expected actual))))))] + (`` (all _.and + (~~ (template [<parser> <format>] + [(do [! random.monad] + [expected (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] + (_.cover [<parser> <format>] + (|> (format.result <format> expected) + (/.result <parser>) + (!expect (^.multi {try.#Success actual} + (# binary.equivalence = expected actual))))))] - [/.binary_8 format.binary_8] - [/.binary_16 format.binary_16] - [/.binary_32 format.binary_32] - [/.binary_64 format.binary_64] - ))))) + [/.binary_8 format.binary_8] + [/.binary_16 format.binary_16] + [/.binary_32 format.binary_32] + [/.binary_64 format.binary_64] + ))))) (def: utf8 Test - (`` ($_ _.and - (~~ (template [<parser> <format>] - [(do [! random.monad] - [expected (random.ascii ..segment_size)] - (_.cover [<parser> <format>] - (|> (format.result <format> expected) - (/.result <parser>) - (!expect (^.multi {try.#Success actual} - (# text.equivalence = expected actual))))))] + (`` (all _.and + (~~ (template [<parser> <format>] + [(do [! random.monad] + [expected (random.ascii ..segment_size)] + (_.cover [<parser> <format>] + (|> (format.result <format> expected) + (/.result <parser>) + (!expect (^.multi {try.#Success actual} + (# text.equivalence = expected actual))))))] - [/.utf8_8 format.utf8_8] - [/.utf8_16 format.utf8_16] - [/.utf8_32 format.utf8_32] - [/.utf8_64 format.utf8_64] - [/.text format.text] - ))))) + [/.utf8_8 format.utf8_8] + [/.utf8_16 format.utf8_16] + [/.utf8_32 format.utf8_32] + [/.utf8_64 format.utf8_64] + [/.text format.text] + ))))) (def: sequence Test - (`` ($_ _.and - (~~ (template [<parser> <format>] - [(do [! random.monad] - [expected (random.sequence ..segment_size random.nat)] - (_.cover [<parser> <format>] - (|> expected - (format.result (<format> format.nat)) - (/.result (<parser> /.nat)) - (!expect (^.multi {try.#Success actual} - (# (sequence.equivalence n.equivalence) = expected actual))))))] + (`` (all _.and + (~~ (template [<parser> <format>] + [(do [! random.monad] + [expected (random.sequence ..segment_size random.nat)] + (_.cover [<parser> <format>] + (|> expected + (format.result (<format> format.nat)) + (/.result (<parser> /.nat)) + (!expect (^.multi {try.#Success actual} + (# (sequence.equivalence n.equivalence) = expected actual))))))] - [/.sequence_8 format.sequence_8] - [/.sequence_16 format.sequence_16] - [/.sequence_32 format.sequence_32] - [/.sequence_64 format.sequence_64] - ))))) + [/.sequence_8 format.sequence_8] + [/.sequence_16 format.sequence_16] + [/.sequence_32 format.sequence_32] + [/.sequence_64 format.sequence_64] + ))))) (def: simple Test - (`` ($_ _.and - (~~ (template [<parser> <format> <random> <equivalence>] - [(do [! random.monad] - [expected <random>] - (_.cover [<parser> <format>] - (|> expected - (format.result <format>) - (/.result <parser>) - (!expect (^.multi {try.#Success actual} - (# <equivalence> = expected actual))))))] + (`` (all _.and + (~~ (template [<parser> <format> <random> <equivalence>] + [(do [! random.monad] + [expected <random>] + (_.cover [<parser> <format>] + (|> expected + (format.result <format>) + (/.result <parser>) + (!expect (^.multi {try.#Success actual} + (# <equivalence> = expected actual))))))] - [/.bit format.bit random.bit bit.equivalence] - [/.nat format.nat random.nat n.equivalence] - [/.int format.int random.int int.equivalence] - [/.rev format.rev random.rev rev.equivalence])) - (do [! random.monad] - [expected random.frac] - (_.cover [/.frac format.frac] - (|> expected - (format.result format.frac) - (/.result /.frac) - (!expect (^.multi {try.#Success actual} - (or (# frac.equivalence = expected actual) - (and (frac.not_a_number? expected) - (frac.not_a_number? actual)))))))) - (do [! random.monad] - [expected (# ! each (|>> (i64.and (i64.mask /.size_8)) - (n.max 2)) - random.nat)] - (_.cover [/.not_a_bit] - (|> expected - (format.result format.bits_8) - (/.result /.bit) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_a_bit error)))))) - ))) + [/.bit format.bit random.bit bit.equivalence] + [/.nat format.nat random.nat n.equivalence] + [/.int format.int random.int int.equivalence] + [/.rev format.rev random.rev rev.equivalence])) + (do [! random.monad] + [expected random.frac] + (_.cover [/.frac format.frac] + (|> expected + (format.result format.frac) + (/.result /.frac) + (!expect (^.multi {try.#Success actual} + (or (# frac.equivalence = expected actual) + (and (frac.not_a_number? expected) + (frac.not_a_number? actual)))))))) + (do [! random.monad] + [expected (# ! each (|>> (i64.and (i64.mask /.size_8)) + (n.max 2)) + random.nat)] + (_.cover [/.not_a_bit] + (|> expected + (format.result format.bits_8) + (/.result /.bit) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_a_bit error)))))) + ))) (def: complex Test - (`` ($_ _.and - (~~ (template [<parser> <format> <random> <equivalence>] - [(do [! random.monad] - [expected <random>] - (_.cover [<parser> <format>] - (|> expected - (format.result <format>) - (/.result <parser>) - (!expect (^.multi {try.#Success actual} - (# <equivalence> = expected actual))))))] + (`` (all _.and + (~~ (template [<parser> <format> <random> <equivalence>] + [(do [! random.monad] + [expected <random>] + (_.cover [<parser> <format>] + (|> expected + (format.result <format>) + (/.result <parser>) + (!expect (^.multi {try.#Success actual} + (# <equivalence> = expected actual))))))] - [/.location format.location random_location location_equivalence] - [/.code format.code random_code code.equivalence] - [/.type format.type random_type type.equivalence] - )) - (~~ (template [<parser_coverage> <parser> <coverage_format> <format> <random> <equivalence>] - [(do [! random.monad] - [expected <random>] - (_.cover [<parser_coverage> <coverage_format>] - (|> expected - (format.result <format>) - (/.result <parser>) - (!expect (^.multi {try.#Success actual} - (# <equivalence> = expected actual))))))] + [/.location format.location random_location location_equivalence] + [/.code format.code random_code code.equivalence] + [/.type format.type random_type type.equivalence] + )) + (~~ (template [<parser_coverage> <parser> <coverage_format> <format> <random> <equivalence>] + [(do [! random.monad] + [expected <random>] + (_.cover [<parser_coverage> <coverage_format>] + (|> expected + (format.result <format>) + (/.result <parser>) + (!expect (^.multi {try.#Success actual} + (# <equivalence> = expected actual))))))] - [/.maybe (/.maybe /.nat) format.maybe (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)] - [/.list (/.list /.nat) format.list (format.list format.nat) (random.list ..segment_size random.nat) (list.equivalence n.equivalence)] - [/.set (/.set n.hash /.nat) format.set (format.set format.nat) (random.set n.hash ..segment_size random.nat) set.equivalence] - [/.symbol /.symbol format.symbol format.symbol ..random_symbol symbol.equivalence])) - (do [! random.monad] - [expected (# ! each (list.repeated ..segment_size) random.nat)] - (_.cover [/.set_elements_are_not_unique] - (|> expected - (format.result (format.list format.nat)) - (/.result (/.set n.hash /.nat)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.set_elements_are_not_unique error)))))) - (do [! random.monad] - [expected (random.or random.bit random.nat)] - (_.cover [/.or format.or] - (|> expected - (format.result (format.or format.bit format.nat)) - (/.result (is (/.Parser (Either Bit Nat)) - (/.or /.bit /.nat))) - (!expect (^.multi {try.#Success actual} - (# (sum.equivalence bit.equivalence n.equivalence) = - expected - actual)))))) - (do [! random.monad] - [tag (# ! each (|>> (i64.and (i64.mask /.size_8)) - (n.max 2)) - random.nat) - value random.bit] - (_.cover [/.invalid_tag] - (|> [tag value] - (format.result (format.and format.bits_8 format.bit)) - (/.result (is (/.Parser (Either Bit Nat)) - (/.or /.bit /.nat))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.invalid_tag error)))))) - (do [! random.monad] - [expected (random.list ..segment_size random.nat)] - (_.cover [/.rec format.rec format.and format.any] - (|> expected - (format.result (format.rec (|>> (format.and format.nat) - (format.or format.any)))) - (/.result (is (/.Parser (List Nat)) - (/.rec - (function (_ again) - (/.or /.any - (<>.and /.nat - again)))))) - (!expect (^.multi {try.#Success actual} - (# (list.equivalence n.equivalence) = - expected - actual)))))) - ))) + [/.maybe (/.maybe /.nat) format.maybe (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)] + [/.list (/.list /.nat) format.list (format.list format.nat) (random.list ..segment_size random.nat) (list.equivalence n.equivalence)] + [/.set (/.set n.hash /.nat) format.set (format.set format.nat) (random.set n.hash ..segment_size random.nat) set.equivalence] + [/.symbol /.symbol format.symbol format.symbol ..random_symbol symbol.equivalence])) + (do [! random.monad] + [expected (# ! each (list.repeated ..segment_size) random.nat)] + (_.cover [/.set_elements_are_not_unique] + (|> expected + (format.result (format.list format.nat)) + (/.result (/.set n.hash /.nat)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.set_elements_are_not_unique error)))))) + (do [! random.monad] + [expected (random.or random.bit random.nat)] + (_.cover [/.or format.or] + (|> expected + (format.result (format.or format.bit format.nat)) + (/.result (is (/.Parser (Either Bit Nat)) + (/.or /.bit /.nat))) + (!expect (^.multi {try.#Success actual} + (# (sum.equivalence bit.equivalence n.equivalence) = + expected + actual)))))) + (do [! random.monad] + [tag (# ! each (|>> (i64.and (i64.mask /.size_8)) + (n.max 2)) + random.nat) + value random.bit] + (_.cover [/.invalid_tag] + (|> [tag value] + (format.result (format.and format.bits_8 format.bit)) + (/.result (is (/.Parser (Either Bit Nat)) + (/.or /.bit /.nat))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.invalid_tag error)))))) + (do [! random.monad] + [expected (random.list ..segment_size random.nat)] + (_.cover [/.rec format.rec format.and format.any] + (|> expected + (format.result (format.rec (|>> (format.and format.nat) + (format.or format.any)))) + (/.result (is (/.Parser (List Nat)) + (/.rec + (function (_ again) + (/.or /.any + (<>.and /.nat + again)))))) + (!expect (^.multi {try.#Success actual} + (# (list.equivalence n.equivalence) = + expected + actual)))))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Parser]) - (`` ($_ _.and - (_.cover [/.result /.any - format.no_op format.instance] - (|> (format.instance format.no_op) - (/.result /.any) - (!expect {try.#Success _}))) - (do [! random.monad] - [data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] - (_.cover [/.binary_was_not_fully_read] - (|> data - (/.result /.any) - (!expect (^.multi {try.#Failure error} - (exception.match? /.binary_was_not_fully_read error)))))) - (do [! random.monad] - [expected (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] - (_.cover [/.segment format.segment format.result] - (|> expected - (format.result (format.segment ..segment_size)) - (/.result (/.segment ..segment_size)) - (!expect (^.multi {try.#Success actual} - (# binary.equivalence = expected actual)))))) - (do [! random.monad] - [data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] - (_.cover [/.end?] - (|> data - (/.result (do <>.monad - [pre /.end? - _ (/.segment ..segment_size) - post /.end?] - (in (and (not pre) - post)))) - (!expect {try.#Success #1})))) - (do [! random.monad] - [to_read (# ! each (n.% (++ ..segment_size)) random.nat) - data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] - (_.cover [/.Offset /.offset] - (|> data - (/.result (do <>.monad - [start /.offset - _ (/.segment to_read) - offset /.offset - _ (/.segment (n.- to_read ..segment_size)) - nothing_left /.offset] - (in (and (n.= 0 start) - (n.= to_read offset) - (n.= ..segment_size nothing_left))))) - (!expect {try.#Success #1})))) - (do [! random.monad] - [to_read (# ! each (n.% (++ ..segment_size)) random.nat) - data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] - (_.cover [/.remaining] - (|> data - (/.result (do <>.monad - [_ (/.segment to_read) - remaining /.remaining - _ (/.segment (n.- to_read ..segment_size)) - nothing_left /.remaining] - (in (and (n.= ..segment_size - (n.+ to_read remaining)) - (n.= 0 nothing_left))))) - (!expect {try.#Success #1})))) - ..size - ..binary - ..utf8 - ..sequence - ..simple - ..complex - )))) + (`` (all _.and + (_.cover [/.result /.any + format.no_op format.instance] + (|> (format.instance format.no_op) + (/.result /.any) + (!expect {try.#Success _}))) + (do [! random.monad] + [data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] + (_.cover [/.binary_was_not_fully_read] + (|> data + (/.result /.any) + (!expect (^.multi {try.#Failure error} + (exception.match? /.binary_was_not_fully_read error)))))) + (do [! random.monad] + [expected (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] + (_.cover [/.segment format.segment format.result] + (|> expected + (format.result (format.segment ..segment_size)) + (/.result (/.segment ..segment_size)) + (!expect (^.multi {try.#Success actual} + (# binary.equivalence = expected actual)))))) + (do [! random.monad] + [data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] + (_.cover [/.end?] + (|> data + (/.result (do <>.monad + [pre /.end? + _ (/.segment ..segment_size) + post /.end?] + (in (and (not pre) + post)))) + (!expect {try.#Success #1})))) + (do [! random.monad] + [to_read (# ! each (n.% (++ ..segment_size)) random.nat) + data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] + (_.cover [/.Offset /.offset] + (|> data + (/.result (do <>.monad + [start /.offset + _ (/.segment to_read) + offset /.offset + _ (/.segment (n.- to_read ..segment_size)) + nothing_left /.offset] + (in (and (n.= 0 start) + (n.= to_read offset) + (n.= ..segment_size nothing_left))))) + (!expect {try.#Success #1})))) + (do [! random.monad] + [to_read (# ! each (n.% (++ ..segment_size)) random.nat) + data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] + (_.cover [/.remaining] + (|> data + (/.result (do <>.monad + [_ (/.segment to_read) + remaining /.remaining + _ (/.segment (n.- to_read ..segment_size)) + nothing_left /.remaining] + (in (and (n.= ..segment_size + (n.+ to_read remaining)) + (n.= 0 nothing_left))))) + (!expect {try.#Success #1})))) + ..size + ..binary + ..utf8 + ..sequence + ..simple + ..complex + )))) diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index 812b23586..5dc368174 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -41,45 +41,45 @@ long (random.unicode 2) pre_ignore (random.list 5 random_dummy) post_ignore (random.list 5 random_dummy)] - ($_ _.and - (_.cover [/.result /.any] - (|> (/.result /.any (list expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual))))) - (_.cover [/.parse] - (|> (/.result (/.parse n#decoded) (list expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected - (n#encoded actual)))))) - (_.cover [/.this] - (and (|> (/.result (/.this expected) (list expected)) - (!expect {try.#Success _})) - (|> (/.result (/.this expected) (list dummy)) - (!expect {try.#Failure _})))) - (_.cover [/.somewhere] - (|> (/.result (|> (/.somewhere (/.this expected)) - (<>.before (<>.some /.any))) - (list.together (list pre_ignore (list expected) post_ignore))) - (!expect {try.#Success _}))) - (_.cover [/.end] - (and (|> (/.result /.end (list)) - (!expect {try.#Success _})) - (|> (/.result (<>.not /.end) (list expected)) - (!expect {try.#Failure _})))) - (_.cover [/.named] - (|> (/.result (/.named dummy /.any) (list dummy expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual))))) - (_.cover [/.parameter] - (and (|> (/.result (/.parameter [short long] /.any) - (list short expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))) - (|> (/.result (/.parameter [short long] /.any) - (list long expected)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))) - (|> (/.result (/.parameter [short long] /.any) - (list dummy expected)) - (!expect {try.#Failure _})))) - )))) + (all _.and + (_.cover [/.result /.any] + (|> (/.result /.any (list expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual))))) + (_.cover [/.parse] + (|> (/.result (/.parse n#decoded) (list expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected + (n#encoded actual)))))) + (_.cover [/.this] + (and (|> (/.result (/.this expected) (list expected)) + (!expect {try.#Success _})) + (|> (/.result (/.this expected) (list dummy)) + (!expect {try.#Failure _})))) + (_.cover [/.somewhere] + (|> (/.result (|> (/.somewhere (/.this expected)) + (<>.before (<>.some /.any))) + (list.together (list pre_ignore (list expected) post_ignore))) + (!expect {try.#Success _}))) + (_.cover [/.end] + (and (|> (/.result /.end (list)) + (!expect {try.#Success _})) + (|> (/.result (<>.not /.end) (list expected)) + (!expect {try.#Failure _})))) + (_.cover [/.named] + (|> (/.result (/.named dummy /.any) (list dummy expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual))))) + (_.cover [/.parameter] + (and (|> (/.result (/.parameter [short long] /.any) + (list short expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))) + (|> (/.result (/.parameter [short long] /.any) + (list long expected)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))) + (|> (/.result (/.parameter [short long] /.any) + (list dummy expected)) + (!expect {try.#Failure _})))) + )))) diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 0063541c4..53afa97a4 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -42,119 +42,119 @@ (def: global (Random Symbol) - ($_ random.and - (random.ascii/lower 1) - (random.ascii/lower 1) - )) + (all random.and + (random.ascii/lower 1) + (random.ascii/lower 1) + )) (def: any_symbol (Random Symbol) - ($_ random.either - (random#each (|>> [""]) - ..local) - ..global - )) + (all random.either + (random#each (|>> [""]) + ..local) + ..global + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Parser]) - (`` ($_ _.and - (do [! random.monad] - [expected (# ! each code.bit random.bit)] - (_.cover [/.result] - (and (|> (/.result /.any (list expected)) - (!expect {try.#Success _})) - (|> (/.result /.any (list)) - (!expect {try.#Failure _}))))) - (~~ (template [<query> <check> <random> <code> <equivalence>] - [(do [! random.monad] - [expected <random> - dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] - ($_ _.and - (_.cover [<query>] - (|> (/.result <query> (list (<code> expected))) - (!expect (^.multi {try.#Success actual} - (# <equivalence> = expected actual))))) - (_.cover [<check>] - (and (|> (/.result (<check> expected) (list (<code> expected))) - (!expect {try.#Success []})) - (|> (/.result (<check> expected) (list (<code> dummy))) - (!expect {try.#Failure _})))) - ))] + (`` (all _.and + (do [! random.monad] + [expected (# ! each code.bit random.bit)] + (_.cover [/.result] + (and (|> (/.result /.any (list expected)) + (!expect {try.#Success _})) + (|> (/.result /.any (list)) + (!expect {try.#Failure _}))))) + (~~ (template [<query> <check> <random> <code> <equivalence>] + [(do [! random.monad] + [expected <random> + dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] + (all _.and + (_.cover [<query>] + (|> (/.result <query> (list (<code> expected))) + (!expect (^.multi {try.#Success actual} + (# <equivalence> = expected actual))))) + (_.cover [<check>] + (and (|> (/.result (<check> expected) (list (<code> expected))) + (!expect {try.#Success []})) + (|> (/.result (<check> expected) (list (<code> dummy))) + (!expect {try.#Failure _})))) + ))] - [/.any /.this (# ! each code.bit random.bit) function.identity code.equivalence] - [/.bit /.this_bit random.bit code.bit bit.equivalence] - [/.nat /.this_nat random.nat code.nat nat.equivalence] - [/.int /.this_int random.int code.int int.equivalence] - [/.rev /.this_rev random.rev code.rev rev.equivalence] - [/.frac /.this_frac random.safe_frac code.frac frac.equivalence] - [/.text /.this_text (random.unicode 1) code.text text.equivalence] - [/.local /.this_local ..local code.local text.equivalence] - [/.global /.this_global ..global code.symbol symbol.equivalence] - [/.symbol /.this_symbol ..any_symbol code.symbol symbol.equivalence] - )) - (~~ (template [<query> <code>] - [(do [! random.monad] - [expected_left random.nat - expected_right random.int] - (_.cover [<query>] - (|> (/.result (<query> (<>.and /.nat /.int)) - (list (<code> (list (code.nat expected_left) - (code.int expected_right))))) - (!expect (^.multi {try.#Success [actual_left actual_right]} - (and (# nat.equivalence = expected_left actual_left) - (# int.equivalence = expected_right actual_right)))))))] + [/.any /.this (# ! each code.bit random.bit) function.identity code.equivalence] + [/.bit /.this_bit random.bit code.bit bit.equivalence] + [/.nat /.this_nat random.nat code.nat nat.equivalence] + [/.int /.this_int random.int code.int int.equivalence] + [/.rev /.this_rev random.rev code.rev rev.equivalence] + [/.frac /.this_frac random.safe_frac code.frac frac.equivalence] + [/.text /.this_text (random.unicode 1) code.text text.equivalence] + [/.local /.this_local ..local code.local text.equivalence] + [/.global /.this_global ..global code.symbol symbol.equivalence] + [/.symbol /.this_symbol ..any_symbol code.symbol symbol.equivalence] + )) + (~~ (template [<query> <code>] + [(do [! random.monad] + [expected_left random.nat + expected_right random.int] + (_.cover [<query>] + (|> (/.result (<query> (<>.and /.nat /.int)) + (list (<code> (list (code.nat expected_left) + (code.int expected_right))))) + (!expect (^.multi {try.#Success [actual_left actual_right]} + (and (# nat.equivalence = expected_left actual_left) + (# int.equivalence = expected_right actual_right)))))))] - [/.form code.form] - [/.variant code.variant] - [/.tuple code.tuple] - )) - (do [! random.monad] - [expected_local random.nat - expected_global random.int] - (_.cover [/.locally] - (|> (/.result (<>.and (/.locally (list (code.nat expected_local)) /.nat) - /.int) - (list (code.int expected_global))) - (!expect (^.multi {try.#Success [actual_local actual_global]} - (and (# nat.equivalence = expected_local actual_local) - (# int.equivalence = expected_global actual_global))))))) - (do [! random.monad] - [dummy (# ! each code.bit random.bit)] - (_.cover [/.end?] - (|> (/.result (do <>.monad - [pre /.end? - _ /.any - post /.end?] - (in (and (not pre) - post))) - (list dummy)) - (!expect (^.multi {try.#Success verdict} - verdict))))) - (do [! random.monad] - [dummy (# ! each code.bit random.bit)] - (_.cover [/.end] - (and (|> (/.result /.end (list)) - (!expect {try.#Success []})) - (|> (/.result /.end (list dummy)) - (!expect {try.#Failure _}))))) - (do [! random.monad] - [expected (# ! each code.bit random.bit)] - (_.cover [/.next] - (|> (/.result (do <>.monad - [pre /.next - post /.any] - (in (and (same? expected pre) - (same? pre post)))) - (list expected)) - (!expect {try.#Success _})))) - (do [! random.monad] - [expected (# ! each code.bit random.bit)] - (_.cover [/.not] - (and (|> (/.result (/.not /.nat) (list expected)) - (!expect (^.multi {try.#Success actual} - (same? expected actual)))) - (|> (/.result (/.not /.bit) (list expected)) - (!expect {try.#Failure _}))))) - )))) + [/.form code.form] + [/.variant code.variant] + [/.tuple code.tuple] + )) + (do [! random.monad] + [expected_local random.nat + expected_global random.int] + (_.cover [/.locally] + (|> (/.result (<>.and (/.locally (list (code.nat expected_local)) /.nat) + /.int) + (list (code.int expected_global))) + (!expect (^.multi {try.#Success [actual_local actual_global]} + (and (# nat.equivalence = expected_local actual_local) + (# int.equivalence = expected_global actual_global))))))) + (do [! random.monad] + [dummy (# ! each code.bit random.bit)] + (_.cover [/.end?] + (|> (/.result (do <>.monad + [pre /.end? + _ /.any + post /.end?] + (in (and (not pre) + post))) + (list dummy)) + (!expect (^.multi {try.#Success verdict} + verdict))))) + (do [! random.monad] + [dummy (# ! each code.bit random.bit)] + (_.cover [/.end] + (and (|> (/.result /.end (list)) + (!expect {try.#Success []})) + (|> (/.result /.end (list dummy)) + (!expect {try.#Failure _}))))) + (do [! random.monad] + [expected (# ! each code.bit random.bit)] + (_.cover [/.next] + (|> (/.result (do <>.monad + [pre /.next + post /.any] + (in (and (same? expected pre) + (same? pre post)))) + (list expected)) + (!expect {try.#Success _})))) + (do [! random.monad] + [expected (# ! each code.bit random.bit)] + (_.cover [/.not] + (and (|> (/.result (/.not /.nat) (list expected)) + (!expect (^.multi {try.#Success actual} + (same? expected actual)))) + (|> (/.result (/.not /.bit) (list expected)) + (!expect {try.#Failure _}))))) + )))) diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux index ed3be6056..1631c5b59 100644 --- a/stdlib/source/test/lux/control/parser/environment.lux +++ b/stdlib/source/test/lux/control/parser/environment.lux @@ -1,53 +1,53 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" text ("[1]#[0]" equivalence)] - [collection - ["[0]" dictionary]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / - ["/[1]" // ("[1]#[0]" monad)]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text ("[1]#[0]" equivalence)] + [collection + ["[0]" dictionary]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + ["/[1]" // ("[1]#[0]" monad)]]]) (def: .public test Test (<| (_.covering /._) (_.for [/.Environment /.Parser]) - ($_ _.and - (_.cover [/.empty] - (dictionary.empty? /.empty)) - (do random.monad - [expected random.nat] - (_.cover [/.result] - (|> (/.result (//#in expected) /.empty) - (# try.functor each (n.= expected)) - (try.else false)))) - (do random.monad - [property (random.ascii/alpha 1) - expected (random.ascii/alpha 1)] - (_.cover [/.Property /.property] - (|> /.empty - (dictionary.has property expected) - (/.result (/.property property)) - (# try.functor each (text#= expected)) - (try.else false)))) - (do random.monad - [property (random.ascii/alpha 1)] - (_.cover [/.unknown_property] - (case (/.result (/.property property) /.empty) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.unknown_property error)))) - ))) + (all _.and + (_.cover [/.empty] + (dictionary.empty? /.empty)) + (do random.monad + [expected random.nat] + (_.cover [/.result] + (|> (/.result (//#in expected) /.empty) + (# try.functor each (n.= expected)) + (try.else false)))) + (do random.monad + [property (random.ascii/alpha 1) + expected (random.ascii/alpha 1)] + (_.cover [/.Property /.property] + (|> /.empty + (dictionary.has property expected) + (/.result (/.property property)) + (# try.functor each (text#= expected)) + (try.else false)))) + (do random.monad + [property (random.ascii/alpha 1)] + (_.cover [/.unknown_property] + (case (/.result (/.property property) /.empty) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.unknown_property error)))) + ))) diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux index 43d184bc3..55387d165 100644 --- a/stdlib/source/test/lux/control/parser/json.lux +++ b/stdlib/source/test/lux/control/parser/json.lux @@ -46,121 +46,121 @@ Test (<| (_.covering /._) (_.for [/.Parser]) - (`` ($_ _.and - (do [! random.monad] - [expected (# ! each (|>> {json.#String}) (random.unicode 1))] - (_.cover [/.result /.any] - (|> (/.result /.any expected) - (!expect (^.multi {try.#Success actual} - (# json.equivalence = expected actual)))))) - (_.cover [/.null] - (|> (/.result /.null {json.#Null}) - (!expect {try.#Success _}))) - (~~ (template [<query> <test> <check> <random> <json> <equivalence>] - [(do [! random.monad] - [expected <random> - dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] - ($_ _.and - (_.cover [<query>] - (|> (/.result <query> {<json> expected}) - (!expect (^.multi {try.#Success actual} - (# <equivalence> = expected actual))))) - (_.cover [<test>] - (and (|> (/.result (<test> expected) {<json> expected}) - (!expect {try.#Success #1})) - (|> (/.result (<test> expected) {<json> dummy}) - (!expect {try.#Success #0})))) - (_.cover [<check>] - (and (|> (/.result (<check> expected) {<json> expected}) - (!expect {try.#Success _})) - (|> (/.result (<check> expected) {<json> dummy}) - (!expect {try.#Failure _}))))))] + (`` (all _.and + (do [! random.monad] + [expected (# ! each (|>> {json.#String}) (random.unicode 1))] + (_.cover [/.result /.any] + (|> (/.result /.any expected) + (!expect (^.multi {try.#Success actual} + (# json.equivalence = expected actual)))))) + (_.cover [/.null] + (|> (/.result /.null {json.#Null}) + (!expect {try.#Success _}))) + (~~ (template [<query> <test> <check> <random> <json> <equivalence>] + [(do [! random.monad] + [expected <random> + dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] + (all _.and + (_.cover [<query>] + (|> (/.result <query> {<json> expected}) + (!expect (^.multi {try.#Success actual} + (# <equivalence> = expected actual))))) + (_.cover [<test>] + (and (|> (/.result (<test> expected) {<json> expected}) + (!expect {try.#Success #1})) + (|> (/.result (<test> expected) {<json> dummy}) + (!expect {try.#Success #0})))) + (_.cover [<check>] + (and (|> (/.result (<check> expected) {<json> expected}) + (!expect {try.#Success _})) + (|> (/.result (<check> expected) {<json> dummy}) + (!expect {try.#Failure _}))))))] - [/.boolean /.boolean? /.this_boolean random.bit json.#Boolean bit.equivalence] - [/.number /.number? /.this_number ..safe_frac json.#Number frac.equivalence] - [/.string /.string? /.this_string (random.unicode 1) json.#String text.equivalence] - )) - (do [! random.monad] - [expected (random.unicode 1) - dummy random.bit] - (_.cover [/.unexpected_value] - (|> (/.result /.string {json.#Boolean dummy}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unexpected_value error)))))) - (do [! random.monad] - [expected (random.unicode 1) - dummy (|> (random.unicode 1) (random.only (|>> (# text.equivalence = expected) not)))] - (_.cover [/.value_mismatch] - (|> (/.result (/.this_string expected) {json.#String dummy}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.value_mismatch error)))))) - (do [! random.monad] - [expected (random.unicode 1)] - (_.cover [/.nullable] - (and (|> (/.result (/.nullable /.string) {json.#Null}) - (!expect (^.multi {try.#Success actual} - (# (maybe.equivalence text.equivalence) = {.#None} actual)))) - (|> (/.result (/.nullable /.string) {json.#String expected}) - (!expect (^.multi {try.#Success actual} - (# (maybe.equivalence text.equivalence) = {.#Some expected} actual))))))) - (do [! random.monad] - [size (# ! each (n.% 10) random.nat) - expected (|> (random.unicode 1) - (random.list size) - (# ! each sequence.of_list))] - (_.cover [/.array] - (|> (/.result (/.array (<>.some /.string)) - {json.#Array (sequence#each (|>> {json.#String}) expected)}) - (!expect (^.multi {try.#Success actual} - (# (sequence.equivalence text.equivalence) = expected (sequence.of_list actual))))))) - (do [! random.monad] - [expected (# ! each (|>> {json.#String}) (random.unicode 1))] - (_.cover [/.unconsumed_input] - (|> (/.result (/.array /.any) {json.#Array (sequence expected expected)}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unconsumed_input error)))))) - (_.cover [/.empty_input] - (|> (/.result (/.array /.any) {json.#Array (sequence)}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.empty_input error))))) - (do [! random.monad] - [expected_boolean random.bit - expected_number ..safe_frac - expected_string (random.unicode 1) - [boolean_field number_field string_field] (|> (random.set text.hash 3 (random.unicode 3)) - (# ! each (|>> set.list - (pipe.case - (pattern (list boolean_field number_field string_field)) - [boolean_field number_field string_field] + [/.boolean /.boolean? /.this_boolean random.bit json.#Boolean bit.equivalence] + [/.number /.number? /.this_number ..safe_frac json.#Number frac.equivalence] + [/.string /.string? /.this_string (random.unicode 1) json.#String text.equivalence] + )) + (do [! random.monad] + [expected (random.unicode 1) + dummy random.bit] + (_.cover [/.unexpected_value] + (|> (/.result /.string {json.#Boolean dummy}) + (!expect (^.multi {try.#Failure error} + (exception.match? /.unexpected_value error)))))) + (do [! random.monad] + [expected (random.unicode 1) + dummy (|> (random.unicode 1) (random.only (|>> (# text.equivalence = expected) not)))] + (_.cover [/.value_mismatch] + (|> (/.result (/.this_string expected) {json.#String dummy}) + (!expect (^.multi {try.#Failure error} + (exception.match? /.value_mismatch error)))))) + (do [! random.monad] + [expected (random.unicode 1)] + (_.cover [/.nullable] + (and (|> (/.result (/.nullable /.string) {json.#Null}) + (!expect (^.multi {try.#Success actual} + (# (maybe.equivalence text.equivalence) = {.#None} actual)))) + (|> (/.result (/.nullable /.string) {json.#String expected}) + (!expect (^.multi {try.#Success actual} + (# (maybe.equivalence text.equivalence) = {.#Some expected} actual))))))) + (do [! random.monad] + [size (# ! each (n.% 10) random.nat) + expected (|> (random.unicode 1) + (random.list size) + (# ! each sequence.of_list))] + (_.cover [/.array] + (|> (/.result (/.array (<>.some /.string)) + {json.#Array (sequence#each (|>> {json.#String}) expected)}) + (!expect (^.multi {try.#Success actual} + (# (sequence.equivalence text.equivalence) = expected (sequence.of_list actual))))))) + (do [! random.monad] + [expected (# ! each (|>> {json.#String}) (random.unicode 1))] + (_.cover [/.unconsumed_input] + (|> (/.result (/.array /.any) {json.#Array (sequence expected expected)}) + (!expect (^.multi {try.#Failure error} + (exception.match? /.unconsumed_input error)))))) + (_.cover [/.empty_input] + (|> (/.result (/.array /.any) {json.#Array (sequence)}) + (!expect (^.multi {try.#Failure error} + (exception.match? /.empty_input error))))) + (do [! random.monad] + [expected_boolean random.bit + expected_number ..safe_frac + expected_string (random.unicode 1) + [boolean_field number_field string_field] (|> (random.set text.hash 3 (random.unicode 3)) + (# ! each (|>> set.list + (pipe.case + (pattern (list boolean_field number_field string_field)) + [boolean_field number_field string_field] - _ - (undefined)))))] - (_.cover [/.object /.field] - (|> (/.result (/.object ($_ <>.and - (/.field boolean_field /.boolean) - (/.field number_field /.number) - (/.field string_field /.string))) - {json.#Object - (dictionary.of_list text.hash - (list [boolean_field {json.#Boolean expected_boolean}] - [number_field {json.#Number expected_number}] - [string_field {json.#String expected_string}]))}) - (!expect (^.multi {try.#Success [actual_boolean actual_number actual_string]} - (and (# bit.equivalence = expected_boolean actual_boolean) - (# frac.equivalence = expected_number actual_number) - (# text.equivalence = expected_string actual_string))))))) - (do [! random.monad] - [size (# ! each (n.% 10) random.nat) - keys (random.list size (random.unicode 1)) - values (random.list size (random.unicode 1)) - .let [expected (dictionary.of_list text.hash (list.zipped_2 keys values))]] - (_.cover [/.dictionary] - (|> (/.result (/.dictionary /.string) - {json.#Object - (|> values - (list#each (|>> {json.#String})) - (list.zipped_2 keys) - (dictionary.of_list text.hash))}) - (!expect (^.multi {try.#Success actual} - (# (dictionary.equivalence text.equivalence) = expected actual)))))) - )))) + _ + (undefined)))))] + (_.cover [/.object /.field] + (|> (/.result (/.object (all <>.and + (/.field boolean_field /.boolean) + (/.field number_field /.number) + (/.field string_field /.string))) + {json.#Object + (dictionary.of_list text.hash + (list [boolean_field {json.#Boolean expected_boolean}] + [number_field {json.#Number expected_number}] + [string_field {json.#String expected_string}]))}) + (!expect (^.multi {try.#Success [actual_boolean actual_number actual_string]} + (and (# bit.equivalence = expected_boolean actual_boolean) + (# frac.equivalence = expected_number actual_number) + (# text.equivalence = expected_string actual_string))))))) + (do [! random.monad] + [size (# ! each (n.% 10) random.nat) + keys (random.list size (random.unicode 1)) + values (random.list size (random.unicode 1)) + .let [expected (dictionary.of_list text.hash (list.zipped_2 keys values))]] + (_.cover [/.dictionary] + (|> (/.result (/.dictionary /.string) + {json.#Object + (|> values + (list#each (|>> {json.#String})) + (list.zipped_2 keys) + (dictionary.of_list text.hash))}) + (!expect (^.multi {try.#Success actual} + (# (dictionary.equivalence text.equivalence) = expected actual)))))) + )))) diff --git a/stdlib/source/test/lux/control/parser/synthesis.lux b/stdlib/source/test/lux/control/parser/synthesis.lux index 0341837ee..addb7c149 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -62,143 +62,143 @@ (def: simple Test - (`` ($_ _.and - (~~ (template [<query> <check> <random> <synthesis> <equivalence>] - [(do [! random.monad] - [expected <random> - dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] - ($_ _.and - (_.cover [<query>] - (|> (/.result <query> (list (<synthesis> expected))) - (!expect (^.multi {try.#Success actual} - (# <equivalence> = expected actual))))) - (_.cover [<check>] - (and (|> (/.result (<check> expected) (list (<synthesis> expected))) - (!expect {try.#Success _})) - (|> (/.result (<check> expected) (list (<synthesis> dummy))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_parse error)))))) - ))] + (`` (all _.and + (~~ (template [<query> <check> <random> <synthesis> <equivalence>] + [(do [! random.monad] + [expected <random> + dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] + (all _.and + (_.cover [<query>] + (|> (/.result <query> (list (<synthesis> expected))) + (!expect (^.multi {try.#Success actual} + (# <equivalence> = expected actual))))) + (_.cover [<check>] + (and (|> (/.result (<check> expected) (list (<synthesis> expected))) + (!expect {try.#Success _})) + (|> (/.result (<check> expected) (list (<synthesis> dummy))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_parse error)))))) + ))] - [/.bit /.this_bit random.bit synthesis.bit bit.equivalence] - [/.i64 /.this_i64 random.i64 synthesis.i64 i64.equivalence] - [/.f64 /.this_f64 random.safe_frac synthesis.f64 frac.equivalence] - [/.text /.this_text (random.unicode 1) synthesis.text text.equivalence] - [/.local /.this_local random.nat synthesis.variable/local n.equivalence] - [/.foreign /.this_foreign random.nat synthesis.variable/foreign n.equivalence] - [/.constant /.this_constant ..random_constant synthesis.constant symbol.equivalence] - )) - ))) + [/.bit /.this_bit random.bit synthesis.bit bit.equivalence] + [/.i64 /.this_i64 random.i64 synthesis.i64 i64.equivalence] + [/.f64 /.this_f64 random.safe_frac synthesis.f64 frac.equivalence] + [/.text /.this_text (random.unicode 1) synthesis.text text.equivalence] + [/.local /.this_local random.nat synthesis.variable/local n.equivalence] + [/.foreign /.this_foreign random.nat synthesis.variable/foreign n.equivalence] + [/.constant /.this_constant ..random_constant synthesis.constant symbol.equivalence] + )) + ))) (def: complex Test - ($_ _.and - (do [! random.monad] - [expected_bit random.bit - expected_i64 random.i64 - expected_f64 random.safe_frac - expected_text (random.unicode 1)] - (_.cover [/.tuple] - (and (|> (/.result (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.tuple (list (synthesis.bit expected_bit) - (synthesis.i64 expected_i64) - (synthesis.f64 expected_f64) - (synthesis.text expected_text))))) - (!expect (^.multi {try.#Success [actual_bit actual_i64 actual_f64 actual_text]} - (and (# bit.equivalence = expected_bit actual_bit) - (# i64.equivalence = expected_i64 actual_i64) - (# frac.equivalence = expected_f64 actual_f64) - (# text.equivalence = expected_text actual_text))))) - (|> (/.result (/.tuple ($_ <>.and /.bit /.i64 /.f64 /.text)) - (list (synthesis.text expected_text))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_parse error))))))) - (do [! random.monad] - [arity random.nat - expected_environment ..random_environment - expected_body (random.unicode 1)] - (_.cover [/.function] - (and (|> (/.result (/.function arity /.text) - (list (synthesis.function/abstraction [expected_environment arity (synthesis.text expected_body)]))) - (!expect (^.multi {try.#Success [actual_environment actual_body]} - (and (# (list.equivalence synthesis.equivalence) = - expected_environment - actual_environment) - (# text.equivalence = expected_body actual_body))))) - (|> (/.result (/.function arity /.text) - (list (synthesis.text expected_body))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_parse error))))))) - (do [! random.monad] - [arity random.nat - expected_environment ..random_environment - expected_body (random.unicode 1)] - (_.cover [/.wrong_arity] - (|> (/.result (/.function (++ arity) /.text) - (list (synthesis.function/abstraction [expected_environment arity (synthesis.text expected_body)]))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.wrong_arity error)))))) - (do [! random.monad] - [arity (# ! each (|>> (n.% 10) ++) random.nat) - expected_offset random.nat - expected_inits (random.list arity random.bit) - expected_body (random.unicode 1)] - (_.cover [/.loop] - (and (|> (/.result (/.loop (<>.many /.bit) /.text) - (list (synthesis.loop/scope [expected_offset - (list#each (|>> synthesis.bit) expected_inits) - (synthesis.text expected_body)]))) - (!expect (^.multi {try.#Success [actual_offset actual_inits actual_body]} - (and (# n.equivalence = expected_offset actual_offset) - (# (list.equivalence bit.equivalence) = - expected_inits - actual_inits) - (# text.equivalence = expected_body actual_body))))) - (|> (/.result (/.loop (<>.many /.bit) /.text) - (list (synthesis.text expected_body))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_parse error))))))) - )) + (all _.and + (do [! random.monad] + [expected_bit random.bit + expected_i64 random.i64 + expected_f64 random.safe_frac + expected_text (random.unicode 1)] + (_.cover [/.tuple] + (and (|> (/.result (/.tuple (all <>.and /.bit /.i64 /.f64 /.text)) + (list (synthesis.tuple (list (synthesis.bit expected_bit) + (synthesis.i64 expected_i64) + (synthesis.f64 expected_f64) + (synthesis.text expected_text))))) + (!expect (^.multi {try.#Success [actual_bit actual_i64 actual_f64 actual_text]} + (and (# bit.equivalence = expected_bit actual_bit) + (# i64.equivalence = expected_i64 actual_i64) + (# frac.equivalence = expected_f64 actual_f64) + (# text.equivalence = expected_text actual_text))))) + (|> (/.result (/.tuple (all <>.and /.bit /.i64 /.f64 /.text)) + (list (synthesis.text expected_text))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_parse error))))))) + (do [! random.monad] + [arity random.nat + expected_environment ..random_environment + expected_body (random.unicode 1)] + (_.cover [/.function] + (and (|> (/.result (/.function arity /.text) + (list (synthesis.function/abstraction [expected_environment arity (synthesis.text expected_body)]))) + (!expect (^.multi {try.#Success [actual_environment actual_body]} + (and (# (list.equivalence synthesis.equivalence) = + expected_environment + actual_environment) + (# text.equivalence = expected_body actual_body))))) + (|> (/.result (/.function arity /.text) + (list (synthesis.text expected_body))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_parse error))))))) + (do [! random.monad] + [arity random.nat + expected_environment ..random_environment + expected_body (random.unicode 1)] + (_.cover [/.wrong_arity] + (|> (/.result (/.function (++ arity) /.text) + (list (synthesis.function/abstraction [expected_environment arity (synthesis.text expected_body)]))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.wrong_arity error)))))) + (do [! random.monad] + [arity (# ! each (|>> (n.% 10) ++) random.nat) + expected_offset random.nat + expected_inits (random.list arity random.bit) + expected_body (random.unicode 1)] + (_.cover [/.loop] + (and (|> (/.result (/.loop (<>.many /.bit) /.text) + (list (synthesis.loop/scope [expected_offset + (list#each (|>> synthesis.bit) expected_inits) + (synthesis.text expected_body)]))) + (!expect (^.multi {try.#Success [actual_offset actual_inits actual_body]} + (and (# n.equivalence = expected_offset actual_offset) + (# (list.equivalence bit.equivalence) = + expected_inits + actual_inits) + (# text.equivalence = expected_body actual_body))))) + (|> (/.result (/.loop (<>.many /.bit) /.text) + (list (synthesis.text expected_body))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_parse error))))))) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Parser]) - ($_ _.and - (do [! random.monad] - [expected (# ! each (|>> synthesis.i64) random.i64)] - (_.cover [/.result /.any] - (|> (/.result /.any (list expected)) - (!expect (^.multi {try.#Success actual} - (# synthesis.equivalence = expected actual)))))) - (_.cover [/.empty_input] - (|> (/.result /.any (list)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.empty_input error))))) - (do [! random.monad] - [expected (# ! each (|>> synthesis.i64) random.i64)] - (_.cover [/.unconsumed_input] - (|> (/.result /.any (list expected expected)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unconsumed_input error)))))) - (do [! random.monad] - [dummy (# ! each (|>> synthesis.i64) random.i64)] - (_.cover [/.end /.expected_empty_input] - (and (|> (/.result /.end (list)) - (!expect {try.#Success _})) - (|> (/.result /.end (list dummy)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.expected_empty_input error))))))) - (do [! random.monad] - [dummy (# ! each (|>> synthesis.i64) random.i64)] - (_.cover [/.end?] - (and (|> (/.result /.end? (list)) - (!expect {try.#Success #1})) - (|> (/.result (<>.before /.any /.end?) (list dummy)) - (!expect {try.#Success #0}))))) - (_.for [/.cannot_parse] - ($_ _.and - ..simple - ..complex - )) - ))) + (all _.and + (do [! random.monad] + [expected (# ! each (|>> synthesis.i64) random.i64)] + (_.cover [/.result /.any] + (|> (/.result /.any (list expected)) + (!expect (^.multi {try.#Success actual} + (# synthesis.equivalence = expected actual)))))) + (_.cover [/.empty_input] + (|> (/.result /.any (list)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.empty_input error))))) + (do [! random.monad] + [expected (# ! each (|>> synthesis.i64) random.i64)] + (_.cover [/.unconsumed_input] + (|> (/.result /.any (list expected expected)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.unconsumed_input error)))))) + (do [! random.monad] + [dummy (# ! each (|>> synthesis.i64) random.i64)] + (_.cover [/.end /.expected_empty_input] + (and (|> (/.result /.end (list)) + (!expect {try.#Success _})) + (|> (/.result /.end (list dummy)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.expected_empty_input error))))))) + (do [! random.monad] + [dummy (# ! each (|>> synthesis.i64) random.i64)] + (_.cover [/.end?] + (and (|> (/.result /.end? (list)) + (!expect {try.#Success #1})) + (|> (/.result (<>.before /.any /.end?) (list dummy)) + (!expect {try.#Success #0}))))) + (_.for [/.cannot_parse] + (all _.and + ..simple + ..complex + )) + ))) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 6c4b3b2ff..12bf56c3a 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -71,373 +71,373 @@ (def: character_classes Test - ($_ _.and - (do [! random.monad] - [offset (# ! each (n.% 50) random.nat) - range (# ! each (|>> (n.% 50) (n.+ 10)) random.nat) - .let [limit (n.+ offset range)] - expected (# ! each (|>> (n.% range) (n.+ offset) text.of_char) random.nat) - out_of_range (case offset - 0 (# ! each (|>> (n.% 10) ++ (n.+ limit) text.of_char) random.nat) - _ (# ! each (|>> (n.% offset) text.of_char) random.nat))] - (_.cover [/.range] - (and (..should_pass expected (/.range offset limit)) - (..should_fail out_of_range (/.range offset limit))))) - (do [! random.monad] - [expected (random.char unicode.ascii/upper) - invalid (random.only (|>> (unicode/block.within? unicode/block.basic_latin/upper) not) - (random.char unicode.character))] - (_.cover [/.upper] - (and (..should_pass (text.of_char expected) /.upper) - (..should_fail (text.of_char invalid) /.upper)))) - (do [! random.monad] - [expected (random.char unicode.ascii/lower) - invalid (random.only (|>> (unicode/block.within? unicode/block.basic_latin/lower) not) - (random.char unicode.character))] - (_.cover [/.lower] - (and (..should_pass (text.of_char expected) /.lower) - (..should_fail (text.of_char invalid) /.lower)))) - (do [! random.monad] - [expected (# ! each (n.% 10) random.nat) - invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] - (_.cover [/.decimal] - (and (..should_pass (# n.decimal encoded expected) /.decimal) - (..should_fail (text.of_char invalid) /.decimal)))) - (do [! random.monad] - [expected (# ! each (n.% 8) random.nat) - invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] - (_.cover [/.octal] - (and (..should_pass (# n.octal encoded expected) /.octal) - (..should_fail (text.of_char invalid) /.octal)))) - (do [! random.monad] - [expected (# ! each (n.% 16) random.nat) - invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] - (_.cover [/.hexadecimal] - (and (..should_pass (# n.hex encoded expected) /.hexadecimal) - (..should_fail (text.of_char invalid) /.hexadecimal)))) - (do [! random.monad] - [expected (random.char unicode.ascii/alpha) - invalid (random.only (function (_ char) - (not (or (unicode/block.within? unicode/block.basic_latin/upper char) - (unicode/block.within? unicode/block.basic_latin/lower char)))) - (random.char unicode.character))] - (_.cover [/.alpha] - (and (..should_pass (text.of_char expected) /.alpha) - (..should_fail (text.of_char invalid) /.alpha)))) - (do [! random.monad] - [expected (random.char unicode.ascii/alpha_num) - invalid (random.only (function (_ char) - (not (or (unicode/block.within? unicode/block.basic_latin/upper char) - (unicode/block.within? unicode/block.basic_latin/lower char) - (unicode/block.within? unicode/block.basic_latin/decimal char)))) - (random.char unicode.character))] - (_.cover [/.alpha_num] - (and (..should_pass (text.of_char expected) /.alpha_num) - (..should_fail (text.of_char invalid) /.alpha_num)))) - (do [! random.monad] - [expected ($_ random.either - (in text.tab) - (in text.vertical_tab) - (in text.space) - (in text.new_line) - (in text.carriage_return) - (in text.form_feed)) - invalid (|> (random.unicode 1) (random.only (function (_ char) - (not (or (text#= text.tab char) - (text#= text.vertical_tab char) - (text#= text.space char) - (text#= text.new_line char) - (text#= text.carriage_return char) - (text#= text.form_feed char))))))] - (_.cover [/.space] - (and (..should_pass expected /.space) - (..should_fail invalid /.space)))) - (do [! random.monad] - [.let [num_options 3] - options (|> (random.char unicode.character) - (random.set n.hash num_options) - (# ! each (|>> set.list - (list#each text.of_char) - text.together))) - expected (# ! each (function (_ value) + (all _.and + (do [! random.monad] + [offset (# ! each (n.% 50) random.nat) + range (# ! each (|>> (n.% 50) (n.+ 10)) random.nat) + .let [limit (n.+ offset range)] + expected (# ! each (|>> (n.% range) (n.+ offset) text.of_char) random.nat) + out_of_range (case offset + 0 (# ! each (|>> (n.% 10) ++ (n.+ limit) text.of_char) random.nat) + _ (# ! each (|>> (n.% offset) text.of_char) random.nat))] + (_.cover [/.range] + (and (..should_pass expected (/.range offset limit)) + (..should_fail out_of_range (/.range offset limit))))) + (do [! random.monad] + [expected (random.char unicode.ascii/upper) + invalid (random.only (|>> (unicode/block.within? unicode/block.basic_latin/upper) not) + (random.char unicode.character))] + (_.cover [/.upper] + (and (..should_pass (text.of_char expected) /.upper) + (..should_fail (text.of_char invalid) /.upper)))) + (do [! random.monad] + [expected (random.char unicode.ascii/lower) + invalid (random.only (|>> (unicode/block.within? unicode/block.basic_latin/lower) not) + (random.char unicode.character))] + (_.cover [/.lower] + (and (..should_pass (text.of_char expected) /.lower) + (..should_fail (text.of_char invalid) /.lower)))) + (do [! random.monad] + [expected (# ! each (n.% 10) random.nat) + invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] + (_.cover [/.decimal] + (and (..should_pass (# n.decimal encoded expected) /.decimal) + (..should_fail (text.of_char invalid) /.decimal)))) + (do [! random.monad] + [expected (# ! each (n.% 8) random.nat) + invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] + (_.cover [/.octal] + (and (..should_pass (# n.octal encoded expected) /.octal) + (..should_fail (text.of_char invalid) /.octal)))) + (do [! random.monad] + [expected (# ! each (n.% 16) random.nat) + invalid (random.char (unicode.set [unicode/block.number_forms (list)]))] + (_.cover [/.hexadecimal] + (and (..should_pass (# n.hex encoded expected) /.hexadecimal) + (..should_fail (text.of_char invalid) /.hexadecimal)))) + (do [! random.monad] + [expected (random.char unicode.ascii/alpha) + invalid (random.only (function (_ char) + (not (or (unicode/block.within? unicode/block.basic_latin/upper char) + (unicode/block.within? unicode/block.basic_latin/lower char)))) + (random.char unicode.character))] + (_.cover [/.alpha] + (and (..should_pass (text.of_char expected) /.alpha) + (..should_fail (text.of_char invalid) /.alpha)))) + (do [! random.monad] + [expected (random.char unicode.ascii/alpha_num) + invalid (random.only (function (_ char) + (not (or (unicode/block.within? unicode/block.basic_latin/upper char) + (unicode/block.within? unicode/block.basic_latin/lower char) + (unicode/block.within? unicode/block.basic_latin/decimal char)))) + (random.char unicode.character))] + (_.cover [/.alpha_num] + (and (..should_pass (text.of_char expected) /.alpha_num) + (..should_fail (text.of_char invalid) /.alpha_num)))) + (do [! random.monad] + [expected (all random.either + (in text.tab) + (in text.vertical_tab) + (in text.space) + (in text.new_line) + (in text.carriage_return) + (in text.form_feed)) + invalid (|> (random.unicode 1) (random.only (function (_ char) + (not (or (text#= text.tab char) + (text#= text.vertical_tab char) + (text#= text.space char) + (text#= text.new_line char) + (text#= text.carriage_return char) + (text#= text.form_feed char))))))] + (_.cover [/.space] + (and (..should_pass expected /.space) + (..should_fail invalid /.space)))) + (do [! random.monad] + [.let [num_options 3] + options (|> (random.char unicode.character) + (random.set n.hash num_options) + (# ! each (|>> set.list + (list#each text.of_char) + text.together))) + expected (# ! each (function (_ value) + (|> options + (text.char (n.% num_options value)) + maybe.trusted)) + random.nat) + invalid (random.only (function (_ char) + (not (text.contains? (text.of_char char) options))) + (random.char unicode.character))] + (_.cover [/.one_of /.one_of! /.character_should_be] + (and (..should_pass (text.of_char expected) (/.one_of options)) + (..should_fail (text.of_char invalid) (/.one_of options)) + (..should_fail' (text.of_char invalid) (/.one_of options) + /.character_should_be) + + (..should_pass! (text.of_char expected) (/.one_of! options)) + (..should_fail (text.of_char invalid) (/.one_of! options)) + (..should_fail' (text.of_char invalid) (/.one_of! options) + /.character_should_be) + ))) + (do [! random.monad] + [.let [num_options 3] + options (|> (random.char unicode.character) + (random.set n.hash num_options) + (# ! each (|>> set.list + (list#each text.of_char) + text.together))) + invalid (# ! each (function (_ value) (|> options (text.char (n.% num_options value)) maybe.trusted)) random.nat) - invalid (random.only (function (_ char) - (not (text.contains? (text.of_char char) options))) - (random.char unicode.character))] - (_.cover [/.one_of /.one_of! /.character_should_be] - (and (..should_pass (text.of_char expected) (/.one_of options)) - (..should_fail (text.of_char invalid) (/.one_of options)) - (..should_fail' (text.of_char invalid) (/.one_of options) - /.character_should_be) - - (..should_pass! (text.of_char expected) (/.one_of! options)) - (..should_fail (text.of_char invalid) (/.one_of! options)) - (..should_fail' (text.of_char invalid) (/.one_of! options) - /.character_should_be) - ))) - (do [! random.monad] - [.let [num_options 3] - options (|> (random.char unicode.character) - (random.set n.hash num_options) - (# ! each (|>> set.list - (list#each text.of_char) - text.together))) - invalid (# ! each (function (_ value) - (|> options - (text.char (n.% num_options value)) - maybe.trusted)) - random.nat) - expected (random.only (function (_ char) - (not (text.contains? (text.of_char char) options))) - (random.char unicode.character))] - (_.cover [/.none_of /.none_of! /.character_should_not_be] - (and (..should_pass (text.of_char expected) (/.none_of options)) - (..should_fail (text.of_char invalid) (/.none_of options)) - (..should_fail' (text.of_char invalid) (/.none_of options) - /.character_should_not_be) + expected (random.only (function (_ char) + (not (text.contains? (text.of_char char) options))) + (random.char unicode.character))] + (_.cover [/.none_of /.none_of! /.character_should_not_be] + (and (..should_pass (text.of_char expected) (/.none_of options)) + (..should_fail (text.of_char invalid) (/.none_of options)) + (..should_fail' (text.of_char invalid) (/.none_of options) + /.character_should_not_be) - (..should_pass! (text.of_char expected) (/.none_of! options)) - (..should_fail (text.of_char invalid) (/.none_of! options)) - (..should_fail' (text.of_char invalid) (/.none_of! options) - /.character_should_not_be) - ))) - )) + (..should_pass! (text.of_char expected) (/.none_of! options)) + (..should_fail (text.of_char invalid) (/.none_of! options)) + (..should_fail' (text.of_char invalid) (/.none_of! options) + /.character_should_not_be) + ))) + )) (def: runs Test (let [octal! (/.one_of! "01234567")] - ($_ _.and - (do [! random.monad] - [left (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) - right (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) - .let [expected (format left right)] - invalid (|> random.nat - (# ! each (n.% 16)) - (random.only (n.>= 8)) - (# ! each (# n.hex encoded)))] - (_.cover [/.many /.many!] - (and (..should_pass expected (/.many /.octal)) - (..should_fail invalid (/.many /.octal)) + (all _.and + (do [! random.monad] + [left (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) + right (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) + .let [expected (format left right)] + invalid (|> random.nat + (# ! each (n.% 16)) + (random.only (n.>= 8)) + (# ! each (# n.hex encoded)))] + (_.cover [/.many /.many!] + (and (..should_pass expected (/.many /.octal)) + (..should_fail invalid (/.many /.octal)) - (..should_pass! expected (/.many! octal!))))) - (do [! random.monad] - [left (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) - right (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) - .let [expected (format left right)] - invalid (|> random.nat - (# ! each (n.% 16)) - (random.only (n.>= 8)) - (# ! each (# n.hex encoded)))] - (_.cover [/.some /.some!] - (and (..should_pass expected (/.some /.octal)) - (..should_pass "" (/.some /.octal)) - (..should_fail invalid (/.some /.octal)) + (..should_pass! expected (/.many! octal!))))) + (do [! random.monad] + [left (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) + right (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat) + .let [expected (format left right)] + invalid (|> random.nat + (# ! each (n.% 16)) + (random.only (n.>= 8)) + (# ! each (# n.hex encoded)))] + (_.cover [/.some /.some!] + (and (..should_pass expected (/.some /.octal)) + (..should_pass "" (/.some /.octal)) + (..should_fail invalid (/.some /.octal)) - (..should_pass! expected (/.some! octal!)) - (..should_pass! "" (/.some! octal!))))) - (do [! random.monad] - [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] - first octal - second octal - third octal] - (_.cover [/.exactly /.exactly!] - (and (..should_pass (format first second) (/.exactly 2 /.octal)) - (..should_fail (format first second third) (/.exactly 2 /.octal)) - (..should_fail (format first) (/.exactly 2 /.octal)) + (..should_pass! expected (/.some! octal!)) + (..should_pass! "" (/.some! octal!))))) + (do [! random.monad] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] + first octal + second octal + third octal] + (_.cover [/.exactly /.exactly!] + (and (..should_pass (format first second) (/.exactly 2 /.octal)) + (..should_fail (format first second third) (/.exactly 2 /.octal)) + (..should_fail (format first) (/.exactly 2 /.octal)) - (..should_pass! (format first second) (/.exactly! 2 octal!)) - (..should_fail (format first second third) (/.exactly! 2 octal!)) - (..should_fail (format first) (/.exactly! 2 octal!))))) - (do [! random.monad] - [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] - first octal - second octal - third octal] - (_.cover [/.at_most /.at_most!] - (and (..should_pass (format first second) (/.at_most 2 /.octal)) - (..should_pass (format first) (/.at_most 2 /.octal)) - (..should_fail (format first second third) (/.at_most 2 /.octal)) + (..should_pass! (format first second) (/.exactly! 2 octal!)) + (..should_fail (format first second third) (/.exactly! 2 octal!)) + (..should_fail (format first) (/.exactly! 2 octal!))))) + (do [! random.monad] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] + first octal + second octal + third octal] + (_.cover [/.at_most /.at_most!] + (and (..should_pass (format first second) (/.at_most 2 /.octal)) + (..should_pass (format first) (/.at_most 2 /.octal)) + (..should_fail (format first second third) (/.at_most 2 /.octal)) - (..should_pass! (format first second) (/.at_most! 2 octal!)) - (..should_pass! (format first) (/.at_most! 2 octal!)) - (..should_fail (format first second third) (/.at_most! 2 octal!))))) - (do [! random.monad] - [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] - first octal - second octal - third octal] - (_.cover [/.at_least /.at_least!] - (and (..should_pass (format first second) (/.at_least 2 /.octal)) - (..should_pass (format first second third) (/.at_least 2 /.octal)) - (..should_fail (format first) (/.at_least 2 /.octal)) + (..should_pass! (format first second) (/.at_most! 2 octal!)) + (..should_pass! (format first) (/.at_most! 2 octal!)) + (..should_fail (format first second third) (/.at_most! 2 octal!))))) + (do [! random.monad] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] + first octal + second octal + third octal] + (_.cover [/.at_least /.at_least!] + (and (..should_pass (format first second) (/.at_least 2 /.octal)) + (..should_pass (format first second third) (/.at_least 2 /.octal)) + (..should_fail (format first) (/.at_least 2 /.octal)) - (..should_pass! (format first second) (/.at_least! 2 octal!)) - (..should_pass! (format first second third) (/.at_least! 2 octal!)) - (..should_fail (format first) (/.at_least! 2 octal!))))) - (do [! random.monad] - [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] - first octal - second octal - third octal] - (_.cover [/.between /.between!] - (and (..should_pass (format first second) (/.between 2 1 /.octal)) - (..should_pass (format first second third) (/.between 2 1 /.octal)) - (..should_fail (format first) (/.between 2 1 /.octal)) + (..should_pass! (format first second) (/.at_least! 2 octal!)) + (..should_pass! (format first second third) (/.at_least! 2 octal!)) + (..should_fail (format first) (/.at_least! 2 octal!))))) + (do [! random.monad] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] + first octal + second octal + third octal] + (_.cover [/.between /.between!] + (and (..should_pass (format first second) (/.between 2 1 /.octal)) + (..should_pass (format first second third) (/.between 2 1 /.octal)) + (..should_fail (format first) (/.between 2 1 /.octal)) - (..should_pass! (format first second) (/.between! 2 1 octal!)) - (..should_pass! (format first second third) (/.between! 2 1 octal!)) - (..should_fail (format first) (/.between! 2 1 octal!))))) - ))) + (..should_pass! (format first second) (/.between! 2 1 octal!)) + (..should_pass! (format first second third) (/.between! 2 1 octal!)) + (..should_fail (format first) (/.between! 2 1 octal!))))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Parser]) - ($_ _.and - (do [! random.monad] - [sample (random.unicode 1)] - (_.cover [/.result /.end] - (and (|> (/.result /.end - "") - (!expect {try.#Success _})) - (|> (/.result /.end - sample) - (!expect {try.#Failure _}))))) - (do [! random.monad] - [.let [size 10] - expected (random.unicode size) - dummy (|> (random.unicode size) - (random.only (|>> (text#= expected) not)))] - (_.cover [/.this /.cannot_match] - (and (|> (/.result (/.this expected) - expected) - (!expect {try.#Success []})) - (|> (/.result (/.this expected) - dummy) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_match error))))))) - (_.cover [/.Slice /.slice /.cannot_slice] - (|> "" - (/.result (/.slice /.any!)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_slice error))))) - (do [! random.monad] - [expected (random.unicode 1)] - (_.cover [/.any /.any!] - (and (..should_pass expected /.any) - (..should_fail "" /.any) + (all _.and + (do [! random.monad] + [sample (random.unicode 1)] + (_.cover [/.result /.end] + (and (|> (/.result /.end + "") + (!expect {try.#Success _})) + (|> (/.result /.end + sample) + (!expect {try.#Failure _}))))) + (do [! random.monad] + [.let [size 10] + expected (random.unicode size) + dummy (|> (random.unicode size) + (random.only (|>> (text#= expected) not)))] + (_.cover [/.this /.cannot_match] + (and (|> (/.result (/.this expected) + expected) + (!expect {try.#Success []})) + (|> (/.result (/.this expected) + dummy) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_match error))))))) + (_.cover [/.Slice /.slice /.cannot_slice] + (|> "" + (/.result (/.slice /.any!)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_slice error))))) + (do [! random.monad] + [expected (random.unicode 1)] + (_.cover [/.any /.any!] + (and (..should_pass expected /.any) + (..should_fail "" /.any) - (..should_pass! expected /.any!) - (..should_fail "" /.any!)))) - (do [! random.monad] - [expected (random.unicode 1)] - (_.cover [/.next /.cannot_parse] - (and (..should_pass expected (<>.before /.any /.next)) - (|> "" - (/.result (<>.before /.any /.next)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_parse error))))))) - (do [! random.monad] - [dummy (random.unicode 1)] - (_.cover [/.unconsumed_input] - (|> (format dummy dummy) - (/.result /.any) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unconsumed_input error)))))) - (do [! random.monad] - [sample (random.unicode 1)] - (_.cover [/.Offset /.offset] - (|> sample - (/.result (do <>.monad - [pre /.offset - _ /.any - post /.offset] - (in [pre post]))) - (!expect {try.#Success [0 1]})))) - (do [! random.monad] - [left (random.unicode 1) - right (random.unicode 1) - .let [input (format left right)]] - (_.cover [/.remaining] - (|> input - (/.result (do <>.monad - [pre /.remaining - _ /.any - post /.remaining - _ /.any] - (in (and (text#= input pre) - (text#= right post))))) - (!expect {try.#Success #1})))) - (do [! random.monad] - [left (random.unicode 1) - right (random.unicode 1) - expected (random.only (|>> (text#= right) not) - (random.unicode 1))] - (_.cover [/.enclosed] - (|> (format left expected right) - (/.result (/.enclosed [left right] (/.this expected))) - (!expect {try.#Success _})))) - (do [! random.monad] - [input (random.unicode 1) - output (random.unicode 1)] - (_.cover [/.local] - (|> output - (/.result (do <>.monad - [_ (/.local input (/.this input))] - (/.this output))) - (!expect {try.#Success _})))) - (do [! random.monad] - [expected (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] - (_.cover [/.then] - (|> (list (code.text expected)) - (<c>.result (/.then /.octal <c>.text)) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))))) - (do [! random.monad] - [invalid (random.ascii/upper 1) - expected (random.only (|>> (unicode/block.within? unicode/block.basic_latin/upper) - not) - (random.char unicode.character)) - .let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] - (_.cover [/.not /.not! /.expected_to_fail] - (and (..should_pass (text.of_char expected) (/.not /.upper)) - (|> invalid - (/.result (/.not /.upper)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.expected_to_fail error)))) + (..should_pass! expected /.any!) + (..should_fail "" /.any!)))) + (do [! random.monad] + [expected (random.unicode 1)] + (_.cover [/.next /.cannot_parse] + (and (..should_pass expected (<>.before /.any /.next)) + (|> "" + (/.result (<>.before /.any /.next)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_parse error))))))) + (do [! random.monad] + [dummy (random.unicode 1)] + (_.cover [/.unconsumed_input] + (|> (format dummy dummy) + (/.result /.any) + (!expect (^.multi {try.#Failure error} + (exception.match? /.unconsumed_input error)))))) + (do [! random.monad] + [sample (random.unicode 1)] + (_.cover [/.Offset /.offset] + (|> sample + (/.result (do <>.monad + [pre /.offset + _ /.any + post /.offset] + (in [pre post]))) + (!expect {try.#Success [0 1]})))) + (do [! random.monad] + [left (random.unicode 1) + right (random.unicode 1) + .let [input (format left right)]] + (_.cover [/.remaining] + (|> input + (/.result (do <>.monad + [pre /.remaining + _ /.any + post /.remaining + _ /.any] + (in (and (text#= input pre) + (text#= right post))))) + (!expect {try.#Success #1})))) + (do [! random.monad] + [left (random.unicode 1) + right (random.unicode 1) + expected (random.only (|>> (text#= right) not) + (random.unicode 1))] + (_.cover [/.enclosed] + (|> (format left expected right) + (/.result (/.enclosed [left right] (/.this expected))) + (!expect {try.#Success _})))) + (do [! random.monad] + [input (random.unicode 1) + output (random.unicode 1)] + (_.cover [/.local] + (|> output + (/.result (do <>.monad + [_ (/.local input (/.this input))] + (/.this output))) + (!expect {try.#Success _})))) + (do [! random.monad] + [expected (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] + (_.cover [/.then] + (|> (list (code.text expected)) + (<c>.result (/.then /.octal <c>.text)) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))))) + (do [! random.monad] + [invalid (random.ascii/upper 1) + expected (random.only (|>> (unicode/block.within? unicode/block.basic_latin/upper) + not) + (random.char unicode.character)) + .let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ")]] + (_.cover [/.not /.not! /.expected_to_fail] + (and (..should_pass (text.of_char expected) (/.not /.upper)) + (|> invalid + (/.result (/.not /.upper)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.expected_to_fail error)))) - (..should_pass! (text.of_char expected) (/.not! upper!)) - (|> invalid - (/.result (/.not! upper!)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.expected_to_fail error))))))) - (do [! random.monad] - [upper (random.ascii/upper 1) - lower (random.ascii/lower 1) - invalid (random.only (function (_ char) - (not (or (unicode/block.within? unicode/block.basic_latin/upper char) - (unicode/block.within? unicode/block.basic_latin/lower char)))) - (random.char unicode.character)) - .let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") - lower! (/.one_of! "abcdefghijklmnopqrstuvwxyz")]] - (_.cover [/.and /.and!] - (and (..should_pass (format upper lower) (/.and /.upper /.lower)) - (..should_fail (format (text.of_char invalid) lower) (/.and /.upper /.lower)) - (..should_fail (format upper (text.of_char invalid)) (/.and /.upper /.lower)) + (..should_pass! (text.of_char expected) (/.not! upper!)) + (|> invalid + (/.result (/.not! upper!)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.expected_to_fail error))))))) + (do [! random.monad] + [upper (random.ascii/upper 1) + lower (random.ascii/lower 1) + invalid (random.only (function (_ char) + (not (or (unicode/block.within? unicode/block.basic_latin/upper char) + (unicode/block.within? unicode/block.basic_latin/lower char)))) + (random.char unicode.character)) + .let [upper! (/.one_of! "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + lower! (/.one_of! "abcdefghijklmnopqrstuvwxyz")]] + (_.cover [/.and /.and!] + (and (..should_pass (format upper lower) (/.and /.upper /.lower)) + (..should_fail (format (text.of_char invalid) lower) (/.and /.upper /.lower)) + (..should_fail (format upper (text.of_char invalid)) (/.and /.upper /.lower)) - (..should_pass! (format upper lower) (/.and! upper! lower!)) - (..should_fail (format (text.of_char invalid) lower) (/.and! upper! lower!)) - (..should_fail (format upper (text.of_char invalid)) (/.and! upper! lower!))))) - (do [! random.monad] - [expected (random.unicode 1) - invalid (random.unicode 1)] - (_.cover [/.satisfies /.character_does_not_satisfy_predicate] - (and (..should_pass expected (/.satisfies (function.constant true))) - (..should_fail' invalid (/.satisfies (function.constant false)) - /.character_does_not_satisfy_predicate)))) - ..character_classes - ..runs - ))) + (..should_pass! (format upper lower) (/.and! upper! lower!)) + (..should_fail (format (text.of_char invalid) lower) (/.and! upper! lower!)) + (..should_fail (format upper (text.of_char invalid)) (/.and! upper! lower!))))) + (do [! random.monad] + [expected (random.unicode 1) + invalid (random.unicode 1)] + (_.cover [/.satisfies /.character_does_not_satisfy_predicate] + (and (..should_pass expected (/.satisfies (function.constant true))) + (..should_fail' invalid (/.satisfies (function.constant false)) + /.character_does_not_satisfy_predicate)))) + ..character_classes + ..runs + ))) diff --git a/stdlib/source/test/lux/control/parser/tree.lux b/stdlib/source/test/lux/control/parser/tree.lux index 3f8bebaaf..4d014f42d 100644 --- a/stdlib/source/test/lux/control/parser/tree.lux +++ b/stdlib/source/test/lux/control/parser/tree.lux @@ -55,121 +55,121 @@ Test (<| (_.covering /._) (_.for [/.Parser]) - ($_ _.and - (!cover [/.result /.value] - /.value - (tree.leaf expected)) - (do [! random.monad] - [expected random.nat] - (_.cover [/.result'] - (|> (/.result' /.value - (zipper.zipper (tree.leaf expected))) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))))) - (!cover [/.down] - (do //.monad - [_ /.down] - /.value) - (tree.branch dummy - (list (tree.leaf expected)))) - (!cover [/.up] - (do //.monad - [_ /.down - _ /.up] - /.value) - (tree.branch expected - (list (tree.leaf dummy)))) - (!cover [/.right] - (do //.monad - [_ /.down - _ /.right] - /.value) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected)))) - (!cover [/.left] - (do //.monad - [_ /.down - _ /.right - _ /.left] - /.value) - (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy)))) - (!cover [/.rightmost] - (do //.monad - [_ /.down - _ /.rightmost] - /.value) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf expected)))) - (!cover [/.leftmost] - (do //.monad - [_ /.down - _ /.rightmost - _ /.leftmost] - /.value) - (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy) - (tree.leaf dummy)))) - (!cover/2 [/.next] - (do //.monad - [_ /.next - _ /.next] - /.value) - (tree.branch dummy - (list (tree.branch dummy - (list (tree.leaf expected))))) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected)))) - (!cover/2 [/.previous] - (do //.monad - [_ /.next - _ /.next - _ /.previous] - /.value) - (tree.branch dummy - (list (tree.branch expected - (list (tree.leaf dummy))))) - (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy)))) - (!cover/2 [/.end] - (do //.monad - [_ /.end] - /.value) - (tree.branch dummy - (list (tree.branch dummy - (list (tree.leaf expected))))) - (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected)))) - (!cover/2 [/.start] - (do //.monad - [_ /.end - _ /.start] - /.value) - (tree.branch expected - (list (tree.branch dummy - (list (tree.leaf dummy))))) - (tree.branch expected - (list (tree.leaf dummy) - (tree.leaf dummy)))) - (do [! random.monad] - [dummy random.nat] - (_.cover [/.cannot_move_further] - (`` (and (~~ (template [<parser>] - [(|> (/.result <parser> - (tree.leaf dummy)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.cannot_move_further error))))] + (all _.and + (!cover [/.result /.value] + /.value + (tree.leaf expected)) + (do [! random.monad] + [expected random.nat] + (_.cover [/.result'] + (|> (/.result' /.value + (zipper.zipper (tree.leaf expected))) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))))) + (!cover [/.down] + (do //.monad + [_ /.down] + /.value) + (tree.branch dummy + (list (tree.leaf expected)))) + (!cover [/.up] + (do //.monad + [_ /.down + _ /.up] + /.value) + (tree.branch expected + (list (tree.leaf dummy)))) + (!cover [/.right] + (do //.monad + [_ /.down + _ /.right] + /.value) + (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf expected)))) + (!cover [/.left] + (do //.monad + [_ /.down + _ /.right + _ /.left] + /.value) + (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy)))) + (!cover [/.rightmost] + (do //.monad + [_ /.down + _ /.rightmost] + /.value) + (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf expected)))) + (!cover [/.leftmost] + (do //.monad + [_ /.down + _ /.rightmost + _ /.leftmost] + /.value) + (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy) + (tree.leaf dummy)))) + (!cover/2 [/.next] + (do //.monad + [_ /.next + _ /.next] + /.value) + (tree.branch dummy + (list (tree.branch dummy + (list (tree.leaf expected))))) + (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf expected)))) + (!cover/2 [/.previous] + (do //.monad + [_ /.next + _ /.next + _ /.previous] + /.value) + (tree.branch dummy + (list (tree.branch expected + (list (tree.leaf dummy))))) + (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy)))) + (!cover/2 [/.end] + (do //.monad + [_ /.end] + /.value) + (tree.branch dummy + (list (tree.branch dummy + (list (tree.leaf expected))))) + (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf expected)))) + (!cover/2 [/.start] + (do //.monad + [_ /.end + _ /.start] + /.value) + (tree.branch expected + (list (tree.branch dummy + (list (tree.leaf dummy))))) + (tree.branch expected + (list (tree.leaf dummy) + (tree.leaf dummy)))) + (do [! random.monad] + [dummy random.nat] + (_.cover [/.cannot_move_further] + (`` (and (~~ (template [<parser>] + [(|> (/.result <parser> + (tree.leaf dummy)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.cannot_move_further error))))] - [/.down] [/.up] - [/.right] [/.left] - [/.next] [/.previous] - )))))) - ))) + [/.down] [/.up] + [/.right] [/.left] + [/.next] [/.previous] + )))))) + ))) diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index b006b0018..bbca8a8fe 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -46,34 +46,34 @@ [expected ..primitive dummy (random.only (|>> (type#= expected) not) ..primitive)]) - ($_ _.and - (_.cover [/.exactly] - (and (|> (/.result (/.exactly expected) expected) - (!expect {try.#Success []})) - (|> (/.result (/.exactly expected) dummy) - (!expect (^.multi {try.#Failure error} - (exception.match? /.types_do_not_match error)))))) - (_.cover [/.sub] - (and (|> (/.result (/.sub expected) expected) - (!expect {try.#Success []})) - (|> (/.result (/.sub Any) expected) - (!expect {try.#Success []})) - (|> (/.result (/.sub expected) Nothing) - (!expect {try.#Success []})) - (|> (/.result (/.sub expected) dummy) - (!expect (^.multi {try.#Failure error} - (exception.match? /.types_do_not_match error)))))) - (_.cover [/.super] - (and (|> (/.result (/.super expected) expected) - (!expect {try.#Success []})) - (|> (/.result (/.super expected) Any) - (!expect {try.#Success []})) - (|> (/.result (/.super Nothing) expected) - (!expect {try.#Success []})) - (|> (/.result (/.super expected) dummy) - (!expect (^.multi {try.#Failure error} - (exception.match? /.types_do_not_match error)))))) - ))) + (all _.and + (_.cover [/.exactly] + (and (|> (/.result (/.exactly expected) expected) + (!expect {try.#Success []})) + (|> (/.result (/.exactly expected) dummy) + (!expect (^.multi {try.#Failure error} + (exception.match? /.types_do_not_match error)))))) + (_.cover [/.sub] + (and (|> (/.result (/.sub expected) expected) + (!expect {try.#Success []})) + (|> (/.result (/.sub Any) expected) + (!expect {try.#Success []})) + (|> (/.result (/.sub expected) Nothing) + (!expect {try.#Success []})) + (|> (/.result (/.sub expected) dummy) + (!expect (^.multi {try.#Failure error} + (exception.match? /.types_do_not_match error)))))) + (_.cover [/.super] + (and (|> (/.result (/.super expected) expected) + (!expect {try.#Success []})) + (|> (/.result (/.super expected) Any) + (!expect {try.#Success []})) + (|> (/.result (/.super Nothing) expected) + (!expect {try.#Success []})) + (|> (/.result (/.super expected) dummy) + (!expect (^.multi {try.#Failure error} + (exception.match? /.types_do_not_match error)))))) + ))) (def: test|aggregate Test @@ -81,47 +81,47 @@ [expected_left ..primitive expected_middle ..primitive expected_right ..primitive] - (`` ($_ _.and - (~~ (template [<parser> <exception> <good_constructor> <bad_constructor>] - [(_.cover [<parser> <exception>] - (and (|> (/.result (<parser> ($_ //.and /.any /.any /.any)) - (<good_constructor> (list expected_left expected_middle expected_right))) - (!expect (^.multi {try.#Success [actual_left actual_middle actual_right]} - (and (type#= expected_left actual_left) - (type#= expected_middle actual_middle) - (type#= expected_right actual_right))))) - (|> (/.result (<parser> ($_ //.and /.any /.any /.any)) - (<bad_constructor> (list expected_left expected_middle expected_right))) - (!expect (^.multi {try.#Failure error} - (exception.match? <exception> error))))))] + (`` (all _.and + (~~ (template [<parser> <exception> <good_constructor> <bad_constructor>] + [(_.cover [<parser> <exception>] + (and (|> (/.result (<parser> (all //.and /.any /.any /.any)) + (<good_constructor> (list expected_left expected_middle expected_right))) + (!expect (^.multi {try.#Success [actual_left actual_middle actual_right]} + (and (type#= expected_left actual_left) + (type#= expected_middle actual_middle) + (type#= expected_right actual_right))))) + (|> (/.result (<parser> (all //.and /.any /.any /.any)) + (<bad_constructor> (list expected_left expected_middle expected_right))) + (!expect (^.multi {try.#Failure error} + (exception.match? <exception> error))))))] - [/.variant /.not_variant type.variant type.tuple] - [/.tuple /.not_tuple type.tuple type.variant] - )) + [/.variant /.not_variant type.variant type.tuple] + [/.tuple /.not_tuple type.tuple type.variant] + )) - (_.cover [/.function /.not_function] - (and (|> (/.result (/.function ($_ //.and /.any /.any) /.any) - (type.function (list expected_left expected_middle) expected_right)) - (!expect (^.multi {try.#Success [[actual_left actual_middle] actual_right]} - (and (type#= expected_left actual_left) - (type#= expected_middle actual_middle) - (type#= expected_right actual_right))))) - (|> (/.result (/.function ($_ //.and /.any /.any) /.any) - (type.variant (list expected_left expected_middle expected_right))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_function error)))))) - (_.cover [/.applied /.not_application] - (and (|> (/.result (/.applied ($_ //.and /.any /.any /.any)) - (type.application (list expected_middle expected_right) expected_left)) - (!expect (^.multi {try.#Success [actual_left actual_middle actual_right]} - (and (type#= expected_left actual_left) - (type#= expected_middle actual_middle) - (type#= expected_right actual_right))))) - (|> (/.result (/.applied ($_ //.and /.any /.any /.any)) - (type.variant (list expected_left expected_middle expected_right))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_application error)))))) - )))) + (_.cover [/.function /.not_function] + (and (|> (/.result (/.function (all //.and /.any /.any) /.any) + (type.function (list expected_left expected_middle) expected_right)) + (!expect (^.multi {try.#Success [[actual_left actual_middle] actual_right]} + (and (type#= expected_left actual_left) + (type#= expected_middle actual_middle) + (type#= expected_right actual_right))))) + (|> (/.result (/.function (all //.and /.any /.any) /.any) + (type.variant (list expected_left expected_middle expected_right))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_function error)))))) + (_.cover [/.applied /.not_application] + (and (|> (/.result (/.applied (all //.and /.any /.any /.any)) + (type.application (list expected_middle expected_right) expected_left)) + (!expect (^.multi {try.#Success [actual_left actual_middle actual_right]} + (and (type#= expected_left actual_left) + (type#= expected_middle actual_middle) + (type#= expected_right actual_right))))) + (|> (/.result (/.applied (all //.and /.any /.any /.any)) + (type.variant (list expected_left expected_middle expected_right))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_application error)))))) + )))) (def: test|parameter Test @@ -130,193 +130,193 @@ argument ..primitive not_parameter ..primitive parameter random.nat] - ($_ _.and - (_.cover [/.not_parameter] - (|> (/.result /.parameter not_parameter) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_parameter error))))) - (_.cover [/.unknown_parameter] - (|> (/.result /.parameter {.#Parameter parameter}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unknown_parameter error))))) - (_.cover [/.with_extension] - (|> (/.result (<| (/.with_extension quantification) - (/.with_extension argument) - /.any) - not_parameter) - (!expect (^.multi {try.#Success [quantification##binding argument##binding actual]} - (same? not_parameter actual))))) - (_.cover [/.parameter] - (|> (/.result (<| (/.with_extension quantification) - (/.with_extension argument) - /.parameter) - {.#Parameter 0}) - (!expect {try.#Success [quantification##binding argument##binding _]}))) - (_.cover [/.argument] - (let [argument? (is (-> Nat Nat Bit) - (function (_ @ expected) - (|> (/.result (<| (/.with_extension quantification) - (/.with_extension argument) - (/.with_extension quantification) - (/.with_extension argument) - (do //.monad - [env /.env - _ /.any] - (in (/.argument env @)))) - not_parameter) - (!expect (^.multi {try.#Success [_ _ _ _ actual]} - (n.= expected actual))))))] - (and (argument? 0 2) - (argument? 1 3) - (argument? 2 0)))) - (_.cover [/.wrong_parameter] - (|> (/.result (<| (/.with_extension quantification) - (/.with_extension argument) - (/.this_parameter 1)) - {.#Parameter 0}) - (!expect (^.multi {try.#Failure error} - (exception.match? /.wrong_parameter error))))) - (_.cover [/.this_parameter] - (|> (/.result (<| (/.with_extension quantification) - (/.with_extension argument) - (/.this_parameter 0)) - {.#Parameter 0}) - (!expect {try.#Success [quantification##binding argument##binding _]}))) - ))) + (all _.and + (_.cover [/.not_parameter] + (|> (/.result /.parameter not_parameter) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_parameter error))))) + (_.cover [/.unknown_parameter] + (|> (/.result /.parameter {.#Parameter parameter}) + (!expect (^.multi {try.#Failure error} + (exception.match? /.unknown_parameter error))))) + (_.cover [/.with_extension] + (|> (/.result (<| (/.with_extension quantification) + (/.with_extension argument) + /.any) + not_parameter) + (!expect (^.multi {try.#Success [quantification##binding argument##binding actual]} + (same? not_parameter actual))))) + (_.cover [/.parameter] + (|> (/.result (<| (/.with_extension quantification) + (/.with_extension argument) + /.parameter) + {.#Parameter 0}) + (!expect {try.#Success [quantification##binding argument##binding _]}))) + (_.cover [/.argument] + (let [argument? (is (-> Nat Nat Bit) + (function (_ @ expected) + (|> (/.result (<| (/.with_extension quantification) + (/.with_extension argument) + (/.with_extension quantification) + (/.with_extension argument) + (do //.monad + [env /.env + _ /.any] + (in (/.argument env @)))) + not_parameter) + (!expect (^.multi {try.#Success [_ _ _ _ actual]} + (n.= expected actual))))))] + (and (argument? 0 2) + (argument? 1 3) + (argument? 2 0)))) + (_.cover [/.wrong_parameter] + (|> (/.result (<| (/.with_extension quantification) + (/.with_extension argument) + (/.this_parameter 1)) + {.#Parameter 0}) + (!expect (^.multi {try.#Failure error} + (exception.match? /.wrong_parameter error))))) + (_.cover [/.this_parameter] + (|> (/.result (<| (/.with_extension quantification) + (/.with_extension argument) + (/.this_parameter 0)) + {.#Parameter 0}) + (!expect {try.#Success [quantification##binding argument##binding _]}))) + ))) (def: test|polymorphic Test (do [! random.monad] [not_polymorphic ..primitive expected_inputs (# ! each (|>> (n.% 10) ++) random.nat)] - ($_ _.and - (_.cover [/.not_polymorphic] - (and (|> (/.result (/.polymorphic /.any) - not_polymorphic) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_polymorphic error)))) - (|> (/.result (/.polymorphic /.any) - (type.univ_q 0 not_polymorphic)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_polymorphic error)))))) - (_.cover [/.polymorphic] - (|> (/.result (/.polymorphic /.any) - (type.univ_q expected_inputs not_polymorphic)) - (!expect (^.multi {try.#Success [g!poly actual_inputs bodyT]} - (and (n.= expected_inputs (list.size actual_inputs)) - (same? not_polymorphic bodyT)))))) - ))) + (all _.and + (_.cover [/.not_polymorphic] + (and (|> (/.result (/.polymorphic /.any) + not_polymorphic) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_polymorphic error)))) + (|> (/.result (/.polymorphic /.any) + (type.univ_q 0 not_polymorphic)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_polymorphic error)))))) + (_.cover [/.polymorphic] + (|> (/.result (/.polymorphic /.any) + (type.univ_q expected_inputs not_polymorphic)) + (!expect (^.multi {try.#Success [g!poly actual_inputs bodyT]} + (and (n.= expected_inputs (list.size actual_inputs)) + (same? not_polymorphic bodyT)))))) + ))) (def: test|recursive Test (do random.monad [expected ..primitive] - ($_ _.and - (_.cover [/.recursive] - (|> (.type (Rec @ expected)) - (/.result (/.recursive /.any)) - (!expect (^.multi {try.#Success [@self actual]} - (type#= expected actual))))) - (_.cover [/.recursive_self] - (|> (.type (Rec @ @)) - (/.result (/.recursive /.recursive_self)) - (!expect (^.multi {try.#Success [@expected @actual]} - (same? @expected @actual))))) - (_.cover [/.recursive_call] - (|> (.type (All (self input) (self input))) - (/.result (/.polymorphic /.recursive_call)) - (!expect {try.#Success [@self inputs ???]}))) - (_.cover [/.not_recursive] - (and (|> expected - (/.result (/.recursive /.any)) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_recursive error)))) - (|> expected - (/.result /.recursive_self) - (!expect (^.multi {try.#Failure error} - (exception.match? /.not_recursive error)))))) - ))) + (all _.and + (_.cover [/.recursive] + (|> (.type (Rec @ expected)) + (/.result (/.recursive /.any)) + (!expect (^.multi {try.#Success [@self actual]} + (type#= expected actual))))) + (_.cover [/.recursive_self] + (|> (.type (Rec @ @)) + (/.result (/.recursive /.recursive_self)) + (!expect (^.multi {try.#Success [@expected @actual]} + (same? @expected @actual))))) + (_.cover [/.recursive_call] + (|> (.type (All (self input) (self input))) + (/.result (/.polymorphic /.recursive_call)) + (!expect {try.#Success [@self inputs ???]}))) + (_.cover [/.not_recursive] + (and (|> expected + (/.result (/.recursive /.any)) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_recursive error)))) + (|> expected + (/.result /.recursive_self) + (!expect (^.multi {try.#Failure error} + (exception.match? /.not_recursive error)))))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Parser]) - ($_ _.and - (do [! random.monad] - [expected ..primitive] - (_.cover [/.result /.any] - (|> (/.result /.any expected) - (!expect (^.multi {try.#Success actual} - (type#= expected actual)))))) - (do [! random.monad] - [expected ..primitive] - (_.cover [/.next /.unconsumed_input] - (and (|> (/.result (do //.monad - [actual /.next - _ /.any] - (in actual)) - expected) - (!expect (^.multi {try.#Success actual} - (type#= expected actual)))) - (|> (/.result /.next expected) - (!expect (^.multi {try.#Failure error} - (exception.match? /.unconsumed_input error))))))) - (do [! random.monad] - [expected ..primitive] - (_.cover [/.empty_input] - (`` (and (~~ (template [<parser>] - [(|> (/.result (do //.monad - [_ /.any] - <parser>) - expected) - (!expect (^.multi {try.#Failure error} - (exception.match? /.empty_input error))))] + (all _.and + (do [! random.monad] + [expected ..primitive] + (_.cover [/.result /.any] + (|> (/.result /.any expected) + (!expect (^.multi {try.#Success actual} + (type#= expected actual)))))) + (do [! random.monad] + [expected ..primitive] + (_.cover [/.next /.unconsumed_input] + (and (|> (/.result (do //.monad + [actual /.next + _ /.any] + (in actual)) + expected) + (!expect (^.multi {try.#Success actual} + (type#= expected actual)))) + (|> (/.result /.next expected) + (!expect (^.multi {try.#Failure error} + (exception.match? /.unconsumed_input error))))))) + (do [! random.monad] + [expected ..primitive] + (_.cover [/.empty_input] + (`` (and (~~ (template [<parser>] + [(|> (/.result (do //.monad + [_ /.any] + <parser>) + expected) + (!expect (^.multi {try.#Failure error} + (exception.match? /.empty_input error))))] - [/.any] - [/.next] - )))))) - (do [! random.monad] - [expected ..primitive] - (_.cover [/.Env /.env /.fresh] - (|> (/.result (do //.monad - [env /.env - _ /.any] - (in env)) - expected) - (!expect (^.multi {try.#Success environment} - (same? /.fresh environment)))))) - (do [! random.monad] - [expected ..primitive - dummy (random.only (|>> (type#= expected) not) - ..primitive)] - (_.cover [/.local] - (|> (/.result (do //.monad - [_ /.any] - (/.local (list expected) - /.any)) - dummy) - (!expect (^.multi {try.#Success actual} - (type#= expected actual)))))) - (do [! random.monad] - [expected random.nat] - (_.cover [/.existential /.not_existential] - (|> (/.result /.existential - {.#Ex expected}) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))))) - (do [! random.monad] - [expected_name (random.and (random.ascii/alpha_num 1) - (random.ascii/alpha_num 1)) - expected_type ..primitive] - (_.cover [/.named /.not_named] - (|> (/.result /.named - {.#Named expected_name expected_type}) - (!expect (^.multi {try.#Success [actual_name actual_type]} - (and (symbol#= expected_name actual_name) - (type#= expected_type actual_type))))))) - ..test|aggregate - ..test|matches - ..test|parameter - ..test|polymorphic - ..test|recursive - ))) + [/.any] + [/.next] + )))))) + (do [! random.monad] + [expected ..primitive] + (_.cover [/.Env /.env /.fresh] + (|> (/.result (do //.monad + [env /.env + _ /.any] + (in env)) + expected) + (!expect (^.multi {try.#Success environment} + (same? /.fresh environment)))))) + (do [! random.monad] + [expected ..primitive + dummy (random.only (|>> (type#= expected) not) + ..primitive)] + (_.cover [/.local] + (|> (/.result (do //.monad + [_ /.any] + (/.local (list expected) + /.any)) + dummy) + (!expect (^.multi {try.#Success actual} + (type#= expected actual)))))) + (do [! random.monad] + [expected random.nat] + (_.cover [/.existential /.not_existential] + (|> (/.result /.existential + {.#Ex expected}) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))))) + (do [! random.monad] + [expected_name (random.and (random.ascii/alpha_num 1) + (random.ascii/alpha_num 1)) + expected_type ..primitive] + (_.cover [/.named /.not_named] + (|> (/.result /.named + {.#Named expected_name expected_type}) + (!expect (^.multi {try.#Success [actual_name actual_type]} + (and (symbol#= expected_name actual_name) + (type#= expected_type actual_type))))))) + ..test|aggregate + ..test|matches + ..test|parameter + ..test|polymorphic + ..test|recursive + ))) diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index c3acb66ba..51292dc61 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -60,121 +60,121 @@ Test (<| (_.covering /._) (_.for [/.Parser]) - ($_ _.and - (do [! random.monad] - [expected (random.ascii/alpha 1)] - (_.cover [/.result /.text] - (|> (/.result /.text (list {xml.#Text expected})) - (!expect (^.multi {try.#Success actual} - (text#= expected actual)))))) - (!failure /.unconsumed_inputs - [[(//#in expected) - {xml.#Text expected}]]) - (do [! random.monad] - [expected (# ! each (|>> {xml.#Text}) (random.ascii/alpha 1))] - (_.cover [/.any] - (|> (/.result /.any (list expected)) - (try#each (xml#= expected)) - (try.else false)))) - (do [! random.monad] - [expected ..random_tag] - (_.cover [/.tag] - (|> (/.result (do //.monad - [actual /.tag - _ /.any] - (in (symbol#= expected actual))) - (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) - (!expect {try.#Success #1})))) - (do [! random.monad] - [expected ..random_tag] - (_.cover [/.node] - (|> (/.result (/.node expected (//#in [])) - (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) - (!expect {try.#Success []})))) - (!failure /.wrong_tag - [[(/.node ["" expected] (//#in [])) - {xml.#Node [expected ""] (dictionary.empty symbol.hash) (list)}]]) - (do [! random.monad] - [expected_tag ..random_tag - expected_attribute ..random_attribute - expected_value (random.ascii/alpha 1)] - (_.cover [/.attribute] - (|> (/.result (<| (/.node expected_tag) - (//.after (/.attribute expected_attribute)) - (//#in [])) - (list {xml.#Node expected_tag - (|> (dictionary.empty symbol.hash) - (dictionary.has expected_attribute expected_value)) - (list)})) - (!expect {try.#Success []})))) - (!failure /.unknown_attribute - [[(/.attribute ["" expected]) - {xml.#Node [expected expected] - (|> (dictionary.empty symbol.hash) - (dictionary.has [expected ""] expected)) - (list)}]]) - (!failure /.empty_input - [[(do //.monad - [_ /.any] - /.any) - {xml.#Text expected}] - [(do //.monad - [_ /.any] - /.text) - {xml.#Text expected}] - [(do //.monad - [_ /.any] - (/.node [expected expected] - (//#in []))) - {xml.#Node [expected expected] - (dictionary.empty symbol.hash) - (list)}] - [(do //.monad - [_ /.any] - (/.node [expected expected] - (/.attribute [expected expected]))) - {xml.#Node [expected expected] - (|> (dictionary.empty symbol.hash) - (dictionary.has [expected expected] expected)) - (list)}]]) - (!failure /.unexpected_input - [[/.text - {xml.#Node [expected expected] (dictionary.empty symbol.hash) (list)}] - [(/.node [expected expected] - (//#in [])) - {xml.#Text expected}] - [(/.node [expected expected] - (/.attribute [expected expected])) - {xml.#Text expected}]]) - (do [! random.monad] - [.let [node (is (-> xml.Tag (List xml.XML) xml.XML) - (function (_ tag children) - {xml.#Node tag (dictionary.empty symbol.hash) children}))] - parent ..random_tag - right ..random_tag - wrong (random.only (|>> (symbol#= right) not) - ..random_tag) - .let [parser (<| (/.node parent) - (do //.monad - [_ (<| /.somewhere - (/.node right) - (//#in [])) - _ (//.some /.any)] - (in [])))] - repetitions (# ! each (n.% 10) random.nat)] - ($_ _.and - (_.cover [/.somewhere] - (|> (/.result parser - (list (node parent - (list.together (list (list.repeated repetitions (node wrong (list))) - (list (node right (list))) - (list.repeated repetitions (node wrong (list)))))))) - (!expect {try.#Success []}))) - (_.cover [/.nowhere] - (|> (/.result parser - (list (node parent - (list.repeated repetitions (node wrong (list)))))) - (!expect (^.multi {try.#Failure error} - (exception.match? /.nowhere error))))) - )) - ))) + (all _.and + (do [! random.monad] + [expected (random.ascii/alpha 1)] + (_.cover [/.result /.text] + (|> (/.result /.text (list {xml.#Text expected})) + (!expect (^.multi {try.#Success actual} + (text#= expected actual)))))) + (!failure /.unconsumed_inputs + [[(//#in expected) + {xml.#Text expected}]]) + (do [! random.monad] + [expected (# ! each (|>> {xml.#Text}) (random.ascii/alpha 1))] + (_.cover [/.any] + (|> (/.result /.any (list expected)) + (try#each (xml#= expected)) + (try.else false)))) + (do [! random.monad] + [expected ..random_tag] + (_.cover [/.tag] + (|> (/.result (do //.monad + [actual /.tag + _ /.any] + (in (symbol#= expected actual))) + (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) + (!expect {try.#Success #1})))) + (do [! random.monad] + [expected ..random_tag] + (_.cover [/.node] + (|> (/.result (/.node expected (//#in [])) + (list {xml.#Node expected (dictionary.empty symbol.hash) (list)})) + (!expect {try.#Success []})))) + (!failure /.wrong_tag + [[(/.node ["" expected] (//#in [])) + {xml.#Node [expected ""] (dictionary.empty symbol.hash) (list)}]]) + (do [! random.monad] + [expected_tag ..random_tag + expected_attribute ..random_attribute + expected_value (random.ascii/alpha 1)] + (_.cover [/.attribute] + (|> (/.result (<| (/.node expected_tag) + (//.after (/.attribute expected_attribute)) + (//#in [])) + (list {xml.#Node expected_tag + (|> (dictionary.empty symbol.hash) + (dictionary.has expected_attribute expected_value)) + (list)})) + (!expect {try.#Success []})))) + (!failure /.unknown_attribute + [[(/.attribute ["" expected]) + {xml.#Node [expected expected] + (|> (dictionary.empty symbol.hash) + (dictionary.has [expected ""] expected)) + (list)}]]) + (!failure /.empty_input + [[(do //.monad + [_ /.any] + /.any) + {xml.#Text expected}] + [(do //.monad + [_ /.any] + /.text) + {xml.#Text expected}] + [(do //.monad + [_ /.any] + (/.node [expected expected] + (//#in []))) + {xml.#Node [expected expected] + (dictionary.empty symbol.hash) + (list)}] + [(do //.monad + [_ /.any] + (/.node [expected expected] + (/.attribute [expected expected]))) + {xml.#Node [expected expected] + (|> (dictionary.empty symbol.hash) + (dictionary.has [expected expected] expected)) + (list)}]]) + (!failure /.unexpected_input + [[/.text + {xml.#Node [expected expected] (dictionary.empty symbol.hash) (list)}] + [(/.node [expected expected] + (//#in [])) + {xml.#Text expected}] + [(/.node [expected expected] + (/.attribute [expected expected])) + {xml.#Text expected}]]) + (do [! random.monad] + [.let [node (is (-> xml.Tag (List xml.XML) xml.XML) + (function (_ tag children) + {xml.#Node tag (dictionary.empty symbol.hash) children}))] + parent ..random_tag + right ..random_tag + wrong (random.only (|>> (symbol#= right) not) + ..random_tag) + .let [parser (<| (/.node parent) + (do //.monad + [_ (<| /.somewhere + (/.node right) + (//#in [])) + _ (//.some /.any)] + (in [])))] + repetitions (# ! each (n.% 10) random.nat)] + (all _.and + (_.cover [/.somewhere] + (|> (/.result parser + (list (node parent + (list.together (list (list.repeated repetitions (node wrong (list))) + (list (node right (list))) + (list.repeated repetitions (node wrong (list)))))))) + (!expect {try.#Success []}))) + (_.cover [/.nowhere] + (|> (/.result parser + (list (node parent + (list.repeated repetitions (node wrong (list)))))) + (!expect (^.multi {try.#Failure error} + (exception.match? /.nowhere error))))) + )) + ))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index 0d9782913..04c181a69 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -21,92 +21,92 @@ (<| (_.covering /._) (do [! random.monad] [sample random.nat] - ($_ _.and - (do ! - [another random.nat] - (_.cover [/.new] - (n.= (++ another) - (|> sample - (n.* 3) - (n.+ 4) - (/.new another [++]))))) - (_.cover [/.let] - (n.= (n.+ sample sample) - (|> sample - (/.let x [(n.+ x x)])))) - (_.cover [/.cond] - (text#= (cond (n.= 0 sample) "zero" - (n.even? sample) "even" - "odd") + (all _.and + (do ! + [another random.nat] + (_.cover [/.new] + (n.= (++ another) (|> sample - (/.cond [(n.= 0)] [(/.new "zero" [])] - [n.even?] [(/.new "even" [])] - [(/.new "odd" [])])))) - (_.cover [/.if] - (text#= (if (n.even? sample) - "even" - "odd") - (|> sample - (/.if [n.even?] - [(/.new "even" [])] - [(/.new "odd" [])])))) - (_.cover [/.when] - (n.= (if (n.even? sample) - (n.* 2 sample) - sample) - (|> sample - (/.when [n.even?] - [(n.* 2)])))) - (_.cover [/.while] - (n.= (n.* 10 sample) - (|> sample - (/.while [(n.= (n.* 10 sample)) not] - [(n.+ sample)])))) - (_.cover [/.do] - (n.= (++ (n.+ 4 (n.* 3 sample))) - (|> sample - (/.do identity.monad - [(n.* 3)] - [(n.+ 4)] - [++])))) - (_.cover [/.exec] - (n.= (n.* 10 sample) - (|> sample - (/.exec [%.nat (format "sample = ") debug.log!]) - (n.* 10)))) - (_.cover [/.tuple] - (let [[left middle right] (|> sample - (/.tuple [++] - [--] - [%.nat]))] - (and (n.= (++ sample) left) - (n.= (-- sample) middle) - (text#= (%.nat sample) right)))) - (_.cover [/.case] - (text#= (case (n.% 10 sample) - 0 "zero" - 1 "one" - 2 "two" - 3 "three" - 4 "four" - 5 "five" - 6 "six" - 7 "seven" - 8 "eight" - 9 "nine" - _ "???") - (|> sample - (n.% 10) - (/.case - 0 "zero" - 1 "one" - 2 "two" - 3 "three" - 4 "four" - 5 "five" - 6 "six" - 7 "seven" - 8 "eight" - 9 "nine" - _ "???")))) - )))) + (n.* 3) + (n.+ 4) + (/.new another [++]))))) + (_.cover [/.let] + (n.= (n.+ sample sample) + (|> sample + (/.let x [(n.+ x x)])))) + (_.cover [/.cond] + (text#= (cond (n.= 0 sample) "zero" + (n.even? sample) "even" + "odd") + (|> sample + (/.cond [(n.= 0)] [(/.new "zero" [])] + [n.even?] [(/.new "even" [])] + [(/.new "odd" [])])))) + (_.cover [/.if] + (text#= (if (n.even? sample) + "even" + "odd") + (|> sample + (/.if [n.even?] + [(/.new "even" [])] + [(/.new "odd" [])])))) + (_.cover [/.when] + (n.= (if (n.even? sample) + (n.* 2 sample) + sample) + (|> sample + (/.when [n.even?] + [(n.* 2)])))) + (_.cover [/.while] + (n.= (n.* 10 sample) + (|> sample + (/.while [(n.= (n.* 10 sample)) not] + [(n.+ sample)])))) + (_.cover [/.do] + (n.= (++ (n.+ 4 (n.* 3 sample))) + (|> sample + (/.do identity.monad + [(n.* 3)] + [(n.+ 4)] + [++])))) + (_.cover [/.exec] + (n.= (n.* 10 sample) + (|> sample + (/.exec [%.nat (format "sample = ") debug.log!]) + (n.* 10)))) + (_.cover [/.tuple] + (let [[left middle right] (|> sample + (/.tuple [++] + [--] + [%.nat]))] + (and (n.= (++ sample) left) + (n.= (-- sample) middle) + (text#= (%.nat sample) right)))) + (_.cover [/.case] + (text#= (case (n.% 10 sample) + 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???") + (|> sample + (n.% 10) + (/.case + 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???")))) + )))) diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index c20b2acbe..4df1e2cdd 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -34,27 +34,27 @@ (do random.monad [sample random.nat factor random.nat] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.result /.read] - (n.= sample - (/.result sample /.read))) - (_.cover [/.local] - (n.= (n.* factor sample) - (/.result sample (/.local (n.* factor) /.read)))) - (let [(open "io#[0]") io.monad] - (_.cover [/.with /.lifted] - (|> (is (/.Reader Any (IO Nat)) - (do (/.with io.monad) - [a (/.lifted (io#in sample)) - b (in factor)] - (in (n.* b a)))) - (/.result []) - io.run! - (n.= (n.* factor sample))))))))) + (_.cover [/.result /.read] + (n.= sample + (/.result sample /.read))) + (_.cover [/.local] + (n.= (n.* factor sample) + (/.result sample (/.local (n.* factor) /.read)))) + (let [(open "io#[0]") io.monad] + (_.cover [/.with /.lifted] + (|> (is (/.Reader Any (IO Nat)) + (do (/.with io.monad) + [a (/.lifted (io#in sample)) + b (in factor)] + (in (n.* b a)))) + (/.result []) + io.run! + (n.= (n.* factor sample))))))))) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 3cd12740a..eb5ccd30a 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -82,107 +82,107 @@ (_.for [/.Region]) (do [! random.monad] [expected_clean_ups (|> random.nat (# ! each (|>> (n.% 100) (n.max 1))))] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison (is (All (_ ! r) - (Functor (Region r (thread.Thread !)))) - (/.functor thread.functor)))) - (_.for [/.apply] - ($apply.spec ..injection ..comparison (is (All (_ ! r) - (Apply (Region r (thread.Thread !)))) - (/.apply thread.monad)))) - (_.for [/.monad] - ($monad.spec ..injection ..comparison (is (All (_ ! r) - (Monad (Region r (thread.Thread !)))) - (/.monad thread.monad)))) - - (_.cover [/.run!] - (thread.result - (do [! thread.monad] - [clean_up_counter (thread.box 0) - .let [//@ ! - count_clean_up (function (_ value) - (do ! - [_ (thread.update! ++ clean_up_counter)] - (in {try.#Success []})))] - outcome (/.run! ! - (do [! (/.monad !)] - [_ (monad.each ! (/.acquire! //@ count_clean_up) - (enum.range n.enum 1 expected_clean_ups))] - (in []))) - actual_clean_ups (thread.read! clean_up_counter)] - (in (and (..success? outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) - (_.cover [/.failure] - (thread.result - (do [! thread.monad] - [clean_up_counter (thread.box 0) - .let [//@ ! - count_clean_up (function (_ value) - (do ! - [_ (thread.update! ++ clean_up_counter)] - (in {try.#Success []})))] - outcome (/.run! ! - (do [! (/.monad !)] - [_ (monad.each ! (/.acquire! //@ count_clean_up) - (enum.range n.enum 1 expected_clean_ups)) - _ (/.failure //@ (exception.error ..oops []))] - (in []))) - actual_clean_ups (thread.read! clean_up_counter)] - (in (and (..throws? ..oops outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) - (_.cover [/.except] - (thread.result - (do [! thread.monad] - [clean_up_counter (thread.box 0) - .let [//@ ! - count_clean_up (function (_ value) - (do ! - [_ (thread.update! ++ clean_up_counter)] - (in {try.#Success []})))] - outcome (/.run! ! - (do [! (/.monad !)] - [_ (monad.each ! (/.acquire! //@ count_clean_up) - (enum.range n.enum 1 expected_clean_ups)) - _ (/.except //@ ..oops [])] - (in []))) - actual_clean_ups (thread.read! clean_up_counter)] - (in (and (..throws? ..oops outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) - (_.cover [/.acquire! /.clean_up_error] - (thread.result - (do [! thread.monad] - [clean_up_counter (thread.box 0) - .let [//@ ! - count_clean_up (function (_ value) - (do ! - [_ (thread.update! ++ clean_up_counter)] - (in (is (Try Any) - (exception.except ..oops [])))))] - outcome (/.run! ! - (do [! (/.monad !)] - [_ (monad.each ! (/.acquire! //@ count_clean_up) - (enum.range n.enum 1 expected_clean_ups))] - (in []))) - actual_clean_ups (thread.read! clean_up_counter)] - (in (and (or (n.= 0 expected_clean_ups) - (..throws? /.clean_up_error outcome)) - (n.= expected_clean_ups - actual_clean_ups)))))) - (_.cover [/.lifted] - (thread.result - (do [! thread.monad] - [clean_up_counter (thread.box 0) - .let [//@ !] - outcome (/.run! ! - (do (/.monad !) - [_ (/.lifted //@ (thread.write! expected_clean_ups clean_up_counter))] - (in []))) - actual_clean_ups (thread.read! clean_up_counter)] - (in (and (..success? outcome) - (n.= expected_clean_ups - actual_clean_ups)))))) - )))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison (is (All (_ ! r) + (Functor (Region r (thread.Thread !)))) + (/.functor thread.functor)))) + (_.for [/.apply] + ($apply.spec ..injection ..comparison (is (All (_ ! r) + (Apply (Region r (thread.Thread !)))) + (/.apply thread.monad)))) + (_.for [/.monad] + ($monad.spec ..injection ..comparison (is (All (_ ! r) + (Monad (Region r (thread.Thread !)))) + (/.monad thread.monad)))) + + (_.cover [/.run!] + (thread.result + (do [! thread.monad] + [clean_up_counter (thread.box 0) + .let [//@ ! + count_clean_up (function (_ value) + (do ! + [_ (thread.update! ++ clean_up_counter)] + (in {try.#Success []})))] + outcome (/.run! ! + (do [! (/.monad !)] + [_ (monad.each ! (/.acquire! //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups))] + (in []))) + actual_clean_ups (thread.read! clean_up_counter)] + (in (and (..success? outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) + (_.cover [/.failure] + (thread.result + (do [! thread.monad] + [clean_up_counter (thread.box 0) + .let [//@ ! + count_clean_up (function (_ value) + (do ! + [_ (thread.update! ++ clean_up_counter)] + (in {try.#Success []})))] + outcome (/.run! ! + (do [! (/.monad !)] + [_ (monad.each ! (/.acquire! //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups)) + _ (/.failure //@ (exception.error ..oops []))] + (in []))) + actual_clean_ups (thread.read! clean_up_counter)] + (in (and (..throws? ..oops outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) + (_.cover [/.except] + (thread.result + (do [! thread.monad] + [clean_up_counter (thread.box 0) + .let [//@ ! + count_clean_up (function (_ value) + (do ! + [_ (thread.update! ++ clean_up_counter)] + (in {try.#Success []})))] + outcome (/.run! ! + (do [! (/.monad !)] + [_ (monad.each ! (/.acquire! //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups)) + _ (/.except //@ ..oops [])] + (in []))) + actual_clean_ups (thread.read! clean_up_counter)] + (in (and (..throws? ..oops outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) + (_.cover [/.acquire! /.clean_up_error] + (thread.result + (do [! thread.monad] + [clean_up_counter (thread.box 0) + .let [//@ ! + count_clean_up (function (_ value) + (do ! + [_ (thread.update! ++ clean_up_counter)] + (in (is (Try Any) + (exception.except ..oops [])))))] + outcome (/.run! ! + (do [! (/.monad !)] + [_ (monad.each ! (/.acquire! //@ count_clean_up) + (enum.range n.enum 1 expected_clean_ups))] + (in []))) + actual_clean_ups (thread.read! clean_up_counter)] + (in (and (or (n.= 0 expected_clean_ups) + (..throws? /.clean_up_error outcome)) + (n.= expected_clean_ups + actual_clean_ups)))))) + (_.cover [/.lifted] + (thread.result + (do [! thread.monad] + [clean_up_counter (thread.box 0) + .let [//@ !] + outcome (/.run! ! + (do (/.monad !) + [_ (/.lifted //@ (thread.write! expected_clean_ups clean_up_counter))] + (in []))) + actual_clean_ups (thread.read! clean_up_counter)] + (in (and (..success? outcome) + (n.= expected_clean_ups + actual_clean_ups)))))) + )))) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index d7313ee0e..ecc1f4116 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -112,16 +112,16 @@ [deadline ..deadline message ..message focus ..focus] - ($_ _.and - (_.cover [/.must_remember] - (and (test_failure deadline message {.#None} - (exception.error /.must_remember [deadline deadline message {.#None}])) - (test_failure deadline message {.#Some focus} - (exception.error /.must_remember [deadline deadline message {.#Some focus}])))) - (_.cover [/.remember] - (..test_macro /.remember "")) - (_.cover [/.to_do] - (..test_macro /.to_do "TODO")) - (_.cover [/.fix_me] - (..test_macro /.fix_me "FIXME")) - )))) + (all _.and + (_.cover [/.must_remember] + (and (test_failure deadline message {.#None} + (exception.error /.must_remember [deadline deadline message {.#None}])) + (test_failure deadline message {.#Some focus} + (exception.error /.must_remember [deadline deadline message {.#Some focus}])))) + (_.cover [/.remember] + (..test_macro /.remember "")) + (_.cover [/.to_do] + (..test_macro /.to_do "TODO")) + (_.cover [/.fix_me] + (..test_macro /.fix_me "FIXME")) + )))) diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux index 51f622e3d..31e711954 100644 --- a/stdlib/source/test/lux/control/security/capability.lux +++ b/stdlib/source/test/lux/control/security/capability.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io {"+" IO}] - [concurrency - ["[0]" async]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" io {"+" IO}] + [concurrency + ["[0]" async]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (/.capability: (Can_Shift a) (can_shift [a Nat] [a Nat])) @@ -30,16 +30,16 @@ .let [expected (n.+ shift base)] pass_through (random.ascii 1)] (_.for [/.Capability] - ($_ _.and - (_.cover [/.capability: /.use] - (let [capability (..can_shift (function (_ [no_op raw]) - [no_op (n.+ shift raw)])) - [untouched actual] (/.use capability [pass_through base])] - (and (same? pass_through untouched) - (n.= expected actual)))) - (in (let [capability (..can_io (function (_ _) (io.io expected)))] - (do async.monad - [actual (/.use (/.async capability) [])] - (_.cover' [/.async] - (n.= expected actual))))) - ))))) + (all _.and + (_.cover [/.capability: /.use] + (let [capability (..can_shift (function (_ [no_op raw]) + [no_op (n.+ shift raw)])) + [untouched actual] (/.use capability [pass_through base])] + (and (same? pass_through untouched) + (n.= expected actual)))) + (in (let [capability (..can_io (function (_ _) (io.io expected)))] + (do async.monad + [actual (/.use (/.async capability) [])] + (_.cover' [/.async] + (n.= expected actual))))) + ))))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index cbdc528bd..7067b6f70 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -78,23 +78,23 @@ [.let [policy_0 (policy [])] raw_password (random.ascii 10) .let [password (# policy_0 password raw_password)]] - ($_ _.and - (_.for [/.Privacy /.Private /.Can_Conceal /.Can_Reveal - /.Safety /.Safe /.Can_Trust /.Can_Distrust] - ($_ _.and - (_.for [/.functor] - ($functor.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.functor)) - (_.for [/.apply] - ($apply.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.apply)) - (_.for [/.monad] - ($monad.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.monad)))) + (all _.and + (_.for [/.Privacy /.Private /.Can_Conceal /.Can_Reveal + /.Safety /.Safe /.Can_Trust /.Can_Distrust] + (all _.and + (_.for [/.functor] + ($functor.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.functor)) + (_.for [/.apply] + ($apply.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.apply)) + (_.for [/.monad] + ($monad.spec (..injection (# policy_0 #can_upgrade)) (..comparison (# policy_0 #can_downgrade)) /.monad)))) - (_.cover [/.Privilege /.Context /.with_policy] - (and (# policy_0 = password password) - (n.= (# text.hash hash raw_password) - (# policy_0 hash password)))) - (let [policy_1 (policy []) - delegate (/.delegation (# policy_0 #can_downgrade) (# policy_1 #can_upgrade))] - (_.cover [/.Delegation /.delegation] - (# policy_1 = (delegate password) (delegate password)))) - )))) + (_.cover [/.Privilege /.Context /.with_policy] + (and (# policy_0 = password password) + (n.= (# text.hash hash raw_password) + (# policy_0 hash password)))) + (let [policy_1 (policy []) + delegate (/.delegation (# policy_0 #can_downgrade) (# policy_1 #can_upgrade))] + (_.cover [/.Delegation /.delegation] + (# policy_1 = (delegate password) (delegate password)))) + )))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index f7e7161be..053170ad6 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -31,28 +31,28 @@ (do random.monad [state random.nat value random.nat] - ($_ _.and - (_.cover [/.State /.get] - (with_conditions [state state] - /.get)) - (_.cover [/.put] - (with_conditions [state value] - (do /.monad - [_ (/.put value)] - /.get))) - (_.cover [/.update] - (with_conditions [state (n.* value state)] - (do /.monad - [_ (/.update (n.* value))] - /.get))) - (_.cover [/.use] - (with_conditions [state (++ state)] - (/.use ++))) - (_.cover [/.local] - (with_conditions [state (n.* value state)] - (/.local (n.* value) - /.get))) - ))) + (all _.and + (_.cover [/.State /.get] + (with_conditions [state state] + /.get)) + (_.cover [/.put] + (with_conditions [state value] + (do /.monad + [_ (/.put value)] + /.get))) + (_.cover [/.update] + (with_conditions [state (n.* value state)] + (do /.monad + [_ (/.update (n.* value))] + /.get))) + (_.cover [/.use] + (with_conditions [state (++ state)] + (/.use ++))) + (_.cover [/.local] + (with_conditions [state (n.* value state)] + (/.local (n.* value) + /.get))) + ))) (def: (injection value) (All (_ s) (Injection (State s))) @@ -69,14 +69,14 @@ Test (do random.monad [state random.nat] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection (..comparison state) /.functor)) - (_.for [/.apply] - ($apply.spec ..injection (..comparison state) /.apply)) - (_.for [/.monad] - ($monad.spec ..injection (..comparison state) /.monad)) - ))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection (..comparison state) /.functor)) + (_.for [/.apply] + ($apply.spec ..injection (..comparison state) /.apply)) + (_.for [/.monad] + ($monad.spec ..injection (..comparison state) /.monad)) + ))) (def: loops Test @@ -85,20 +85,20 @@ .let [condition (do /.monad [state /.get] (in (n.< limit state)))]] - ($_ _.and - (_.cover [/.while /.result] - (|> (/.while condition (/.update ++)) - (/.result 0) - (pipe.let [state' output'] - (n.= limit state')))) - (_.cover [/.do_while] - (|> (/.do_while condition (/.update ++)) - (/.result 0) - (pipe.let [state' output'] - (or (n.= limit state') - (and (n.= 0 limit) - (n.= 1 state')))))) - ))) + (all _.and + (_.cover [/.while /.result] + (|> (/.while condition (/.update ++)) + (/.result 0) + (pipe.let [state' output'] + (n.= limit state')))) + (_.cover [/.do_while] + (|> (/.do_while condition (/.update ++)) + (/.result 0) + (pipe.let [state' output'] + (or (n.= limit state') + (and (n.= 0 limit) + (n.= 1 state')))))) + ))) (def: monad_transformer Test @@ -123,8 +123,8 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..basics - ..structures - ..loops - ..monad_transformer))) + (all _.and + ..basics + ..structures + ..loops + ..monad_transformer))) diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index cfff55018..411a0c386 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -32,51 +32,51 @@ [sample random.nat factor random.nat] (<| (_.covering /._) - ($_ _.and - (_.for [/.Thread] - ($_ _.and - (_.cover [/.result] - (n.= sample - (|> sample - (# /.monad in) - /.result))) - (_.cover [/.io] - (n.= sample - (|> sample - (# /.monad in) - /.io - io.run!))) - - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) - )) + (all _.and + (_.for [/.Thread] + (all _.and + (_.cover [/.result] + (n.= sample + (|> sample + (# /.monad in) + /.result))) + (_.cover [/.io] + (n.= sample + (|> sample + (# /.monad in) + /.io + io.run!))) + + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + )) - (_.for [/.Box /.box] - ($_ _.and - (_.cover [/.read!] - (n.= sample - (/.result (is (All (_ !) (Thread ! Nat)) - (do /.monad - [box (/.box sample)] - (/.read! box)))))) + (_.for [/.Box /.box] + (all _.and + (_.cover [/.read!] + (n.= sample + (/.result (is (All (_ !) (Thread ! Nat)) + (do /.monad + [box (/.box sample)] + (/.read! box)))))) - (_.cover [/.write!] - (n.= factor - (/.result (is (All (_ !) (Thread ! Nat)) - (do /.monad - [box (/.box sample) - _ (/.write! factor box)] - (/.read! box)))))) + (_.cover [/.write!] + (n.= factor + (/.result (is (All (_ !) (Thread ! Nat)) + (do /.monad + [box (/.box sample) + _ (/.write! factor box)] + (/.read! box)))))) - (_.cover [/.update!] - (n.= (n.* factor sample) - (/.result (is (All (_ !) (Thread ! Nat)) - (do /.monad - [box (/.box sample) - [old new] (/.update! (n.* factor) box)] - (in new)))))))) - )))) + (_.cover [/.update!] + (n.= (n.* factor sample) + (/.result (is (All (_ !) (Thread ! Nat)) + (do /.monad + [box (/.box sample) + [old new] (/.update! (n.* factor) box)] + (in new)))))))) + )))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index aeb49df81..2919e59f8 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -32,9 +32,9 @@ (def: .public (attempt element) (All (_ a) (-> (Random a) (Random (Try a)))) - ($_ random.or - (random.unicode 1) - element)) + (all random.or + (random.unicode 1) + element)) (def: .public test Test @@ -45,52 +45,52 @@ alternative (|> random.nat (random.only (|>> (n.= expected) not))) error (random.unicode 1) .let [(open "io#[0]") io.monad]]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..attempt random.nat))) - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..attempt random.nat))) + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) - (_.cover [/.trusted] - (n.= expected - (/.trusted {/.#Success expected}))) - (_.cover [/.of_maybe] - (case [(/.of_maybe {.#Some expected}) - (/.of_maybe {.#None})] - [{/.#Success actual} {/.#Failure _}] - (n.= expected actual) + (_.cover [/.trusted] + (n.= expected + (/.trusted {/.#Success expected}))) + (_.cover [/.of_maybe] + (case [(/.of_maybe {.#Some expected}) + (/.of_maybe {.#None})] + [{/.#Success actual} {/.#Failure _}] + (n.= expected actual) - _ - false)) - (_.cover [/.maybe] - (case [(/.maybe {/.#Success expected}) - (/.maybe (is (/.Try Nat) {/.#Failure error}))] - [{.#Some actual} {.#None}] - (n.= expected actual) + _ + false)) + (_.cover [/.maybe] + (case [(/.maybe {/.#Success expected}) + (/.maybe (is (/.Try Nat) {/.#Failure error}))] + [{.#Some actual} {.#None}] + (n.= expected actual) - _ - false)) - (_.cover [/.else] - (and (n.= expected - (/.else alternative {/.#Success expected})) - (n.= alternative - (/.else alternative (is (Try Nat) {/.#Failure error}))))) - (_.cover [/.with /.lifted] - (let [lifted (/.lifted io.monad)] - (|> (do (/.with io.monad) - [a (lifted (io#in expected)) - b (in alternative)] - (in (n.+ a b))) - io.run! - (pipe.case - {/.#Success result} - (n.= (n.+ expected alternative) - result) + _ + false)) + (_.cover [/.else] + (and (n.= expected + (/.else alternative {/.#Success expected})) + (n.= alternative + (/.else alternative (is (Try Nat) {/.#Failure error}))))) + (_.cover [/.with /.lifted] + (let [lifted (/.lifted io.monad)] + (|> (do (/.with io.monad) + [a (lifted (io#in expected)) + b (in alternative)] + (in (n.+ a b))) + io.run! + (pipe.case + {/.#Success result} + (n.= (n.+ expected alternative) + result) - _ - false)))) - ))) + _ + false)))) + ))) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index 2e8989f1f..9842de747 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -39,25 +39,25 @@ right random.nat] (<| (_.covering /._) (_.for [/.Writer]) - ($_ _.and - (_.for [/.functor] - ($functor.spec (..injection text.monoid) ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid))) - (_.for [/.monad] - ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid))) + (all _.and + (_.for [/.functor] + ($functor.spec (..injection text.monoid) ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid))) + (_.for [/.monad] + ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid))) - (_.cover [/.write] - (text#= log - (product.left (/.write log)))) - (_.cover [/.with /.lifted] - (let [lifted (/.lifted text.monoid io.monad) - (open "io#[0]") io.monad] - (|> (do (/.with text.monoid io.monad) - [a (lifted (io#in left)) - b (in right)] - (in (n.+ a b))) - io.run! - product.right - (n.= (n.+ left right))))) - )))) + (_.cover [/.write] + (text#= log + (product.left (/.write log)))) + (_.cover [/.with /.lifted] + (let [lifted (/.lifted text.monoid io.monad) + (open "io#[0]") io.monad] + (|> (do (/.with text.monoid io.monad) + [a (lifted (io#in left)) + b (in right)] + (in (n.+ a b))) + io.run! + product.right + (n.= (n.+ left right))))) + )))) diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 07ec343ce..dc85d5c14 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -31,40 +31,40 @@ (def: format Test - ($_ _.and - /format/binary.test - /format/json.test - /format/tar.test - /format/xml.test - )) + (all _.and + /format/binary.test + /format/json.test + /format/tar.test + /format/xml.test + )) (def: test/0 Test - ($_ _.and - /binary.test - /bit.test - /color.test - /color/named.test)) + (all _.and + /binary.test + /bit.test + /color.test + /color/named.test)) (def: test/1 Test - ($_ _.and - /identity.test)) + (all _.and + /identity.test)) (def: test/2 Test - ($_ _.and - /product.test - /sum.test - /text.test)) + (all _.and + /product.test + /sum.test + /text.test)) (def: .public test Test ... TODO: Inline ASAP - ($_ _.and - (!bundle test/0) - (!bundle test/1) - (!bundle test/2) - (!bundle ..format) - (!bundle /collection.test) - )) + (all _.and + (!bundle test/0) + (!bundle test/1) + (!bundle test/2) + (!bundle ..format) + (!bundle /collection.test) + )) diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index badf40980..d46560ddc 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -91,57 +91,57 @@ .let [gen_idx (|> random.nat (# ! each (n.% size)))] offset gen_idx length (# ! each (n.% (n.- offset size)) random.nat)] - (`` ($_ _.and - (_.for [!.=] - ($equivalence.spec (function (_ left right) - (!.= left right)) - (..random size))) - (_.cover [!.empty] - (!.= (!.empty size) (!.empty size))) - (_.cover [!.size] - (|> (!.empty size) !.size (n.= size))) - (~~ (template [<power> <bytes/?> <has/?>] - [(_.cover [<bytes/?> <has/?>] - (let [bytes (i64.left_shifted <power> 1) - binary (!.empty bytes) - cap (case bytes - 8 (-- 0) - _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --)) - capped_value (i64.and cap value) - - pre (<bytes/?> 0 binary) - _ (<has/?> 0 value binary) - post (<bytes/?> 0 binary)] - (and (n.= 0 pre) - (n.= capped_value post))))] + (`` (all _.and + (_.for [!.=] + ($equivalence.spec (function (_ left right) + (!.= left right)) + (..random size))) + (_.cover [!.empty] + (!.= (!.empty size) (!.empty size))) + (_.cover [!.size] + (|> (!.empty size) !.size (n.= size))) + (~~ (template [<power> <bytes/?> <has/?>] + [(_.cover [<bytes/?> <has/?>] + (let [bytes (i64.left_shifted <power> 1) + binary (!.empty bytes) + cap (case bytes + 8 (-- 0) + _ (|> 1 (i64.left_shifted (n.* 8 bytes)) --)) + capped_value (i64.and cap value) + + pre (<bytes/?> 0 binary) + _ (<has/?> 0 value binary) + post (<bytes/?> 0 binary)] + (and (n.= 0 pre) + (n.= capped_value post))))] - [0 !.bits_8 !.has_8!] - [1 !.bits_16 !.has_16!] - [2 !.bits_32 !.has_32!] - [3 !.bits_64 !.has_64!])) - (_.cover [!.slice] - (let [random_slice (!.slice offset length sample) - idxs (is (List Nat) - (case length - 0 (list) - _ (enum.range n.enum 0 (-- length)))) - reader (function (_ binary idx) - (!.bits_8 idx binary))] - (and (n.= length (!.size random_slice)) - (# (list.equivalence n.equivalence) = - (list#each (|>> (n.+ offset) (reader sample)) idxs) - (list#each (reader random_slice) idxs))))) - (_.cover [!.copy!] - (and (let [it (!.copy! size 0 sample 0 (!.empty size))] - (and (not (same? sample it)) - (!.= sample it))) - (let [sample/0 (!.bits_8 0 sample) - copy (!.copy! 1 0 sample 0 (!.empty 2)) - copy/0 (!.bits_8 0 copy) - copy/1 (!.bits_8 1 copy)] - (and (n.= sample/0 copy/0) - (n.= 0 copy/1))))) - ))))) + [0 !.bits_8 !.has_8!] + [1 !.bits_16 !.has_16!] + [2 !.bits_32 !.has_32!] + [3 !.bits_64 !.has_64!])) + (_.cover [!.slice] + (let [random_slice (!.slice offset length sample) + idxs (is (List Nat) + (case length + 0 (list) + _ (enum.range n.enum 0 (-- length)))) + reader (function (_ binary idx) + (!.bits_8 idx binary))] + (and (n.= length (!.size random_slice)) + (# (list.equivalence n.equivalence) = + (list#each (|>> (n.+ offset) (reader sample)) idxs) + (list#each (reader random_slice) idxs))))) + (_.cover [!.copy!] + (and (let [it (!.copy! size 0 sample 0 (!.empty size))] + (and (not (same? sample it)) + (!.= sample it))) + (let [sample/0 (!.bits_8 0 sample) + copy (!.copy! 1 0 sample 0 (!.empty 2)) + copy/0 (!.bits_8 0 copy) + copy/1 (!.bits_8 1 copy)] + (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))) + ))))) (def: .public test Test @@ -155,89 +155,89 @@ .let [gen_idx (|> random.nat (# ! each (n.% size)))] offset (# ! each (n.max 1) gen_idx) length (# ! each (n.% (n.- offset size)) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random size))) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid (..random size))) - (_.cover [/.mix] - (n.= (# list.mix mix n.+ 0 (..as_list sample)) - (/.mix n.+ 0 sample))) - - (_.cover [/.empty] - (# /.equivalence = - (/.empty size) - (/.empty size))) - (_.cover [/.size] - (|> (/.empty size) /.size (n.= size))) - (_.for [/.index_out_of_bounds] - ($_ _.and - (_.cover [/.bits_8 /.has_8!] - (..binary_io 0 /.bits_8 /.has_8! value)) - (_.cover [/.bits_16 /.has_16!] - (..binary_io 1 /.bits_16 /.has_16! value)) - (_.cover [/.bits_32 /.has_32!] - (..binary_io 2 /.bits_32 /.has_32! value)) - (_.cover [/.bits_64 /.has_64!] - (..binary_io 3 /.bits_64 /.has_64! value)))) - (_.cover [/.slice] - (let [random_slice (try.trusted (/.slice offset length sample)) - idxs (is (List Nat) - (case length - 0 (list) - _ (enum.range n.enum 0 (-- length)))) - reader (function (_ binary idx) - (/.bits_8 idx binary))] - (and (n.= length (/.size random_slice)) - (case [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs) - (monad.each try.monad (reader random_slice) idxs)] - [{try.#Success binary_vals} {try.#Success slice_vals}] - (# (list.equivalence n.equivalence) = binary_vals slice_vals) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random size))) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid (..random size))) + (_.cover [/.mix] + (n.= (# list.mix mix n.+ 0 (..as_list sample)) + (/.mix n.+ 0 sample))) + + (_.cover [/.empty] + (# /.equivalence = + (/.empty size) + (/.empty size))) + (_.cover [/.size] + (|> (/.empty size) /.size (n.= size))) + (_.for [/.index_out_of_bounds] + (all _.and + (_.cover [/.bits_8 /.has_8!] + (..binary_io 0 /.bits_8 /.has_8! value)) + (_.cover [/.bits_16 /.has_16!] + (..binary_io 1 /.bits_16 /.has_16! value)) + (_.cover [/.bits_32 /.has_32!] + (..binary_io 2 /.bits_32 /.has_32! value)) + (_.cover [/.bits_64 /.has_64!] + (..binary_io 3 /.bits_64 /.has_64! value)))) + (_.cover [/.slice] + (let [random_slice (try.trusted (/.slice offset length sample)) + idxs (is (List Nat) + (case length + 0 (list) + _ (enum.range n.enum 0 (-- length)))) + reader (function (_ binary idx) + (/.bits_8 idx binary))] + (and (n.= length (/.size random_slice)) + (case [(monad.each try.monad (|>> (n.+ offset) (reader sample)) idxs) + (monad.each try.monad (reader random_slice) idxs)] + [{try.#Success binary_vals} {try.#Success slice_vals}] + (# (list.equivalence n.equivalence) = binary_vals slice_vals) - _ - #0)))) - (_.cover [/.slice_out_of_bounds] - (and (throws? /.slice_out_of_bounds (/.slice size size sample)) - (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))] - (case offset - 0 (not verdict) - _ verdict)))) - (_.cover [/.after] - (and (# /.equivalence = sample (/.after 0 sample)) - (# /.equivalence = (/.empty 0) (/.after size sample)) - (n.= (n.- offset size) (/.size (/.after offset sample))) - (case (list.reversed (..as_list sample)) - {.#End} - false + _ + #0)))) + (_.cover [/.slice_out_of_bounds] + (and (throws? /.slice_out_of_bounds (/.slice size size sample)) + (let [verdict (throws? /.slice_out_of_bounds (/.slice offset size sample))] + (case offset + 0 (not verdict) + _ verdict)))) + (_.cover [/.after] + (and (# /.equivalence = sample (/.after 0 sample)) + (# /.equivalence = (/.empty 0) (/.after size sample)) + (n.= (n.- offset size) (/.size (/.after offset sample))) + (case (list.reversed (..as_list sample)) + {.#End} + false - {.#Item head tail} - (n.= (list.mix n.+ 0 tail) - (/.mix n.+ 0 (/.after 1 sample)))))) - (_.cover [/.copy!] - (and (case (/.copy! size 0 sample 0 (/.empty size)) - {try.#Success output} - (and (not (same? sample output)) - (# /.equivalence = sample output)) + {.#Item head tail} + (n.= (list.mix n.+ 0 tail) + (/.mix n.+ 0 (/.after 1 sample)))))) + (_.cover [/.copy!] + (and (case (/.copy! size 0 sample 0 (/.empty size)) + {try.#Success output} + (and (not (same? sample output)) + (# /.equivalence = sample output)) - {try.#Failure _} - false) - (succeed - (do try.monad - [sample/0 (/.bits_8 0 sample) - copy (/.copy! 1 0 sample 0 (/.empty 2)) - copy/0 (/.bits_8 0 copy) - copy/1 (/.bits_8 1 copy)] - (in (and (n.= sample/0 copy/0) - (n.= 0 copy/1))))))) - (_.cover [/.cannot_copy] - (and (not (throws? /.cannot_copy - (/.copy! size 0 sample 0 (/.empty size)))) - (throws? /.cannot_copy - (/.copy! (n.+ offset size) 0 sample 0 (/.empty size))) - (throws? /.cannot_copy - (/.copy! size offset sample 0 (/.empty size))) - (throws? /.cannot_copy - (/.copy! size 0 sample offset (/.empty size))))) + {try.#Failure _} + false) + (succeed + (do try.monad + [sample/0 (/.bits_8 0 sample) + copy (/.copy! 1 0 sample 0 (/.empty 2)) + copy/0 (/.bits_8 0 copy) + copy/1 (/.bits_8 1 copy)] + (in (and (n.= sample/0 copy/0) + (n.= 0 copy/1))))))) + (_.cover [/.cannot_copy] + (and (not (throws? /.cannot_copy + (/.copy! size 0 sample 0 (/.empty size)))) + (throws? /.cannot_copy + (/.copy! (n.+ offset size) 0 sample 0 (/.empty size))) + (throws? /.cannot_copy + (/.copy! size offset sample 0 (/.empty size))) + (throws? /.cannot_copy + (/.copy! size 0 sample offset (/.empty size))))) - ..test|unsafe - )))) + ..test|unsafe + )))) diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index 695052aab..fed07f172 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -1,45 +1,45 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" monoid] - ["$[0]" codec]]] - [control - ["[0]" function]] - [math - ["[0]" random]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" monoid] + ["$[0]" codec]]] + [control + ["[0]" function]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) (do random.monad [value random.bit] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.bit)) - (_.for [/.hash] - ($hash.spec /.hash random.bit)) - (_.for [/.disjunction] - ($monoid.spec /.equivalence /.disjunction random.bit)) - (_.for [/.conjunction] - ($monoid.spec /.equivalence /.conjunction random.bit)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.bit)) - - (_.cover [/.no /.yes] - (and (# /.equivalence = false /.no) - (# /.equivalence = true /.yes))) - (_.cover [/.off /.on] - (and (# /.equivalence = false /.off) - (# /.equivalence = true /.on))) - (_.cover [/.complement] - (and (not (# /.equivalence = value ((/.complement function.identity) value))) - (# /.equivalence = value ((/.complement not) value)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.bit)) + (_.for [/.hash] + ($hash.spec /.hash random.bit)) + (_.for [/.disjunction] + ($monoid.spec /.equivalence /.disjunction random.bit)) + (_.for [/.conjunction] + ($monoid.spec /.equivalence /.conjunction random.bit)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.bit)) + + (_.cover [/.no /.yes] + (and (# /.equivalence = false /.no) + (# /.equivalence = true /.yes))) + (_.cover [/.off /.on] + (and (# /.equivalence = false /.off) + (# /.equivalence = true /.on))) + (_.cover [/.complement] + (and (not (# /.equivalence = value ((/.complement function.identity) value))) + (# /.equivalence = value ((/.complement not) value)))) + )))) diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 686ccdacf..42c962e59 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -1,68 +1,68 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}]]] - ["[0]" / "_" - ["[1][0]" array] - ["[1][0]" bits] - ["[1][0]" list] - ["[1][0]" sequence] - ["[1][0]" stream] - ["[1][0]" stack] - ["[1][0]" dictionary - ["[1]/[0]" ordered] - ["[1]/[0]" plist]] - ["[1][0]" queue - ["[1]/[0]" priority]] - ["[1][0]" set - ["[1]/[0]" multi] - ["[1]/[0]" ordered]] - ["[1][0]" tree - ["[1]/[0]" finger] - ["[1]/[0]" zipper]]]) + [library + [lux "*" + ["_" test {"+" Test}]]] + ["[0]" / "_" + ["[1][0]" array] + ["[1][0]" bits] + ["[1][0]" list] + ["[1][0]" sequence] + ["[1][0]" stream] + ["[1][0]" stack] + ["[1][0]" dictionary + ["[1]/[0]" ordered] + ["[1]/[0]" plist]] + ["[1][0]" queue + ["[1]/[0]" priority]] + ["[1][0]" set + ["[1]/[0]" multi] + ["[1]/[0]" ordered]] + ["[1][0]" tree + ["[1]/[0]" finger] + ["[1]/[0]" zipper]]]) (def: dictionary Test - ($_ _.and - /dictionary.test - /dictionary/ordered.test - /dictionary/plist.test - )) + (all _.and + /dictionary.test + /dictionary/ordered.test + /dictionary/plist.test + )) (def: queue Test - ($_ _.and - /queue.test - /queue/priority.test - )) + (all _.and + /queue.test + /queue/priority.test + )) (def: set Test - ($_ _.and - /set.test - /set/multi.test - /set/ordered.test - )) + (all _.and + /set.test + /set/multi.test + /set/ordered.test + )) (def: tree Test - ($_ _.and - /tree.test - /tree/finger.test - /tree/zipper.test - )) + (all _.and + /tree.test + /tree/finger.test + /tree/zipper.test + )) (def: .public test Test - ($_ _.and - /array.test - /bits.test - /list.test - /sequence.test - /stream.test - /stack.test - ..dictionary - ..queue - ..set - ..tree - )) + (all _.and + /array.test + /bits.test + /list.test + /sequence.test + /stream.test + /stack.test + ..dictionary + ..queue + ..set + ..tree + )) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 1008f2422..bbb829d98 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -41,16 +41,16 @@ Test (do [! random.monad] [size ..bounded_size] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) - (_.for [/.mix] - ($mix.spec ..injection /.equivalence /.mix)) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + (_.for [/.mix] + ($mix.spec ..injection /.equivalence /.mix)) + ))) (def: search Test @@ -61,58 +61,58 @@ .let [expected (n.+ base shift)] the_array (random.array size random.nat) evens (random.array size (random.only n.even? random.nat))] - ($_ _.and - (let [(open "/#[0]") /.functor - choose (is (-> Nat (Maybe Text)) - (function (_ value) - (if (n.even? value) - {.#Some (# n.decimal encoded value)} - {.#None})))] - (_.cover [/.one] - (case [(|> evens - (/#each (# n.decimal encoded)) - (/.item 0)) - (/.one choose evens)] - [{.#Some expected} {.#Some actual}] - (text#= expected actual) + (all _.and + (let [(open "/#[0]") /.functor + choose (is (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (_.cover [/.one] + (case [(|> evens + (/#each (# n.decimal encoded)) + (/.item 0)) + (/.one choose evens)] + [{.#Some expected} {.#Some actual}] + (text#= expected actual) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false))) - (_.cover [/.example] - (# (maybe.equivalence n.equivalence) = - (/.example n.even? the_array) - (list.example n.even? (/.list {.#None} the_array)))) - (_.cover [/.example'] - (case [(/.example n.even? the_array) - (/.example' (function (_ idx member) - (n.even? member)) - the_array)] - [{.#Some expected} {.#Some [idx actual]}] - (case (/.item idx the_array) - {.#Some again} - (and (n.= expected actual) - (n.= actual again)) - - {.#None} - false) + _ + false))) + (_.cover [/.example] + (# (maybe.equivalence n.equivalence) = + (/.example n.even? the_array) + (list.example n.even? (/.list {.#None} the_array)))) + (_.cover [/.example'] + (case [(/.example n.even? the_array) + (/.example' (function (_ idx member) + (n.even? member)) + the_array)] + [{.#Some expected} {.#Some [idx actual]}] + (case (/.item idx the_array) + {.#Some again} + (and (n.= expected actual) + (n.= actual again)) + + {.#None} + false) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false)) - (_.cover [/.every?] - (# bit.equivalence = - (list.every? n.even? (/.list {.#None} the_array)) - (/.every? n.even? the_array))) - (_.cover [/.any?] - (# bit.equivalence = - (list.any? n.even? (/.list {.#None} the_array)) - (/.any? n.even? the_array))) - ))) + _ + false)) + (_.cover [/.every?] + (# bit.equivalence = + (list.every? n.even? (/.list {.#None} the_array)) + (/.every? n.even? the_array))) + (_.cover [/.any?] + (# bit.equivalence = + (list.any? n.even? (/.list {.#None} the_array)) + (/.any? n.even? the_array))) + ))) (def: test|unsafe Test @@ -126,183 +126,183 @@ .let [expected (n.+ base shift)] the_array (random.array size random.nat) evens (random.array size (random.only n.even? random.nat))] - (`` ($_ _.and - (_.for [!.=] - ($equivalence.spec (function (_ left right) - (!.= n.equivalence left right)) - (random.array size random.nat))) - (_.for [!.composite] - ($monoid.spec (/.equivalence n.equivalence) - (implementation - (def: identity (!.empty 0)) - (def: (composite left right) - (!.composite left right))) - (random.array size random.nat))) - (_.for [!.each] - ($functor.spec ..injection /.equivalence - (function (_ $ it) - (!.each $ it)))) - (_.for [!.mix] - ($mix.spec ..injection /.equivalence - (is (Mix !.Array) - (function (_ $ init it) - (!.mix (function (_ index item output) - ($ item output)) - init - it))))) - - (_.cover [!.empty !.size] - (n.= size (!.size (is (Array Nat) - (!.empty size))))) - (_.cover [!.type] - (case !.Array - (pattern (<| {.#Named (symbol !.Array)} - {.#UnivQ (list)} - {.#Primitive nominal_type (list {.#Parameter 1})})) - (same? !.type nominal_type) + (`` (all _.and + (_.for [!.=] + ($equivalence.spec (function (_ left right) + (!.= n.equivalence left right)) + (random.array size random.nat))) + (_.for [!.composite] + ($monoid.spec (/.equivalence n.equivalence) + (implementation + (def: identity (!.empty 0)) + (def: (composite left right) + (!.composite left right))) + (random.array size random.nat))) + (_.for [!.each] + ($functor.spec ..injection /.equivalence + (function (_ $ it) + (!.each $ it)))) + (_.for [!.mix] + ($mix.spec ..injection /.equivalence + (is (Mix !.Array) + (function (_ $ init it) + (!.mix (function (_ index item output) + ($ item output)) + init + it))))) + + (_.cover [!.empty !.size] + (n.= size (!.size (is (Array Nat) + (!.empty size))))) + (_.cover [!.type] + (case !.Array + (pattern (<| {.#Named (symbol !.Array)} + {.#UnivQ (list)} + {.#Primitive nominal_type (list {.#Parameter 1})})) + (same? !.type nominal_type) - _ - false)) - (_.cover [!.lacks?] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected))] - (and (not (!.lacks? 0 the_array)) - (!.lacks? 1 the_array)))) - (_.cover [!.item !.has!] - (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected) - (!.item 0) - (n.= expected))) - (_.cover [!.lacks!] - (|> (!.empty 1) - (is (Array Nat)) - (!.has! 0 expected) - (!.lacks! 0) - (!.lacks? 0))) - (_.cover [!.lacks?] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected))] - (and (not (!.lacks? 0 the_array)) - (!.lacks? 1 the_array)))) - (_.cover [!.has?] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 expected))] - (and (!.has? 0 the_array) - (not (!.has? 1 the_array))))) - (_.cover [!.revised!] - (|> (!.empty 1) - (is (Array Nat)) - (!.has! 0 base) - (!.revised! 0 (n.+ shift)) - (!.item 0) - (n.= expected))) - (_.cover [!.upsert!] - (let [the_array (|> (!.empty 2) - (is (Array Nat)) - (!.has! 0 base) - (!.upsert! 0 dummy (n.+ shift)) - (!.upsert! 1 base (n.+ shift)))] - (and (n.= expected (!.item 0 the_array)) - (n.= expected (!.item 1 the_array))))) - (do ! - [occupancy (# ! each (n.% (++ size)) random.nat)] - (_.cover [!.occupancy !.vacancy] - (let [the_array (loop (again [output (is (Array Nat) - (!.empty size)) - idx 0]) - (if (n.< occupancy idx) - (again (!.has! idx expected output) - (++ idx)) - output))] - (and (n.= occupancy (!.occupancy the_array)) - (n.= size (n.+ (!.occupancy the_array) - (!.vacancy the_array))))))) - (do ! - [the_list (random.list size random.nat) - .let [the_array (!.clone the_array) - members (|> the_array (!.list {.#None}) (set.of_list n.hash))] - default (random.only (function (_ value) - (not (or (n.even? value) - (set.member? members value)))) - random.nat)] - (_.cover [!.of_list !.list] - (and (|> the_list !.of_list (!.list {.#None}) - (# (list.equivalence n.equivalence) = the_list)) - (|> the_array (!.list {.#None}) !.of_list - (!.= n.equivalence the_array)) - (exec - (!.only! n.even? the_array) - (list.every? (function (_ value) - (or (n.even? value) - (same? default value))) - (!.list {.#Some default} the_array)))))) - (do ! - [amount (# ! each (n.% (++ size)) random.nat)] - (_.cover [!.copy!] - (let [copy (is (Array Nat) - (!.empty size))] - (exec (!.copy! amount 0 the_array 0 copy) - (# (list.equivalence n.equivalence) = - (list.first amount (!.list {.#None} the_array)) - (!.list {.#None} copy)))))) - (_.cover [!.clone] - (let [clone (!.clone the_array)] - (and (not (same? the_array clone)) - (!.= n.equivalence the_array clone)))) - (let [the_array (!.clone the_array) - evens (|> the_array (!.list {.#None}) (list.only n.even?)) - odds (|> the_array (!.list {.#None}) (list.only n.odd?))] - (_.cover [!.only!] - (exec (!.only! n.even? the_array) - (and (n.= (list.size evens) (!.occupancy the_array)) - (n.= (list.size odds) (!.vacancy the_array)) - (|> the_array - (!.list {.#None}) - (# (list.equivalence n.equivalence) = evens)))))) - (let [choose (is (-> Nat (Maybe Text)) - (function (_ value) - (if (n.even? value) - {.#Some (# n.decimal encoded value)} - {.#None})))] - (_.cover [!.one] - (|> evens - (!.one choose) - (maybe#each (text#= (|> evens - (!.each (# n.decimal encoded)) - (!.item 0)))) - (maybe.else false)))) - (_.cover [!.example] - (# (maybe.equivalence n.equivalence) = - (!.example n.even? the_array) - (list.example n.even? (!.list {.#None} the_array)))) - (_.cover [!.example'] - (case [(!.example n.even? the_array) - (!.example' (function (_ idx member) - (n.even? member)) - the_array)] - [{.#Some expected} {.#Some [idx actual]}] - (and (not (!.lacks? idx the_array)) - (n.= expected actual) - (n.= actual (!.item idx the_array))) + _ + false)) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.item !.has!] + (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected) + (!.item 0) + (n.= expected))) + (_.cover [!.lacks!] + (|> (!.empty 1) + (is (Array Nat)) + (!.has! 0 expected) + (!.lacks! 0) + (!.lacks? 0))) + (_.cover [!.lacks?] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected))] + (and (not (!.lacks? 0 the_array)) + (!.lacks? 1 the_array)))) + (_.cover [!.has?] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 expected))] + (and (!.has? 0 the_array) + (not (!.has? 1 the_array))))) + (_.cover [!.revised!] + (|> (!.empty 1) + (is (Array Nat)) + (!.has! 0 base) + (!.revised! 0 (n.+ shift)) + (!.item 0) + (n.= expected))) + (_.cover [!.upsert!] + (let [the_array (|> (!.empty 2) + (is (Array Nat)) + (!.has! 0 base) + (!.upsert! 0 dummy (n.+ shift)) + (!.upsert! 1 base (n.+ shift)))] + (and (n.= expected (!.item 0 the_array)) + (n.= expected (!.item 1 the_array))))) + (do ! + [occupancy (# ! each (n.% (++ size)) random.nat)] + (_.cover [!.occupancy !.vacancy] + (let [the_array (loop (again [output (is (Array Nat) + (!.empty size)) + idx 0]) + (if (n.< occupancy idx) + (again (!.has! idx expected output) + (++ idx)) + output))] + (and (n.= occupancy (!.occupancy the_array)) + (n.= size (n.+ (!.occupancy the_array) + (!.vacancy the_array))))))) + (do ! + [the_list (random.list size random.nat) + .let [the_array (!.clone the_array) + members (|> the_array (!.list {.#None}) (set.of_list n.hash))] + default (random.only (function (_ value) + (not (or (n.even? value) + (set.member? members value)))) + random.nat)] + (_.cover [!.of_list !.list] + (and (|> the_list !.of_list (!.list {.#None}) + (# (list.equivalence n.equivalence) = the_list)) + (|> the_array (!.list {.#None}) !.of_list + (!.= n.equivalence the_array)) + (exec + (!.only! n.even? the_array) + (list.every? (function (_ value) + (or (n.even? value) + (same? default value))) + (!.list {.#Some default} the_array)))))) + (do ! + [amount (# ! each (n.% (++ size)) random.nat)] + (_.cover [!.copy!] + (let [copy (is (Array Nat) + (!.empty size))] + (exec (!.copy! amount 0 the_array 0 copy) + (# (list.equivalence n.equivalence) = + (list.first amount (!.list {.#None} the_array)) + (!.list {.#None} copy)))))) + (_.cover [!.clone] + (let [clone (!.clone the_array)] + (and (not (same? the_array clone)) + (!.= n.equivalence the_array clone)))) + (let [the_array (!.clone the_array) + evens (|> the_array (!.list {.#None}) (list.only n.even?)) + odds (|> the_array (!.list {.#None}) (list.only n.odd?))] + (_.cover [!.only!] + (exec (!.only! n.even? the_array) + (and (n.= (list.size evens) (!.occupancy the_array)) + (n.= (list.size odds) (!.vacancy the_array)) + (|> the_array + (!.list {.#None}) + (# (list.equivalence n.equivalence) = evens)))))) + (let [choose (is (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (_.cover [!.one] + (|> evens + (!.one choose) + (maybe#each (text#= (|> evens + (!.each (# n.decimal encoded)) + (!.item 0)))) + (maybe.else false)))) + (_.cover [!.example] + (# (maybe.equivalence n.equivalence) = + (!.example n.even? the_array) + (list.example n.even? (!.list {.#None} the_array)))) + (_.cover [!.example'] + (case [(!.example n.even? the_array) + (!.example' (function (_ idx member) + (n.even? member)) + the_array)] + [{.#Some expected} {.#Some [idx actual]}] + (and (not (!.lacks? idx the_array)) + (n.= expected actual) + (n.= actual (!.item idx the_array))) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false)) - (_.cover [!.every?] - (# bit.equivalence = - (list.every? n.even? (!.list {.#None} the_array)) - (!.every? n.even? the_array))) - (_.cover [!.any?] - (# bit.equivalence = - (list.any? n.even? (!.list {.#None} the_array)) - (!.any? n.even? the_array))) - ))))) + _ + false)) + (_.cover [!.every?] + (# bit.equivalence = + (list.every? n.even? (!.list {.#None} the_array)) + (!.every? n.even? the_array))) + (_.cover [!.any?] + (# bit.equivalence = + (list.any? n.even? (!.list {.#None} the_array)) + (!.any? n.even? the_array))) + ))))) (def: .public test Test @@ -315,135 +315,135 @@ dummy (random.only (|>> (n.= base) not) random.nat) .let [expected (n.+ base shift)] the_array (random.array size random.nat)] - ($_ _.and - ..structures - ..search + (all _.and + ..structures + ..search - (_.cover [/.empty /.size] - (n.= size (/.size (is (Array Nat) - (/.empty size))))) - (_.cover [/.type_name] - (case /.Array - (pattern (<| {.#Named (symbol /.Array)} - {.#Named (symbol !.Array)} - {.#UnivQ (list)} - {.#Primitive nominal_type (list {.#Parameter 1})})) - (same? /.type_name nominal_type) + (_.cover [/.empty /.size] + (n.= size (/.size (is (Array Nat) + (/.empty size))))) + (_.cover [/.type_name] + (case /.Array + (pattern (<| {.#Named (symbol /.Array)} + {.#Named (symbol !.Array)} + {.#UnivQ (list)} + {.#Primitive nominal_type (list {.#Parameter 1})})) + (same? /.type_name nominal_type) - _ - false)) - (_.cover [/.item /.has!] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 expected))] - (case [(/.item 0 the_array) - (/.item 1 the_array)] - [{.#Some actual} {.#None}] - (n.= expected actual) + _ + false)) + (_.cover [/.item /.has!] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 expected))] + (case [(/.item 0 the_array) + (/.item 1 the_array)] + [{.#Some actual} {.#None}] + (n.= expected actual) - _ - false))) - (_.cover [/.lacks!] - (let [the_array (|> (/.empty 1) - (is (Array Nat)) - (/.has! 0 expected))] - (case [(/.item 0 the_array) - (/.item 0 (/.lacks! 0 the_array))] - [{.#Some actual} {.#None}] - (n.= expected actual) + _ + false))) + (_.cover [/.lacks!] + (let [the_array (|> (/.empty 1) + (is (Array Nat)) + (/.has! 0 expected))] + (case [(/.item 0 the_array) + (/.item 0 (/.lacks! 0 the_array))] + [{.#Some actual} {.#None}] + (n.= expected actual) - _ - false))) - (_.cover [/.lacks?] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 expected))] - (and (not (/.lacks? 0 the_array)) - (/.lacks? 1 the_array)))) - (_.cover [/.has?] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 expected))] - (and (/.has? 0 the_array) - (not (/.has? 1 the_array))))) - (_.cover [/.revised!] - (let [the_array (|> (/.empty 1) - (is (Array Nat)) - (/.has! 0 base) - (/.revised! 0 (n.+ shift)))] - (case (/.item 0 the_array) - {.#Some actual} - (n.= expected actual) + _ + false))) + (_.cover [/.lacks?] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 expected))] + (and (not (/.lacks? 0 the_array)) + (/.lacks? 1 the_array)))) + (_.cover [/.has?] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 expected))] + (and (/.has? 0 the_array) + (not (/.has? 1 the_array))))) + (_.cover [/.revised!] + (let [the_array (|> (/.empty 1) + (is (Array Nat)) + (/.has! 0 base) + (/.revised! 0 (n.+ shift)))] + (case (/.item 0 the_array) + {.#Some actual} + (n.= expected actual) - _ - false))) - (_.cover [/.upsert!] - (let [the_array (|> (/.empty 2) - (is (Array Nat)) - (/.has! 0 base) - (/.upsert! 0 dummy (n.+ shift)) - (/.upsert! 1 base (n.+ shift)))] - (case [(/.item 0 the_array) - (/.item 1 the_array)] - [{.#Some actual/0} {.#Some actual/1}] - (and (n.= expected actual/0) - (n.= expected actual/1)) + _ + false))) + (_.cover [/.upsert!] + (let [the_array (|> (/.empty 2) + (is (Array Nat)) + (/.has! 0 base) + (/.upsert! 0 dummy (n.+ shift)) + (/.upsert! 1 base (n.+ shift)))] + (case [(/.item 0 the_array) + (/.item 1 the_array)] + [{.#Some actual/0} {.#Some actual/1}] + (and (n.= expected actual/0) + (n.= expected actual/1)) - _ - false))) - (do ! - [occupancy (# ! each (n.% (++ size)) random.nat)] - (_.cover [/.occupancy /.vacancy] - (let [the_array (loop (again [output (is (Array Nat) - (/.empty size)) - idx 0]) - (if (n.< occupancy idx) - (again (/.has! idx expected output) - (++ idx)) - output))] - (and (n.= occupancy (/.occupancy the_array)) - (n.= size (n.+ (/.occupancy the_array) - (/.vacancy the_array))))))) - (do ! - [the_list (random.list size random.nat) - .let [the_array (/.clone the_array) - members (|> the_array (/.list {.#None}) (set.of_list n.hash))] - default (random.only (function (_ value) - (not (or (n.even? value) - (set.member? members value)))) - random.nat)] - (_.cover [/.of_list /.list] - (and (|> the_list /.of_list (/.list {.#None}) - (# (list.equivalence n.equivalence) = the_list)) - (|> the_array (/.list {.#None}) /.of_list - (# (/.equivalence n.equivalence) = the_array)) - (exec - (/.only! n.even? the_array) - (list.every? (function (_ value) - (or (n.even? value) - (same? default value))) - (/.list {.#Some default} the_array)))))) - (do ! - [amount (# ! each (n.% (++ size)) random.nat)] - (_.cover [/.copy!] - (let [copy (is (Array Nat) - (/.empty size))] - (exec (/.copy! amount 0 the_array 0 copy) - (# (list.equivalence n.equivalence) = - (list.first amount (/.list {.#None} the_array)) - (/.list {.#None} copy)))))) - (_.cover [/.clone] - (let [clone (/.clone the_array)] - (and (not (same? the_array clone)) - (# (/.equivalence n.equivalence) = the_array clone)))) - (let [the_array (/.clone the_array) - evens (|> the_array (/.list {.#None}) (list.only n.even?)) - odds (|> the_array (/.list {.#None}) (list.only n.odd?))] - (_.cover [/.only!] - (exec (/.only! n.even? the_array) - (and (n.= (list.size evens) (/.occupancy the_array)) - (n.= (list.size odds) (/.vacancy the_array)) - (|> the_array (/.list {.#None}) (# (list.equivalence n.equivalence) = evens)))))) + _ + false))) + (do ! + [occupancy (# ! each (n.% (++ size)) random.nat)] + (_.cover [/.occupancy /.vacancy] + (let [the_array (loop (again [output (is (Array Nat) + (/.empty size)) + idx 0]) + (if (n.< occupancy idx) + (again (/.has! idx expected output) + (++ idx)) + output))] + (and (n.= occupancy (/.occupancy the_array)) + (n.= size (n.+ (/.occupancy the_array) + (/.vacancy the_array))))))) + (do ! + [the_list (random.list size random.nat) + .let [the_array (/.clone the_array) + members (|> the_array (/.list {.#None}) (set.of_list n.hash))] + default (random.only (function (_ value) + (not (or (n.even? value) + (set.member? members value)))) + random.nat)] + (_.cover [/.of_list /.list] + (and (|> the_list /.of_list (/.list {.#None}) + (# (list.equivalence n.equivalence) = the_list)) + (|> the_array (/.list {.#None}) /.of_list + (# (/.equivalence n.equivalence) = the_array)) + (exec + (/.only! n.even? the_array) + (list.every? (function (_ value) + (or (n.even? value) + (same? default value))) + (/.list {.#Some default} the_array)))))) + (do ! + [amount (# ! each (n.% (++ size)) random.nat)] + (_.cover [/.copy!] + (let [copy (is (Array Nat) + (/.empty size))] + (exec (/.copy! amount 0 the_array 0 copy) + (# (list.equivalence n.equivalence) = + (list.first amount (/.list {.#None} the_array)) + (/.list {.#None} copy)))))) + (_.cover [/.clone] + (let [clone (/.clone the_array)] + (and (not (same? the_array clone)) + (# (/.equivalence n.equivalence) = the_array clone)))) + (let [the_array (/.clone the_array) + evens (|> the_array (/.list {.#None}) (list.only n.even?)) + odds (|> the_array (/.list {.#None}) (list.only n.odd?))] + (_.cover [/.only!] + (exec (/.only! n.even? the_array) + (and (n.= (list.size evens) (/.occupancy the_array)) + (n.= (list.size odds) (/.vacancy the_array)) + (|> the_array (/.list {.#None}) (# (list.equivalence n.equivalence) = evens)))))) - ..test|unsafe - )))) + ..test|unsafe + )))) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 9cc283a9a..8547bcf42 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - ["[0]" predicate] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Bits}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + ["[0]" predicate] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" Bits}]]) (def: (size min max) (-> Nat Nat (Random Nat)) @@ -33,63 +33,63 @@ Test (<| (_.covering /._) (_.for [/.Bits]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [sample ..random] - (_.cover [/.empty? /.size] - (if (/.empty? sample) - (n.= 0 (/.size sample)) - (n.> 0 (/.size sample))))) - (_.cover [/.empty] - (/.empty? /.empty)) - - (do [! random.monad] - [size (# ! each (|>> (n.% 1,000) ++) random.nat) - idx (# ! each (n.% size) random.nat) - sample ..random] - ($_ _.and - (_.cover [/.bit /.one] - (and (|> /.empty (/.bit idx) not) - (|> /.empty (/.one idx) (/.bit idx)))) - (_.cover [/.zero] - (|> /.empty (/.one idx) (/.zero idx) (/.bit idx) not)) - (_.cover [/.flipped] - (and (|> /.empty (/.flipped idx) (/.bit idx)) - (|> /.empty (/.flipped idx) (/.flipped idx) (/.bit idx) not))) - (_.cover [/.Chunk /.capacity /.chunk_size] - (and (n.= 0 (/.capacity /.empty)) - (|> /.empty (/.one idx) /.capacity - (n.- idx) - (predicate.or (n.>= 0) - (n.< /.chunk_size))) - (let [grown (/.flipped idx /.empty)] - (and (n.> 0 (/.capacity grown)) - (same? /.empty (/.flipped idx grown)))))) - (_.cover [/.intersects?] - (and (not (/.intersects? /.empty - /.empty)) - (/.intersects? (/.one idx /.empty) - (/.one idx /.empty)) - (not (/.intersects? (/.one (++ idx) /.empty) - (/.one idx /.empty))) - (not (/.intersects? sample (/.not sample))))) - (_.cover [/.not] - (and (same? /.empty (/.not /.empty)) - (or (same? /.empty sample) - (and (not (# /.equivalence = sample (/.not sample))) - (# /.equivalence = sample (/.not (/.not sample))))))) - (_.cover [/.xor] - (and (same? /.empty (/.xor sample sample)) - (n.= (/.size (/.xor sample (/.not sample))) - (/.capacity sample)))) - (_.cover [/.or] - (and (# /.equivalence = sample (/.or sample sample)) - (n.= (/.size (/.or sample (/.not sample))) - (/.capacity sample)))) - (_.cover [/.and] - (and (# /.equivalence = sample (/.and sample sample)) - (same? /.empty (/.and sample (/.not sample))))) - ))))) + (do random.monad + [sample ..random] + (_.cover [/.empty? /.size] + (if (/.empty? sample) + (n.= 0 (/.size sample)) + (n.> 0 (/.size sample))))) + (_.cover [/.empty] + (/.empty? /.empty)) + + (do [! random.monad] + [size (# ! each (|>> (n.% 1,000) ++) random.nat) + idx (# ! each (n.% size) random.nat) + sample ..random] + (all _.and + (_.cover [/.bit /.one] + (and (|> /.empty (/.bit idx) not) + (|> /.empty (/.one idx) (/.bit idx)))) + (_.cover [/.zero] + (|> /.empty (/.one idx) (/.zero idx) (/.bit idx) not)) + (_.cover [/.flipped] + (and (|> /.empty (/.flipped idx) (/.bit idx)) + (|> /.empty (/.flipped idx) (/.flipped idx) (/.bit idx) not))) + (_.cover [/.Chunk /.capacity /.chunk_size] + (and (n.= 0 (/.capacity /.empty)) + (|> /.empty (/.one idx) /.capacity + (n.- idx) + (predicate.or (n.>= 0) + (n.< /.chunk_size))) + (let [grown (/.flipped idx /.empty)] + (and (n.> 0 (/.capacity grown)) + (same? /.empty (/.flipped idx grown)))))) + (_.cover [/.intersects?] + (and (not (/.intersects? /.empty + /.empty)) + (/.intersects? (/.one idx /.empty) + (/.one idx /.empty)) + (not (/.intersects? (/.one (++ idx) /.empty) + (/.one idx /.empty))) + (not (/.intersects? sample (/.not sample))))) + (_.cover [/.not] + (and (same? /.empty (/.not /.empty)) + (or (same? /.empty sample) + (and (not (# /.equivalence = sample (/.not sample))) + (# /.equivalence = sample (/.not (/.not sample))))))) + (_.cover [/.xor] + (and (same? /.empty (/.xor sample sample)) + (n.= (/.size (/.xor sample (/.not sample))) + (/.capacity sample)))) + (_.cover [/.or] + (and (# /.equivalence = sample (/.or sample sample)) + (n.= (/.size (/.or sample (/.not sample))) + (/.capacity sample)))) + (_.cover [/.and] + (and (# /.equivalence = sample (/.and sample sample)) + (same? /.empty (/.and sample (/.not sample))))) + ))))) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 2f9465e94..9c1121143 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -38,97 +38,97 @@ random.nat) test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size dict))) - - (_.cover [/.empty?] - (case size - 0 (/.empty? dict) - _ (not (/.empty? dict)))) - - (_.cover [/.empty] - (let [sample (/.empty n.hash)] - (and (n.= 0 (/.size sample)) - (/.empty? sample)))) + (all _.and + (_.cover [/.size] + (n.= size (/.size dict))) + + (_.cover [/.empty?] + (case size + 0 (/.empty? dict) + _ (not (/.empty? dict)))) + + (_.cover [/.empty] + (let [sample (/.empty n.hash)] + (and (n.= 0 (/.size sample)) + (/.empty? sample)))) - (do ! - [constant random.nat - .let [hash (is (Hash Nat) - (implementation - (def: equivalence n.equivalence) - (def: (hash _) - constant)))]] - (_.cover [/.key_hash] - (same? hash (/.key_hash (/.empty hash))))) - - (_.cover [/.entries] - (let [entries (/.entries dict) + (do ! + [constant random.nat + .let [hash (is (Hash Nat) + (implementation + (def: equivalence n.equivalence) + (def: (hash _) + constant)))]] + (_.cover [/.key_hash] + (same? hash (/.key_hash (/.empty hash))))) + + (_.cover [/.entries] + (let [entries (/.entries dict) - correct_size! - (n.= (/.size dict) - (list.size entries)) + correct_size! + (n.= (/.size dict) + (list.size entries)) - unique_keys! - (|> entries - (list#each product.left) - (set.of_list n.hash) - set.size - (n.= (/.size dict))) - - correct_pairing! - (list.every? (function (_ [key value]) - (|> dict - (/.value key) - (maybe#each (n.= value)) - (maybe.else false))) - entries)] - (and correct_size! unique_keys! - correct_pairing!))) - (_.cover [/.keys] - (let [keys (/.keys dict) + (|> entries + (list#each product.left) + (set.of_list n.hash) + set.size + (n.= (/.size dict))) - correct_size! - (n.= (/.size dict) - (list.size keys)) + correct_pairing! + (list.every? (function (_ [key value]) + (|> dict + (/.value key) + (maybe#each (n.= value)) + (maybe.else false))) + entries)] + (and correct_size! + unique_keys! + correct_pairing!))) + (_.cover [/.keys] + (let [keys (/.keys dict) - unique_keys! - (|> keys - (set.of_list n.hash) - set.size - (n.= (/.size dict))) + correct_size! + (n.= (/.size dict) + (list.size keys)) - recognized! - (list.every? (/.key? dict) keys)] - (and correct_size! unique_keys! - recognized!))) - (_.cover [/.values] - (n.= (/.size dict) - (list.size (/.values dict)))) + (|> keys + (set.of_list n.hash) + set.size + (n.= (/.size dict))) + + recognized! + (list.every? (/.key? dict) keys)] + (and correct_size! + unique_keys! + recognized!))) + (_.cover [/.values] + (n.= (/.size dict) + (list.size (/.values dict)))) - (_.cover [/.composite] - (let [merging_with_oneself (let [(open "[0]") (/.equivalence n.equivalence)] - (= dict (/.composite dict dict))) - overwritting_keys (let [dict' (|> dict /.entries - (list#each (function (_ [k v]) [k (++ v)])) - (/.of_list n.hash)) - (open "[0]") (/.equivalence n.equivalence)] - (= dict' (/.composite dict' dict)))] - (and merging_with_oneself - overwritting_keys))) - - (_.cover [/.composite_with] - (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) - (list.zipped_2 (/.values dict) - (/.values (/.composite_with n.+ dict dict))))) + (_.cover [/.composite] + (let [merging_with_oneself (let [(open "[0]") (/.equivalence n.equivalence)] + (= dict (/.composite dict dict))) + overwritting_keys (let [dict' (|> dict /.entries + (list#each (function (_ [k v]) [k (++ v)])) + (/.of_list n.hash)) + (open "[0]") (/.equivalence n.equivalence)] + (= dict' (/.composite dict' dict)))] + (and merging_with_oneself + overwritting_keys))) + + (_.cover [/.composite_with] + (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) + (list.zipped_2 (/.values dict) + (/.values (/.composite_with n.+ dict dict))))) - (_.cover [/.of_list] - (let [(open "[0]") (/.equivalence n.equivalence)] - (and (= dict dict) - (|> dict /.entries (/.of_list n.hash) (= dict))))) - ))) + (_.cover [/.of_list] + (let [(open "[0]") (/.equivalence n.equivalence)] + (and (= dict dict) + (|> dict /.entries (/.of_list n.hash) (= dict))))) + ))) (def: for_entries Test @@ -140,113 +140,113 @@ random.nat) test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] - ($_ _.and - (_.cover [/.key?] - (list.every? (/.key? dict) - (/.keys dict))) - - (_.cover [/.value] - (and (list.every? (function (_ key) (case (/.value key dict) - {.#Some _} true - _ false)) - (/.keys dict)) - (case (/.value non_key dict) - {.#Some _} false - _ true))) - - (_.cover [/.has] - (and (n.= (++ (/.size dict)) - (/.size (/.has non_key test_val dict))) - (case (/.value non_key (/.has non_key test_val dict)) - {.#Some v} (n.= test_val v) - _ true))) - - (_.cover [/.has' /.key_already_exists] - (let [can_put_new_keys! - (case (/.has' non_key test_val dict) - {try.#Success dict} - (case (/.value non_key dict) - {.#Some v} (n.= test_val v) - _ true) + (all _.and + (_.cover [/.key?] + (list.every? (/.key? dict) + (/.keys dict))) + + (_.cover [/.value] + (and (list.every? (function (_ key) (case (/.value key dict) + {.#Some _} true + _ false)) + (/.keys dict)) + (case (/.value non_key dict) + {.#Some _} false + _ true))) + + (_.cover [/.has] + (and (n.= (++ (/.size dict)) + (/.size (/.has non_key test_val dict))) + (case (/.value non_key (/.has non_key test_val dict)) + {.#Some v} (n.= test_val v) + _ true))) + + (_.cover [/.has' /.key_already_exists] + (let [can_put_new_keys! + (case (/.has' non_key test_val dict) + {try.#Success dict} + (case (/.value non_key dict) + {.#Some v} (n.= test_val v) + _ true) - {try.#Failure _} - false) - - cannot_put_old_keys! - (or (n.= 0 size) - (let [first_key (|> dict /.keys list.head maybe.trusted)] - (case (/.has' first_key test_val dict) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.key_already_exists error))))] - (and can_put_new_keys! - cannot_put_old_keys!))) - - (_.cover [/.lacks] - (and (let [base (/.has non_key test_val dict)] - (and (/.key? base non_key) - (not (/.key? (/.lacks non_key base) non_key)))) - (case (list.head (/.keys dict)) - {.#None} - true + {try.#Failure _} + false) - {.#Some known_key} - (n.= (-- (/.size dict)) - (/.size (/.lacks known_key dict)))))) - - (_.cover [/.revised] - (let [base (/.has non_key test_val dict) - updt (/.revised non_key ++ base)] - (case [(/.value non_key base) (/.value non_key updt)] - [{.#Some x} {.#Some y}] - (n.= (++ x) y) - - _ - false))) - - (_.cover [/.revised'] - (let [can_upsert_new_key! - (case (/.value non_key (/.revised' non_key test_val ++ dict)) - {.#Some inserted} - (n.= (++ test_val) inserted) - - {.#None} - false) - - can_upsert_old_key! - (case (list.head (/.entries dict)) + cannot_put_old_keys! + (or (n.= 0 size) + (let [first_key (|> dict /.keys list.head maybe.trusted)] + (case (/.has' first_key test_val dict) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.key_already_exists error))))] + (and can_put_new_keys! + cannot_put_old_keys!))) + + (_.cover [/.lacks] + (and (let [base (/.has non_key test_val dict)] + (and (/.key? base non_key) + (not (/.key? (/.lacks non_key base) non_key)))) + (case (list.head (/.keys dict)) {.#None} true - {.#Some [known_key known_value]} - (case (/.value known_key (/.revised' known_key test_val ++ dict)) - {.#Some updated} - (n.= (++ known_value) updated) + {.#Some known_key} + (n.= (-- (/.size dict)) + (/.size (/.lacks known_key dict)))))) + + (_.cover [/.revised] + (let [base (/.has non_key test_val dict) + updt (/.revised non_key ++ base)] + (case [(/.value non_key base) (/.value non_key updt)] + [{.#Some x} {.#Some y}] + (n.= (++ x) y) + + _ + false))) + + (_.cover [/.revised'] + (let [can_upsert_new_key! + (case (/.value non_key (/.revised' non_key test_val ++ dict)) + {.#Some inserted} + (n.= (++ test_val) inserted) + + {.#None} + false) + + can_upsert_old_key! + (case (list.head (/.entries dict)) + {.#None} + true + + {.#Some [known_key known_value]} + (case (/.value known_key (/.revised' known_key test_val ++ dict)) + {.#Some updated} + (n.= (++ known_value) updated) - {.#None} - false))] - (and can_upsert_new_key! - can_upsert_old_key!))) + {.#None} + false))] + (and can_upsert_new_key! + can_upsert_old_key!))) - (_.cover [/.sub] - (|> dict - (/.has non_key test_val) - (/.sub (list non_key)) - /.size - (n.= 1))) - - (_.cover [/.re_bound] - (or (n.= 0 size) - (let [first_key (|> dict /.keys list.head maybe.trusted) - rebound (/.re_bound first_key non_key dict)] - (and (n.= (/.size dict) (/.size rebound)) - (/.key? rebound non_key) - (not (/.key? rebound first_key)) - (n.= (maybe.trusted (/.value first_key dict)) - (maybe.trusted (/.value non_key rebound))))))) - ))) + (_.cover [/.sub] + (|> dict + (/.has non_key test_val) + (/.sub (list non_key)) + /.size + (n.= 1))) + + (_.cover [/.re_bound] + (or (n.= 0 size) + (let [first_key (|> dict /.keys list.head maybe.trusted) + rebound (/.re_bound first_key non_key dict)] + (and (n.= (/.size dict) (/.size rebound)) + (/.key? rebound non_key) + (not (/.key? rebound first_key)) + (n.= (maybe.trusted (/.value first_key dict)) + (maybe.trusted (/.value non_key rebound))))))) + ))) (def: .public test Test @@ -260,14 +260,14 @@ random.nat) test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) - (random.dictionary n.hash size random.nat random.nat))) - - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (random.dictionary n.hash size random.nat random.nat))) + + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) - ..for_dictionaries - ..for_entries - )))) + ..for_dictionaries + ..for_entries + )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 471565d52..6dd9ce772 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -62,76 +62,76 @@ (and (n.= kr ks) (n.= vr vs))))) (open "/#[0]") (/.equivalence n.equivalence)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) - - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? (/.empty n.order))) - (_.cover [/.min] - (case [(/.min sample) (list.head sorted_values)] - [{.#None} {.#None}] - #1 + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? (/.empty n.order))) + (_.cover [/.min] + (case [(/.min sample) (list.head sorted_values)] + [{.#None} {.#None}] + #1 - [{.#Some reference} {.#Some sample}] - (n.= reference sample) + [{.#Some reference} {.#Some sample}] + (n.= reference sample) - _ - #0)) - (_.cover [/.max] - (case [(/.max sample) (list.last sorted_values)] - [{.#None} {.#None}] - #1 + _ + #0)) + (_.cover [/.max] + (case [(/.max sample) (list.last sorted_values)] + [{.#None} {.#None}] + #1 - [{.#Some reference} {.#Some sample}] - (n.= reference sample) + [{.#Some reference} {.#Some sample}] + (n.= reference sample) - _ - #0)) - (_.cover [/.entries] - (list#= (/.entries sample) - sorted_pairs)) - (_.cover [/.keys /.values] - (list#= (/.entries sample) - (list.zipped_2 (/.keys sample) (/.values sample)))) - (_.cover [/.of_list] - (|> sample - /.entries (/.of_list n.order) - (/#= sample))) - (_.cover [/.key?] - (and (list.every? (/.key? sample) - (/.keys sample)) - (not (/.key? sample extra_key)))) - (_.cover [/.has] - (and (not (/.key? sample extra_key)) - (let [sample+ (/.has extra_key extra_value sample)] - (and (/.key? sample+ extra_key) - (n.= (++ (/.size sample)) - (/.size sample+)))))) - (_.cover [/.value] - (let [sample+ (/.has extra_key extra_value sample)] - (case [(/.value extra_key sample) - (/.value extra_key sample+)] - [{.#None} {.#Some actual}] - (n.= extra_value actual) - - _ - false))) - (_.cover [/.lacks] - (|> sample - (/.has extra_key extra_value) - (/.lacks extra_key) - (/#= sample))) - (_.cover [/.revised] - (|> sample - (/.has extra_key extra_value) - (/.revised extra_key (n.+ shift)) - (/.value extra_key) - (maybe#each (n.= (n.+ shift extra_value))) - (maybe.else false))) - )))) + _ + #0)) + (_.cover [/.entries] + (list#= (/.entries sample) + sorted_pairs)) + (_.cover [/.keys /.values] + (list#= (/.entries sample) + (list.zipped_2 (/.keys sample) (/.values sample)))) + (_.cover [/.of_list] + (|> sample + /.entries (/.of_list n.order) + (/#= sample))) + (_.cover [/.key?] + (and (list.every? (/.key? sample) + (/.keys sample)) + (not (/.key? sample extra_key)))) + (_.cover [/.has] + (and (not (/.key? sample extra_key)) + (let [sample+ (/.has extra_key extra_value sample)] + (and (/.key? sample+ extra_key) + (n.= (++ (/.size sample)) + (/.size sample+)))))) + (_.cover [/.value] + (let [sample+ (/.has extra_key extra_value sample)] + (case [(/.value extra_key sample) + (/.value extra_key sample+)] + [{.#None} {.#Some actual}] + (n.= extra_value actual) + + _ + false))) + (_.cover [/.lacks] + (|> sample + (/.has extra_key extra_value) + (/.lacks extra_key) + (/#= sample))) + (_.cover [/.revised] + (|> sample + (/.has extra_key extra_value) + (/.revised extra_key (n.+ shift)) + (/.value extra_key) + (maybe#each (n.= (n.+ shift extra_value))) + (maybe.else false))) + )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index fa4e221cd..2e5fb1810 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -44,54 +44,54 @@ gen_key) extra_value random.nat shift random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) - (..random size gen_key random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) - /.monoid - (..random 10 (random.ascii/lower 1) random.nat))) - - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.keys /.values] - (# (/.equivalence n.equivalence) = - sample - (list.zipped_2 (/.keys sample) - (/.values sample)))) - (_.cover [/.contains?] - (and (list.every? (function (_ key) - (/.contains? key sample)) - (/.keys sample)) - (not (/.contains? extra_key sample)))) - (_.cover [/.has] - (let [sample+ (/.has extra_key extra_value sample)] - (and (not (/.contains? extra_key sample)) - (/.contains? extra_key sample+) - (n.= (++ (/.size sample)) - (/.size sample+))))) - (_.cover [/.value] - (|> sample - (/.has extra_key extra_value) - (/.value extra_key) - (maybe#each (n.= extra_value)) - (maybe.else false))) - (_.cover [/.revised] - (|> sample - (/.has extra_key extra_value) - (/.revised extra_key (n.+ shift)) - (/.value extra_key) - (maybe#each (n.= (n.+ shift extra_value))) - (maybe.else false))) - (_.cover [/.lacks] - (|> sample - (/.has extra_key extra_value) - (/.lacks extra_key) - (# (/.equivalence n.equivalence) = sample))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) + (..random size gen_key random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) + /.monoid + (..random 10 (random.ascii/lower 1) random.nat))) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.keys /.values] + (# (/.equivalence n.equivalence) = + sample + (list.zipped_2 (/.keys sample) + (/.values sample)))) + (_.cover [/.contains?] + (and (list.every? (function (_ key) + (/.contains? key sample)) + (/.keys sample)) + (not (/.contains? extra_key sample)))) + (_.cover [/.has] + (let [sample+ (/.has extra_key extra_value sample)] + (and (not (/.contains? extra_key sample)) + (/.contains? extra_key sample+) + (n.= (++ (/.size sample)) + (/.size sample+))))) + (_.cover [/.value] + (|> sample + (/.has extra_key extra_value) + (/.value extra_key) + (maybe#each (n.= extra_value)) + (maybe.else false))) + (_.cover [/.revised] + (|> sample + (/.has extra_key extra_value) + (/.revised extra_key (n.+ shift)) + (/.value extra_key) + (maybe#each (n.= (n.+ shift extra_value))) + (maybe.else false))) + (_.cover [/.lacks] + (|> sample + (/.has extra_key extra_value) + (/.lacks extra_key) + (# (/.equivalence n.equivalence) = sample))) + )))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 5fe98b03c..379c31458 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -47,42 +47,42 @@ (def: signatures Test - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) ..random)) - (_.for [/.hash] - (|> random.nat - (# random.monad each (|>> list)) - ($hash.spec (/.hash n.hash)))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) - (_.for [/.mix] - ($mix.spec /#in /.equivalence /.mix)) - (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /#in /.equivalence /.monad)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) ..random)) + (_.for [/.hash] + (|> random.nat + (# random.monad each (|>> list)) + ($hash.spec (/.hash n.hash)))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) + (_.for [/.mix] + ($mix.spec /#in /.equivalence /.mix)) + (_.for [/.functor] + ($functor.spec /#in /.equivalence /.functor)) + (_.for [/.apply] + ($apply.spec /#in /.equivalence /.apply)) + (_.for [/.monad] + ($monad.spec /#in /.equivalence /.monad)) - (do [! random.monad] - [parameter random.nat - subject random.nat] - (let [lifted (/.lifted io.monad) - (open "io#[0]") io.monad - expected (n.+ parameter subject)] - (_.cover [/.with /.lifted] - (|> (io.run! (do (/.with io.monad) - [a (lifted (io#in parameter)) - b (in subject)] - (in (n.+ a b)))) - (pipe.case - (pattern (list actual)) - (n.= expected actual) - - _ - false))))) - )) + (do [! random.monad] + [parameter random.nat + subject random.nat] + (let [lifted (/.lifted io.monad) + (open "io#[0]") io.monad + expected (n.+ parameter subject)] + (_.cover [/.with /.lifted] + (|> (io.run! (do (/.with io.monad) + [a (lifted (io#in parameter)) + b (in subject)] + (in (n.+ a b)))) + (pipe.case + (pattern (list actual)) + (n.= expected actual) + + _ + false))))) + )) (def: whole Test @@ -90,43 +90,43 @@ [size ..bounded_size .let [(open "/#[0]") (/.equivalence n.equivalence)] sample (# ! each set.list (random.set n.hash size random.nat))] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (# bit.equivalence = - (/.empty? sample) - (n.= 0 (/.size sample)))) - (_.cover [/.repeated] - (n.= size (/.size (/.repeated size [])))) - (_.cover [/.reversed] - (or (n.< 2 (/.size sample)) - (let [not_same! - (not (/#= sample - (/.reversed sample))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (# bit.equivalence = + (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.repeated] + (n.= size (/.size (/.repeated size [])))) + (_.cover [/.reversed] + (or (n.< 2 (/.size sample)) + (let [not_same! + (not (/#= sample + (/.reversed sample))) - self_symmetry! - (/#= sample - (/.reversed (/.reversed sample)))] - (and not_same! - self_symmetry!)))) - (_.cover [/.every? /.any?] - (if (/.every? n.even? sample) - (not (/.any? (bit.complement n.even?) sample)) - (/.any? (bit.complement n.even?) sample))) - (_.cover [/.sorted] - (let [<<< n.< - - size_preservation! - (n.= (/.size sample) - (/.size (/.sorted <<< sample))) - - symmetry! - (/#= (/.sorted <<< sample) - (/.reversed (/.sorted (function.flipped <<<) sample)))] - (and size_preservation! - symmetry!))) - ))) + self_symmetry! + (/#= sample + (/.reversed (/.reversed sample)))] + (and not_same! + self_symmetry!)))) + (_.cover [/.every? /.any?] + (if (/.every? n.even? sample) + (not (/.any? (bit.complement n.even?) sample)) + (/.any? (bit.complement n.even?) sample))) + (_.cover [/.sorted] + (let [<<< n.< + + size_preservation! + (n.= (/.size sample) + (/.size (/.sorted <<< sample))) + + symmetry! + (/#= (/.sorted <<< sample) + (/.reversed (/.sorted (function.flipped <<<) sample)))] + (and size_preservation! + symmetry!))) + ))) (def: indices Test @@ -135,58 +135,58 @@ (do [! random.monad] [sample ..random .let [size (/.size sample)]] - ($_ _.and - (_.cover [/.indices] - (let [indices (/.indices size) - - expected_amount! - (n.= size (/.size indices)) + (all _.and + (_.cover [/.indices] + (let [indices (/.indices size) - already_sorted! - (/#= indices - (/.sorted n.< indices)) + expected_amount! + (n.= size (/.size indices)) - expected_numbers! - (/.every? (n.= (-- size)) - (/.zipped_with_2 n.+ - indices - (/.sorted n.> indices)))] - (and expected_amount! already_sorted! - expected_numbers!))) - (_.cover [/.enumeration] - (let [enumeration (/.enumeration sample) + (/#= indices + (/.sorted n.< indices)) + + expected_numbers! + (/.every? (n.= (-- size)) + (/.zipped_with_2 n.+ + indices + (/.sorted n.> indices)))] + (and expected_amount! + already_sorted! + expected_numbers!))) + (_.cover [/.enumeration] + (let [enumeration (/.enumeration sample) - has_correct_indices! - (/#= (/.indices (/.size enumeration)) - (/#each product.left enumeration)) + has_correct_indices! + (/#= (/.indices (/.size enumeration)) + (/#each product.left enumeration)) - has_correct_values! - (/#= sample - (/#each product.right enumeration))] - (and has_correct_indices! - has_correct_values!))) - (_.cover [/.item] - (/.every? (function (_ [index expected]) - (case (/.item index sample) - {.#Some actual} - (n.= expected actual) - - {.#None} - false)) - (/.enumeration sample))) - (do ! - [index (case size - 0 random.nat - _ (# ! each (n.% size) random.nat)) - .let [changed? (/#= sample (/.revised index ++ sample)) - same? (/#= sample (/.revised size ++ sample))]] - (_.cover [/.revised] - (case size - 0 (and changed? - same?) - _ (not changed?)))) - )))) + has_correct_values! + (/#= sample + (/#each product.right enumeration))] + (and has_correct_indices! + has_correct_values!))) + (_.cover [/.item] + (/.every? (function (_ [index expected]) + (case (/.item index sample) + {.#Some actual} + (n.= expected actual) + + {.#None} + false)) + (/.enumeration sample))) + (do ! + [index (case size + 0 random.nat + _ (# ! each (n.% size) random.nat)) + .let [changed? (/#= sample (/.revised index ++ sample)) + same? (/#= sample (/.revised size ++ sample))]] + (_.cover [/.revised] + (case size + 0 (and changed? + same?) + _ (not changed?)))) + )))) (def: slice Test @@ -198,82 +198,82 @@ .let [size (/.size sample)] idx (# ! each (n.% size) random.nat) sub_size (# ! each (|>> (n.% size) ++) random.nat)] - ($_ _.and - (_.cover [/.only] - (let [positives (/.only n.even? sample) - negatives (/.only (bit.complement n.even?) sample)] - (and (/.every? n.even? positives) - (not (/.any? n.even? negatives)) + (all _.and + (_.cover [/.only] + (let [positives (/.only n.even? sample) + negatives (/.only (bit.complement n.even?) sample)] + (and (/.every? n.even? positives) + (not (/.any? n.even? negatives)) - (n.= (/.size sample) - (n.+ (/.size positives) - (/.size negatives)))))) - (_.cover [/.partition] - (let [[positives negatives] (/.partition n.even? sample)] - (and (/#= (/.only n.even? sample) - positives) - (/#= (/.only (bit.complement n.even?) sample) - negatives)))) - (_.cover [/.split_at] - (let [[left right] (/.split_at idx sample)] - (/#= sample - (/#composite left right)))) - (_.cover [/.split_when] - (let [[left right] (/.split_when n.even? sample)] - (/#= sample - (/#composite left right)))) - (_.cover [/.first /.after] - (/#= sample - (/#composite (/.first idx sample) - (/.after idx sample)))) - (_.cover [/.while /.until] - (/#= sample - (/#composite (/.while n.even? sample) - (/.until n.even? sample)))) - (_.cover [/.sub] - (let [subs (/.sub sub_size sample)] - (and (/.every? (|>> /.size (n.<= sub_size)) subs) - (/#= sample - (/.together subs))))) - )))) + (n.= (/.size sample) + (n.+ (/.size positives) + (/.size negatives)))))) + (_.cover [/.partition] + (let [[positives negatives] (/.partition n.even? sample)] + (and (/#= (/.only n.even? sample) + positives) + (/#= (/.only (bit.complement n.even?) sample) + negatives)))) + (_.cover [/.split_at] + (let [[left right] (/.split_at idx sample)] + (/#= sample + (/#composite left right)))) + (_.cover [/.split_when] + (let [[left right] (/.split_when n.even? sample)] + (/#= sample + (/#composite left right)))) + (_.cover [/.first /.after] + (/#= sample + (/#composite (/.first idx sample) + (/.after idx sample)))) + (_.cover [/.while /.until] + (/#= sample + (/#composite (/.while n.even? sample) + (/.until n.even? sample)))) + (_.cover [/.sub] + (let [subs (/.sub sub_size sample)] + (and (/.every? (|>> /.size (n.<= sub_size)) subs) + (/#= sample + (/.together subs))))) + )))) (def: member Test (let [(open "/#[0]") (/.equivalence n.equivalence)] (do [! random.monad] [sample ..random] - (`` ($_ _.and - (_.cover [/.member?] - (/.every? (/.member? n.equivalence sample) - sample)) - (~~ (template [<head> <tail> <pre>] - [($_ _.and - (_.cover [<head>] - (case [(<pre> sample) (<head> sample)] - [{.#Item expected _} {.#Some actual}] - (n.= expected actual) + (`` (all _.and + (_.cover [/.member?] + (/.every? (/.member? n.equivalence sample) + sample)) + (~~ (template [<head> <tail> <pre>] + [(all _.and + (_.cover [<head>] + (case [(<pre> sample) (<head> sample)] + [{.#Item expected _} {.#Some actual}] + (n.= expected actual) - [{.#End} {.#None}] - true + [{.#End} {.#None}] + true - _ - false)) - (_.cover [<tail>] - (case [(<pre> sample) (<tail> sample)] - [{.#Item _ expected} {.#Some actual}] - (/#= (<pre> expected) actual) + _ + false)) + (_.cover [<tail>] + (case [(<pre> sample) (<tail> sample)] + [{.#Item _ expected} {.#Some actual}] + (/#= (<pre> expected) actual) - [{.#End} {.#None}] - true + [{.#End} {.#None}] + true - _ - false)) - )] + _ + false)) + )] - [/.head /.tail |>] - [/.last /.inits /.reversed] - )) - ))))) + [/.head /.tail |>] + [/.last /.inits /.reversed] + )) + ))))) (def: grouping Test @@ -283,92 +283,92 @@ +/2 (is (-> Nat Nat Nat) (function (_ left right) - ($_ n.+ left right))) + (all n.+ left right))) +/3 (is (-> Nat Nat Nat Nat) (function (_ left mid right) - ($_ n.+ left mid right)))] + (all n.+ left mid right)))] (do [! random.monad] [sample/0 ..random sample/1 ..random sample/2 ..random] - ($_ _.and - (_.cover [/.pairs] - (let [even_sized? (|> sample/0 - /.size - (n.% 2) - (n.= 0))] - (case (/.pairs sample/0) - {.#Some pairs/0} - (and even_sized? - (n.= (n./ 2 (/.size sample/0)) - (/.size pairs/0))) + (all _.and + (_.cover [/.pairs] + (let [even_sized? (|> sample/0 + /.size + (n.% 2) + (n.= 0))] + (case (/.pairs sample/0) + {.#Some pairs/0} + (and even_sized? + (n.= (n./ 2 (/.size sample/0)) + (/.size pairs/0))) - {.#None} - (not even_sized?)))) - (_.cover [/.zipped_2] - (let [zipped (/.zipped_2 sample/0 sample/1) - zipped::size (/.size zipped) + {.#None} + (not even_sized?)))) + (_.cover [/.zipped_2] + (let [zipped (/.zipped_2 sample/0 sample/1) + zipped::size (/.size zipped) - size_of_smaller_list! - (n.= zipped::size - (n.min (/.size sample/0) (/.size sample/1))) + size_of_smaller_list! + (n.= zipped::size + (n.min (/.size sample/0) (/.size sample/1))) - can_extract_values! - (and (/#= (/.first zipped::size sample/0) - (/#each product.left zipped)) - (/#= (/.first zipped::size sample/1) - (/#each product.right zipped)))] - (and size_of_smaller_list! - can_extract_values!))) - (_.cover [/.zipped_3] - (let [zipped (/.zipped_3 sample/0 sample/1 sample/2) - zipped::size (/.size zipped) - - size_of_smaller_list! - (n.= zipped::size - ($_ n.min - (/.size sample/0) - (/.size sample/1) - (/.size sample/2))) + can_extract_values! + (and (/#= (/.first zipped::size sample/0) + (/#each product.left zipped)) + (/#= (/.first zipped::size sample/1) + (/#each product.right zipped)))] + (and size_of_smaller_list! + can_extract_values!))) + (_.cover [/.zipped_3] + (let [zipped (/.zipped_3 sample/0 sample/1 sample/2) + zipped::size (/.size zipped) + + size_of_smaller_list! + (n.= zipped::size + (all n.min + (/.size sample/0) + (/.size sample/1) + (/.size sample/2))) - can_extract_values! - (and (/#= (/.first zipped::size sample/0) - (/#each product.left zipped)) - (/#= (/.first zipped::size sample/1) - (/#each (|>> product.right product.left) zipped)) - (/#= (/.first zipped::size sample/2) - (/#each (|>> product.right product.right) zipped)))] - (and size_of_smaller_list! - can_extract_values!))) - (_.cover [/.zipped] - (and (# (/.equivalence (product.equivalence n.equivalence n.equivalence)) = - (/.zipped_2 sample/0 sample/1) - ((/.zipped 2) sample/0 sample/1)) - (# (/.equivalence ($_ product.equivalence n.equivalence n.equivalence n.equivalence)) = - (/.zipped_3 sample/0 sample/1 sample/2) - ((/.zipped 3) sample/0 sample/1 sample/2)))) + can_extract_values! + (and (/#= (/.first zipped::size sample/0) + (/#each product.left zipped)) + (/#= (/.first zipped::size sample/1) + (/#each (|>> product.right product.left) zipped)) + (/#= (/.first zipped::size sample/2) + (/#each (|>> product.right product.right) zipped)))] + (and size_of_smaller_list! + can_extract_values!))) + (_.cover [/.zipped] + (and (# (/.equivalence (product.equivalence n.equivalence n.equivalence)) = + (/.zipped_2 sample/0 sample/1) + ((/.zipped 2) sample/0 sample/1)) + (# (/.equivalence (all product.equivalence n.equivalence n.equivalence n.equivalence)) = + (/.zipped_3 sample/0 sample/1 sample/2) + ((/.zipped 3) sample/0 sample/1 sample/2)))) - (_.cover [/.zipped_with_2] - (/#= (/#each (function (_ [left right]) - (+/2 left right)) - (/.zipped_2 sample/0 sample/1)) - (/.zipped_with_2 +/2 sample/0 sample/1))) - (_.cover [/.zipped_with_3] - (/#= (/#each (function (_ [left mid right]) - (+/3 left mid right)) - (/.zipped_3 sample/0 sample/1 sample/2)) - (/.zipped_with_3 +/3 sample/0 sample/1 sample/2))) - (_.cover [/.zipped_with] - (and (/#= (/.zipped_with_2 +/2 sample/0 sample/1) - ((/.zipped_with 2) +/2 sample/0 sample/1)) - (/#= (/.zipped_with_3 +/3 sample/0 sample/1 sample/2) - ((/.zipped_with 3) +/3 sample/0 sample/1 sample/2)))) - (_.cover [/.together] - (and (/#= (/#composite sample/0 sample/1) - (/.together (list sample/0 sample/1))) - (/#= ($_ /#composite sample/0 sample/1 sample/2) - (/.together (list sample/0 sample/1 sample/2))))) - )))) + (_.cover [/.zipped_with_2] + (/#= (/#each (function (_ [left right]) + (+/2 left right)) + (/.zipped_2 sample/0 sample/1)) + (/.zipped_with_2 +/2 sample/0 sample/1))) + (_.cover [/.zipped_with_3] + (/#= (/#each (function (_ [left mid right]) + (+/3 left mid right)) + (/.zipped_3 sample/0 sample/1 sample/2)) + (/.zipped_with_3 +/3 sample/0 sample/1 sample/2))) + (_.cover [/.zipped_with] + (and (/#= (/.zipped_with_2 +/2 sample/0 sample/1) + ((/.zipped_with 2) +/2 sample/0 sample/1)) + (/#= (/.zipped_with_3 +/3 sample/0 sample/1 sample/2) + ((/.zipped_with 3) +/3 sample/0 sample/1 sample/2)))) + (_.cover [/.together] + (and (/#= (/#composite sample/0 sample/1) + (/.together (list sample/0 sample/1))) + (/#= (all /#composite sample/0 sample/1 sample/2) + (/.together (list sample/0 sample/1 sample/2))))) + )))) (def: search Test @@ -381,35 +381,35 @@ {.#None})))] (do [! random.monad] [sample ..random] - ($_ _.and - (_.cover [/.one] - (case [(|> sample - (/.only n.even?) - (/#each (# n.decimal encoded)) - /.head) - (/.one choice sample)] - [{.#Some expected} {.#Some actual}] - (text#= expected actual) + (all _.and + (_.cover [/.one] + (case [(|> sample + (/.only n.even?) + (/#each (# n.decimal encoded)) + /.head) + (/.one choice sample)] + [{.#Some expected} {.#Some actual}] + (text#= expected actual) - [{.#None} {.#None}] - true + [{.#None} {.#None}] + true - _ - false)) - (_.cover [/.all] - (# (/.equivalence text.equivalence) = - (|> sample - (/.only n.even?) - (/#each (# n.decimal encoded))) - (/.all choice sample))) - (_.cover [/.example] - (case (/.example n.even? sample) - {.#Some found} - (n.even? found) + _ + false)) + (_.cover [/.all] + (# (/.equivalence text.equivalence) = + (|> sample + (/.only n.even?) + (/#each (# n.decimal encoded))) + (/.all choice sample))) + (_.cover [/.example] + (case (/.example n.even? sample) + {.#Some found} + (n.even? found) - {.#None} - (not (/.any? n.even? sample)))) - )))) + {.#None} + (not (/.any? n.even? sample)))) + )))) (def: .public test Test @@ -420,42 +420,42 @@ (do [! random.monad] [sample ..random separator random.nat] - ($_ _.and - ..signatures - ..whole - ..indices - ..slice - ..member - ..grouping - ..search - - (_.cover [/.interposed] - (or (/.empty? sample) - (let [sample+ (/.interposed separator sample)] - (and (n.= (|> (/.size sample) (n.* 2) --) - (/.size sample+)) - (|> sample+ - /.pairs - (maybe.else (list)) - (/.every? (|>> product.right (n.= separator)))))))) - (_.cover [/.iterations] - (or (/.empty? sample) - (let [size (/.size sample)] - (/#= (/.indices size) - (/.iterations (function (_ index) - (if (n.< size index) - {.#Some (++ index)} - {.#None})) - 0))))) - (_.cover [/.mixes] - (/#= (/#each (function (_ index) - (# /.mix mix n.+ 0 (/.first index sample))) - (/.indices (++ (/.size sample)))) - (/.mixes n.+ 0 sample))) - (do random.monad - [expected random.nat - .let [(open "/#[0]") (/.equivalence n.equivalence)]] - (_.cover [/.when] - (and (/#= (list expected) (/.when true (list expected))) - (/#= (list) (/.when false (list expected)))))) - ))))) + (all _.and + ..signatures + ..whole + ..indices + ..slice + ..member + ..grouping + ..search + + (_.cover [/.interposed] + (or (/.empty? sample) + (let [sample+ (/.interposed separator sample)] + (and (n.= (|> (/.size sample) (n.* 2) --) + (/.size sample+)) + (|> sample+ + /.pairs + (maybe.else (list)) + (/.every? (|>> product.right (n.= separator)))))))) + (_.cover [/.iterations] + (or (/.empty? sample) + (let [size (/.size sample)] + (/#= (/.indices size) + (/.iterations (function (_ index) + (if (n.< size index) + {.#Some (++ index)} + {.#None})) + 0))))) + (_.cover [/.mixes] + (/#= (/#each (function (_ index) + (# /.mix mix n.+ 0 (/.first index sample))) + (/.indices (++ (/.size sample)))) + (/.mixes n.+ 0 sample))) + (do random.monad + [expected random.nat + .let [(open "/#[0]") (/.equivalence n.equivalence)]] + (_.cover [/.when] + (and (/#= (list expected) (/.when true (list expected))) + (/#= (list) (/.when false (list expected)))))) + ))))) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 96d793d61..aa6365a41 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -1,23 +1,23 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" functor {"+" Injection}]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - [collection - ["[0]" set] - ["[0]" list ("[1]#[0]" monoid)]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" functor {"+" Injection}]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + [collection + ["[0]" set] + ["[0]" list ("[1]#[0]" monoid)]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: injection (Injection /.Queue) @@ -34,86 +34,86 @@ random.nat) .let [members (set.list members) sample (/.of_list members)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) - (_.cover [/.of_list /.list] - (|> members /.of_list /.list - (# (list.equivalence n.equivalence) = members))) - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 size) (/.empty? sample))) - (_.cover [/.empty] - (let [empty_is_empty! - (/.empty? /.empty) + (_.cover [/.of_list /.list] + (|> members /.of_list /.list + (# (list.equivalence n.equivalence) = members))) + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 size) (/.empty? sample))) + (_.cover [/.empty] + (let [empty_is_empty! + (/.empty? /.empty) - all_empty_queues_look_the_same! - (bit#= (/.empty? sample) - (# (/.equivalence n.equivalence) = - sample - /.empty))] - (and empty_is_empty! - all_empty_queues_look_the_same!))) - (_.cover [/.front] - (case [members (/.front sample)] - [{.#Item head tail} {.#Some first}] - (n.= head first) - - [{.#End} {.#None}] - true + all_empty_queues_look_the_same! + (bit#= (/.empty? sample) + (# (/.equivalence n.equivalence) = + sample + /.empty))] + (and empty_is_empty! + all_empty_queues_look_the_same!))) + (_.cover [/.front] + (case [members (/.front sample)] + [{.#Item head tail} {.#Some first}] + (n.= head first) + + [{.#End} {.#None}] + true - _ - false)) - (_.cover [/.member?] - (let [every_member_is_identified! - (list.every? (/.member? n.equivalence sample) - (/.list sample)) + _ + false)) + (_.cover [/.member?] + (let [every_member_is_identified! + (list.every? (/.member? n.equivalence sample) + (/.list sample)) - non_member_is_not_identified! - (not (/.member? n.equivalence sample non_member))] - (and every_member_is_identified! - non_member_is_not_identified!))) - (_.cover [/.end] - (let [pushed (/.end non_member sample) + non_member_is_not_identified! + (not (/.member? n.equivalence sample non_member))] + (and every_member_is_identified! + non_member_is_not_identified!))) + (_.cover [/.end] + (let [pushed (/.end non_member sample) - size_increases! - (n.= (++ (/.size sample)) (/.size pushed)) + size_increases! + (n.= (++ (/.size sample)) (/.size pushed)) - new_member_is_identified! - (/.member? n.equivalence pushed non_member) - - has_expected_order! - (# (list.equivalence n.equivalence) = - (list#composite (/.list sample) (list non_member)) - (/.list pushed))] - (and size_increases! new_member_is_identified! - has_expected_order!))) - (_.cover [/.next] - (case members - {.#Item target expected} - (let [popped (/.next sample) + (/.member? n.equivalence pushed non_member) - size_decreases! - (n.= (-- (/.size sample)) - (/.size popped)) + has_expected_order! + (# (list.equivalence n.equivalence) = + (list#composite (/.list sample) (list non_member)) + (/.list pushed))] + (and size_increases! + new_member_is_identified! + has_expected_order!))) + (_.cover [/.next] + (case members + {.#Item target expected} + (let [popped (/.next sample) - popped_member_is_not_identified! - (not (/.member? n.equivalence popped target)) + size_decreases! + (n.= (-- (/.size sample)) + (/.size popped)) - has_expected_order! - (# (list.equivalence n.equivalence) = - expected - (/.list popped))] - (and size_decreases! popped_member_is_not_identified! - has_expected_order!)) - - {.#End} - (and (/.empty? sample) - (/.empty? (/.next sample))))) - )))) + (not (/.member? n.equivalence popped target)) + + has_expected_order! + (# (list.equivalence n.equivalence) = + expected + (/.list popped))] + (and size_decreases! + popped_member_is_not_identified! + has_expected_order!)) + + {.#End} + (and (/.empty? sample) + (/.empty? (/.next sample))))) + )))) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 643c284fe..d0a8faf6c 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - ["[0]" monad {"+" do}]] - [control - ["[0]" maybe ("[1]#[0]" functor)]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" / {"+" Queue}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + ["[0]" monad {"+" do}]] + [control + ["[0]" maybe ("[1]#[0]" functor)]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / {"+" Queue}]]) (def: .public (random size) (-> Nat (Random (Queue Nat))) @@ -39,56 +39,56 @@ max_member random.nat min_member random.nat] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.front] - (case (/.front sample) - {.#Some first} - (n.> 0 (/.size sample)) - - {.#None} - (/.empty? sample))) - (_.cover [/.member?] - (case (/.front sample) - {.#Some first} - (/.member? n.equivalence sample first) - - {.#None} - (/.empty? sample))) - (_.cover [/.end] - (let [sample+ (/.end non_member_priority non_member sample)] - (and (not (/.member? n.equivalence sample non_member)) - (n.= (++ (/.size sample)) - (/.size sample+)) - (/.member? n.equivalence sample+ non_member)))) - (_.cover [/.next] - (let [sample- (/.next sample)] - (or (and (/.empty? sample) - (/.empty? sample-)) - (n.= (-- (/.size sample)) - (/.size sample-))))) - (_.for [/.Priority] - ($_ _.and - (_.cover [/.max] - (|> /.empty - (/.end /.min min_member) - (/.end /.max max_member) - /.front - (maybe#each (n.= max_member)) - (maybe.else false))) - (_.cover [/.min] - (|> /.empty - (/.end /.max max_member) - (/.end /.min min_member) - /.next - /.front - (maybe#each (n.= min_member)) - (maybe.else false))) - )) - )))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.front] + (case (/.front sample) + {.#Some first} + (n.> 0 (/.size sample)) + + {.#None} + (/.empty? sample))) + (_.cover [/.member?] + (case (/.front sample) + {.#Some first} + (/.member? n.equivalence sample first) + + {.#None} + (/.empty? sample))) + (_.cover [/.end] + (let [sample+ (/.end non_member_priority non_member sample)] + (and (not (/.member? n.equivalence sample non_member)) + (n.= (++ (/.size sample)) + (/.size sample+)) + (/.member? n.equivalence sample+ non_member)))) + (_.cover [/.next] + (let [sample- (/.next sample)] + (or (and (/.empty? sample) + (/.empty? sample-)) + (n.= (-- (/.size sample)) + (/.size sample-))))) + (_.for [/.Priority] + (all _.and + (_.cover [/.max] + (|> /.empty + (/.end /.min min_member) + (/.end /.max max_member) + /.front + (maybe#each (n.= max_member)) + (maybe.else false))) + (_.cover [/.min] + (|> /.empty + (/.end /.max max_member) + (/.end /.min min_member) + /.next + /.front + (maybe#each (n.= min_member)) + (maybe.else false))) + )) + )))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 34e1b13c2..a88a1f8de 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -31,20 +31,20 @@ Test (do [! random.monad] [size (# ! each (n.% 100) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.sequence size random.nat))) - (_.for [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.sequence size random.nat))) - (_.for [/.mix] - ($mix.spec /#in /.equivalence /.mix)) - (_.for [/.functor] - ($functor.spec /#in /.equivalence /.functor)) - (_.for [/.apply] - ($apply.spec /#in /.equivalence /.apply)) - (_.for [/.monad] - ($monad.spec /#in /.equivalence /.monad)) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.sequence size random.nat))) + (_.for [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.sequence size random.nat))) + (_.for [/.mix] + ($mix.spec /#in /.equivalence /.mix)) + (_.for [/.functor] + ($functor.spec /#in /.equivalence /.functor)) + (_.for [/.apply] + ($apply.spec /#in /.equivalence /.apply)) + (_.for [/.monad] + ($monad.spec /#in /.equivalence /.monad)) + ))) (def: whole Test @@ -53,82 +53,82 @@ sample (random.set n.hash size random.nat) .let [sample (|> sample set.list /.of_list)] .let [(open "/#[0]") (/.equivalence n.equivalence)]] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (/.empty? sample) (n.= 0 (/.size sample)))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.list /.of_list] - (|> sample /.list /.of_list (/#= sample))) - (_.cover [/.reversed] - (or (n.< 2 (/.size sample)) - (let [not_same! - (not (/#= sample - (/.reversed sample))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (/.empty? sample) (n.= 0 (/.size sample)))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.list /.of_list] + (|> sample /.list /.of_list (/#= sample))) + (_.cover [/.reversed] + (or (n.< 2 (/.size sample)) + (let [not_same! + (not (/#= sample + (/.reversed sample))) - self_symmetry! - (/#= sample - (/.reversed (/.reversed sample)))] - (and not_same! - self_symmetry!)))) - (_.cover [/.every? /.any?] - (if (/.every? n.even? sample) - (not (/.any? (bit.complement n.even?) sample)) - (/.any? (bit.complement n.even?) sample))) - ))) + self_symmetry! + (/#= sample + (/.reversed (/.reversed sample)))] + (and not_same! + self_symmetry!)))) + (_.cover [/.every? /.any?] + (if (/.every? n.even? sample) + (not (/.any? (bit.complement n.even?) sample)) + (/.any? (bit.complement n.even?) sample))) + ))) (def: index_based Test (do [! random.monad] [size (# ! each (|>> (n.% 100) ++) random.nat)] - ($_ _.and - (do ! - [good_index (|> random.nat (# ! each (n.% size))) - .let [bad_index (n.+ size good_index)] - sample (random.set n.hash size random.nat) - non_member (random.only (|>> (set.member? sample) not) - random.nat) - .let [sample (|> sample set.list /.of_list)]] - ($_ _.and - (_.cover [/.item] - (case (/.item good_index sample) - {try.#Success member} - (/.member? n.equivalence sample member) - - {try.#Failure error} - false)) - (_.cover [/.has] - (<| (try.else false) - (do try.monad - [sample (/.has good_index non_member sample) - actual (/.item good_index sample)] - (in (same? non_member actual))))) - (_.cover [/.revised] - (<| (try.else false) - (do try.monad - [sample (/.has good_index non_member sample) - sample (/.revised good_index ++ sample) - actual (/.item good_index sample)] - (in (n.= (++ non_member) actual))))) - (_.cover [/.within_bounds?] - (and (/.within_bounds? sample good_index) - (not (/.within_bounds? sample bad_index)))) - (_.cover [/.index_out_of_bounds] - (let [fails! (is (All (_ a) (-> (Try a) Bit)) - (function (_ situation) - (case situation - {try.#Success member} - false - - {try.#Failure error} - (exception.match? /.index_out_of_bounds error))))] - (and (fails! (/.item bad_index sample)) - (fails! (/.has bad_index non_member sample)) - (fails! (/.revised bad_index ++ sample))))) - )) - ))) + (all _.and + (do ! + [good_index (|> random.nat (# ! each (n.% size))) + .let [bad_index (n.+ size good_index)] + sample (random.set n.hash size random.nat) + non_member (random.only (|>> (set.member? sample) not) + random.nat) + .let [sample (|> sample set.list /.of_list)]] + (all _.and + (_.cover [/.item] + (case (/.item good_index sample) + {try.#Success member} + (/.member? n.equivalence sample member) + + {try.#Failure error} + false)) + (_.cover [/.has] + (<| (try.else false) + (do try.monad + [sample (/.has good_index non_member sample) + actual (/.item good_index sample)] + (in (same? non_member actual))))) + (_.cover [/.revised] + (<| (try.else false) + (do try.monad + [sample (/.has good_index non_member sample) + sample (/.revised good_index ++ sample) + actual (/.item good_index sample)] + (in (n.= (++ non_member) actual))))) + (_.cover [/.within_bounds?] + (and (/.within_bounds? sample good_index) + (not (/.within_bounds? sample bad_index)))) + (_.cover [/.index_out_of_bounds] + (let [fails! (is (All (_ a) (-> (Try a) Bit)) + (function (_ situation) + (case situation + {try.#Success member} + false + + {try.#Failure error} + (exception.match? /.index_out_of_bounds error))))] + (and (fails! (/.item bad_index sample)) + (fails! (/.has bad_index non_member sample)) + (fails! (/.revised bad_index ++ sample))))) + )) + ))) (def: .public test Test @@ -136,82 +136,82 @@ (_.for [/.Sequence]) (do [! random.monad] [size (# ! each (|>> (n.% 100) ++) random.nat)] - ($_ _.and - ..signatures - ..whole - ..index_based + (all _.and + ..signatures + ..whole + ..index_based - (do ! - [sample (random.set n.hash size random.nat) - non_member (random.only (|>> (set.member? sample) not) - random.nat) - .let [sample (|> sample set.list /.of_list)] - .let [(open "/#[0]") (/.equivalence n.equivalence)]] - ($_ _.and - (do ! - [value/0 random.nat - value/1 random.nat - value/2 random.nat] - (_.cover [/.sequence] - (/#= (/.of_list (list value/0 value/1 value/2)) - (/.sequence value/0 value/1 value/2)))) - (_.cover [/.member?] - (and (list.every? (/.member? n.equivalence sample) - (/.list sample)) - (not (/.member? n.equivalence sample non_member)))) - (_.cover [/.suffix] - (let [added (/.suffix non_member sample) + (do ! + [sample (random.set n.hash size random.nat) + non_member (random.only (|>> (set.member? sample) not) + random.nat) + .let [sample (|> sample set.list /.of_list)] + .let [(open "/#[0]") (/.equivalence n.equivalence)]] + (all _.and + (do ! + [value/0 random.nat + value/1 random.nat + value/2 random.nat] + (_.cover [/.sequence] + (/#= (/.of_list (list value/0 value/1 value/2)) + (/.sequence value/0 value/1 value/2)))) + (_.cover [/.member?] + (and (list.every? (/.member? n.equivalence sample) + (/.list sample)) + (not (/.member? n.equivalence sample non_member)))) + (_.cover [/.suffix] + (let [added (/.suffix non_member sample) - size_increases! - (n.= (++ (/.size sample)) - (/.size added)) + size_increases! + (n.= (++ (/.size sample)) + (/.size added)) - is_a_member! - (/.member? n.equivalence added non_member)] - (and size_increases! - is_a_member!))) - (_.cover [/.prefix] - (if (/.empty? sample) - (/.empty? (/.prefix sample)) - (let [expected_size! - (n.= (-- (/.size sample)) - (/.size (/.prefix sample))) + is_a_member! + (/.member? n.equivalence added non_member)] + (and size_increases! + is_a_member!))) + (_.cover [/.prefix] + (if (/.empty? sample) + (/.empty? (/.prefix sample)) + (let [expected_size! + (n.= (-- (/.size sample)) + (/.size (/.prefix sample))) - symmetry! - (|> sample - (/.suffix non_member) - /.prefix - (/#= sample))] - (and expected_size! - symmetry!)))) - (_.cover [/.only] - (let [positives (/.only n.even? sample) - negatives (/.only (bit.complement n.even?) sample)] - (and (/.every? n.even? positives) - (not (/.any? n.even? negatives)) + symmetry! + (|> sample + (/.suffix non_member) + /.prefix + (/#= sample))] + (and expected_size! + symmetry!)))) + (_.cover [/.only] + (let [positives (/.only n.even? sample) + negatives (/.only (bit.complement n.even?) sample)] + (and (/.every? n.even? positives) + (not (/.any? n.even? negatives)) - (n.= (/.size sample) - (n.+ (/.size positives) - (/.size negatives)))))) - (_.cover [/.one] - (let [(open "/#[0]") /.functor - choice (is (-> Nat (Maybe Text)) - (function (_ value) - (if (n.even? value) - {.#Some (# n.decimal encoded value)} - {.#None})))] - (case [(|> sample - (/.only n.even?) - (/#each (# n.decimal encoded)) - (/.item 0)) - (/.one choice sample)] - [{try.#Success expected} {.#Some actual}] - (text#= expected actual) + (n.= (/.size sample) + (n.+ (/.size positives) + (/.size negatives)))))) + (_.cover [/.one] + (let [(open "/#[0]") /.functor + choice (is (-> Nat (Maybe Text)) + (function (_ value) + (if (n.even? value) + {.#Some (# n.decimal encoded value)} + {.#None})))] + (case [(|> sample + (/.only n.even?) + (/#each (# n.decimal encoded)) + (/.item 0)) + (/.one choice sample)] + [{try.#Success expected} {.#Some actual}] + (text#= expected actual) - [{try.#Failure _} {.#None}] - true + [{try.#Failure _} {.#None}] + true - _ - false))) - )) - )))) + _ + false))) + )) + )))) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index a5336f6f7..c444f5419 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -31,103 +31,103 @@ (_.for [/.Set]) (do [! random.monad] [size ..gen_nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) - (_.for [/.hash] - (|> random.nat - (# random.monad each (|>> list (/.of_list n.hash))) - ($hash.spec /.hash))) - (_.for [/.monoid] - ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) + (_.for [/.hash] + (|> random.nat + (# random.monad each (|>> list (/.of_list n.hash))) + ($hash.spec /.hash))) + (_.for [/.monoid] + ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) - (do ! - [sizeL ..gen_nat - sizeR ..gen_nat - setL (random.set n.hash sizeL random.nat) - setR (random.set n.hash sizeR random.nat) - non_memberL (random.only (|>> (/.member? setL) not) - random.nat)] - ($_ _.and - (_.cover [/.empty] - (/.empty? (/.empty n.hash))) - (do ! - [hash (# ! each (function (_ constant) - (is (Hash Nat) - (implementation - (def: equivalence n.equivalence) - - (def: (hash _) - constant)))) - random.nat)] - (_.cover [/.member_hash] - (same? hash (/.member_hash (/.empty hash))))) - (_.cover [/.size] - (n.= sizeL (/.size setL))) - (_.cover [/.empty?] - (bit#= (/.empty? setL) - (n.= 0 (/.size setL)))) - (_.cover [/.list /.of_list] - (|> setL /.list (/.of_list n.hash) (#= setL))) - (_.cover [/.member?] - (and (list.every? (/.member? setL) (/.list setL)) - (not (/.member? setL non_memberL)))) - (_.cover [/.has] - (let [before_addition! - (not (/.member? setL non_memberL)) + (do ! + [sizeL ..gen_nat + sizeR ..gen_nat + setL (random.set n.hash sizeL random.nat) + setR (random.set n.hash sizeR random.nat) + non_memberL (random.only (|>> (/.member? setL) not) + random.nat)] + (all _.and + (_.cover [/.empty] + (/.empty? (/.empty n.hash))) + (do ! + [hash (# ! each (function (_ constant) + (is (Hash Nat) + (implementation + (def: equivalence n.equivalence) + + (def: (hash _) + constant)))) + random.nat)] + (_.cover [/.member_hash] + (same? hash (/.member_hash (/.empty hash))))) + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit#= (/.empty? setL) + (n.= 0 (/.size setL)))) + (_.cover [/.list /.of_list] + (|> setL /.list (/.of_list n.hash) (#= setL))) + (_.cover [/.member?] + (and (list.every? (/.member? setL) (/.list setL)) + (not (/.member? setL non_memberL)))) + (_.cover [/.has] + (let [before_addition! + (not (/.member? setL non_memberL)) - after_addition! - (/.member? (/.has non_memberL setL) non_memberL) + after_addition! + (/.member? (/.has non_memberL setL) non_memberL) - size_increase! - (n.= (++ (/.size setL)) - (/.size (/.has non_memberL setL)))] - (and before_addition! - after_addition!))) - (_.cover [/.lacks] - (let [symmetry! - (|> setL - (/.has non_memberL) - (/.lacks non_memberL) - (#= setL)) + size_increase! + (n.= (++ (/.size setL)) + (/.size (/.has non_memberL setL)))] + (and before_addition! + after_addition!))) + (_.cover [/.lacks] + (let [symmetry! + (|> setL + (/.has non_memberL) + (/.lacks non_memberL) + (#= setL)) - idempotency! - (|> setL - (/.lacks non_memberL) - (#= setL))] - (and symmetry! - idempotency!))) - (_.cover [/.union /.sub?] - (let [setLR (/.union setL setR) - - sets_are_subs_of_their_unions! - (and (/.sub? setLR setL) - (/.sub? setLR setR)) + idempotency! + (|> setL + (/.lacks non_memberL) + (#= setL))] + (and symmetry! + idempotency!))) + (_.cover [/.union /.sub?] + (let [setLR (/.union setL setR) + + sets_are_subs_of_their_unions! + (and (/.sub? setLR setL) + (/.sub? setLR setR)) - union_with_empty_set! - (|> setL - (/.union (/.empty n.hash)) - (#= setL))] - (and sets_are_subs_of_their_unions! - union_with_empty_set!))) - (_.cover [/.intersection /.super?] - (let [setLR (/.intersection setL setR) - - sets_are_supers_of_their_intersections! - (and (/.super? setLR setL) - (/.super? setLR setR)) + union_with_empty_set! + (|> setL + (/.union (/.empty n.hash)) + (#= setL))] + (and sets_are_subs_of_their_unions! + union_with_empty_set!))) + (_.cover [/.intersection /.super?] + (let [setLR (/.intersection setL setR) + + sets_are_supers_of_their_intersections! + (and (/.super? setLR setL) + (/.super? setLR setR)) - intersection_with_empty_set! - (|> setL - (/.intersection (/.empty n.hash)) - /.empty?)] - (and sets_are_supers_of_their_intersections! - intersection_with_empty_set!))) - (_.cover [/.difference] - (let [setL+R (/.union setR setL) - setL_R (/.difference setR setL+R)] - (and (list.every? (/.member? setL+R) (/.list setR)) - (not (list.any? (/.member? setL_R) (/.list setR)))))) - (_.cover [/.predicate] - (list.every? (/.predicate setL) (/.list setL))) - )))))) + intersection_with_empty_set! + (|> setL + (/.intersection (/.empty n.hash)) + /.empty?)] + (and sets_are_supers_of_their_intersections! + intersection_with_empty_set!))) + (_.cover [/.difference] + (let [setL+R (/.union setR setL) + setL_R (/.difference setR setL+R)] + (and (list.every? (/.member? setL+R) (/.list setR)) + (not (list.any? (/.member? setL_R) (/.list setR)))))) + (_.cover [/.predicate] + (list.every? (/.predicate setL) (/.list setL))) + )))))) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 755efb685..9ace968fb 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -40,15 +40,15 @@ Test (do [! random.monad] [diversity (# ! each (n.% 10) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) - (_.for [/.hash] - (|> random.nat - (# random.monad each (function (_ single) - (/.has 1 single (/.empty n.hash)))) - ($hash.spec /.hash))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) + (_.for [/.hash] + (|> random.nat + (# random.monad each (function (_ single) + (/.has 1 single (/.empty n.hash)))) + ($hash.spec /.hash))) + ))) (def: composition Test @@ -56,57 +56,57 @@ [diversity (# ! each (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) another (..random diversity n.hash ..count random.nat)] - (`` ($_ _.and - (~~ (template [<name> <composition>] - [(_.cover [<name>] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (<name> sample another) + (`` (all _.and + (~~ (template [<name> <composition>] + [(_.cover [<name>] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (<name> sample another) - no_left_changes! (list.every? (function (_ member) - (n.= (/.multiplicity sample member) - (/.multiplicity composed member))) - (set.list sample_only)) - no_right_changes! (list.every? (function (_ member) - (n.= (/.multiplicity another member) + no_left_changes! (list.every? (function (_ member) + (n.= (/.multiplicity sample member) (/.multiplicity composed member))) - (set.list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (<composition> (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.list common))] - (and no_left_changes! - no_right_changes! - common_changes!)))] + (set.list sample_only)) + no_right_changes! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (<composition> (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.list common))] + (and no_left_changes! + no_right_changes! + common_changes!)))] - [/.sum n.+] - [/.union n.max] - )) - (_.cover [/.intersection] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.intersection sample another) + [/.sum n.+] + [/.union n.max] + )) + (_.cover [/.intersection] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.intersection sample another) - left_removals! (list.every? (|>> (/.member? composed) not) - (set.list sample_only)) - right_removals! (list.every? (|>> (/.member? composed) not) - (set.list another_only)) - common_changes! (list.every? (function (_ member) - (n.= (n.min (/.multiplicity sample member) - (/.multiplicity another member)) - (/.multiplicity composed member))) - (set.list common))] - (and left_removals! - right_removals! - common_changes!))) - )))) + left_removals! (list.every? (|>> (/.member? composed) not) + (set.list sample_only)) + right_removals! (list.every? (|>> (/.member? composed) not) + (set.list another_only)) + common_changes! (list.every? (function (_ member) + (n.= (n.min (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.list common))] + (and left_removals! + right_removals! + common_changes!))) + )))) (def: .public test Test @@ -120,121 +120,121 @@ addition_count ..count partial_removal_count (# ! each (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] - ($_ _.and - (_.cover [/.list /.of_list] - (|> sample - /.list - (/.of_list n.hash) - (# /.equivalence = sample))) - (_.cover [/.size] - (n.= (list.size (/.list sample)) - (/.size sample))) - (_.cover [/.empty?] - (bit#= (/.empty? sample) - (n.= 0 (/.size sample)))) - (_.cover [/.empty] - (/.empty? (/.empty n.hash))) - (_.cover [/.support] - (list.every? (set.member? (/.support sample)) - (/.list sample))) - (_.cover [/.member?] - (let [non_member_is_not_identified! - (not (/.member? sample non_member)) + (all _.and + (_.cover [/.list /.of_list] + (|> sample + /.list + (/.of_list n.hash) + (# /.equivalence = sample))) + (_.cover [/.size] + (n.= (list.size (/.list sample)) + (/.size sample))) + (_.cover [/.empty?] + (bit#= (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.empty] + (/.empty? (/.empty n.hash))) + (_.cover [/.support] + (list.every? (set.member? (/.support sample)) + (/.list sample))) + (_.cover [/.member?] + (let [non_member_is_not_identified! + (not (/.member? sample non_member)) - all_members_are_identified! - (list.every? (/.member? sample) - (/.list sample))] - (and non_member_is_not_identified! - all_members_are_identified!))) - (_.cover [/.multiplicity] - (let [non_members_have_0_multiplicity! - (n.= 0 (/.multiplicity sample non_member)) + all_members_are_identified! + (list.every? (/.member? sample) + (/.list sample))] + (and non_member_is_not_identified! + all_members_are_identified!))) + (_.cover [/.multiplicity] + (let [non_members_have_0_multiplicity! + (n.= 0 (/.multiplicity sample non_member)) - every_member_has_positive_multiplicity! - (list.every? (|>> (/.multiplicity sample) (n.> 0)) - (/.list sample))] - (and non_members_have_0_multiplicity! - every_member_has_positive_multiplicity!))) - (_.cover [/.has] - (let [null_scenario! - (|> sample - (/.has 0 non_member) - (# /.equivalence = sample)) + every_member_has_positive_multiplicity! + (list.every? (|>> (/.multiplicity sample) (n.> 0)) + (/.list sample))] + (and non_members_have_0_multiplicity! + every_member_has_positive_multiplicity!))) + (_.cover [/.has] + (let [null_scenario! + (|> sample + (/.has 0 non_member) + (# /.equivalence = sample)) - normal_scenario! - (let [sample+ (/.has addition_count non_member sample)] - (and (not (/.member? sample non_member)) - (/.member? sample+ non_member) - (n.= addition_count (/.multiplicity sample+ non_member))))] - (and null_scenario! - normal_scenario!))) - (_.cover [/.lacks] - (let [null_scenario! - (# /.equivalence = - (|> sample - (/.has addition_count non_member)) - (|> sample - (/.has addition_count non_member) - (/.lacks 0 non_member))) + normal_scenario! + (let [sample+ (/.has addition_count non_member sample)] + (and (not (/.member? sample non_member)) + (/.member? sample+ non_member) + (n.= addition_count (/.multiplicity sample+ non_member))))] + (and null_scenario! + normal_scenario!))) + (_.cover [/.lacks] + (let [null_scenario! + (# /.equivalence = + (|> sample + (/.has addition_count non_member)) + (|> sample + (/.has addition_count non_member) + (/.lacks 0 non_member))) - partial_scenario! - (let [sample* (|> sample - (/.has addition_count non_member) - (/.lacks partial_removal_count non_member))] - (and (/.member? sample* non_member) - (n.= (n.- partial_removal_count - addition_count) - (/.multiplicity sample* non_member)))) - - total_scenario! - (|> sample - (/.has addition_count non_member) - (/.lacks addition_count non_member) - (# /.equivalence = sample))] - (and null_scenario! partial_scenario! - total_scenario!))) - (_.cover [/.of_set] - (let [unary (|> sample /.support /.of_set)] - (list.every? (|>> (/.multiplicity unary) (n.= 1)) - (/.list unary)))) - (_.cover [/.sub?] - (let [unary (|> sample /.support /.of_set)] - (and (/.sub? sample unary) - (or (not (/.sub? unary sample)) - (# /.equivalence = sample unary))))) - (_.cover [/.super?] - (let [unary (|> sample /.support /.of_set)] - (and (/.super? unary sample) - (or (not (/.super? sample unary)) - (# /.equivalence = sample unary))))) - (_.cover [/.difference] - (let [|sample| (/.support sample) - |another| (/.support another) - sample_only (set.difference |another| |sample|) - another_only (set.difference |sample| |another|) - common (set.intersection |sample| |another|) - composed (/.difference sample another) + (let [sample* (|> sample + (/.has addition_count non_member) + (/.lacks partial_removal_count non_member))] + (and (/.member? sample* non_member) + (n.= (n.- partial_removal_count + addition_count) + (/.multiplicity sample* non_member)))) + + total_scenario! + (|> sample + (/.has addition_count non_member) + (/.lacks addition_count non_member) + (# /.equivalence = sample))] + (and null_scenario! + partial_scenario! + total_scenario!))) + (_.cover [/.of_set] + (let [unary (|> sample /.support /.of_set)] + (list.every? (|>> (/.multiplicity unary) (n.= 1)) + (/.list unary)))) + (_.cover [/.sub?] + (let [unary (|> sample /.support /.of_set)] + (and (/.sub? sample unary) + (or (not (/.sub? unary sample)) + (# /.equivalence = sample unary))))) + (_.cover [/.super?] + (let [unary (|> sample /.support /.of_set)] + (and (/.super? unary sample) + (or (not (/.super? sample unary)) + (# /.equivalence = sample unary))))) + (_.cover [/.difference] + (let [|sample| (/.support sample) + |another| (/.support another) + sample_only (set.difference |another| |sample|) + another_only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.difference sample another) - ommissions! (list.every? (|>> (/.member? composed) not) - (set.list sample_only)) - intact! (list.every? (function (_ member) - (n.= (/.multiplicity another member) - (/.multiplicity composed member))) - (set.list another_only)) - subtractions! (list.every? (function (_ member) - (let [sample_multiplicity (/.multiplicity sample member) - another_multiplicity (/.multiplicity another member)] - (n.= (if (n.> another_multiplicity sample_multiplicity) - 0 - (n.- sample_multiplicity - another_multiplicity)) - (/.multiplicity composed member)))) - (set.list common))] - (and ommissions! - intact! - subtractions!))) + ommissions! (list.every? (|>> (/.member? composed) not) + (set.list sample_only)) + intact! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.list another_only)) + subtractions! (list.every? (function (_ member) + (let [sample_multiplicity (/.multiplicity sample member) + another_multiplicity (/.multiplicity another member)] + (n.= (if (n.> another_multiplicity sample_multiplicity) + 0 + (n.- sample_multiplicity + another_multiplicity)) + (/.multiplicity composed member)))) + (set.list common))] + (and ommissions! + intact! + subtractions!))) - ..signature - ..composition - )))) + ..signature + ..composition + )))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index b4b97a984..67f7bb483 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -52,126 +52,126 @@ setL (/.of_list n.order listL) setR (/.of_list n.order listR) empty (/.empty n.order)]] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random sizeL n.order random.nat))) - - (_.cover [/.size] - (n.= sizeL (/.size setL))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size setL)) - (/.empty? setL))) - (_.cover [/.empty] - (/.empty? (/.empty n.order))) - (_.cover [/.list] - (# (list.equivalence n.equivalence) = - (/.list (/.of_list n.order listL)) - (list.sorted (# n.order <) listL))) - (_.cover [/.of_list] - (|> setL - /.list (/.of_list n.order) - (/#= setL))) - (~~ (template [<coverage> <comparison>] - [(_.cover [<coverage>] - (case (<coverage> setL) - {.#Some value} - (|> setL /.list (list.every? (<comparison> value))) - - {.#None} - (/.empty? setL)))] - - [/.min n.>=] - [/.max n.<=] - )) - (_.cover [/.member?] - (let [members_are_identified! - (list.every? (/.member? setL) (/.list setL)) - - non_members_are_not_identified! - (not (/.member? setL non_memberL))] - (and members_are_identified! - non_members_are_not_identified!))) - (_.cover [/.has] - (let [setL+ (/.has non_memberL setL)] - (and (not (/.member? setL non_memberL)) - (/.member? setL+ non_memberL) - (n.= (++ (/.size setL)) - (/.size setL+))))) - (_.cover [/.lacks] - (|> setL - (/.has non_memberL) - (/.lacks non_memberL) - (# /.equivalence = setL))) - (_.cover [/.sub?] - (let [self! - (/.sub? setL setL) - - empty! - (/.sub? setL empty)] - (and self! - empty!))) - (_.cover [/.super?] - (let [self! - (/.super? setL setL) - - empty! - (/.super? empty setL) - - symmetry! - (bit#= (/.super? setL setR) - (/.sub? setR setL))] - (and self! + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random sizeL n.order random.nat))) + + (_.cover [/.size] + (n.= sizeL (/.size setL))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size setL)) + (/.empty? setL))) + (_.cover [/.empty] + (/.empty? (/.empty n.order))) + (_.cover [/.list] + (# (list.equivalence n.equivalence) = + (/.list (/.of_list n.order listL)) + (list.sorted (# n.order <) listL))) + (_.cover [/.of_list] + (|> setL + /.list (/.of_list n.order) + (/#= setL))) + (~~ (template [<coverage> <comparison>] + [(_.cover [<coverage>] + (case (<coverage> setL) + {.#Some value} + (|> setL /.list (list.every? (<comparison> value))) + + {.#None} + (/.empty? setL)))] + + [/.min n.>=] + [/.max n.<=] + )) + (_.cover [/.member?] + (let [members_are_identified! + (list.every? (/.member? setL) (/.list setL)) + + non_members_are_not_identified! + (not (/.member? setL non_memberL))] + (and members_are_identified! + non_members_are_not_identified!))) + (_.cover [/.has] + (let [setL+ (/.has non_memberL setL)] + (and (not (/.member? setL non_memberL)) + (/.member? setL+ non_memberL) + (n.= (++ (/.size setL)) + (/.size setL+))))) + (_.cover [/.lacks] + (|> setL + (/.has non_memberL) + (/.lacks non_memberL) + (# /.equivalence = setL))) + (_.cover [/.sub?] + (let [self! + (/.sub? setL setL) + + empty! + (/.sub? setL empty)] + (and self! + empty!))) + (_.cover [/.super?] + (let [self! + (/.super? setL setL) + empty! - symmetry!))) - (~~ (template [<coverage> <relation> <empty?>] - [(_.cover [<coverage>] - (let [self! - (# /.equivalence = - setL - (<coverage> setL setL)) - - super! - (and (<relation> (<coverage> setL setR) setL) - (<relation> (<coverage> setL setR) setR)) - - empty! - (# /.equivalence = - (if <empty?> empty setL) - (<coverage> setL empty)) - - idempotence! - (# /.equivalence = - (<coverage> setL (<coverage> setL setR)) - (<coverage> setR (<coverage> setL setR)))] - (and self! + (/.super? empty setL) + + symmetry! + (bit#= (/.super? setL setR) + (/.sub? setR setL))] + (and self! + empty! + symmetry!))) + (~~ (template [<coverage> <relation> <empty?>] + [(_.cover [<coverage>] + (let [self! + (# /.equivalence = + setL + (<coverage> setL setL)) + super! + (and (<relation> (<coverage> setL setR) setL) + (<relation> (<coverage> setL setR) setR)) + empty! - idempotence!)))] - - [/.union /.sub? false] - [/.intersection /.super? true] - )) - (_.cover [/.difference] - (let [self! - (|> setL - (/.difference setL) - (# /.equivalence = empty)) - - empty! - (|> setL - (/.difference empty) - (# /.equivalence = setL)) - - difference! - (not (list.any? (/.member? (/.difference setL setR)) - (/.list setL))) - - idempotence! - (# /.equivalence = - (/.difference setL setR) - (/.difference setL (/.difference setL setR)))] - (and self! + (# /.equivalence = + (if <empty?> empty setL) + (<coverage> setL empty)) + + idempotence! + (# /.equivalence = + (<coverage> setL (<coverage> setL setR)) + (<coverage> setR (<coverage> setL setR)))] + (and self! + super! + empty! + idempotence!)))] + + [/.union /.sub? false] + [/.intersection /.super? true] + )) + (_.cover [/.difference] + (let [self! + (|> setL + (/.difference setL) + (# /.equivalence = empty)) + empty! + (|> setL + (/.difference empty) + (# /.equivalence = setL)) + difference! - idempotence!))) - ))))) + (not (list.any? (/.member? (/.difference setL setR)) + (/.list setL))) + + idempotence! + (# /.equivalence = + (/.difference setL setR) + (/.difference setL (/.difference setL setR)))] + (and self! + empty! + difference! + idempotence!))) + ))))) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index db77ca8b3..f23767283 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -1,22 +1,22 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" functor {"+" Injection}]]] - [control - ["[0]" maybe]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" functor {"+" Injection}]]] + [control + ["[0]" maybe]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: (injection value) (Injection /.Stack) @@ -30,41 +30,41 @@ [size (# random.monad each (n.% 100) random.nat) sample (random.stack size random.nat) expected_top random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) - (_.for [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) - - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (bit#= (n.= 0 (/.size sample)) - (/.empty? sample))) - (_.cover [/.empty] - (/.empty? /.empty)) - (_.cover [/.value] - (case (/.value sample) - {.#None} - (/.empty? sample) - - {.#Some _} - (not (/.empty? sample)))) - (_.cover [/.next] - (case (/.next sample) - {.#None} - (/.empty? sample) - - {.#Some [top remaining]} - (# (/.equivalence n.equivalence) = - sample - (/.top top remaining)))) - (_.cover [/.top] - (case (/.next (/.top expected_top sample)) - {.#Some [actual_top actual_sample]} - (and (same? expected_top actual_top) - (same? sample actual_sample)) - - {.#None} - false)) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) + (_.for [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit#= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.empty] + (/.empty? /.empty)) + (_.cover [/.value] + (case (/.value sample) + {.#None} + (/.empty? sample) + + {.#Some _} + (not (/.empty? sample)))) + (_.cover [/.next] + (case (/.next sample) + {.#None} + (/.empty? sample) + + {.#Some [top remaining]} + (# (/.equivalence n.equivalence) = + sample + (/.top top remaining)))) + (_.cover [/.top] + (case (/.next (/.top expected_top sample)) + {.#Some [actual_top actual_sample]} + (and (same? expected_top actual_top) + (same? sample actual_sample)) + + {.#None} + false)) + )))) diff --git a/stdlib/source/test/lux/data/collection/stream.lux b/stdlib/source/test/lux/data/collection/stream.lux index 64c5d6337..f6ddd13d3 100644 --- a/stdlib/source/test/lux/data/collection/stream.lux +++ b/stdlib/source/test/lux/data/collection/stream.lux @@ -50,74 +50,74 @@ offset (# ! each (n.% 100) random.nat) cycle_start random.nat cycle_next (random.list size random.nat)] - ($_ _.and - (_.for [/.functor] - ($functor.spec /.repeated ..equivalence /.functor)) - (_.for [/.comonad] - ($comonad.spec /.repeated ..equivalence /.comonad)) - - (_.cover [/.item] - (n.= (n.+ offset index) - (/.item index (..iterations ++ offset)))) - (_.cover [/.repeated] - (n.= repeated - (/.item index (/.repeated repeated)))) - (_.cover [/.first] - (list#= (enum.range n.enum offset (-- (n.+ size offset))) - (/.first size (..iterations ++ offset)))) - (_.cover [/.after] - (list#= (enum.range n.enum offset (-- (n.+ size offset))) - (/.first size (/.after offset (..iterations ++ 0))))) - (_.cover [/.split_at] - (let [[drops takes] (/.split_at size (..iterations ++ 0))] - (and (list#= (enum.range n.enum 0 (-- size)) - drops) - (list#= (enum.range n.enum size (-- (n.* 2 size))) - (/.first size takes))))) - (_.cover [/.while] - (list#= (enum.range n.enum 0 (-- size)) - (/.while (n.< size) (..iterations ++ 0)))) - (_.cover [/.until] - (list#= (enum.range n.enum offset (-- (n.+ size offset))) - (/.while (n.< (n.+ size offset)) - (/.until (n.< offset) (..iterations ++ 0))))) - (_.cover [/.split_when] - (let [[drops takes] (/.split_when (n.= size) (..iterations ++ 0))] - (and (list#= (enum.range n.enum 0 (-- size)) - drops) - (list#= (enum.range n.enum size (-- (n.* 2 size))) - (/.while (n.< (n.* 2 size)) takes))))) - (_.cover [/.head] - (n.= offset - (/.head (..iterations ++ offset)))) - (_.cover [/.tail] - (list#= (enum.range n.enum (++ offset) (n.+ size offset)) - (/.first size (/.tail (..iterations ++ offset))))) - (_.cover [/.only] - (list#= (list#each (n.* 2) (enum.range n.enum 0 (-- size))) - (/.first size (/.only n.even? (..iterations ++ 0))))) - (_.cover [/.partition] - (let [[evens odds] (/.partition n.even? (..iterations ++ 0))] - (and (n.= (n.* 2 offset) - (/.item offset evens)) - (n.= (++ (n.* 2 offset)) - (/.item offset odds))))) - (_.cover [/.iterations] - (let [(open "/#[0]") /.functor - (open "list#[0]") (list.equivalence text.equivalence)] - (list#= (/.first size - (/#each %.nat (..iterations ++ offset))) - (/.first size - (/.iterations (function (_ n) [(++ n) (%.nat n)]) - offset))))) - (_.cover [/.cycle] - (let [cycle (partial_list cycle_start cycle_next)] - (list#= (list.together (list.repeated size cycle)) - (/.first (n.* size (list.size cycle)) - (/.cycle [cycle_start cycle_next]))))) - (_.cover [/.pattern] - (let [(/.pattern first second third next) (..iterations ++ offset)] - (and (n.= offset first) - (n.= (n.+ 1 offset) second) - (n.= (n.+ 2 offset) third)))) - )))) + (all _.and + (_.for [/.functor] + ($functor.spec /.repeated ..equivalence /.functor)) + (_.for [/.comonad] + ($comonad.spec /.repeated ..equivalence /.comonad)) + + (_.cover [/.item] + (n.= (n.+ offset index) + (/.item index (..iterations ++ offset)))) + (_.cover [/.repeated] + (n.= repeated + (/.item index (/.repeated repeated)))) + (_.cover [/.first] + (list#= (enum.range n.enum offset (-- (n.+ size offset))) + (/.first size (..iterations ++ offset)))) + (_.cover [/.after] + (list#= (enum.range n.enum offset (-- (n.+ size offset))) + (/.first size (/.after offset (..iterations ++ 0))))) + (_.cover [/.split_at] + (let [[drops takes] (/.split_at size (..iterations ++ 0))] + (and (list#= (enum.range n.enum 0 (-- size)) + drops) + (list#= (enum.range n.enum size (-- (n.* 2 size))) + (/.first size takes))))) + (_.cover [/.while] + (list#= (enum.range n.enum 0 (-- size)) + (/.while (n.< size) (..iterations ++ 0)))) + (_.cover [/.until] + (list#= (enum.range n.enum offset (-- (n.+ size offset))) + (/.while (n.< (n.+ size offset)) + (/.until (n.< offset) (..iterations ++ 0))))) + (_.cover [/.split_when] + (let [[drops takes] (/.split_when (n.= size) (..iterations ++ 0))] + (and (list#= (enum.range n.enum 0 (-- size)) + drops) + (list#= (enum.range n.enum size (-- (n.* 2 size))) + (/.while (n.< (n.* 2 size)) takes))))) + (_.cover [/.head] + (n.= offset + (/.head (..iterations ++ offset)))) + (_.cover [/.tail] + (list#= (enum.range n.enum (++ offset) (n.+ size offset)) + (/.first size (/.tail (..iterations ++ offset))))) + (_.cover [/.only] + (list#= (list#each (n.* 2) (enum.range n.enum 0 (-- size))) + (/.first size (/.only n.even? (..iterations ++ 0))))) + (_.cover [/.partition] + (let [[evens odds] (/.partition n.even? (..iterations ++ 0))] + (and (n.= (n.* 2 offset) + (/.item offset evens)) + (n.= (++ (n.* 2 offset)) + (/.item offset odds))))) + (_.cover [/.iterations] + (let [(open "/#[0]") /.functor + (open "list#[0]") (list.equivalence text.equivalence)] + (list#= (/.first size + (/#each %.nat (..iterations ++ offset))) + (/.first size + (/.iterations (function (_ n) [(++ n) (%.nat n)]) + offset))))) + (_.cover [/.cycle] + (let [cycle (partial_list cycle_start cycle_next)] + (list#= (list.together (list.repeated size cycle)) + (/.first (n.* size (list.size cycle)) + (/.cycle [cycle_start cycle_next]))))) + (_.cover [/.pattern] + (let [(/.pattern first second third next) (..iterations ++ offset)] + (and (n.= offset first) + (n.= (n.+ 1 offset) second) + (n.= (n.+ 2 offset) third)))) + )))) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index b8569005e..b5dbfa7c4 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -35,57 +35,57 @@ Test (<| (_.covering /._) (_.for [/.Tree]) - ($_ _.and - (_.for [/.equivalence] - (|> (..tree random.nat) - (# random.monad each product.right) - ($equivalence.spec (/.equivalence n.equivalence)))) - (_.for [/.mix] - ($mix.spec /.leaf /.equivalence /.mix)) - (_.for [/.functor] - ($functor.spec /.leaf /.equivalence /.functor)) - - (do random.monad - [[size sample] (..tree random.nat)] - (_.cover [/.flat] - (n.= size - (list.size (/.flat sample))))) - (do random.monad - [expected random.nat] - (_.cover [/.leaf] - (# (list.equivalence n.equivalence) = - (list expected) - (/.flat (/.leaf expected))))) - (do [! random.monad] - [value random.nat - num_children (# ! each (n.% 3) random.nat) - children (random.list num_children random.nat)] - (_.cover [/.branch] - (# (list.equivalence n.equivalence) = - (partial_list value children) - (/.flat (/.branch value (list#each /.leaf children)))))) - (do random.monad - [expected/0 random.nat - expected/1 random.nat - expected/2 random.nat - expected/3 random.nat - expected/4 random.nat - expected/5 random.nat] - (_.cover [/.tree] - (and (# (list.equivalence n.equivalence) = - (list expected/0) - (/.flat (/.tree expected/0))) - (# (list.equivalence n.equivalence) = - (list expected/0 expected/1 expected/2) - (/.flat (/.tree expected/0 - {expected/1 {} - expected/2 {}}))) - (# (list.equivalence n.equivalence) = - (list expected/0 expected/1 expected/2 - expected/3 expected/4 expected/5) - (/.flat (/.tree expected/0 - {expected/1 {} - expected/2 {expected/3 {} - expected/4 {expected/5 {}}}}))) - ))) - ))) + (all _.and + (_.for [/.equivalence] + (|> (..tree random.nat) + (# random.monad each product.right) + ($equivalence.spec (/.equivalence n.equivalence)))) + (_.for [/.mix] + ($mix.spec /.leaf /.equivalence /.mix)) + (_.for [/.functor] + ($functor.spec /.leaf /.equivalence /.functor)) + + (do random.monad + [[size sample] (..tree random.nat)] + (_.cover [/.flat] + (n.= size + (list.size (/.flat sample))))) + (do random.monad + [expected random.nat] + (_.cover [/.leaf] + (# (list.equivalence n.equivalence) = + (list expected) + (/.flat (/.leaf expected))))) + (do [! random.monad] + [value random.nat + num_children (# ! each (n.% 3) random.nat) + children (random.list num_children random.nat)] + (_.cover [/.branch] + (# (list.equivalence n.equivalence) = + (partial_list value children) + (/.flat (/.branch value (list#each /.leaf children)))))) + (do random.monad + [expected/0 random.nat + expected/1 random.nat + expected/2 random.nat + expected/3 random.nat + expected/4 random.nat + expected/5 random.nat] + (_.cover [/.tree] + (and (# (list.equivalence n.equivalence) = + (list expected/0) + (/.flat (/.tree expected/0))) + (# (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2) + (/.flat (/.tree expected/0 + {expected/1 {} + expected/2 {}}))) + (# (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2 + expected/3 expected/4 expected/5) + (/.flat (/.tree expected/0 + {expected/1 {} + expected/2 {expected/3 {} + expected/4 {expected/5 {}}}}))) + ))) + ))) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index fb4ddc214..1a54f242e 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -38,115 +38,115 @@ (random.ascii/alpha_num 1)) expected_left random.nat expected_right random.nat] - ($_ _.and - (_.cover [/.Builder /.builder] - (exec (/.builder text.monoid) - true)) - (_.cover [/.tag] - (and (text#= tag_left - (/.tag (# ..builder leaf tag_left expected_left))) - (text#= (text#composite tag_left tag_right) - (/.tag (# ..builder branch + (all _.and + (_.cover [/.Builder /.builder] + (exec (/.builder text.monoid) + true)) + (_.cover [/.tag] + (and (text#= tag_left + (/.tag (# ..builder leaf tag_left expected_left))) + (text#= (text#composite tag_left tag_right) + (/.tag (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)))))) + (_.cover [/.root] + (and (case (/.root (# ..builder leaf tag_left expected_left)) + {.#Left actual} + (n.= expected_left actual) + + {.#Right _} + false) + (case (/.root (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right))) + {.#Left _} + false + + {.#Right [left right]} + (case [(/.root left) + (/.root right)] + [{.#Left actual_left} {.#Left actual_right}] + (and (n.= expected_left actual_left) + (n.= expected_right actual_right)) + + _ + false)))) + (_.cover [/.value] + (and (n.= expected_left + (/.value (# ..builder leaf tag_left expected_left))) + (n.= expected_left + (/.value (# ..builder branch (# ..builder leaf tag_left expected_left) (# ..builder leaf tag_right expected_right)))))) - (_.cover [/.root] - (and (case (/.root (# ..builder leaf tag_left expected_left)) - {.#Left actual} - (n.= expected_left actual) - - {.#Right _} - false) - (case (/.root (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right))) - {.#Left _} - false - - {.#Right [left right]} - (case [(/.root left) - (/.root right)] - [{.#Left actual_left} {.#Left actual_right}] - (and (n.= expected_left actual_left) - (n.= expected_right actual_right)) - - _ - false)))) - (_.cover [/.value] - (and (n.= expected_left - (/.value (# ..builder leaf tag_left expected_left))) - (n.= expected_left - (/.value (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right)))))) - (do random.monad - [.let [tags_equivalence (list.equivalence text.equivalence) - values_equivalence (list.equivalence n.equivalence)] - tags/H (random.ascii/alpha_num 1) - tags/T (random.list 5 (random.ascii/alpha_num 1)) - values/H random.nat - values/T (random.list 5 random.nat)] - (_.cover [/.tags /.values] - (let [tree (list#mix (function (_ [tag value] tree) - (# builder branch tree (# builder leaf tag value))) - (# builder leaf tags/H values/H) - (list.zipped_2 tags/T values/T))] - (and (# tags_equivalence = (partial_list tags/H tags/T) (/.tags tree)) - (# values_equivalence = (partial_list values/H values/T) (/.values tree)))))) - (_.cover [/.one] - (let [can_find_correct_one! - (|> (# ..builder leaf tag_left expected_left) - (/.one (text.contains? tag_left)) - (maybe#each (n.= expected_left)) - (maybe.else false)) - - cannot_find_incorrect_one! - (|> (# ..builder leaf tag_right expected_right) - (/.one (text.contains? tag_left)) - (maybe#each (n.= expected_left)) - (maybe.else false) - not) + (do random.monad + [.let [tags_equivalence (list.equivalence text.equivalence) + values_equivalence (list.equivalence n.equivalence)] + tags/H (random.ascii/alpha_num 1) + tags/T (random.list 5 (random.ascii/alpha_num 1)) + values/H random.nat + values/T (random.list 5 random.nat)] + (_.cover [/.tags /.values] + (let [tree (list#mix (function (_ [tag value] tree) + (# builder branch tree (# builder leaf tag value))) + (# builder leaf tags/H values/H) + (list.zipped_2 tags/T values/T))] + (and (# tags_equivalence = (partial_list tags/H tags/T) (/.tags tree)) + (# values_equivalence = (partial_list values/H values/T) (/.values tree)))))) + (_.cover [/.one] + (let [can_find_correct_one! + (|> (# ..builder leaf tag_left expected_left) + (/.one (text.contains? tag_left)) + (maybe#each (n.= expected_left)) + (maybe.else false)) - can_find_left! - (|> (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right)) - (/.one (text.contains? tag_left)) - (maybe#each (n.= expected_left)) - (maybe.else false)) - - can_find_right! - (|> (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right)) - (/.one (text.contains? tag_right)) - (maybe#each (n.= expected_right)) - (maybe.else false))] - (and can_find_correct_one! cannot_find_incorrect_one! - can_find_left! - can_find_right!))) - (_.cover [/.exists?] - (let [can_find_correct_one! - (/.exists? (text.contains? tag_left) - (# ..builder leaf tag_left expected_left)) + (|> (# ..builder leaf tag_right expected_right) + (/.one (text.contains? tag_left)) + (maybe#each (n.= expected_left)) + (maybe.else false) + not) - cannot_find_incorrect_one! - (not (/.exists? (text.contains? tag_left) - (# ..builder leaf tag_right expected_right))) + can_find_left! + (|> (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)) + (/.one (text.contains? tag_left)) + (maybe#each (n.= expected_left)) + (maybe.else false)) - can_find_left! - (/.exists? (text.contains? tag_left) - (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right))) + can_find_right! + (|> (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)) + (/.one (text.contains? tag_right)) + (maybe#each (n.= expected_right)) + (maybe.else false))] + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) + (_.cover [/.exists?] + (let [can_find_correct_one! + (/.exists? (text.contains? tag_left) + (# ..builder leaf tag_left expected_left)) - can_find_right! - (/.exists? (text.contains? tag_right) - (# ..builder branch - (# ..builder leaf tag_left expected_left) - (# ..builder leaf tag_right expected_right)))] - (and can_find_correct_one! cannot_find_incorrect_one! + (not (/.exists? (text.contains? tag_left) + (# ..builder leaf tag_right expected_right))) + can_find_left! - can_find_right!))) - )))) + (/.exists? (text.contains? tag_left) + (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right))) + + can_find_right! + (/.exists? (text.contains? tag_right) + (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right)))] + (and can_find_correct_one! + cannot_find_incorrect_one! + can_find_left! + can_find_right!))) + )))) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index b39f5ea63..3a74a5030 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -30,126 +30,126 @@ (do random.monad [expected random.nat dummy (random.only (|>> (n.= expected) not) random.nat)] - ($_ _.and - (_.cover [/.down] - (|> (tree.branch dummy (list (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.up] - (|> (tree.branch expected (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.up] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.right] - (|> (tree.branch dummy (list (tree.leaf dummy) (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.right] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.rightmost] - (|> (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.rightmost] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.left] - (|> (tree.branch dummy (list (tree.leaf expected) (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.right] - [/.left] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.leftmost] - (|> (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [/.rightmost] - [/.leftmost] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.next] - (and (|> (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.next] - [/.value (n.= expected) in]) - (maybe.else false)))) - (_.cover [/.end] - (|> (tree.branch dummy - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf expected))) - /.zipper - (pipe.do maybe.monad - [/.end] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.start] - (|> (tree.branch expected - (list (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.end] - [/.start] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.previous] - (and (|> (tree.branch expected - (list (tree.leaf dummy) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.previous] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> (tree.branch dummy - (list (tree.leaf expected) - (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.next] - [/.next] - [/.previous] - [/.value (n.= expected) in]) - (maybe.else false)))) - ))) + (all _.and + (_.cover [/.down] + (|> (tree.branch dummy (list (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.up] + (|> (tree.branch expected (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.up] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.right] + (|> (tree.branch dummy (list (tree.leaf dummy) (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.right] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.rightmost] + (|> (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.rightmost] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.left] + (|> (tree.branch dummy (list (tree.leaf expected) (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.right] + [/.left] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.leftmost] + (|> (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [/.rightmost] + [/.leftmost] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.next] + (and (|> (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.next] + [/.value (n.= expected) in]) + (maybe.else false)))) + (_.cover [/.end] + (|> (tree.branch dummy + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf expected))) + /.zipper + (pipe.do maybe.monad + [/.end] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.start] + (|> (tree.branch expected + (list (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.end] + [/.start] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.previous] + (and (|> (tree.branch expected + (list (tree.leaf dummy) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.previous] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> (tree.branch dummy + (list (tree.leaf expected) + (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.next] + [/.next] + [/.previous] + [/.value (n.= expected) in]) + (maybe.else false)))) + ))) (def: .public test Test @@ -161,101 +161,101 @@ dummy (random.only (|>> (n.= expected) not) random.nat) .let [(open "tree#[0]") (tree.equivalence n.equivalence) (open "list#[0]") (list.equivalence n.equivalence)]] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (# ! each (|>> product.right /.zipper) (//.tree random.nat)))) - (_.for [/.functor] - ($functor.spec (|>> tree.leaf /.zipper) /.equivalence /.functor)) - (_.for [/.comonad] - ($comonad.spec (|>> tree.leaf /.zipper) /.equivalence /.comonad)) - - (_.cover [/.zipper /.tree] - (|> sample /.zipper /.tree (tree#= sample))) - (_.cover [/.start?] - (|> sample /.zipper /.start?)) - (_.cover [/.leaf?] - (/.leaf? (/.zipper (tree.leaf expected)))) - (_.cover [/.branch?] - (and (/.branch? (/.zipper (tree.branch expected (list (tree.leaf expected))))) - (not (/.branch? (/.zipper (tree.branch expected (list))))))) - (_.cover [/.value] - (and (n.= expected (/.value (/.zipper (tree.leaf expected)))) - (n.= expected (/.value (/.zipper (tree.branch expected (list (tree.leaf expected)))))))) - (_.cover [/.set] - (|> (/.zipper (tree.leaf dummy)) - (/.set expected) - /.value - (n.= expected))) - (_.cover [/.update] - (|> (/.zipper (tree.leaf expected)) - (/.update ++) - /.value - (n.= (++ expected)))) - ..move - (_.cover [/.end?] - (or (/.end? (/.zipper sample)) - (|> sample - /.zipper - /.end - (maybe#each /.end?) - (maybe.else false)))) - (_.cover [/.interpose] - (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (/.interpose expected))] - (and (n.= dummy (/.value cursor)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.down] - [/.value (n.= dummy) in]) - (maybe.else false))))) - (_.cover [/.adopt] - (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (/.adopt expected))] - (and (n.= dummy (/.value cursor)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.value (n.= expected) in]) - (maybe.else false)) - (|> cursor - (pipe.do maybe.monad - [/.down] - [/.right] - [/.value (n.= dummy) in]) - (maybe.else false))))) - (_.cover [/.insert_left] - (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [(/.insert_left expected)] - [/.left] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.insert_right] - (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [(/.insert_right expected)] - [/.right] - [/.value (n.= expected) in]) - (maybe.else false))) - (_.cover [/.remove] - (|> (tree.branch dummy (list (tree.leaf dummy))) - /.zipper - (pipe.do maybe.monad - [/.down] - [(/.insert_left expected)] - [/.remove] - [/.value (n.= expected) in]) - (maybe.else false))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (# ! each (|>> product.right /.zipper) (//.tree random.nat)))) + (_.for [/.functor] + ($functor.spec (|>> tree.leaf /.zipper) /.equivalence /.functor)) + (_.for [/.comonad] + ($comonad.spec (|>> tree.leaf /.zipper) /.equivalence /.comonad)) + + (_.cover [/.zipper /.tree] + (|> sample /.zipper /.tree (tree#= sample))) + (_.cover [/.start?] + (|> sample /.zipper /.start?)) + (_.cover [/.leaf?] + (/.leaf? (/.zipper (tree.leaf expected)))) + (_.cover [/.branch?] + (and (/.branch? (/.zipper (tree.branch expected (list (tree.leaf expected))))) + (not (/.branch? (/.zipper (tree.branch expected (list))))))) + (_.cover [/.value] + (and (n.= expected (/.value (/.zipper (tree.leaf expected)))) + (n.= expected (/.value (/.zipper (tree.branch expected (list (tree.leaf expected)))))))) + (_.cover [/.set] + (|> (/.zipper (tree.leaf dummy)) + (/.set expected) + /.value + (n.= expected))) + (_.cover [/.update] + (|> (/.zipper (tree.leaf expected)) + (/.update ++) + /.value + (n.= (++ expected)))) + ..move + (_.cover [/.end?] + (or (/.end? (/.zipper sample)) + (|> sample + /.zipper + /.end + (maybe#each /.end?) + (maybe.else false)))) + (_.cover [/.interpose] + (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (/.interpose expected))] + (and (n.= dummy (/.value cursor)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.down] + [/.value (n.= dummy) in]) + (maybe.else false))))) + (_.cover [/.adopt] + (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (/.adopt expected))] + (and (n.= dummy (/.value cursor)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.value (n.= expected) in]) + (maybe.else false)) + (|> cursor + (pipe.do maybe.monad + [/.down] + [/.right] + [/.value (n.= dummy) in]) + (maybe.else false))))) + (_.cover [/.insert_left] + (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [(/.insert_left expected)] + [/.left] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.insert_right] + (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [(/.insert_right expected)] + [/.right] + [/.value (n.= expected) in]) + (maybe.else false))) + (_.cover [/.remove] + (|> (tree.branch dummy (list (tree.leaf dummy))) + /.zipper + (pipe.do maybe.monad + [/.down] + [(/.insert_left expected)] + [/.remove] + [/.value (n.= expected) in]) + (maybe.else false))) + )))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index a8b175c3a..14c22b77c 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -23,7 +23,7 @@ (def: .public random (Random /.Color) - (|> ($_ random.and random.nat random.nat random.nat) + (|> (all random.and random.nat random.nat random.nat) (# random.monad each /.of_rgb))) (def: scale @@ -49,10 +49,10 @@ (let [[fr fg fb] (/.rgb from) [tr tg tb] (/.rgb to)] (square_root - ($_ f.+ - (|> (scale tr) (f.- (scale fr)) square) - (|> (scale tg) (f.- (scale fg)) square) - (|> (scale tb) (f.- (scale fb)) square))))) + (all f.+ + (|> (scale tr) (f.- (scale fr)) square) + (|> (scale tg) (f.- (scale fg)) square) + (|> (scale tb) (f.- (scale fb)) square))))) (def: rgb_error_margin +1.8) @@ -68,23 +68,23 @@ (def: (encoding expected) (-> /.Color Test) - ($_ _.and - (_.cover [/.RGB /.rgb /.of_rgb] - (|> expected /.rgb /.of_rgb - (# /.equivalence = expected))) - (_.cover [/.HSL /.hsl /.of_hsl] - (|> expected /.hsl /.of_hsl - (distance/3 expected) - (f.<= ..rgb_error_margin))) - (_.cover [/.HSB /.hsb /.of_hsb] - (|> expected /.hsb /.of_hsb - (distance/3 expected) - (f.<= ..rgb_error_margin))) - (_.cover [/.CMYK /.cmyk /.of_cmyk] - (|> expected /.cmyk /.of_cmyk - (distance/3 expected) - (f.<= ..rgb_error_margin))) - )) + (all _.and + (_.cover [/.RGB /.rgb /.of_rgb] + (|> expected /.rgb /.of_rgb + (# /.equivalence = expected))) + (_.cover [/.HSL /.hsl /.of_hsl] + (|> expected /.hsl /.of_hsl + (distance/3 expected) + (f.<= ..rgb_error_margin))) + (_.cover [/.HSB /.hsb /.of_hsb] + (|> expected /.hsb /.of_hsb + (distance/3 expected) + (f.<= ..rgb_error_margin))) + (_.cover [/.CMYK /.cmyk /.of_cmyk] + (|> expected /.cmyk /.of_cmyk + (distance/3 expected) + (f.<= ..rgb_error_margin))) + )) (def: transformation Test @@ -98,32 +98,32 @@ (and (f.>= +0.25 saturation) (f.<= +0.75 saturation))))))) ratio (|> random.safe_frac (random.only (f.>= +0.5)))] - ($_ _.and - (_.cover [/.darker /.brighter] - (and (f.<= (distance/3 colorful /.black) - (distance/3 (/.darker ratio colorful) /.black)) - (f.<= (distance/3 colorful /.white) - (distance/3 (/.brighter ratio colorful) /.white)))) - (_.cover [/.interpolated] - (and (f.<= (distance/3 colorful /.black) - (distance/3 (/.interpolated ratio /.black colorful) /.black)) - (f.<= (distance/3 colorful /.white) - (distance/3 (/.interpolated ratio /.white colorful) /.white)))) - (_.cover [/.saturated] - (f.> (saturation mediocre) - (saturation (/.saturated ratio mediocre)))) - (_.cover [/.un_saturated] - (f.< (saturation mediocre) - (saturation (/.un_saturated ratio mediocre)))) - (_.cover [/.gray_scale] - (let [gray'ed (/.gray_scale mediocre)] - (and (f.= +0.0 - (saturation gray'ed)) - (|> (luminance gray'ed) - (f.- (luminance mediocre)) - f.abs - (f.<= ..rgb_error_margin))))) - ))) + (all _.and + (_.cover [/.darker /.brighter] + (and (f.<= (distance/3 colorful /.black) + (distance/3 (/.darker ratio colorful) /.black)) + (f.<= (distance/3 colorful /.white) + (distance/3 (/.brighter ratio colorful) /.white)))) + (_.cover [/.interpolated] + (and (f.<= (distance/3 colorful /.black) + (distance/3 (/.interpolated ratio /.black colorful) /.black)) + (f.<= (distance/3 colorful /.white) + (distance/3 (/.interpolated ratio /.white colorful) /.white)))) + (_.cover [/.saturated] + (f.> (saturation mediocre) + (saturation (/.saturated ratio mediocre)))) + (_.cover [/.un_saturated] + (f.< (saturation mediocre) + (saturation (/.un_saturated ratio mediocre)))) + (_.cover [/.gray_scale] + (let [gray'ed (/.gray_scale mediocre)] + (and (f.= +0.0 + (saturation gray'ed)) + (|> (luminance gray'ed) + (f.- (luminance mediocre)) + f.abs + (f.<= ..rgb_error_margin))))) + ))) (def: palette Test @@ -139,40 +139,40 @@ spread_space (f.- min_spread max_spread)] spread (# ! each (|>> f.abs (f.% spread_space) (f.+ min_spread)) random.safe_frac)] - (`` ($_ _.and - (~~ (template [<brightness> <palette>] - [(_.cover [<palette>] - (let [eB <brightness> - expected (/.of_hsb [eH eS eB]) - palette (<palette> spread variations expected)] - (and (n.= variations (list.size palette)) - (not (list.any? (# /.equivalence = expected) palette)))))] - [+1.0 /.analogous] - [+0.5 /.monochromatic] - )) - (~~ (template [<palette>] - [(_.cover [<palette>] - (let [expected (/.of_hsb [eH eS +0.5]) - [c0 c1 c2] (<palette> expected)] - (and (# /.equivalence = expected c0) - (not (# /.equivalence = expected c1)) - (not (# /.equivalence = expected c2)))))] + (`` (all _.and + (~~ (template [<brightness> <palette>] + [(_.cover [<palette>] + (let [eB <brightness> + expected (/.of_hsb [eH eS eB]) + palette (<palette> spread variations expected)] + (and (n.= variations (list.size palette)) + (not (list.any? (# /.equivalence = expected) palette)))))] + [+1.0 /.analogous] + [+0.5 /.monochromatic] + )) + (~~ (template [<palette>] + [(_.cover [<palette>] + (let [expected (/.of_hsb [eH eS +0.5]) + [c0 c1 c2] (<palette> expected)] + (and (# /.equivalence = expected c0) + (not (# /.equivalence = expected c1)) + (not (# /.equivalence = expected c2)))))] - [/.triad] - [/.clash] - [/.split_complement])) - (~~ (template [<palette>] - [(_.cover [<palette>] - (let [expected (/.of_hsb [eH eS +0.5]) - [c0 c1 c2 c3] (<palette> expected)] - (and (# /.equivalence = expected c0) - (not (# /.equivalence = expected c1)) - (not (# /.equivalence = expected c2)) - (not (# /.equivalence = expected c3)))))] + [/.triad] + [/.clash] + [/.split_complement])) + (~~ (template [<palette>] + [(_.cover [<palette>] + (let [expected (/.of_hsb [eH eS +0.5]) + [c0 c1 c2 c3] (<palette> expected)] + (and (# /.equivalence = expected c0) + (not (# /.equivalence = expected c1)) + (not (# /.equivalence = expected c2)) + (not (# /.equivalence = expected c3)))))] - [/.square] - [/.tetradic])) - ))))) + [/.square] + [/.tetradic])) + ))))) (def: .public test Test @@ -180,33 +180,33 @@ (_.for [/.Color]) (do [! random.monad] [expected ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.addition] - ($monoid.spec /.equivalence /.addition ..random)) - (_.for [/.subtraction] - ($monoid.spec /.equivalence /.addition ..random)) - - (..encoding expected) - (_.cover [/.complement] - (let [~expected (/.complement expected) - (open "/#[0]") /.equivalence] - (and (not (/#= expected ~expected)) - (/#= expected (/.complement ~expected))))) - (_.cover [/.black /.white] - (and (# /.equivalence = /.white (/.complement /.black)) - (# /.equivalence = /.black (/.complement /.white)))) - ..transformation - ..palette - (_.for [/.Alpha /.Pigment] - ($_ _.and - (_.cover [/.transparent /.opaque] - (and (r.= /.opaque (-- /.transparent)) - (r.= /.transparent (++ /.opaque)))) - (_.cover [/.translucent] - (r.= /.transparent (r.+ /.translucent /.translucent))) - )) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.addition] + ($monoid.spec /.equivalence /.addition ..random)) + (_.for [/.subtraction] + ($monoid.spec /.equivalence /.addition ..random)) + + (..encoding expected) + (_.cover [/.complement] + (let [~expected (/.complement expected) + (open "/#[0]") /.equivalence] + (and (not (/#= expected ~expected)) + (/#= expected (/.complement ~expected))))) + (_.cover [/.black /.white] + (and (# /.equivalence = /.white (/.complement /.black)) + (# /.equivalence = /.black (/.complement /.white)))) + ..transformation + ..palette + (_.for [/.Alpha /.Pigment] + (all _.and + (_.cover [/.transparent /.opaque] + (and (r.= /.opaque (-- /.transparent)) + (r.= /.transparent (++ /.opaque)))) + (_.cover [/.translucent] + (r.= /.transparent (r.+ /.translucent /.translucent))) + )) + )))) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 2c9d336a4..ce4f22fc3 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -227,14 +227,14 @@ (def: .public test Test (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<definition> <by_letter>] - [<definition>] - - <colors>)) - (_.cover [/.aqua] - (# //.equivalence = /.cyan /.aqua)) - (_.cover [/.fuchsia] - (# //.equivalence = /.magenta /.fuchsia)) - )))) + (`` (all _.and + (~~ (template [<definition> <by_letter>] + [<definition>] + + <colors>)) + (_.cover [/.aqua] + (# //.equivalence = /.cyan /.aqua)) + (_.cover [/.fuchsia] + (# //.equivalence = /.magenta /.fuchsia)) + )))) ) diff --git a/stdlib/source/test/lux/data/format/binary.lux b/stdlib/source/test/lux/data/format/binary.lux index 0a7227fd6..571a1ef5a 100644 --- a/stdlib/source/test/lux/data/format/binary.lux +++ b/stdlib/source/test/lux/data/format/binary.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [equivalence {"+" Equivalence}] - [monad {"+" do}] - [\\specification - ["$[0]" monoid]]] - [data - ["[0]" binary ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [equivalence {"+" Equivalence}] + [monad {"+" do}] + [\\specification + ["$[0]" monoid]]] + [data + ["[0]" binary ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" /]]) (implementation: equivalence (Equivalence /.Specification) @@ -29,7 +29,7 @@ Test (<| (_.covering /._) (_.for [/.Mutation /.Specification /.Writer]) - ($_ _.and - (_.for [/.monoid] - ($monoid.spec ..equivalence /.monoid ..random)) - ))) + (all _.and + (_.for [/.monoid] + ($monoid.spec ..equivalence /.monoid ..random)) + ))) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 3d10458af..1c33df2b6 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -37,14 +37,14 @@ (function (_ again) (do [! random.monad] [size (# ! each (n.% 2) random.nat)] - ($_ random.or - (# ! in []) - random.bit - random.safe_frac - (random.unicode size) - (random.sequence size again) - (random.dictionary text.hash size (random.unicode size) again) - ))))) + (all random.or + (# ! in []) + random.bit + random.safe_frac + (random.unicode size) + (random.sequence size again) + (random.dictionary text.hash size (random.unicode size) again) + ))))) (syntax: (boolean []) (do meta.monad @@ -65,135 +65,135 @@ Test (<| (_.covering /._) (_.for [/.JSON]) - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [sample ..random] - (_.cover [/.Null /.null?] - (# bit.equivalence = - (/.null? sample) - (case sample - {/.#Null} true - _ false)))) - (do random.monad - [expected ..random] - (_.cover [/.format] - (|> expected - /.format - (# /.codec decoded) - (try#each (#= expected)) - (try.else false)))) - (do random.monad - [keys (random.set text.hash 3 (random.ascii/alpha 1)) - values (random.set frac.hash 3 random.safe_frac) - .let [expected (list.zipped_2 (set.list keys) - (list#each (|>> {/.#Number}) (set.list values))) - object (/.object expected)]] - ($_ _.and - (_.cover [/.object /.fields] - (case (/.fields object) - {try.#Success actual} - (# (list.equivalence text.equivalence) = - (list#each product.left expected) - actual) - - {try.#Failure error} - false)) - (_.cover [/.field] - (list.every? (function (_ [key expected]) - (|> (/.field key object) - (try#each (#= expected)) - (try.else false))) - expected)) - )) - (do random.monad - [key (random.ascii/alpha 1) - unknown (random.only (|>> (# text.equivalence = key) not) - (random.ascii/alpha 1)) - expected random.safe_frac] - (_.cover [/.has] - (<| (try.else false) - (do try.monad - [object (/.has key {/.#Number expected} (/.object (list))) - .let [can_find_known_key! - (|> object - (/.field key) - (try#each (#= {/.#Number expected})) - (try.else false)) + (do random.monad + [sample ..random] + (_.cover [/.Null /.null?] + (# bit.equivalence = + (/.null? sample) + (case sample + {/.#Null} true + _ false)))) + (do random.monad + [expected ..random] + (_.cover [/.format] + (|> expected + /.format + (# /.codec decoded) + (try#each (#= expected)) + (try.else false)))) + (do random.monad + [keys (random.set text.hash 3 (random.ascii/alpha 1)) + values (random.set frac.hash 3 random.safe_frac) + .let [expected (list.zipped_2 (set.list keys) + (list#each (|>> {/.#Number}) (set.list values))) + object (/.object expected)]] + (all _.and + (_.cover [/.object /.fields] + (case (/.fields object) + {try.#Success actual} + (# (list.equivalence text.equivalence) = + (list#each product.left expected) + actual) + + {try.#Failure error} + false)) + (_.cover [/.field] + (list.every? (function (_ [key expected]) + (|> (/.field key object) + (try#each (#= expected)) + (try.else false))) + expected)) + )) + (do random.monad + [key (random.ascii/alpha 1) + unknown (random.only (|>> (# text.equivalence = key) not) + (random.ascii/alpha 1)) + expected random.safe_frac] + (_.cover [/.has] + (<| (try.else false) + (do try.monad + [object (/.has key {/.#Number expected} (/.object (list))) + .let [can_find_known_key! + (|> object + (/.field key) + (try#each (#= {/.#Number expected})) + (try.else false)) - cannot_find_unknown_key! - (case (/.field unknown object) - {try.#Success _} - false + cannot_find_unknown_key! + (case (/.field unknown object) + {try.#Success _} + false - {try.#Failure error} - true)]] - (in (and can_find_known_key! - cannot_find_unknown_key!)))))) - (~~ (template [<type> <field> <tag> <random> <equivalence>] - [(do random.monad - [key (random.ascii/alpha 1) - value <random>] - (_.cover [<type> <field>] - (|> (/.object (list [key {<tag> value}])) - (<field> key) - (try#each (# <equivalence> = value)) - (try.else false))))] + {try.#Failure error} + true)]] + (in (and can_find_known_key! + cannot_find_unknown_key!)))))) + (~~ (template [<type> <field> <tag> <random> <equivalence>] + [(do random.monad + [key (random.ascii/alpha 1) + value <random>] + (_.cover [<type> <field>] + (|> (/.object (list [key {<tag> value}])) + (<field> key) + (try#each (# <equivalence> = value)) + (try.else false))))] - [/.Boolean /.boolean_field /.#Boolean random.bit bit.equivalence] - [/.Number /.number_field /.#Number random.safe_frac frac.equivalence] - [/.String /.string_field /.#String (random.ascii/alpha 1) text.equivalence] - [/.Array /.array_field /.#Array (random.sequence 3 ..random) (sequence.equivalence /.equivalence)] - [/.Object /.object_field /.#Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] - )) - (with_expansions [<boolean> (boolean) - <number> (number) - <string> (string) - <array_sequence> (sequence.sequence {/.#Null} - {/.#Boolean <boolean>} - {/.#Number <number>} - {/.#String <string>}) - <key0> (string) - <key1> (string) - <key2> (string) - <key3> (string) - <key4> (string) - <key5> (string) - <key6> (string)] - (_.cover [/.json] - (and (#= {/.#Null} (/.json ())) - (~~ (template [<tag> <value>] - [(#= {<tag> <value>} (/.json <value>))] - - [/.#Boolean <boolean>] - [/.#Number <number>] - [/.#String <string>] - )) - (#= {/.#Array <array_sequence>} (/.json [() <boolean> <number> <string>])) - (let [object (/.json {<key0> () - <key1> <boolean> - <key2> <number> - <key3> <string> - <key4> [() <boolean> <number> <string>] - <key5> {<key6> <number>}})] - (<| (try.else false) - (do try.monad - [value0 (/.field <key0> object) - value1 (/.field <key1> object) - value2 (/.field <key2> object) - value3 (/.field <key3> object) - value4 (/.field <key4> object) - value5 (/.field <key5> object) - value6 (/.field <key6> value5)] - (in (and (#= {/.#Null} value0) - (#= {/.#Boolean <boolean>} value1) - (#= {/.#Number <number>} value2) - (#= {/.#String <string>} value3) - (#= {/.#Array <array_sequence>} value4) - (#= {/.#Number <number>} value6)))))) - ))) - )))) + [/.Boolean /.boolean_field /.#Boolean random.bit bit.equivalence] + [/.Number /.number_field /.#Number random.safe_frac frac.equivalence] + [/.String /.string_field /.#String (random.ascii/alpha 1) text.equivalence] + [/.Array /.array_field /.#Array (random.sequence 3 ..random) (sequence.equivalence /.equivalence)] + [/.Object /.object_field /.#Object (random.dictionary text.hash 3 (random.ascii/alpha 1) ..random) (dictionary.equivalence /.equivalence)] + )) + (with_expansions [<boolean> (boolean) + <number> (number) + <string> (string) + <array_sequence> (sequence.sequence {/.#Null} + {/.#Boolean <boolean>} + {/.#Number <number>} + {/.#String <string>}) + <key0> (string) + <key1> (string) + <key2> (string) + <key3> (string) + <key4> (string) + <key5> (string) + <key6> (string)] + (_.cover [/.json] + (and (#= {/.#Null} (/.json ())) + (~~ (template [<tag> <value>] + [(#= {<tag> <value>} (/.json <value>))] + + [/.#Boolean <boolean>] + [/.#Number <number>] + [/.#String <string>] + )) + (#= {/.#Array <array_sequence>} (/.json [() <boolean> <number> <string>])) + (let [object (/.json {<key0> () + <key1> <boolean> + <key2> <number> + <key3> <string> + <key4> [() <boolean> <number> <string>] + <key5> {<key6> <number>}})] + (<| (try.else false) + (do try.monad + [value0 (/.field <key0> object) + value1 (/.field <key1> object) + value2 (/.field <key2> object) + value3 (/.field <key3> object) + value4 (/.field <key4> object) + value5 (/.field <key5> object) + value6 (/.field <key6> value5)] + (in (and (#= {/.#Null} value0) + (#= {/.#Boolean <boolean>} value1) + (#= {/.#Number <number>} value2) + (#= {/.#String <string>} value3) + (#= {/.#Array <array_sequence>} value4) + (#= {/.#Number <number>} value6)))))) + ))) + )))) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index d38efe7ec..1bffe48ec 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -44,32 +44,32 @@ invalid (random.ascii/lower (++ /.path_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.path_size)] - (`` ($_ _.and - (_.cover [/.path /.from_path] - (case (/.path expected) - {try.#Success actual} - (text#= expected - (/.from_path actual)) - - {try.#Failure error} - false)) - (_.cover [/.no_path] - (text#= "" (/.from_path /.no_path))) - (_.cover [/.path_size /.path_is_too_long] - (case (/.path invalid) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.path_is_too_long error))) - (_.cover [/.not_ascii] - (case (/.path not_ascii) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_ascii error))) - ))))) + (`` (all _.and + (_.cover [/.path /.from_path] + (case (/.path expected) + {try.#Success actual} + (text#= expected + (/.from_path actual)) + + {try.#Failure error} + false)) + (_.cover [/.no_path] + (text#= "" (/.from_path /.no_path))) + (_.cover [/.path_size /.path_is_too_long] + (case (/.path invalid) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.path_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.path not_ascii) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_ascii error))) + ))))) (def: name Test @@ -79,30 +79,30 @@ invalid (random.ascii/lower (++ /.name_size)) not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name_size)] - (`` ($_ _.and - (_.cover [/.name /.from_name] - (case (/.name expected) - {try.#Success actual} - (text#= expected - (/.from_name actual)) - - {try.#Failure error} - false)) - (_.cover [/.name_size /.name_is_too_long] - (case (/.name invalid) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.name_is_too_long error))) - (_.cover [/.not_ascii] - (case (/.name not_ascii) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_ascii error))) - ))))) + (`` (all _.and + (_.cover [/.name /.from_name] + (case (/.name expected) + {try.#Success actual} + (text#= expected + (/.from_name actual)) + + {try.#Failure error} + false)) + (_.cover [/.name_size /.name_is_too_long] + (case (/.name invalid) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.name_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.name not_ascii) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_ascii error))) + ))))) (def: small Test @@ -110,23 +110,23 @@ (do [! random.monad] [expected (|> random.nat (# ! each (n.% /.small_limit))) invalid (|> random.nat (# ! each (n.max /.small_limit)))] - (`` ($_ _.and - (_.cover [/.small /.from_small] - (case (/.small expected) - {try.#Success actual} - (n.= expected - (/.from_small actual)) - - {try.#Failure error} - false)) - (_.cover [/.small_limit /.not_a_small_number] - (case (/.small invalid) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_a_small_number error))) - ))))) + (`` (all _.and + (_.cover [/.small /.from_small] + (case (/.small expected) + {try.#Success actual} + (n.= expected + (/.from_small actual)) + + {try.#Failure error} + false)) + (_.cover [/.small_limit /.not_a_small_number] + (case (/.small invalid) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_a_small_number error))) + ))))) (def: big Test @@ -134,23 +134,23 @@ (do [! random.monad] [expected (|> random.nat (# ! each (n.% /.big_limit))) invalid (|> random.nat (# ! each (n.max /.big_limit)))] - (`` ($_ _.and - (_.cover [/.big /.from_big] - (case (/.big expected) - {try.#Success actual} - (n.= expected - (/.from_big actual)) - - {try.#Failure error} - false)) - (_.cover [/.big_limit /.not_a_big_number] - (case (/.big invalid) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_a_big_number error))) - ))))) + (`` (all _.and + (_.cover [/.big /.from_big] + (case (/.big expected) + {try.#Success actual} + (n.= expected + (/.from_big actual)) + + {try.#Failure error} + false)) + (_.cover [/.big_limit /.not_a_big_number] + (case (/.big invalid) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_a_big_number error))) + ))))) (def: chunk_size 32) @@ -166,61 +166,61 @@ (list.repeated chunks) text.together (# utf8.codec encoded))]] - (`` ($_ _.and - (~~ (template [<type> <tag>] - [(_.cover [<type>] - (|> (do try.monad - [expected_path (/.path expected_path) - tar (|> (sequence.sequence {<tag> expected_path}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {<tag> actual_path})) - (text#= (/.from_path expected_path) - (/.from_path actual_path)) - - _ - false))) - (try.else false)))] - - [/.Symbolic_Link /.#Symbolic_Link] - [/.Directory /.#Directory] - )) - (_.for [/.File /.Content /.content /.data] - ($_ _.and - (~~ (template [<type> <tag>] - [(_.cover [<type>] - (|> (do try.monad - [expected_path (/.path expected_path) - expected_content (/.content content) - tar (|> (sequence.sequence {<tag> [expected_path - expected_moment - /.none - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - expected_content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]})) - (let [seconds (is (-> Instant Int) - (|>> instant.relative (duration.ticks duration.second)))] - (and (text#= (/.from_path expected_path) - (/.from_path actual_path)) - (i.= (seconds expected_moment) - (seconds actual_moment)) - (binary#= (/.data expected_content) - (/.data actual_content)))) - - _ - false))) - (try.else false)))] - - [/.Normal /.#Normal] - [/.Contiguous /.#Contiguous] - )))))))) + (`` (all _.and + (~~ (template [<type> <tag>] + [(_.cover [<type>] + (|> (do try.monad + [expected_path (/.path expected_path) + tar (|> (sequence.sequence {<tag> expected_path}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {<tag> actual_path})) + (text#= (/.from_path expected_path) + (/.from_path actual_path)) + + _ + false))) + (try.else false)))] + + [/.Symbolic_Link /.#Symbolic_Link] + [/.Directory /.#Directory] + )) + (_.for [/.File /.Content /.content /.data] + (all _.and + (~~ (template [<type> <tag>] + [(_.cover [<type>] + (|> (do try.monad + [expected_path (/.path expected_path) + expected_content (/.content content) + tar (|> (sequence.sequence {<tag> [expected_path + expected_moment + /.none + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + expected_content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]})) + (let [seconds (is (-> Instant Int) + (|>> instant.relative (duration.ticks duration.second)))] + (and (text#= (/.from_path expected_path) + (/.from_path actual_path)) + (i.= (seconds expected_moment) + (seconds actual_moment)) + (binary#= (/.data expected_content) + (/.data actual_content)))) + + _ + false))) + (try.else false)))] + + [/.Normal /.#Normal] + [/.Contiguous /.#Contiguous] + )))))))) (def: random_mode (Random /.Mode) @@ -246,71 +246,71 @@ [path (random.ascii/lower 10) modes (random.list 4 ..random_mode) .let [expected_mode (list#mix /.and /.none modes)]] - (`` ($_ _.and - (_.cover [/.and] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - expected_mode - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ actual_mode _ _]})) - (n.= (/.mode expected_mode) - (/.mode actual_mode)) - - _ - false))) - (try.else false))) - (~~ (template [<expected_mode>] - [(_.cover [<expected_mode>] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - <expected_mode> - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ actual_mode _ _]})) - (n.= (/.mode <expected_mode>) - (/.mode actual_mode)) - - _ - false))) - (try.else false)))] - - [/.none] - - [/.execute_by_other] - [/.write_by_other] - [/.read_by_other] - - [/.execute_by_group] - [/.write_by_group] - [/.read_by_group] - - [/.execute_by_owner] - [/.write_by_owner] - [/.read_by_owner] - - [/.save_text] - [/.set_group_id_on_execution] - [/.set_user_id_on_execution] - ))))))) + (`` (all _.and + (_.cover [/.and] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + expected_mode + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ actual_mode _ _]})) + (n.= (/.mode expected_mode) + (/.mode actual_mode)) + + _ + false))) + (try.else false))) + (~~ (template [<expected_mode>] + [(_.cover [<expected_mode>] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + <expected_mode> + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ actual_mode _ _]})) + (n.= (/.mode <expected_mode>) + (/.mode actual_mode)) + + _ + false))) + (try.else false)))] + + [/.none] + + [/.execute_by_other] + [/.write_by_other] + [/.read_by_other] + + [/.execute_by_group] + [/.write_by_group] + [/.read_by_group] + + [/.execute_by_owner] + [/.write_by_owner] + [/.read_by_owner] + + [/.save_text] + [/.set_group_id_on_execution] + [/.set_user_id_on_execution] + ))))))) (def: ownership Test @@ -321,75 +321,75 @@ not_ascii (random.text (random.char (unicode.set [unicode/block.katakana (list)])) /.name_size)] (_.for [/.Ownership /.Owner /.ID] - ($_ _.and - (_.cover [/.name_size /.name_is_too_long] - (case (/.name invalid) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.name_is_too_long error))) - (_.cover [/.not_ascii] - (case (/.name not_ascii) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.not_ascii error))) - (_.cover [/.Name /.name /.from_name] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - expected (/.name expected) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - /.none - [/.#user [/.#name expected - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) - (and (text#= (/.from_name expected) - (/.from_name (the [/.#user /.#name] actual_ownership))) - (text#= (/.from_name /.anonymous) - (/.from_name (the [/.#group /.#name] actual_ownership)))) - - _ - false))) - (try.else false))) - (_.cover [/.anonymous /.no_id] - (|> (do try.monad - [path (/.path path) - content (/.content (binary.empty 0)) - tar (|> (sequence.sequence {/.#Normal [path - (instant.of_millis +0) - /.none - [/.#user [/.#name /.anonymous - /.#id /.no_id] - /.#group [/.#name /.anonymous - /.#id /.no_id]] - content]}) - (format.result /.writer) - (<b>.result /.parser))] - (in (case (sequence.list tar) - (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) - (and (text#= (/.from_name /.anonymous) - (/.from_name (the [/.#user /.#name] actual_ownership))) - (n.= (/.from_small /.no_id) - (/.from_small (the [/.#user /.#id] actual_ownership))) - (text#= (/.from_name /.anonymous) - (/.from_name (the [/.#group /.#name] actual_ownership))) - (n.= (/.from_small /.no_id) - (/.from_small (the [/.#group /.#id] actual_ownership)))) - - _ - false))) - (try.else false))) - )))) + (all _.and + (_.cover [/.name_size /.name_is_too_long] + (case (/.name invalid) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.name_is_too_long error))) + (_.cover [/.not_ascii] + (case (/.name not_ascii) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.not_ascii error))) + (_.cover [/.Name /.name /.from_name] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + expected (/.name expected) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + /.none + [/.#user [/.#name expected + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) + (and (text#= (/.from_name expected) + (/.from_name (the [/.#user /.#name] actual_ownership))) + (text#= (/.from_name /.anonymous) + (/.from_name (the [/.#group /.#name] actual_ownership)))) + + _ + false))) + (try.else false))) + (_.cover [/.anonymous /.no_id] + (|> (do try.monad + [path (/.path path) + content (/.content (binary.empty 0)) + tar (|> (sequence.sequence {/.#Normal [path + (instant.of_millis +0) + /.none + [/.#user [/.#name /.anonymous + /.#id /.no_id] + /.#group [/.#name /.anonymous + /.#id /.no_id]] + content]}) + (format.result /.writer) + (<b>.result /.parser))] + (in (case (sequence.list tar) + (pattern (list {/.#Normal [_ _ _ actual_ownership _]})) + (and (text#= (/.from_name /.anonymous) + (/.from_name (the [/.#user /.#name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (the [/.#user /.#id] actual_ownership))) + (text#= (/.from_name /.anonymous) + (/.from_name (the [/.#group /.#name] actual_ownership))) + (n.= (/.from_small /.no_id) + (/.from_small (the [/.#group /.#id] actual_ownership)))) + + _ + false))) + (try.else false))) + )))) (def: .public test Test @@ -397,30 +397,30 @@ (_.for [/.Tar]) (do random.monad [_ (in [])] - ($_ _.and - (_.cover [/.writer /.parser] - (|> sequence.empty - (format.result /.writer) - (<b>.result /.parser) - (# try.monad each sequence.empty?) - (try.else false))) - (_.cover [/.invalid_end_of_archive] - (let [dump (format.result /.writer sequence.empty)] - (case (<b>.result /.parser (binary#composite dump dump)) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.invalid_end_of_archive error)))) - - ..path - ..name - ..small - ..big - (_.for [/.Entry] - ($_ _.and - ..entry - ..mode - ..ownership - )) - )))) + (all _.and + (_.cover [/.writer /.parser] + (|> sequence.empty + (format.result /.writer) + (<b>.result /.parser) + (# try.monad each sequence.empty?) + (try.else false))) + (_.cover [/.invalid_end_of_archive] + (let [dump (format.result /.writer sequence.empty)] + (case (<b>.result /.parser (binary#composite dump dump)) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.invalid_end_of_archive error)))) + + ..path + ..name + ..small + ..big + (_.for [/.Entry] + (all _.and + ..entry + ..mode + ..ownership + )) + )))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index c547d400c..b4c0e7276 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -63,35 +63,35 @@ (random.or (..text 1 10) (do random.monad [size (..size 0 2)] - ($_ random.and - ..symbol - (random.dictionary symbol.hash size ..symbol (..text 0 10)) - (random.list size random))))))) + (all random.and + ..symbol + (random.dictionary symbol.hash size ..symbol (..text 0 10)) + (random.list size random))))))) (def: .public test Test (<| (_.covering /._) (_.for [/.XML]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do [! random.monad] - [(^.let symbol [namespace name]) ..symbol] - (`` ($_ _.and - (~~ (template [<type> <format>] - [(_.cover [<type> <format>] - (and (text#= name (<format> ["" name])) - (let [symbol (<format> symbol)] - (and (text.starts_with? namespace symbol) - (text.ends_with? name symbol)))))] + (do [! random.monad] + [(^.let symbol [namespace name]) ..symbol] + (`` (all _.and + (~~ (template [<type> <format>] + [(_.cover [<type> <format>] + (and (text#= name (<format> ["" name])) + (let [symbol (<format> symbol)] + (and (text.starts_with? namespace symbol) + (text.ends_with? name symbol)))))] - [/.Tag /.tag] - [/.Attribute /.attribute] - )) - (_.cover [/.Attrs /.attributes] - (dictionary.empty? /.attributes)) - ))) - ))) + [/.Tag /.tag] + [/.Attribute /.attribute] + )) + (_.cover [/.Attrs /.attributes] + (dictionary.empty? /.attributes)) + ))) + ))) diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index 7694292ba..2e8c63f0b 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -1,16 +1,16 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad] - ["$[0]" comonad]]]]] - [\\library - ["[0]" / {"+" Identity}]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad] + ["$[0]" comonad]]]]] + [\\library + ["[0]" / {"+" Identity}]]) (def: injection (Injection Identity) @@ -25,13 +25,13 @@ Test (<| (_.covering /._) (_.for [/.Identity]) - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) - (_.for [/.comonad] - ($comonad.spec ..injection ..comparison /.comonad)) - ))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + (_.for [/.comonad] + ($comonad.spec ..injection ..comparison /.comonad)) + ))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index a16cead5e..a33f53a1d 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" /]]) (def: .public test Test @@ -23,47 +23,47 @@ shift random.nat dummy (random.only (|>> (n.= expected) not) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence i.equivalence) - (random.and random.nat random.int))) - (do random.monad - [left random.int - right random.nat] - (_.cover [/.hash] - (let [hash (/.hash i.hash n.hash)] - (n.= (n.+ (# i.hash hash left) - (# n.hash hash right)) - (# hash hash [left right]))))) - - (<| (_.cover [/.left]) - (n.= expected (/.left [expected dummy]))) - (<| (_.cover [/.right]) - (n.= expected (/.right [dummy expected]))) - (<| (_.cover [/.forked]) - (let [[left right] ((/.forked (n.+ shift) (n.- shift)) expected)] - (and (n.= (n.+ shift expected) - left) - (n.= (n.- shift expected) - right)))) - (do random.monad - [left random.nat - right random.nat] - ($_ _.and - (<| (_.cover [/.swapped]) - (let [pair [left right]] - (and (n.= (/.left pair) - (/.right (/.swapped pair))) - (n.= (/.right pair) - (/.left (/.swapped pair)))))) - (<| (_.cover [/.uncurried]) - (n.= (n.+ left right) - ((/.uncurried n.+) [left right]))) - (<| (_.cover [/.curried]) - (n.= (n.+ left right) - ((/.curried (/.uncurried n.+)) left right))) - (<| (_.cover [/.then]) - (let [[left' right'] (/.then (n.+ shift) (n.- shift) [left right])] - (and (n.= (n.+ shift left) left') - (n.= (n.- shift right) right')))))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence i.equivalence) + (random.and random.nat random.int))) + (do random.monad + [left random.int + right random.nat] + (_.cover [/.hash] + (let [hash (/.hash i.hash n.hash)] + (n.= (n.+ (# i.hash hash left) + (# n.hash hash right)) + (# hash hash [left right]))))) + + (<| (_.cover [/.left]) + (n.= expected (/.left [expected dummy]))) + (<| (_.cover [/.right]) + (n.= expected (/.right [dummy expected]))) + (<| (_.cover [/.forked]) + (let [[left right] ((/.forked (n.+ shift) (n.- shift)) expected)] + (and (n.= (n.+ shift expected) + left) + (n.= (n.- shift expected) + right)))) + (do random.monad + [left random.nat + right random.nat] + (all _.and + (<| (_.cover [/.swapped]) + (let [pair [left right]] + (and (n.= (/.left pair) + (/.right (/.swapped pair))) + (n.= (/.right pair) + (/.left (/.swapped pair)))))) + (<| (_.cover [/.uncurried]) + (n.= (n.+ left right) + ((/.uncurried n.+) [left right]))) + (<| (_.cover [/.curried]) + (n.= (n.+ left right) + ((/.curried (/.uncurried n.+)) left right))) + (<| (_.cover [/.then]) + (let [[left' right'] (/.then (n.+ shift) (n.- shift) [left right])] + (and (n.= (n.+ shift left) left') + (n.= (n.- shift right) right')))))) + )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 6d9e6cc5e..ec9e7d67d 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -28,79 +28,79 @@ (do [! random.monad] [expected random.nat shift random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence n.equivalence) - (random.or random.nat random.nat))) - (_.for [/.hash] - ($hash.spec (/.hash n.hash n.hash) - (random.or random.nat random.nat))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence n.equivalence) + (random.or random.nat random.nat))) + (_.for [/.hash] + ($hash.spec (/.hash n.hash n.hash) + (random.or random.nat random.nat))) - (_.cover [/.left] - (|> (/.left expected) - (is (Or Nat Nat)) - (pipe.case - {0 #0 actual} (n.= expected actual) - _ false))) - (_.cover [/.right] - (|> (/.right expected) - (is (Or Nat Nat)) - (pipe.case - {0 #1 actual} (n.= expected actual) - _ false))) - (_.cover [/.either] - (and (|> (/.left expected) - (is (Or Nat Nat)) - (/.either (n.+ shift) (n.- shift)) - (n.= (n.+ shift expected))) - (|> (/.right expected) - (is (Or Nat Nat)) - (/.either (n.+ shift) (n.- shift)) - (n.= (n.- shift expected))))) - (_.cover [/.then] - (and (|> (/.left expected) - (is (Or Nat Nat)) - (/.then (n.+ shift) (n.- shift)) - (pipe.case {0 #0 actual} (n.= (n.+ shift expected) actual) _ false)) - (|> (/.right expected) - (is (Or Nat Nat)) - (/.then (n.+ shift) (n.- shift)) - (pipe.case {0 #1 actual} (n.= (n.- shift expected) actual) _ false)))) - (do ! - [size (# ! each (n.% 5) random.nat) - expected (random.list size random.nat)] - ($_ _.and - (_.cover [/.lefts] - (let [actual (is (List (Or Nat Nat)) - (list#each /.left expected))] - (and (# (list.equivalence n.equivalence) = - expected - (/.lefts actual)) - (# (list.equivalence n.equivalence) = - (list) - (/.rights actual))))) - (_.cover [/.rights] - (let [actual (is (List (Or Nat Nat)) - (list#each /.right expected))] - (and (# (list.equivalence n.equivalence) = - expected - (/.rights actual)) - (# (list.equivalence n.equivalence) = - (list) - (/.lefts actual))))) - (_.cover [/.partition] - (let [[lefts rights] (|> expected - (list#each (function (_ value) - (if (n.even? value) - (/.left value) - (/.right value)))) - (is (List (Or Nat Nat))) - /.partition)] - (and (# (list.equivalence n.equivalence) = - (list.only n.even? expected) - lefts) - (# (list.equivalence n.equivalence) = - (list.only (|>> n.even? not) expected) - rights)))) - )) - )))) + (_.cover [/.left] + (|> (/.left expected) + (is (Or Nat Nat)) + (pipe.case + {0 #0 actual} (n.= expected actual) + _ false))) + (_.cover [/.right] + (|> (/.right expected) + (is (Or Nat Nat)) + (pipe.case + {0 #1 actual} (n.= expected actual) + _ false))) + (_.cover [/.either] + (and (|> (/.left expected) + (is (Or Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.+ shift expected))) + (|> (/.right expected) + (is (Or Nat Nat)) + (/.either (n.+ shift) (n.- shift)) + (n.= (n.- shift expected))))) + (_.cover [/.then] + (and (|> (/.left expected) + (is (Or Nat Nat)) + (/.then (n.+ shift) (n.- shift)) + (pipe.case {0 #0 actual} (n.= (n.+ shift expected) actual) _ false)) + (|> (/.right expected) + (is (Or Nat Nat)) + (/.then (n.+ shift) (n.- shift)) + (pipe.case {0 #1 actual} (n.= (n.- shift expected) actual) _ false)))) + (do ! + [size (# ! each (n.% 5) random.nat) + expected (random.list size random.nat)] + (all _.and + (_.cover [/.lefts] + (let [actual (is (List (Or Nat Nat)) + (list#each /.left expected))] + (and (# (list.equivalence n.equivalence) = + expected + (/.lefts actual)) + (# (list.equivalence n.equivalence) = + (list) + (/.rights actual))))) + (_.cover [/.rights] + (let [actual (is (List (Or Nat Nat)) + (list#each /.right expected))] + (and (# (list.equivalence n.equivalence) = + expected + (/.rights actual)) + (# (list.equivalence n.equivalence) = + (list) + (/.lefts actual))))) + (_.cover [/.partition] + (let [[lefts rights] (|> expected + (list#each (function (_ value) + (if (n.even? value) + (/.left value) + (/.right value)))) + (is (List (Or Nat Nat))) + /.partition)] + (and (# (list.equivalence n.equivalence) = + (list.only n.even? expected) + lefts) + (# (list.equivalence n.equivalence) = + (list.only (|>> n.even? not) expected) + rights)))) + )) + )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 8825bc192..00bcfb12d 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -41,12 +41,12 @@ (do [! random.monad] [size (# ! each (n.% 10) random.nat) sample (random.unicode size)] - ($_ _.and - (_.cover [/.size] - (n.= size (/.size sample))) - (_.cover [/.empty?] - (or (/.empty? sample) - (not (n.= 0 size))))))) + (all _.and + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (or (/.empty? sample) + (not (n.= 0 size))))))) (def: affix Test @@ -58,24 +58,24 @@ right (random.unicode 1) .let [full (# /.monoid composite inner outer) fake_index (-- 0)]] - (`` ($_ _.and - (~~ (template [<affix> <predicate>] - [(_.cover [<affix> <predicate>] - (<predicate> outer (<affix> outer inner)))] + (`` (all _.and + (~~ (template [<affix> <predicate>] + [(_.cover [<affix> <predicate>] + (<predicate> outer (<affix> outer inner)))] - [/.prefix /.starts_with?] - [/.suffix /.ends_with?] - [/.enclosed' /.enclosed_by?] - )) - (_.cover [/.enclosed] - (let [value (/.enclosed [left right] inner)] - (and (/.starts_with? left value) - (/.ends_with? right value)))) - (_.cover [/.format] - (let [sample (/.format inner)] - (and (/.enclosed_by? /.double_quote sample) - (/.contains? inner sample)))) - )))) + [/.prefix /.starts_with?] + [/.suffix /.ends_with?] + [/.enclosed' /.enclosed_by?] + )) + (_.cover [/.enclosed] + (let [value (/.enclosed [left right] inner)] + (and (/.starts_with? left value) + (/.ends_with? right value)))) + (_.cover [/.format] + (let [sample (/.format inner)] + (and (/.enclosed_by? /.double_quote sample) + (/.contains? inner sample)))) + )))) (def: index Test @@ -84,96 +84,96 @@ outer (random.only (|>> (# /.equivalence = inner) not) (random.unicode 1)) .let [fake_index (-- 0)]] - ($_ _.and - (_.cover [/.contains?] - (let [full (# /.monoid composite inner outer)] - (and (/.contains? inner full) - (/.contains? outer full)))) - (_.cover [/.index] - (and (|> (/.index inner (# /.monoid composite inner outer)) - (maybe.else fake_index) - (n.= 0)) - (|> (/.index outer (# /.monoid composite inner outer)) - (maybe.else fake_index) - (n.= 1)))) - (_.cover [/.index_since] - (let [full (# /.monoid composite inner outer)] - (and (|> (/.index_since 0 inner full) - (maybe.else fake_index) - (n.= 0)) - (|> (/.index_since 1 inner full) - (maybe.else fake_index) - (n.= fake_index)) - - (|> (/.index_since 0 outer full) - (maybe.else fake_index) - (n.= 1)) - (|> (/.index_since 1 outer full) - (maybe.else fake_index) - (n.= 1)) - (|> (/.index_since 2 outer full) - (maybe.else fake_index) - (n.= fake_index))))) - (_.cover [/.last_index] - (let [full ($_ (# /.monoid composite) outer inner outer)] - (and (|> (/.last_index inner full) - (maybe.else fake_index) - (n.= 1)) - (|> (/.last_index outer full) - (maybe.else fake_index) - (n.= 2))))) - ))) + (all _.and + (_.cover [/.contains?] + (let [full (# /.monoid composite inner outer)] + (and (/.contains? inner full) + (/.contains? outer full)))) + (_.cover [/.index] + (and (|> (/.index inner (# /.monoid composite inner outer)) + (maybe.else fake_index) + (n.= 0)) + (|> (/.index outer (# /.monoid composite inner outer)) + (maybe.else fake_index) + (n.= 1)))) + (_.cover [/.index_since] + (let [full (# /.monoid composite inner outer)] + (and (|> (/.index_since 0 inner full) + (maybe.else fake_index) + (n.= 0)) + (|> (/.index_since 1 inner full) + (maybe.else fake_index) + (n.= fake_index)) + + (|> (/.index_since 0 outer full) + (maybe.else fake_index) + (n.= 1)) + (|> (/.index_since 1 outer full) + (maybe.else fake_index) + (n.= 1)) + (|> (/.index_since 2 outer full) + (maybe.else fake_index) + (n.= fake_index))))) + (_.cover [/.last_index] + (let [full (all (# /.monoid composite) outer inner outer)] + (and (|> (/.last_index inner full) + (maybe.else fake_index) + (n.= 1)) + (|> (/.last_index outer full) + (maybe.else fake_index) + (n.= 2))))) + ))) (def: char Test - ($_ _.and - (_.for [/.Char /.of_char] - (`` ($_ _.and - (~~ (template [<short> <long>] - [(_.cover [<short> <long>] - (# /.equivalence = <short> <long>))] + (all _.and + (_.for [/.Char /.of_char] + (`` (all _.and + (~~ (template [<short> <long>] + [(_.cover [<short> <long>] + (# /.equivalence = <short> <long>))] - [/.\0 /.null] - [/.\a /.alarm] - [/.\b /.back_space] - [/.\t /.tab] - [/.\n /.new_line] - [/.\v /.vertical_tab] - [/.\f /.form_feed] - [/.\r /.carriage_return] - [/.\'' /.double_quote])) - (_.cover [/.line_feed] - (# /.equivalence = /.new_line /.line_feed)) - ))) - (do [! random.monad] - [size (# ! each (|>> (n.% 10) ++) random.nat) - characters (random.set /.hash size (random.ascii/alpha 1)) - .let [sample (|> characters set.list /.together)] - expected (# ! each (n.% size) random.nat)] - (_.cover [/.char] - (case (/.char expected sample) - {.#Some char} - (case (/.index (/.of_char char) sample) - {.#Some actual} - (n.= expected actual) + [/.\0 /.null] + [/.\a /.alarm] + [/.\b /.back_space] + [/.\t /.tab] + [/.\n /.new_line] + [/.\v /.vertical_tab] + [/.\f /.form_feed] + [/.\r /.carriage_return] + [/.\'' /.double_quote])) + (_.cover [/.line_feed] + (# /.equivalence = /.new_line /.line_feed)) + ))) + (do [! random.monad] + [size (# ! each (|>> (n.% 10) ++) random.nat) + characters (random.set /.hash size (random.ascii/alpha 1)) + .let [sample (|> characters set.list /.together)] + expected (# ! each (n.% size) random.nat)] + (_.cover [/.char] + (case (/.char expected sample) + {.#Some char} + (case (/.index (/.of_char char) sample) + {.#Some actual} + (n.= expected actual) - _ - false) - - {.#None} - false))) - (_.cover [/.space /.space?] - (`` (and (~~ (template [<char>] - [(/.space? (`` (.char (~~ (static <char>)))))] - - [/.tab] - [/.vertical_tab] - [/.space] - [/.new_line] - [/.carriage_return] - [/.form_feed] - ))))) - )) + _ + false) + + {.#None} + false))) + (_.cover [/.space /.space?] + (`` (and (~~ (template [<char>] + [(/.space? (`` (.char (~~ (static <char>)))))] + + [/.tab] + [/.vertical_tab] + [/.space] + [/.new_line] + [/.carriage_return] + [/.form_feed] + ))))) + )) (def: manipulation Test @@ -191,150 +191,150 @@ lower (random.ascii/lower 1) upper (random.ascii/upper 1)] - ($_ _.and - (_.cover [/.together] - (n.= (set.size characters) - (/.size (/.together (set.list characters))))) - (_.cover [/.interposed /.all_split_by] - (and (|> (set.list characters) - (/.interposed separator) - (/.all_split_by separator) - (set.of_list /.hash) - (# set.equivalence = characters)) - (# /.equivalence = - (/.together (set.list characters)) - (/.interposed "" (set.list characters))))) - (_.cover [/.replaced_once] - (# /.equivalence = - (# /.monoid composite post static) - (/.replaced_once pre post (# /.monoid composite pre static)))) - (_.cover [/.split_by] - (case (/.split_by static ($_ (# /.monoid composite) pre static post)) - {.#Some [left right]} - (and (# /.equivalence = pre left) - (# /.equivalence = post right)) - - {.#None} - false)) - (_.cover [/.lower_cased] - (let [effectiveness! - (|> upper - /.lower_cased - (# /.equivalence = upper) - not) + (all _.and + (_.cover [/.together] + (n.= (set.size characters) + (/.size (/.together (set.list characters))))) + (_.cover [/.interposed /.all_split_by] + (and (|> (set.list characters) + (/.interposed separator) + (/.all_split_by separator) + (set.of_list /.hash) + (# set.equivalence = characters)) + (# /.equivalence = + (/.together (set.list characters)) + (/.interposed "" (set.list characters))))) + (_.cover [/.replaced_once] + (# /.equivalence = + (# /.monoid composite post static) + (/.replaced_once pre post (# /.monoid composite pre static)))) + (_.cover [/.split_by] + (case (/.split_by static (all (# /.monoid composite) pre static post)) + {.#Some [left right]} + (and (# /.equivalence = pre left) + (# /.equivalence = post right)) + + {.#None} + false)) + (_.cover [/.lower_cased] + (let [effectiveness! + (|> upper + /.lower_cased + (# /.equivalence = upper) + not) - idempotence! - (|> lower - /.lower_cased - (# /.equivalence = lower)) - - inverse! - (|> lower - /.upper_cased - /.lower_cased - (# /.equivalence = lower))] - (and effectiveness! idempotence! - inverse!))) - (_.cover [/.upper_cased] - (let [effectiveness! - (|> lower - /.upper_cased - (# /.equivalence = lower) - not) + (|> lower + /.lower_cased + (# /.equivalence = lower)) + + inverse! + (|> lower + /.upper_cased + /.lower_cased + (# /.equivalence = lower))] + (and effectiveness! + idempotence! + inverse!))) + (_.cover [/.upper_cased] + (let [effectiveness! + (|> lower + /.upper_cased + (# /.equivalence = lower) + not) - idempotence! - (|> upper - /.upper_cased - (# /.equivalence = upper)) - - inverse! - (|> upper - /.lower_cased - /.upper_cased - (# /.equivalence = upper))] - (and effectiveness! idempotence! - inverse!))) - ))) + (|> upper + /.upper_cased + (# /.equivalence = upper)) + + inverse! + (|> upper + /.lower_cased + /.upper_cased + (# /.equivalence = upper))] + (and effectiveness! + idempotence! + inverse!))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [.Text]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (random.ascii 2))) - (_.for [/.hash] - ($hash.spec /.hash (random.ascii 1))) - (_.for [/.order] - ($order.spec /.order (random.ascii 2))) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid (random.ascii 2))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (random.ascii 2))) + (_.for [/.hash] + ($hash.spec /.hash (random.ascii 1))) + (_.for [/.order] + ($order.spec /.order (random.ascii 2))) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid (random.ascii 2))) - ..size - ..affix - ..index - ..char - ..manipulation - - (do random.monad - [sizeL bounded_size - sizeR bounded_size - sampleL (random.unicode sizeL) - sampleR (random.unicode sizeR) - middle (random.unicode 1) - .let [sample (/.together (list sampleL sampleR)) - (open "/#[0]") /.equivalence]] - ($_ _.and - (_.cover [/.split_at] - (|> (/.split_at sizeL sample) - (pipe.case - {.#Right [_l _r]} - (and (/#= sampleL _l) - (/#= sampleR _r) - (/#= sample (/.together (list _l _r)))) + ..size + ..affix + ..index + ..char + ..manipulation + + (do random.monad + [sizeL bounded_size + sizeR bounded_size + sampleL (random.unicode sizeL) + sampleR (random.unicode sizeR) + middle (random.unicode 1) + .let [sample (/.together (list sampleL sampleR)) + (open "/#[0]") /.equivalence]] + (all _.and + (_.cover [/.split_at] + (|> (/.split_at sizeL sample) + (pipe.case + {.#Right [_l _r]} + (and (/#= sampleL _l) + (/#= sampleR _r) + (/#= sample (/.together (list _l _r)))) - _ - #0))) - (_.cover [/.clip /.clip_since] - (|> [(/.clip 0 sizeL sample) - (/.clip sizeL (n.- sizeL (/.size sample)) sample) - (/.clip_since sizeL sample) - (/.clip_since 0 sample)] - (pipe.case - [{.#Right _l} {.#Right _r} {.#Right _r'} {.#Right _f}] - (and (/#= sampleL _l) - (/#= sampleR _r) - (/#= _r _r') - (/#= sample _f)) + _ + #0))) + (_.cover [/.clip /.clip_since] + (|> [(/.clip 0 sizeL sample) + (/.clip sizeL (n.- sizeL (/.size sample)) sample) + (/.clip_since sizeL sample) + (/.clip_since 0 sample)] + (pipe.case + [{.#Right _l} {.#Right _r} {.#Right _r'} {.#Right _f}] + (and (/#= sampleL _l) + (/#= sampleR _r) + (/#= _r _r') + (/#= sample _f)) - _ - #0))) - )) - (do [! random.monad] - [sizeP bounded_size - sizeL bounded_size - .let [... The wider unicode charset includes control characters that - ... can make text replacement work improperly. - ... Because of that, I restrict the charset. - normal_char_gen (|> random.nat (# ! each (|>> (n.% 128) (n.max 1))))] - sep1 (random.text normal_char_gen 1) - sep2 (random.text normal_char_gen 1) - .let [part_gen (|> (random.text normal_char_gen sizeP) - (random.only (|>> (/.contains? sep1) not)))] - parts (random.list sizeL part_gen) - .let [sample1 (/.together (list.interposed sep1 parts)) - sample2 (/.together (list.interposed sep2 parts)) - (open "/#[0]") /.equivalence]] - (_.cover [/.replaced] - (/#= sample2 - (/.replaced sep1 sep2 sample1)))) + _ + #0))) + )) + (do [! random.monad] + [sizeP bounded_size + sizeL bounded_size + .let [... The wider unicode charset includes control characters that + ... can make text replacement work improperly. + ... Because of that, I restrict the charset. + normal_char_gen (|> random.nat (# ! each (|>> (n.% 128) (n.max 1))))] + sep1 (random.text normal_char_gen 1) + sep2 (random.text normal_char_gen 1) + .let [part_gen (|> (random.text normal_char_gen sizeP) + (random.only (|>> (/.contains? sep1) not)))] + parts (random.list sizeL part_gen) + .let [sample1 (/.together (list.interposed sep1 parts)) + sample2 (/.together (list.interposed sep2 parts)) + (open "/#[0]") /.equivalence]] + (_.cover [/.replaced] + (/#= sample2 + (/.replaced sep1 sep2 sample1)))) - /buffer.test - /encoding.test - /format.test - /regex.test - /escape.test - /unicode.test - ))) + /buffer.test + /encoding.test + /format.test + /regex.test + /escape.test + /unicode.test + ))) diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux index 1e5946104..dbe4732df 100644 --- a/stdlib/source/test/lux/data/text/buffer.lux +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: part (Random Text) @@ -28,17 +28,17 @@ [left ..part mid ..part right ..part] - ($_ _.and - (_.cover [/.empty] - (n.= 0(/.size /.empty))) - (_.cover [/.size /.then] - (n.= (text.size left) - (/.size (/.then left /.empty)))) - (_.cover [/.text] - (text#= (format left mid right) - (|> /.empty - (/.then left) - (/.then mid) - (/.then right) - /.text))) - )))) + (all _.and + (_.cover [/.empty] + (n.= 0(/.size /.empty))) + (_.cover [/.size /.then] + (n.= (text.size left) + (/.size (/.then left /.empty)))) + (_.cover [/.text] + (text#= (format left mid right) + (|> /.empty + (/.then left) + (/.then mid) + (/.then right) + /.text))) + )))) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index 6317fef10..eaa9b6aba 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -221,12 +221,12 @@ Test (<| (_.covering /._) (_.for [/.Encoding]) - (`` ($_ _.and - (~~ (template [<definition> <by_letter>] - [<definition>] - - <encodings>)) + (`` (all _.and + (~~ (template [<definition> <by_letter>] + [<definition>] + + <encodings>)) - /utf8.test - )))) + /utf8.test + )))) ) diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index 6abb32e94..c7fb6d2fc 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -82,76 +82,76 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [ascii ..ascii_range] - (_.cover [/.escapable?] - (`` (if (or (~~ (template [<char>] - [(n.= (debug.private <char>) ascii)] - - [/.\0] [/.\a] [/.\b] [/.\t] - [/.\n] [/.\v] [/.\f] [/.\r] - [/.\''] [/.\\]))) - (/.escapable? ascii) - (bit#= (/.escapable? ascii) - (or (n.< (debug.private /.ascii_bottom) ascii) - (n.> (debug.private /.ascii_top) ascii))))))) - (do random.monad - [left (random.char unicode.character) - right (random.char unicode.character)] - (_.cover [/.escaped /.un_escaped] - (let [expected (format (text.of_char left) (text.of_char right))] - (if (or (/.escapable? left) - (/.escapable? right)) - (let [escaped (/.escaped expected)] - (case (/.un_escaped escaped) - {try.#Success un_escaped} - (and (not (text#= escaped expected)) - (text#= un_escaped expected)) - - {try.#Failure error} - false)) - (text#= expected (/.escaped expected)))))) - (do [! random.monad] - [dummy (|> (random.char unicode.character) - (# ! each text.of_char))] - (_.cover [/.dangling_escape] - (case (/.un_escaped (format (/.escaped dummy) "\")) - {try.#Success _} - false + (all _.and + (do random.monad + [ascii ..ascii_range] + (_.cover [/.escapable?] + (`` (if (or (~~ (template [<char>] + [(n.= (debug.private <char>) ascii)] + + [/.\0] [/.\a] [/.\b] [/.\t] + [/.\n] [/.\v] [/.\f] [/.\r] + [/.\''] [/.\\]))) + (/.escapable? ascii) + (bit#= (/.escapable? ascii) + (or (n.< (debug.private /.ascii_bottom) ascii) + (n.> (debug.private /.ascii_top) ascii))))))) + (do random.monad + [left (random.char unicode.character) + right (random.char unicode.character)] + (_.cover [/.escaped /.un_escaped] + (let [expected (format (text.of_char left) (text.of_char right))] + (if (or (/.escapable? left) + (/.escapable? right)) + (let [escaped (/.escaped expected)] + (case (/.un_escaped escaped) + {try.#Success un_escaped} + (and (not (text#= escaped expected)) + (text#= un_escaped expected)) + + {try.#Failure error} + false)) + (text#= expected (/.escaped expected)))))) + (do [! random.monad] + [dummy (|> (random.char unicode.character) + (# ! each text.of_char))] + (_.cover [/.dangling_escape] + (case (/.un_escaped (format (/.escaped dummy) "\")) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.dangling_escape error)))) - (do [! random.monad] - [dummy (|> (random.char unicode.character) - (random.only (|>> (set.member? ..valid_sigils) not)) - (# ! each text.of_char))] - (_.cover [/.invalid_escape] - (case (/.un_escaped (format "\" dummy)) - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.dangling_escape error)))) + (do [! random.monad] + [dummy (|> (random.char unicode.character) + (random.only (|>> (set.member? ..valid_sigils) not)) + (# ! each text.of_char))] + (_.cover [/.invalid_escape] + (case (/.un_escaped (format "\" dummy)) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.invalid_escape error)))) - (do [! random.monad] - [too_short (|> (random.char unicode.character) - (# ! each (n.% (hex "1000")))) - code (|> (random.unicode 4) - (random.only (function (_ code) - (case (# n.hex decoded code) - {try.#Failure error} true - {try.#Success _} false))))] - (_.cover [/.invalid_unicode_escape] - (template.let [(!invalid <code>) - [(case (/.un_escaped (format "\u" <code>)) - {try.#Success _} - false + {try.#Failure error} + (exception.match? /.invalid_escape error)))) + (do [! random.monad] + [too_short (|> (random.char unicode.character) + (# ! each (n.% (hex "1000")))) + code (|> (random.unicode 4) + (random.only (function (_ code) + (case (# n.hex decoded code) + {try.#Failure error} true + {try.#Success _} false))))] + (_.cover [/.invalid_unicode_escape] + (template.let [(!invalid <code>) + [(case (/.un_escaped (format "\u" <code>)) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.invalid_unicode_escape error))]] - (and (!invalid (# n.hex encoded too_short)) - (!invalid code))))) - (_.cover [/.literal] - (with_expansions [<example> (..static_sample)] - (text#= <example> (`` (/.literal (~~ (..static_escaped <example>))))))) - ))) + {try.#Failure error} + (exception.match? /.invalid_unicode_escape error))]] + (and (!invalid (# n.hex encoded too_short)) + (!invalid code))))) + (_.cover [/.literal] + (with_expansions [<example> (..static_sample)] + (text#= <example> (`` (/.literal (~~ (..static_escaped <example>))))))) + ))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index 62dfcd17d..5ac493e4e 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -62,125 +62,125 @@ (def: random_contravariant (Random (Ex (_ a) [(/.Format a) (Random a)])) - ($_ random.either - (random#in [/.bit random.bit]) - (random#in [/.nat random.nat]) - (random#in [/.int random.int]) - (random#in [/.rev random.rev]) - (random#in [/.frac random.frac]) - )) + (all random.either + (random#in [/.bit random.bit]) + (random#in [/.nat random.nat]) + (random#in [/.int random.int]) + (random#in [/.rev random.rev]) + (random#in [/.frac random.frac]) + )) (def: codec Test - (`` ($_ _.and - (~~ (template [<format> <codec> <random>] - [(do random.monad - [sample <random>] - (_.cover [<format>] - (text#= (# <codec> encoded sample) - (<format> sample))))] + (`` (all _.and + (~~ (template [<format> <codec> <random>] + [(do random.monad + [sample <random>] + (_.cover [<format>] + (text#= (# <codec> encoded sample) + (<format> sample))))] - [/.bit bit.codec random.bit] - [/.nat nat.decimal random.nat] - [/.int int.decimal random.int] - [/.rev rev.decimal random.rev] - [/.frac frac.decimal random.frac] - [/.ratio ratio.codec random.ratio] - [/.symbol symbol.codec ($///symbol.random 5 5)] - [/.xml xml.codec $///xml.random] - [/.json json.codec $///json.random] - [/.day day.codec random.day] - [/.month month.codec random.month] - [/.instant instant.codec random.instant] - [/.duration duration.codec random.duration] - [/.date date.codec random.date] - [/.time time.codec random.time] - - [/.nat_2 nat.binary random.nat] - [/.nat_8 nat.octal random.nat] - [/.nat_10 nat.decimal random.nat] - [/.nat_16 nat.hex random.nat] - - [/.int_2 int.binary random.int] - [/.int_8 int.octal random.int] - [/.int_10 int.decimal random.int] - [/.int_16 int.hex random.int] - - [/.rev_2 rev.binary random.rev] - [/.rev_8 rev.octal random.rev] - [/.rev_10 rev.decimal random.rev] - [/.rev_16 rev.hex random.rev] - - [/.frac_2 frac.binary random.frac] - [/.frac_8 frac.octal random.frac] - [/.frac_10 frac.decimal random.frac] - [/.frac_16 frac.hex random.frac] - )) - ))) + [/.bit bit.codec random.bit] + [/.nat nat.decimal random.nat] + [/.int int.decimal random.int] + [/.rev rev.decimal random.rev] + [/.frac frac.decimal random.frac] + [/.ratio ratio.codec random.ratio] + [/.symbol symbol.codec ($///symbol.random 5 5)] + [/.xml xml.codec $///xml.random] + [/.json json.codec $///json.random] + [/.day day.codec random.day] + [/.month month.codec random.month] + [/.instant instant.codec random.instant] + [/.duration duration.codec random.duration] + [/.date date.codec random.date] + [/.time time.codec random.time] + + [/.nat_2 nat.binary random.nat] + [/.nat_8 nat.octal random.nat] + [/.nat_10 nat.decimal random.nat] + [/.nat_16 nat.hex random.nat] + + [/.int_2 int.binary random.int] + [/.int_8 int.octal random.int] + [/.int_10 int.decimal random.int] + [/.int_16 int.hex random.int] + + [/.rev_2 rev.binary random.rev] + [/.rev_8 rev.octal random.rev] + [/.rev_10 rev.decimal random.rev] + [/.rev_16 rev.hex random.rev] + + [/.frac_2 frac.binary random.frac] + [/.frac_8 frac.octal random.frac] + [/.frac_10 frac.decimal random.frac] + [/.frac_16 frac.hex random.frac] + )) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Format]) - (`` ($_ _.and - (_.for [/.functor] - (do random.monad - [[format random] ..random_contravariant - example random] - ($contravariant.spec (..equivalence example) - format - /.functor))) - - (do random.monad - [left (random.unicode 5) - mid (random.unicode 5) - right (random.unicode 5)] - (_.cover [/.format] - (text#= (/.format left mid right) - ($_ "lux text concat" left mid right)))) - ..codec - (~~ (template [<format> <alias> <random>] - [(do random.monad - [sample <random>] - (_.cover [<format>] - (text#= (<alias> sample) - (<format> sample))))] + (`` (all _.and + (_.for [/.functor] + (do random.monad + [[format random] ..random_contravariant + example random] + ($contravariant.spec (..equivalence example) + format + /.functor))) + + (do random.monad + [left (random.unicode 5) + mid (random.unicode 5) + right (random.unicode 5)] + (_.cover [/.format] + (text#= (/.format left mid right) + (all "lux text concat" left mid right)))) + ..codec + (~~ (template [<format> <alias> <random>] + [(do random.monad + [sample <random>] + (_.cover [<format>] + (text#= (<alias> sample) + (<format> sample))))] - [/.text text.format (random.unicode 5)] - [/.code code.format $///code.random] - [/.type type.format ($///type.random 0)] - [/.location location.format - ($_ random.and - (random.unicode 5) - random.nat - random.nat)] - )) - (do random.monad - [members (random.list 5 random.nat)] - (_.cover [/.list] - (text#= (/.list /.nat members) - (|> members - (list#each /.nat) - (text.interposed " ") - list - (/.list (|>>)))))) - (do random.monad - [sample (random.maybe random.nat)] - (_.cover [/.maybe] - (case sample - {.#None} - true - - {.#Some value} - (text.contains? (/.nat value) - (/.maybe /.nat sample))))) - (do [! random.monad] - [modulus (random.one (|>> modulus.modulus - try.maybe) - random.int) - sample (# ! each (modular.modular modulus) - random.int)] - (_.cover [/.mod] - (text#= (# (modular.codec modulus) encoded sample) - (/.mod sample)))) - )))) + [/.text text.format (random.unicode 5)] + [/.code code.format $///code.random] + [/.type type.format ($///type.random 0)] + [/.location location.format + (all random.and + (random.unicode 5) + random.nat + random.nat)] + )) + (do random.monad + [members (random.list 5 random.nat)] + (_.cover [/.list] + (text#= (/.list /.nat members) + (|> members + (list#each /.nat) + (text.interposed " ") + list + (/.list (|>>)))))) + (do random.monad + [sample (random.maybe random.nat)] + (_.cover [/.maybe] + (case sample + {.#None} + true + + {.#Some value} + (text.contains? (/.nat value) + (/.maybe /.nat sample))))) + (do [! random.monad] + [modulus (random.one (|>> modulus.modulus + try.maybe) + random.int) + sample (# ! each (modular.modular modulus) + random.int)] + (_.cover [/.mod] + (text#= (# (modular.codec modulus) encoded sample) + (/.mod sample)))) + )))) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 58c26d067..a9f5d8cc4 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -78,120 +78,120 @@ (def: system_character_classes Test - ($_ _.and - (_.test "Can parse anything." - (should_pass (/.regex ".") "a")) + (all _.and + (_.test "Can parse anything." + (should_pass (/.regex ".") "a")) - (_.test "Can parse digits." - (and (should_pass (/.regex "\d") "0") - (should_fail (/.regex "\d") "m"))) + (_.test "Can parse digits." + (and (should_pass (/.regex "\d") "0") + (should_fail (/.regex "\d") "m"))) - (_.test "Can parse non digits." - (and (should_pass (/.regex "\D") "m") - (should_fail (/.regex "\D") "0"))) + (_.test "Can parse non digits." + (and (should_pass (/.regex "\D") "m") + (should_fail (/.regex "\D") "0"))) - (_.test "Can parse white-space." - (and (should_pass (/.regex "\s") " ") - (should_fail (/.regex "\s") "m"))) + (_.test "Can parse white-space." + (and (should_pass (/.regex "\s") " ") + (should_fail (/.regex "\s") "m"))) - (_.test "Can parse non white-space." - (and (should_pass (/.regex "\S") "m") - (should_fail (/.regex "\S") " "))) + (_.test "Can parse non white-space." + (and (should_pass (/.regex "\S") "m") + (should_fail (/.regex "\S") " "))) - (_.test "Can parse word characters." - (and (should_pass (/.regex "\w") "_") - (should_fail (/.regex "\w") "^"))) + (_.test "Can parse word characters." + (and (should_pass (/.regex "\w") "_") + (should_fail (/.regex "\w") "^"))) - (_.test "Can parse non word characters." - (and (should_pass (/.regex "\W") ".") - (should_fail (/.regex "\W") "a"))) - )) + (_.test "Can parse non word characters." + (and (should_pass (/.regex "\W") ".") + (should_fail (/.regex "\W") "a"))) + )) (def: special_system_character_classes Test - ($_ _.and - (_.test "Lower-case." - (and (should_pass (/.regex "\p{Lower}") "m") - (should_fail (/.regex "\p{Lower}") "M"))) - (_.test "Upper-case." - (and (should_pass (/.regex "\p{Upper}") "M") - (should_fail (/.regex "\p{Upper}") "m"))) - (_.test "Alphabetic." - (and (should_pass (/.regex "\p{Alpha}") "M") - (should_fail (/.regex "\p{Alpha}") "0"))) - (_.test "Numeric digits." - (and (should_pass (/.regex "\p{Digit}") "1") - (should_fail (/.regex "\p{Digit}") "n"))) - (_.test "Alphanumeric." - (and (should_pass (/.regex "\p{Alnum}") "1") - (should_fail (/.regex "\p{Alnum}") "."))) - (_.test "Whitespace." - (and (should_pass (/.regex "\p{Space}") " ") - (should_fail (/.regex "\p{Space}") "."))) - (_.test "Hexadecimal." - (and (should_pass (/.regex "\p{HexDigit}") "a") - (should_fail (/.regex "\p{HexDigit}") "."))) - (_.test "Octal." - (and (should_pass (/.regex "\p{OctDigit}") "6") - (should_fail (/.regex "\p{OctDigit}") "."))) - (_.test "Blank." - (and (should_pass (/.regex "\p{Blank}") text.tab) - (should_fail (/.regex "\p{Blank}") "."))) - (_.test "ASCII." - (and (should_pass (/.regex "\p{ASCII}") text.tab) - (should_fail (/.regex "\p{ASCII}") (text.of_char (hex "1234"))))) - (_.test "Control characters." - (and (should_pass (/.regex "\p{Contrl}") (text.of_char (hex "12"))) - (should_fail (/.regex "\p{Contrl}") "a"))) - (_.test "Punctuation." - (and (should_pass (/.regex "\p{Punct}") "@") - (should_fail (/.regex "\p{Punct}") "a"))) - (_.test "Graph." - (and (should_pass (/.regex "\p{Graph}") "@") - (should_fail (/.regex "\p{Graph}") " "))) - (_.test "Print." - (and (should_pass (/.regex "\p{Print}") (text.of_char (hex "20"))) - (should_fail (/.regex "\p{Print}") (text.of_char (hex "1234"))))) - )) + (all _.and + (_.test "Lower-case." + (and (should_pass (/.regex "\p{Lower}") "m") + (should_fail (/.regex "\p{Lower}") "M"))) + (_.test "Upper-case." + (and (should_pass (/.regex "\p{Upper}") "M") + (should_fail (/.regex "\p{Upper}") "m"))) + (_.test "Alphabetic." + (and (should_pass (/.regex "\p{Alpha}") "M") + (should_fail (/.regex "\p{Alpha}") "0"))) + (_.test "Numeric digits." + (and (should_pass (/.regex "\p{Digit}") "1") + (should_fail (/.regex "\p{Digit}") "n"))) + (_.test "Alphanumeric." + (and (should_pass (/.regex "\p{Alnum}") "1") + (should_fail (/.regex "\p{Alnum}") "."))) + (_.test "Whitespace." + (and (should_pass (/.regex "\p{Space}") " ") + (should_fail (/.regex "\p{Space}") "."))) + (_.test "Hexadecimal." + (and (should_pass (/.regex "\p{HexDigit}") "a") + (should_fail (/.regex "\p{HexDigit}") "."))) + (_.test "Octal." + (and (should_pass (/.regex "\p{OctDigit}") "6") + (should_fail (/.regex "\p{OctDigit}") "."))) + (_.test "Blank." + (and (should_pass (/.regex "\p{Blank}") text.tab) + (should_fail (/.regex "\p{Blank}") "."))) + (_.test "ASCII." + (and (should_pass (/.regex "\p{ASCII}") text.tab) + (should_fail (/.regex "\p{ASCII}") (text.of_char (hex "1234"))))) + (_.test "Control characters." + (and (should_pass (/.regex "\p{Contrl}") (text.of_char (hex "12"))) + (should_fail (/.regex "\p{Contrl}") "a"))) + (_.test "Punctuation." + (and (should_pass (/.regex "\p{Punct}") "@") + (should_fail (/.regex "\p{Punct}") "a"))) + (_.test "Graph." + (and (should_pass (/.regex "\p{Graph}") "@") + (should_fail (/.regex "\p{Graph}") " "))) + (_.test "Print." + (and (should_pass (/.regex "\p{Print}") (text.of_char (hex "20"))) + (should_fail (/.regex "\p{Print}") (text.of_char (hex "1234"))))) + )) (def: custom_character_classes Test - ($_ _.and - (_.test "Can parse using custom character classes." - (and (should_pass (/.regex "[abc]") "a") - (should_fail (/.regex "[abc]") "m"))) - (_.test "Can parse using character ranges." - (and (should_pass (/.regex "[a-z]") "a") - (should_pass (/.regex "[a-z]") "m") - (should_pass (/.regex "[a-z]") "z"))) - (_.test "Can combine character ranges." - (and (should_pass (/.regex "[a-zA-Z]") "a") - (should_pass (/.regex "[a-zA-Z]") "m") - (should_pass (/.regex "[a-zA-Z]") "z") - (should_pass (/.regex "[a-zA-Z]") "A") - (should_pass (/.regex "[a-zA-Z]") "M") - (should_pass (/.regex "[a-zA-Z]") "Z"))) - (_.test "Can negate custom character classes." - (and (should_fail (/.regex "[^abc]") "a") - (should_pass (/.regex "[^abc]") "m"))) - (_.test "Can negate character ranges.." - (and (should_fail (/.regex "[^a-z]") "a") - (should_pass (/.regex "[^a-z]") "0"))) - (_.test "Can parse negate combinations of character ranges." - (and (should_fail (/.regex "[^a-zA-Z]") "a") - (should_pass (/.regex "[^a-zA-Z]") "0"))) - (_.test "Can make custom character classes more specific." - (and (let [RE (/.regex "[a-z&&[def]]")] - (and (should_fail RE "a") - (should_pass RE "d"))) - (let [RE (/.regex "[a-z&&[^bc]]")] - (and (should_pass RE "a") - (should_fail RE "b"))) - (let [RE (/.regex "[a-z&&[^m-p]]")] - (and (should_pass RE "a") - (should_fail RE "m") - (should_fail RE "p"))))) - )) + (all _.and + (_.test "Can parse using custom character classes." + (and (should_pass (/.regex "[abc]") "a") + (should_fail (/.regex "[abc]") "m"))) + (_.test "Can parse using character ranges." + (and (should_pass (/.regex "[a-z]") "a") + (should_pass (/.regex "[a-z]") "m") + (should_pass (/.regex "[a-z]") "z"))) + (_.test "Can combine character ranges." + (and (should_pass (/.regex "[a-zA-Z]") "a") + (should_pass (/.regex "[a-zA-Z]") "m") + (should_pass (/.regex "[a-zA-Z]") "z") + (should_pass (/.regex "[a-zA-Z]") "A") + (should_pass (/.regex "[a-zA-Z]") "M") + (should_pass (/.regex "[a-zA-Z]") "Z"))) + (_.test "Can negate custom character classes." + (and (should_fail (/.regex "[^abc]") "a") + (should_pass (/.regex "[^abc]") "m"))) + (_.test "Can negate character ranges.." + (and (should_fail (/.regex "[^a-z]") "a") + (should_pass (/.regex "[^a-z]") "0"))) + (_.test "Can parse negate combinations of character ranges." + (and (should_fail (/.regex "[^a-zA-Z]") "a") + (should_pass (/.regex "[^a-zA-Z]") "0"))) + (_.test "Can make custom character classes more specific." + (and (let [RE (/.regex "[a-z&&[def]]")] + (and (should_fail RE "a") + (should_pass RE "d"))) + (let [RE (/.regex "[a-z&&[^bc]]")] + (and (should_pass RE "a") + (should_fail RE "b"))) + (let [RE (/.regex "[a-z&&[^m-p]]")] + (and (should_pass RE "a") + (should_fail RE "m") + (should_fail RE "p"))))) + )) (def: references Test @@ -203,78 +203,78 @@ (def: fuzzy_quantifiers Test - ($_ _.and - (_.test "Can sequentially combine patterns." - (text_should_pass "aa" (/.regex "aa") "aa")) + (all _.and + (_.test "Can sequentially combine patterns." + (text_should_pass "aa" (/.regex "aa") "aa")) - (_.test "Can match patterns optionally." - (and (text_should_pass "a" (/.regex "a?") "a") - (text_should_pass "" (/.regex "a?") ""))) + (_.test "Can match patterns optionally." + (and (text_should_pass "a" (/.regex "a?") "a") + (text_should_pass "" (/.regex "a?") ""))) - (_.test "Can match a pattern 0 or more times." - (and (text_should_pass "aaa" (/.regex "a*") "aaa") - (text_should_pass "" (/.regex "a*") ""))) + (_.test "Can match a pattern 0 or more times." + (and (text_should_pass "aaa" (/.regex "a*") "aaa") + (text_should_pass "" (/.regex "a*") ""))) - (_.test "Can match a pattern 1 or more times." - (and (text_should_pass "aaa" (/.regex "a+") "aaa") - (text_should_pass "a" (/.regex "a+") "a") - (should_fail (/.regex "a+") ""))) - )) + (_.test "Can match a pattern 1 or more times." + (and (text_should_pass "aaa" (/.regex "a+") "aaa") + (text_should_pass "a" (/.regex "a+") "a") + (should_fail (/.regex "a+") ""))) + )) (def: crisp_quantifiers Test - ($_ _.and - (_.test "Can match a pattern N times." - (and (text_should_pass "aa" (/.regex "a{2}") "aa") - (text_should_pass "a" (/.regex "a{1}") "a") - (should_fail (/.regex "a{3}") "aa"))) - - (_.test "Can match a pattern at-least N times." - (and (text_should_pass "aa" (/.regex "a{1,}") "aa") - (text_should_pass "aa" (/.regex "a{2,}") "aa") - (should_fail (/.regex "a{3,}") "aa"))) - - (_.test "Can match a pattern at-most N times." - (and (text_should_pass "aa" (/.regex "a{,2}") "aa") - (text_should_pass "aa" (/.regex "a{,3}") "aa"))) - - (_.test "Can match a pattern between N and M times." - (and (text_should_pass "a" (/.regex "a{1,2}") "a") - (text_should_pass "aa" (/.regex "a{1,2}") "aa"))) - )) + (all _.and + (_.test "Can match a pattern N times." + (and (text_should_pass "aa" (/.regex "a{2}") "aa") + (text_should_pass "a" (/.regex "a{1}") "a") + (should_fail (/.regex "a{3}") "aa"))) + + (_.test "Can match a pattern at-least N times." + (and (text_should_pass "aa" (/.regex "a{1,}") "aa") + (text_should_pass "aa" (/.regex "a{2,}") "aa") + (should_fail (/.regex "a{3,}") "aa"))) + + (_.test "Can match a pattern at-most N times." + (and (text_should_pass "aa" (/.regex "a{,2}") "aa") + (text_should_pass "aa" (/.regex "a{,3}") "aa"))) + + (_.test "Can match a pattern between N and M times." + (and (text_should_pass "a" (/.regex "a{1,2}") "a") + (text_should_pass "aa" (/.regex "a{1,2}") "aa"))) + )) (def: groups Test - ($_ _.and - (_.test "Can extract groups of sub-matches specified in a pattern." - (and (should_check ["abc" "b"] (/.regex "a(.)c") "abc") - (should_check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc") - (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") - (should_check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") - (should_check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789") - (should_check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") - (should_check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) - - (_.test "Can specify groups within groups." - (should_check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) - )) + (all _.and + (_.test "Can extract groups of sub-matches specified in a pattern." + (and (should_check ["abc" "b"] (/.regex "a(.)c") "abc") + (should_check ["abbbbbc" "bbbbb"] (/.regex "a(b+)c") "abbbbbc") + (should_check ["809-345-6789" "809" "345" "6789"] (/.regex "(\d{3})-(\d{3})-(\d{4})") "809-345-6789") + (should_check ["809-345-6789" "809" "6789"] (/.regex "(\d{3})-(?:\d{3})-(\d{4})") "809-345-6789") + (should_check ["809-809-6789" "809" "6789"] (/.regex "(\d{3})-\0-(\d{4})") "809-809-6789") + (should_check ["809-809-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") + (should_check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) + + (_.test "Can specify groups within groups." + (should_check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (/.regex "(\d{3})-((\d{3})-(\d{4}))") "809-345-6789")) + )) (def: alternation Test - ($_ _.and - (_.test "Can specify alternative patterns." - (and (should_check ["a" {0 #0 []}] (/.regex "a|b") "a") - (should_check ["b" {0 #1 []}] (/.regex "a|b") "b") - (should_fail (/.regex "a|b") "c"))) - (_.test "Can have groups within alternations." - (and (should_check ["abc" {0 #0 ["b" "c"]}] (/.regex "a(.)(.)|b(.)(.)") "abc") - (should_check ["bcd" {0 #1 ["c" "d"]}] (/.regex "a(.)(.)|b(.)(.)") "bcd") - (should_fail (/.regex "a(.)(.)|b(.)(.)") "cde") - - (should_check ["123-456-7890" {0 #0 ["123" "456-7890" "456" "7890"]}] - (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") - "123-456-7890"))) - )) + (all _.and + (_.test "Can specify alternative patterns." + (and (should_check ["a" {0 #0 []}] (/.regex "a|b") "a") + (should_check ["b" {0 #1 []}] (/.regex "a|b") "b") + (should_fail (/.regex "a|b") "c"))) + (_.test "Can have groups within alternations." + (and (should_check ["abc" {0 #0 ["b" "c"]}] (/.regex "a(.)(.)|b(.)(.)") "abc") + (should_check ["bcd" {0 #1 ["c" "d"]}] (/.regex "a(.)(.)|b(.)(.)") "bcd") + (should_fail (/.regex "a(.)(.)|b(.)(.)") "cde") + + (should_check ["123-456-7890" {0 #0 ["123" "456-7890" "456" "7890"]}] + (/.regex "(\d{3})-((\d{3})-(\d{4}))|b(.)d") + "123-456-7890"))) + )) (syntax: (expands? [form <code>.any]) (function (_ lux) @@ -288,34 +288,34 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.regex] - ($_ _.and - ..basics - ..system_character_classes - ..special_system_character_classes - ..custom_character_classes - ..references - ..fuzzy_quantifiers - ..crisp_quantifiers - ..groups - ..alternation - )) - (do random.monad - [sample1 (random.unicode 3) - sample2 (random.unicode 3) - sample3 (random.unicode 4)] - (_.cover [/.pattern] - (case (format sample1 "-" sample2 "-" sample3) - (/.pattern "(.{3})-(.{3})-(.{4})" - [_ match1 match2 match3]) - (and (text#= sample1 match1) - (text#= sample2 match2) - (text#= sample3 match3)) - - _ - false))) - (_.cover [/.incorrect_quantification] - (and (expands? (/.regex "a{1,2}")) - (not (expands? (/.regex "a{2,1}"))))) - ))) + (all _.and + (_.for [/.regex] + (all _.and + ..basics + ..system_character_classes + ..special_system_character_classes + ..custom_character_classes + ..references + ..fuzzy_quantifiers + ..crisp_quantifiers + ..groups + ..alternation + )) + (do random.monad + [sample1 (random.unicode 3) + sample2 (random.unicode 3) + sample3 (random.unicode 4)] + (_.cover [/.pattern] + (case (format sample1 "-" sample2 "-" sample3) + (/.pattern "(.{3})-(.{3})-(.{4})" + [_ match1 match2 match3]) + (and (text#= sample1 match1) + (text#= sample2 match2) + (text#= sample3 match3)) + + _ + false))) + (_.cover [/.incorrect_quantification] + (and (expands? (/.regex "a{1,2}")) + (not (expands? (/.regex "a{2,1}"))))) + ))) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index 4e3de67c4..767a8cf4c 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -182,32 +182,32 @@ (|>> (n.% size) (n.+ (/.start sample))) random.nat)] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid ..random)) - - (_.for [/.block] - ($_ _.and - (_.cover [/.start] - (n.= start - (/.start sample))) - (_.cover [/.end] - (n.= end - (/.end sample))) - (_.cover [/.size] - (n.= (++ additional) - (/.size sample))) - (_.cover [/.within?] - (and (/.within? sample inside) - (not (/.within? sample (-- (/.start sample)))) - (not (/.within? sample (++ (/.end sample)))))) - (~~ (template [<definition> <part>] - [<definition>] - - <blocks>)))) - ))))) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid ..random)) + + (_.for [/.block] + (all _.and + (_.cover [/.start] + (n.= start + (/.start sample))) + (_.cover [/.end] + (n.= end + (/.end sample))) + (_.cover [/.size] + (n.= (++ additional) + (/.size sample))) + (_.cover [/.within?] + (and (/.within? sample inside) + (not (/.within? sample (-- (/.start sample)))) + (not (/.within? sample (++ (/.end sample)))))) + (~~ (template [<definition> <part>] + [<definition>] + + <blocks>)))) + ))))) ) diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index c2f567fc2..20f6c2e42 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -1,27 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [data - ["[0]" product] - ["[0]" bit ("[1]#[0]" equivalence)] - [collection - ["[0]" set ("[1]#[0]" equivalence)]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - ["[0]" / "_" - ["/[1]" // "_" - ["[1][0]" block]]] - [\\library - ["[0]" / - [// - ["[0]" block]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [data + ["[0]" product] + ["[0]" bit ("[1]#[0]" equivalence)] + [collection + ["[0]" set ("[1]#[0]" equivalence)]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + ["[0]" / "_" + ["/[1]" // "_" + ["[1][0]" block]]] + [\\library + ["[0]" / + [// + ["[0]" block]]]]) (def: .public random (Random /.Set) @@ -44,55 +44,55 @@ right //block.random .let [equivalence (product.equivalence n.equivalence n.equivalence)]] - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.set] - (and (n.= (block.start left) - (/.start (/.set [left (list)]))) - (n.= (block.end left) - (/.end (/.set [left (list)]))))) - (_.cover [/.start] - (n.= (n.min (block.start left) - (block.start right)) - (/.start (/.set [left (list right)])))) - (_.cover [/.end] - (n.= (n.max (block.end left) - (block.end right)) - (/.end (/.set [left (list right)])))) - (_.cover [/.member?] - (bit#= (block.within? block inside) - (/.member? (/.set [block (list)]) inside))) - (_.cover [/.composite] - (let [composed (/.composite (/.set [left (list)]) - (/.set [right (list)]))] - (and (n.= (n.min (block.start left) - (block.start right)) - (/.start composed)) - (n.= (n.max (block.end left) - (block.end right)) - (/.end composed))))) - (~~ (template [<set>] - [(do random.monad - [char (random.char <set>) - .let [start (/.start <set>) - end (/.end <set>)]] - (_.cover [<set>] - (and (/.member? <set> char) - (not (/.member? <set> (-- start))) - (not (/.member? <set> (++ end))))))] + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.set] + (and (n.= (block.start left) + (/.start (/.set [left (list)]))) + (n.= (block.end left) + (/.end (/.set [left (list)]))))) + (_.cover [/.start] + (n.= (n.min (block.start left) + (block.start right)) + (/.start (/.set [left (list right)])))) + (_.cover [/.end] + (n.= (n.max (block.end left) + (block.end right)) + (/.end (/.set [left (list right)])))) + (_.cover [/.member?] + (bit#= (block.within? block inside) + (/.member? (/.set [block (list)]) inside))) + (_.cover [/.composite] + (let [composed (/.composite (/.set [left (list)]) + (/.set [right (list)]))] + (and (n.= (n.min (block.start left) + (block.start right)) + (/.start composed)) + (n.= (n.max (block.end left) + (block.end right)) + (/.end composed))))) + (~~ (template [<set>] + [(do random.monad + [char (random.char <set>) + .let [start (/.start <set>) + end (/.end <set>)]] + (_.cover [<set>] + (and (/.member? <set> char) + (not (/.member? <set> (-- start))) + (not (/.member? <set> (++ end))))))] - [/.ascii] - [/.ascii/alpha] - [/.ascii/alpha_num] - [/.ascii/lower] - [/.ascii/upper] - [/.ascii/numeric] - [/.character] - [/.non_character] - [/.full] - )) + [/.ascii] + [/.ascii/alpha] + [/.ascii/alpha_num] + [/.ascii/lower] + [/.ascii/upper] + [/.ascii/numeric] + [/.character] + [/.non_character] + [/.full] + )) - //block.test - ))))) + //block.test + ))))) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index d8b81370d..960d314b9 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -161,36 +161,36 @@ can_represent_structure_types! ..can_represent_structure_types can_represent_complex_types! ..can_represent_complex_types can_represent_time_types! ..can_represent_time_types] - ($_ _.and - (_.cover [/.representation] - (`` (and can_represent_simple_types! - can_represent_structure_types! - can_represent_complex_types! - can_represent_time_types! - - (|> (/.representation .Any sample_frac) - (try#each (text#= "[]")) - (try.else false)) - (|> (/.representation (type (List Nat)) (is (List Nat) (list sample_nat))) - (try#each (text#= (%.list %.nat (list sample_nat)))) - (try.else false)) - (~~ (template [<sample>] - [(|> (/.representation (type (Maybe Nat)) (is (Maybe Nat) <sample>)) - (try#each (text#= (%.maybe %.nat <sample>))) - (try.else false))] - - [{.#Some sample_nat}] - [{.#None}] - )) - ))) - (_.cover [/.cannot_represent_value] - (case (/.representation (-> Nat Nat) (|>>)) - {try.#Success representation} - false + (all _.and + (_.cover [/.representation] + (`` (and can_represent_simple_types! + can_represent_structure_types! + can_represent_complex_types! + can_represent_time_types! + + (|> (/.representation .Any sample_frac) + (try#each (text#= "[]")) + (try.else false)) + (|> (/.representation (type (List Nat)) (is (List Nat) (list sample_nat))) + (try#each (text#= (%.list %.nat (list sample_nat)))) + (try.else false)) + (~~ (template [<sample>] + [(|> (/.representation (type (Maybe Nat)) (is (Maybe Nat) <sample>)) + (try#each (text#= (%.maybe %.nat <sample>))) + (try.else false))] + + [{.#Some sample_nat}] + [{.#None}] + )) + ))) + (_.cover [/.cannot_represent_value] + (case (/.representation (-> Nat Nat) (|>>)) + {try.#Success representation} + false - {try.#Failure error} - (exception.match? /.cannot_represent_value error))) - ))) + {try.#Failure error} + (exception.match? /.cannot_represent_value error))) + ))) (def: inspection Test @@ -233,36 +233,36 @@ (<| (_.covering /._) (do random.monad [message (random.ascii/lower 5)] - ($_ _.and - ..inspection - ..representation - (_.cover [/.hole /.type_hole] - (let [error (is My_Text (..macro_error (/.hole)))] - (and (exception.match? /.type_hole error) - (text.contains? (%.type My_Text) error)))) - (do random.monad - [foo (random.ascii/upper 10) - bar random.nat - baz random.bit] - (_.cover [/.here] - (with_expansions [<no_parameters> (for @.js (~~ (these)) - (~~ (these (/.here))))] - (`` (exec - <no_parameters> - (/.here foo - [bar %.nat]) - true))))) - (_.cover [/.unknown_local_binding] - (exception.match? /.unknown_local_binding - (..macro_error (/.here yolo)))) - (_.cover [/.private] - (exec - (is (/.private /.Inspector) - /.inspection) - true)) - (_.cover [/.log!] - (exec - (/.log! (format (%.symbol (symbol /.log!)) - " works: " (%.text message))) - true)) - )))) + (all _.and + ..inspection + ..representation + (_.cover [/.hole /.type_hole] + (let [error (is My_Text (..macro_error (/.hole)))] + (and (exception.match? /.type_hole error) + (text.contains? (%.type My_Text) error)))) + (do random.monad + [foo (random.ascii/upper 10) + bar random.nat + baz random.bit] + (_.cover [/.here] + (with_expansions [<no_parameters> (for @.js (~~ (these)) + (~~ (these (/.here))))] + (`` (exec + <no_parameters> + (/.here foo + [bar %.nat]) + true))))) + (_.cover [/.unknown_local_binding] + (exception.match? /.unknown_local_binding + (..macro_error (/.here yolo)))) + (_.cover [/.private] + (exec + (is (/.private /.Inspector) + /.inspection) + true)) + (_.cover [/.log!] + (exec + (/.log! (format (%.symbol (symbol /.log!)) + " works: " (%.text message))) + true)) + )))) diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux index 8e6fd65d2..c5b8620e4 100644 --- a/stdlib/source/test/lux/documentation.lux +++ b/stdlib/source/test/lux/documentation.lux @@ -48,73 +48,73 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.Definition] - ($_ _.and - (_.cover [/.default] - (case (`` (/.default (~~ (template.symbol [.._] [g!default])))) - (pattern (list definition)) - (and (|> definition - (the /.#definition) - (text#= (template.text [g!default]))) - (|> definition - (the /.#documentation) - md.markdown - (text#= "") - not)) + (all _.and + (_.for [/.Definition] + (all _.and + (_.cover [/.default] + (case (`` (/.default (~~ (template.symbol [.._] [g!default])))) + (pattern (list definition)) + (and (|> definition + (the /.#definition) + (text#= (template.text [g!default]))) + (|> definition + (the /.#documentation) + md.markdown + (text#= "") + not)) - _ - false)) - (_.cover [/.documentation:] - (case ..documentation: - (pattern (list documentation:)) - (and (|> documentation: - (the /.#definition) - (text#= (template.text [/.documentation:]))) - (|> documentation: - (the /.#documentation) - md.markdown - (text.contains? 'definition_description'))) + _ + false)) + (_.cover [/.documentation:] + (case ..documentation: + (pattern (list documentation:)) + (and (|> documentation: + (the /.#definition) + (text#= (template.text [/.documentation:]))) + (|> documentation: + (the /.#documentation) + md.markdown + (text.contains? 'definition_description'))) - _ - false)) - )) - (_.for [/.Module] - ($_ _.and - (_.cover [/.module /.documentation] - (let [sub (`` (/.module /._ - (~~ (template.text ['sub_description'])) - [] - [])) - super (`` (/.module .._ - (~~ (template.text ['super_description'])) - [..documentation:] - [sub]))] - (and (text.contains? (template.text ['sub_description']) - (/.documentation sub)) - (text.contains? (/.documentation sub) - (/.documentation super)) - (text.contains? (template.text ['super_description']) - (/.documentation super)) - (case ..documentation: - (pattern (list documentation:)) - (text.contains? (md.markdown (the /.#documentation documentation:)) + _ + false)) + )) + (_.for [/.Module] + (all _.and + (_.cover [/.module /.documentation] + (let [sub (`` (/.module /._ + (~~ (template.text ['sub_description'])) + [] + [])) + super (`` (/.module .._ + (~~ (template.text ['super_description'])) + [..documentation:] + [sub]))] + (and (text.contains? (template.text ['sub_description']) + (/.documentation sub)) + (text.contains? (/.documentation sub) (/.documentation super)) + (text.contains? (template.text ['super_description']) + (/.documentation super)) + (case ..documentation: + (pattern (list documentation:)) + (text.contains? (md.markdown (the /.#documentation documentation:)) + (/.documentation super)) - _ - false)))) - )) - (_.cover [/.unqualified_symbol] - (`` (and (~~ (template [<example>] - [(macro_error <example>)] - - [(/.default g!default)] - [(/.documentation: g!default - (~~ (template.text ['definition_description'])))] - [(/.module g!default - "" - [..documentation:] - [sub])] - ))))) - ))))) + _ + false)))) + )) + (_.cover [/.unqualified_symbol] + (`` (and (~~ (template [<example>] + [(macro_error <example>)] + + [(/.default g!default)] + [(/.documentation: g!default + (~~ (template.text ['definition_description'])))] + [(/.module g!default + "" + [..documentation:] + [sub])] + ))))) + ))))) ) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index f07656314..4233cd956 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -186,21 +186,21 @@ (<| (_.covering /._) (do random.monad [expected random.nat] - (`` ($_ _.and - (~~ (template [<macro> <extension>] - [(_.cover [<macro>] - (for @.old false - (n.= expected - (`` ((~~ (static <extension>)) expected)))))] - - [/.analysis: ..analysis] - [/.synthesis: ..synthesis])) - (_.cover [/.generation:] - (for @.old false - (and (n.= expected - (`` ((~~ (static ..generation)) expected))) - (text#= ..dummy_generation - (`` ((~~ (static ..dummy_generation)))))))) - (_.cover [/.directive:] - true) - ))))) + (`` (all _.and + (~~ (template [<macro> <extension>] + [(_.cover [<macro>] + (for @.old false + (n.= expected + (`` ((~~ (static <extension>)) expected)))))] + + [/.analysis: ..analysis] + [/.synthesis: ..synthesis])) + (_.cover [/.generation:] + (for @.old false + (and (n.= expected + (`` ((~~ (static ..generation)) expected))) + (text#= ..dummy_generation + (`` ((~~ (static ..dummy_generation)))))))) + (_.cover [/.directive:] + true) + ))))) diff --git a/stdlib/source/test/lux/ffi.js.lux b/stdlib/source/test/lux/ffi.js.lux index e015ea5e8..d1ab5636a 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -58,91 +58,91 @@ ... I64s get compiled as JavaScript objects with a specific structure. object random.nat] (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<type> <value>] - [(_.cover [<type>] - (exec - (is <type> <value>) - true))] + (`` (all _.and + (~~ (template [<type> <value>] + [(_.cover [<type>] + (exec + (is <type> <value>) + true))] - [/.Boolean boolean] - [/.Number number] - [/.String string] - )) - (_.for [/.Object] - ($_ _.and - (~~ (template [<type>] - [(_.cover [<type>] - (exec - (is (Ex (_ a) (/.Object a)) - (is <type> - (as_expected []))) - true))] + [/.Boolean boolean] + [/.Number number] + [/.String string] + )) + (_.for [/.Object] + (all _.and + (~~ (template [<type>] + [(_.cover [<type>] + (exec + (is (Ex (_ a) (/.Object a)) + (is <type> + (as_expected []))) + true))] - [/.Function] - [/.Symbol] - [/.Null] - [/.Undefined] - )) - )) - (_.cover [/.null] - (exec - (is Nat (/.null [])) - (is Text (/.null [])) - (is (All (_ a) (-> a a)) (/.null [])) - true)) - (_.cover [/.null?] - (and (/.null? (/.null [])) - (not (/.null? 0)) - (not (/.null? "0")) - (not (/.null? (|>>))))) - (_.cover [/.global] - (|> (/.global /.Function [parseFloat]) - "js object null?" - not)) - (_.cover [/.function] - (|> (/.function (_ [input/0 Nat]) - Int - (.int input/0)) - "js object null?" - not)) - (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] - (and (or /.on_nashorn? - /.on_node_js? - /.on_browser?) - (bit#= /.on_nashorn? - (not (or /.on_node_js? - /.on_browser?))) - (bit#= /.on_node_js? - (not (or /.on_nashorn? - /.on_browser?))) - (bit#= /.on_browser? - (not (or /.on_nashorn? - /.on_node_js?))))) - (_.cover [/.type_of] - (and (text#= "boolean" (/.type_of boolean)) - (text#= "number" (/.type_of number)) - (text#= "string" (/.type_of string)) - (text#= "function" (/.type_of function)) - (text#= "object" (/.type_of object)))) - (_.cover [/.import:] - (let [encoding "utf8"] - (text#= string - (cond /.on_nashorn? - (let [binary (java/lang/String::getBytes encoding (as java/lang/String string))] - (|> (java/lang/String::new binary encoding) - (as Text))) - - /.on_node_js? - (|> (Buffer::from string encoding) - (Buffer::toString encoding)) - - ... On the browser - (let [binary (|> (TextEncoder::new encoding) - (TextEncoder::encode string))] - (|> (TextDecoder::new encoding) - (TextDecoder::decode binary))) - )))) + [/.Function] + [/.Symbol] + [/.Null] + [/.Undefined] + )) + )) + (_.cover [/.null] + (exec + (is Nat (/.null [])) + (is Text (/.null [])) + (is (All (_ a) (-> a a)) (/.null [])) + true)) + (_.cover [/.null?] + (and (/.null? (/.null [])) + (not (/.null? 0)) + (not (/.null? "0")) + (not (/.null? (|>>))))) + (_.cover [/.global] + (|> (/.global /.Function [parseFloat]) + "js object null?" + not)) + (_.cover [/.function] + (|> (/.function (_ [input/0 Nat]) + Int + (.int input/0)) + "js object null?" + not)) + (_.cover [/.on_browser? /.on_node_js? /.on_nashorn?] + (and (or /.on_nashorn? + /.on_node_js? + /.on_browser?) + (bit#= /.on_nashorn? + (not (or /.on_node_js? + /.on_browser?))) + (bit#= /.on_node_js? + (not (or /.on_nashorn? + /.on_browser?))) + (bit#= /.on_browser? + (not (or /.on_nashorn? + /.on_node_js?))))) + (_.cover [/.type_of] + (and (text#= "boolean" (/.type_of boolean)) + (text#= "number" (/.type_of number)) + (text#= "string" (/.type_of string)) + (text#= "function" (/.type_of function)) + (text#= "object" (/.type_of object)))) + (_.cover [/.import:] + (let [encoding "utf8"] + (text#= string + (cond /.on_nashorn? + (let [binary (java/lang/String::getBytes encoding (as java/lang/String string))] + (|> (java/lang/String::new binary encoding) + (as Text))) + + /.on_node_js? + (|> (Buffer::from string encoding) + (Buffer::toString encoding)) + + ... On the browser + (let [binary (|> (TextEncoder::new encoding) + (TextEncoder::encode string))] + (|> (TextDecoder::new encoding) + (TextDecoder::decode binary))) + )))) - $/export.test - ))))) + $/export.test + ))))) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index 6169ba219..31de211a2 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -92,30 +92,30 @@ float (|> random.frac (random.only (|>> f.not_a_number? not)) (# ! each (|>> /.as_float)))] - (`` ($_ _.and - (~~ (template [<sample> <=> <to> <from>] - [(_.cover [<to> <from>] - (or (|> <sample> <to> <from> (<=> <sample>)) - (let [capped (|> <sample> <to> <from>)] - (|> capped <to> <from> (<=> capped)))))] - - [long long#= /.long_to_byte /.byte_to_long] - [long long#= /.long_to_short /.short_to_long] - [long long#= /.long_to_int /.int_to_long] - [long long#= /.long_to_float /.float_to_long] - [long long#= /.long_to_double /.double_to_long] - [long long#= /.long_to_char /.char_to_long] - - [integer integer#= /.int_to_double /.double_to_int] - [integer integer#= /.int_to_float /.float_to_int] - [integer integer#= /.int_to_char /.char_to_int] - - [byte byte#= /.byte_to_int /.int_to_byte] - [short short#= /.short_to_int /.int_to_short] - [byte byte#= /.byte_to_char /.char_to_byte] - [short short#= /.short_to_char /.char_to_short] - [float float#= /.float_to_double /.double_to_float] - )))))) + (`` (all _.and + (~~ (template [<sample> <=> <to> <from>] + [(_.cover [<to> <from>] + (or (|> <sample> <to> <from> (<=> <sample>)) + (let [capped (|> <sample> <to> <from>)] + (|> capped <to> <from> (<=> capped)))))] + + [long long#= /.long_to_byte /.byte_to_long] + [long long#= /.long_to_short /.short_to_long] + [long long#= /.long_to_int /.int_to_long] + [long long#= /.long_to_float /.float_to_long] + [long long#= /.long_to_double /.double_to_long] + [long long#= /.long_to_char /.char_to_long] + + [integer integer#= /.int_to_double /.double_to_int] + [integer integer#= /.int_to_float /.float_to_int] + [integer integer#= /.int_to_char /.char_to_int] + + [byte byte#= /.byte_to_int /.int_to_byte] + [short short#= /.short_to_int /.int_to_short] + [byte byte#= /.byte_to_char /.char_to_byte] + [short short#= /.short_to_char /.char_to_short] + [float float#= /.float_to_double /.double_to_float] + )))))) (def: for_arrays Test @@ -123,25 +123,25 @@ [size (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) idx (|> random.nat (# ! each (n.% size))) value (# ! each (|>> /.as_long) random.int)] - ($_ _.and - (_.cover [/.array /.length] - (|> size - (/.array java/lang/Long) - /.length - (n.= size))) - (_.cover [/.write! /.read!] - (|> (/.array java/lang/Long size) - (/.write! idx value) - (/.read! idx) - /.of_long - (i.= (/.of_long value)))) - (_.cover [/.cannot_convert_to_jvm_type] - (let [array (as (Array Nothing) - (array.empty 1))] - (|> array - /.length - ..macro_error - (text.contains? (the exception.#label /.cannot_convert_to_jvm_type)))))))) + (all _.and + (_.cover [/.array /.length] + (|> size + (/.array java/lang/Long) + /.length + (n.= size))) + (_.cover [/.write! /.read!] + (|> (/.array java/lang/Long size) + (/.write! idx value) + (/.read! idx) + /.of_long + (i.= (/.of_long value)))) + (_.cover [/.cannot_convert_to_jvm_type] + (let [array (as (Array Nothing) + (array.empty 1))] + (|> array + /.length + ..macro_error + (text.contains? (the exception.#label /.cannot_convert_to_jvm_type)))))))) (def: for_miscellaneous Test @@ -164,102 +164,102 @@ (random.ascii 1)) bit/0 random.bit] - ($_ _.and - (_.cover [/.as] - (and (case (/.as java/lang/String sample) {.#Some _} true {.#None} false) - (case (/.as java/lang/Long sample) {.#Some _} false {.#None} true) - (case (/.as java/lang/Object sample) {.#Some _} true {.#None} false) - (case (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true))) - (_.cover [/.synchronized] - (/.synchronized sample #1)) - (_.cover [/.class_for] - (text#= "java.lang.Class" (/.of_string (java/lang/Class::getName (/.class_for java/lang/Class))))) - (_.cover [/.null /.null?] - (and (/.null? (/.null)) - (not (/.null? sample)))) - (_.cover [/.???] - (and (|> (/.??? (/.null)) - (is (Maybe java/lang/Object)) - (pipe.case - {.#None} #1 - {.#Some _} #0)) - (|> (/.??? sample) - (is (Maybe java/lang/Object)) - (pipe.case - {.#Some _} #1 - {.#None} #0)))) - (_.cover [/.!!!] - (and (|> (/.??? (/.null)) - /.!!! - /.null?) - (|> (/.??? sample) - /.!!! - /.null? - not))) - (~~ (template [<object> <primitive> <jvm#value> <jvm#=> - <lux#value> <as> <of> <lux#=>] - [(_.cover [<object> <primitive>] - (|> <jvm#value> - (is <object>) - "jvm object cast" - (is <primitive>) - "jvm object cast" - (is <object>) - (<jvm#=> <jvm#value>))) - (_.cover [<as> <of>] - (|> <lux#value> - <as> - <of> - (<lux#=> <lux#value>)))] - - [/.Boolean /.boolean boolean boolean#= - bit/0 /.as_boolean /.of_boolean bit#=] - [/.Byte /.byte byte byte#= - (/.of_byte byte) /.as_byte /.of_byte i#=] - [/.Short /.short short short#= - (/.of_short short) /.as_short /.of_short i#=] - [/.Integer /.int integer integer#= - (/.of_int integer) /.as_int /.of_int i#=] - [/.Long /.long long long#= - (/.of_long long) /.as_long /.of_long i#=] - [/.Float /.float float float#= - (/.of_float float) /.as_float /.of_float f#=] - [/.Double /.double double double#= - (/.of_double double) /.as_double /.of_double f#=] - [/.Character /.char character character#= - (/.of_char character) /.as_char /.of_char i#=] - )) - (_.cover [/.as_string /.of_string] - (let [it (/.of_string string)] - (|> it - /.as_string - /.of_string - (text#= it)))) - (_.cover [/.cannot_cast_to_non_object] - (text.contains? (the exception.#label /.cannot_cast_to_non_object) - (macro_error (/.is boolean (is /.Boolean boolean))))) - (_.cover [/.is] - (|> string - (/.is java/lang/Object) - (same? (as java/lang/Object string)))) - (_.cover [/.type] - (and (and (type#= /.Boolean (/.type java/lang/Boolean)) - (type#= /.Boolean (/.type boolean))) - (and (type#= /.Byte (/.type java/lang/Byte)) - (type#= /.Byte (/.type byte))) - (and (type#= /.Short (/.type java/lang/Short)) - (type#= /.Short (/.type short))) - (and (type#= /.Integer (/.type java/lang/Integer)) - (type#= /.Integer (/.type int))) - (and (type#= /.Long (/.type java/lang/Long)) - (type#= /.Long (/.type long))) - (and (type#= /.Float (/.type java/lang/Float)) - (type#= /.Float (/.type float))) - (and (type#= /.Double (/.type java/lang/Double)) - (type#= /.Double (/.type double))) - (and (type#= /.Character (/.type java/lang/Character)) - (type#= /.Character (/.type char))))) - )))) + (all _.and + (_.cover [/.as] + (and (case (/.as java/lang/String sample) {.#Some _} true {.#None} false) + (case (/.as java/lang/Long sample) {.#Some _} false {.#None} true) + (case (/.as java/lang/Object sample) {.#Some _} true {.#None} false) + (case (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true))) + (_.cover [/.synchronized] + (/.synchronized sample #1)) + (_.cover [/.class_for] + (text#= "java.lang.Class" (/.of_string (java/lang/Class::getName (/.class_for java/lang/Class))))) + (_.cover [/.null /.null?] + (and (/.null? (/.null)) + (not (/.null? sample)))) + (_.cover [/.???] + (and (|> (/.??? (/.null)) + (is (Maybe java/lang/Object)) + (pipe.case + {.#None} #1 + {.#Some _} #0)) + (|> (/.??? sample) + (is (Maybe java/lang/Object)) + (pipe.case + {.#Some _} #1 + {.#None} #0)))) + (_.cover [/.!!!] + (and (|> (/.??? (/.null)) + /.!!! + /.null?) + (|> (/.??? sample) + /.!!! + /.null? + not))) + (~~ (template [<object> <primitive> <jvm#value> <jvm#=> + <lux#value> <as> <of> <lux#=>] + [(_.cover [<object> <primitive>] + (|> <jvm#value> + (is <object>) + "jvm object cast" + (is <primitive>) + "jvm object cast" + (is <object>) + (<jvm#=> <jvm#value>))) + (_.cover [<as> <of>] + (|> <lux#value> + <as> + <of> + (<lux#=> <lux#value>)))] + + [/.Boolean /.boolean boolean boolean#= + bit/0 /.as_boolean /.of_boolean bit#=] + [/.Byte /.byte byte byte#= + (/.of_byte byte) /.as_byte /.of_byte i#=] + [/.Short /.short short short#= + (/.of_short short) /.as_short /.of_short i#=] + [/.Integer /.int integer integer#= + (/.of_int integer) /.as_int /.of_int i#=] + [/.Long /.long long long#= + (/.of_long long) /.as_long /.of_long i#=] + [/.Float /.float float float#= + (/.of_float float) /.as_float /.of_float f#=] + [/.Double /.double double double#= + (/.of_double double) /.as_double /.of_double f#=] + [/.Character /.char character character#= + (/.of_char character) /.as_char /.of_char i#=] + )) + (_.cover [/.as_string /.of_string] + (let [it (/.of_string string)] + (|> it + /.as_string + /.of_string + (text#= it)))) + (_.cover [/.cannot_cast_to_non_object] + (text.contains? (the exception.#label /.cannot_cast_to_non_object) + (macro_error (/.is boolean (is /.Boolean boolean))))) + (_.cover [/.is] + (|> string + (/.is java/lang/Object) + (same? (as java/lang/Object string)))) + (_.cover [/.type] + (and (and (type#= /.Boolean (/.type java/lang/Boolean)) + (type#= /.Boolean (/.type boolean))) + (and (type#= /.Byte (/.type java/lang/Byte)) + (type#= /.Byte (/.type byte))) + (and (type#= /.Short (/.type java/lang/Short)) + (type#= /.Short (/.type short))) + (and (type#= /.Integer (/.type java/lang/Integer)) + (type#= /.Integer (/.type int))) + (and (type#= /.Long (/.type java/lang/Long)) + (type#= /.Long (/.type long))) + (and (type#= /.Float (/.type java/lang/Float)) + (type#= /.Float (/.type float))) + (and (type#= /.Double (/.type java/lang/Double)) + (type#= /.Double (/.type double))) + (and (type#= /.Character (/.type java/lang/Character)) + (type#= /.Character (/.type char))))) + )))) (/.interface: test/TestInterface0 ([] actual0 [] java/lang/Long)) @@ -600,19 +600,19 @@ test/TestClass9::get_actual9 /.as_long (same? dummy/2))]] - ($_ _.and - (_.cover [/.class: /.import:] - (and example/0! - example/1! - example/2! - example/3! - example/4! - example/5! - example/7! - example_8!)) - (_.cover [/.do_to] - example/9!) - ))) + (all _.and + (_.cover [/.class: /.import:] + (and example/0! + example/1! + example/2! + example/3! + example/4! + example/5! + example/7! + example_8!)) + (_.cover [/.do_to] + example/9!) + ))) (syntax: (expands? [expression <code>.any]) (function (_ lux) @@ -635,46 +635,46 @@ [var/0 (random.ascii/lower 1) var/1 (random.ascii/lower 2) var/2 (random.ascii/lower 3)] - ($_ _.and - (_.cover [/.class_names_cannot_contain_periods] - (with_expansions [<class> (template.symbol ["java.lang.Float"])] - (not (expands? (/.import: <class>))))) - (_.cover [/.class_name_cannot_be_a_type_variable] - (and (not (expands? (/.import: (java/lang/Double a) - "[1]::[0]" - (invalid [] (a java/lang/String))))) - (not (expands? (/.import: java/lang/Double - "[1]::[0]" - ([a] invalid [] (a java/lang/String))))))) - (_.cover [/.unknown_type_variable] - (let [type_variable ((debug.private /.type_variable) (list (jvm.var var/0) (jvm.var var/1)))] - (and (|> (list (code.local var/0)) - (<code>.result type_variable) - (try#each (|>> (jvm#= (jvm.var var/0)))) - (try.else false)) - (|> (list (code.local var/1)) - (<code>.result type_variable) - (try#each (|>> (jvm#= (jvm.var var/1)))) - (try.else false)) - (|> (list (code.local var/2)) - (<code>.result type_variable) - (pipe.case - {try.#Failure error} - (exception.match? /.unknown_type_variable error) - - _ - false))))) - ))) + (all _.and + (_.cover [/.class_names_cannot_contain_periods] + (with_expansions [<class> (template.symbol ["java.lang.Float"])] + (not (expands? (/.import: <class>))))) + (_.cover [/.class_name_cannot_be_a_type_variable] + (and (not (expands? (/.import: (java/lang/Double a) + "[1]::[0]" + (invalid [] (a java/lang/String))))) + (not (expands? (/.import: java/lang/Double + "[1]::[0]" + ([a] invalid [] (a java/lang/String))))))) + (_.cover [/.unknown_type_variable] + (let [type_variable ((debug.private /.type_variable) (list (jvm.var var/0) (jvm.var var/1)))] + (and (|> (list (code.local var/0)) + (<code>.result type_variable) + (try#each (|>> (jvm#= (jvm.var var/0)))) + (try.else false)) + (|> (list (code.local var/1)) + (<code>.result type_variable) + (try#each (|>> (jvm#= (jvm.var var/1)))) + (try.else false)) + (|> (list (code.local var/2)) + (<code>.result type_variable) + (pipe.case + {try.#Failure error} + (exception.match? /.unknown_type_variable error) + + _ + false))))) + ))) (def: .public test (<| (_.covering /._) - ($_ _.and - ..for_conversions - ..for_arrays - ..for_miscellaneous - ..for_interface - ..for_class - ..for_exception - - $/export.test - ))) + (all _.and + ..for_conversions + ..for_arrays + ..for_miscellaneous + ..for_interface + ..for_class + ..for_exception + + $/export.test + ))) diff --git a/stdlib/source/test/lux/ffi.lua.lux b/stdlib/source/test/lux/ffi.lua.lux index 75faa3349..ba0671906 100644 --- a/stdlib/source/test/lux/ffi.lua.lux +++ b/stdlib/source/test/lux/ffi.lua.lux @@ -23,43 +23,43 @@ float random.frac string (random.ascii/lower 1)] (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<type> <sample>] - [(_.cover [<type>] - (exec - (is <type> <sample>) - true))] + (`` (all _.and + (~~ (template [<type> <sample>] + [(_.cover [<type>] + (exec + (is <type> <sample>) + true))] - [/.Boolean boolean] - [/.Integer integer] - [/.Float float] - [/.String string] - )) - (_.for [/.Object] - ($_ _.and - (~~ (template [<type>] - [(_.cover [<type>] - (exec - (|> [] - (as <type>) - (is (Ex (_ a) (/.Object a)))) - true))] + [/.Boolean boolean] + [/.Integer integer] + [/.Float float] + [/.String string] + )) + (_.for [/.Object] + (all _.and + (~~ (template [<type>] + [(_.cover [<type>] + (exec + (|> [] + (as <type>) + (is (Ex (_ a) (/.Object a)))) + true))] - [/.Nil] - [/.Table] - )))) - (_.cover [/.Function /.function] - (exec - (|> (/.function (_ [input/0 Nat]) - Int - (.int input/0)) - (is /.Function) - (is (Ex (_ a) (/.Object a)))) - true)) - (_.cover [/.import:] - (case (io.run! (..os/getenv string)) - {.#Some _} true - {.#None} true)) + [/.Nil] + [/.Table] + )))) + (_.cover [/.Function /.function] + (exec + (|> (/.function (_ [input/0 Nat]) + Int + (.int input/0)) + (is /.Function) + (is (Ex (_ a) (/.Object a)))) + true)) + (_.cover [/.import:] + (case (io.run! (..os/getenv string)) + {.#Some _} true + {.#None} true)) - $/export.test - ))))) + $/export.test + ))))) diff --git a/stdlib/source/test/lux/ffi.old.lux b/stdlib/source/test/lux/ffi.old.lux index 2b50f700c..6b6bc0f34 100644 --- a/stdlib/source/test/lux/ffi.old.lux +++ b/stdlib/source/test/lux/ffi.old.lux @@ -99,62 +99,62 @@ float (|> random.frac (random.only (|>> f.not_a_number? not)) (# ! each (|>> /.double_to_float)))] - (`` ($_ _.and - (~~ (template [<=> <sample> <to> <from>] - [(_.cover [<to> <from>] - (or (|> <sample> <to> <from> (<=> <sample>)) - (let [capped (|> <sample> <to> <from>)] - (|> capped <to> <from> (<=> capped)))))] - - [i.= long /.long_to_byte /.byte_to_long] - [i.= long /.long_to_short /.short_to_long] - [i.= long /.long_to_int /.int_to_long] - [i.= long /.long_to_float /.float_to_long] - [i.= long /.long_to_double /.double_to_long] - - [f.= double /.double_to_float /.float_to_double] - [f.= double /.double_to_int /.int_to_double] - )) - (~~ (template [<to> <from>] - [(_.cover [<to>] - (or (|> int <to> <from> (i.= (/.int_to_long int))) + (`` (all _.and + (~~ (template [<=> <sample> <to> <from>] + [(_.cover [<to> <from>] + (or (|> <sample> <to> <from> (<=> <sample>)) + (let [capped (|> <sample> <to> <from>)] + (|> capped <to> <from> (<=> capped)))))] + + [i.= long /.long_to_byte /.byte_to_long] + [i.= long /.long_to_short /.short_to_long] + [i.= long /.long_to_int /.int_to_long] + [i.= long /.long_to_float /.float_to_long] + [i.= long /.long_to_double /.double_to_long] + + [f.= double /.double_to_float /.float_to_double] + [f.= double /.double_to_int /.int_to_double] + )) + (~~ (template [<to> <from>] + [(_.cover [<to>] + (or (|> int <to> <from> (i.= (/.int_to_long int))) + (let [capped (|> int <to> <from>)] + (|> capped /.long_to_int <to> <from> (i.= capped)))))] + + [/.int_to_byte /.byte_to_long] + [/.int_to_short /.short_to_long] + [/.int_to_char /.char_to_long] + )) + (~~ (template [<sample> <to> <from>] + [(_.cover [<to> <from>] + (or (|> <sample> <to> <from> /.float_to_double (f.= (/.float_to_double <sample>))) + (let [capped (|> <sample> <to> <from>)] + (|> capped <to> <from> /.float_to_double (f.= (/.float_to_double capped))))))] + + [float /.float_to_int /.int_to_float] + )) + (~~ (template [<to> <from>] + [(_.cover [<to>] + (or (|> char <to> <from> (i.= (|> char /.char_to_int /.int_to_long))) + (let [capped (|> char <to> <from>)] + (|> capped /.long_to_int /.int_to_char <to> <from> (i.= capped)))))] + + [/.char_to_byte /.byte_to_long] + [/.char_to_short /.short_to_long] + )) + (_.cover [/.char_to_long] + (with_expansions [<to> /.int_to_char + <from> /.char_to_long] + (`` (or (|> int <to> <from> (i.= (/.int_to_long int))) (let [capped (|> int <to> <from>)] - (|> capped /.long_to_int <to> <from> (i.= capped)))))] - - [/.int_to_byte /.byte_to_long] - [/.int_to_short /.short_to_long] - [/.int_to_char /.char_to_long] - )) - (~~ (template [<sample> <to> <from>] - [(_.cover [<to> <from>] - (or (|> <sample> <to> <from> /.float_to_double (f.= (/.float_to_double <sample>))) - (let [capped (|> <sample> <to> <from>)] - (|> capped <to> <from> /.float_to_double (f.= (/.float_to_double capped))))))] - - [float /.float_to_int /.int_to_float] - )) - (~~ (template [<to> <from>] - [(_.cover [<to>] - (or (|> char <to> <from> (i.= (|> char /.char_to_int /.int_to_long))) - (let [capped (|> char <to> <from>)] - (|> capped /.long_to_int /.int_to_char <to> <from> (i.= capped)))))] - - [/.char_to_byte /.byte_to_long] - [/.char_to_short /.short_to_long] - )) - (_.cover [/.char_to_long] - (with_expansions [<to> /.int_to_char - <from> /.char_to_long] - (`` (or (|> int <to> <from> (i.= (/.int_to_long int))) - (let [capped (|> int <to> <from>)] - (|> capped /.long_to_int <to> <from> (i.= capped))))))) - (_.cover [/.char_to_int] - (with_expansions [<to> /.int_to_char - <from> /.char_to_int] - (`` (or (|> int <to> <from> /.int_to_long (i.= (/.int_to_long int))) - (let [capped (|> int <to> <from>)] - (|> capped <to> <from> /.int_to_long (i.= (/.int_to_long capped)))))))) - )))) + (|> capped /.long_to_int <to> <from> (i.= capped))))))) + (_.cover [/.char_to_int] + (with_expansions [<to> /.int_to_char + <from> /.char_to_int] + (`` (or (|> int <to> <from> /.int_to_long (i.= (/.int_to_long int))) + (let [capped (|> int <to> <from>)] + (|> capped <to> <from> /.int_to_long (i.= (/.int_to_long capped)))))))) + )))) (def: arrays Test @@ -162,37 +162,37 @@ [size (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) idx (|> random.nat (# ! each (n.% size))) value random.int] - ($_ _.and - (_.cover [/.array /.length] - (n.= size (/.length (/.array java/lang/Long size)))) - (_.cover [/.write! /.read!] - (|> (/.array java/lang/Long size) - (/.write! idx value) - (/.read! idx) - (i.= value))) - ))) + (all _.and + (_.cover [/.array /.length] + (n.= size (/.length (/.array java/lang/Long size)))) + (_.cover [/.write! /.read!] + (|> (/.array java/lang/Long size) + (/.write! idx value) + (/.read! idx) + (i.= value))) + ))) (def: null Test (do random.monad [sample (random.ascii 1)] - ($_ _.and - (_.cover [/.null /.null?] - (and (/.null? (/.null)) - (not (/.null? sample)))) - (_.cover [/.???] - (and (|> (is (Maybe java/lang/Object) (/.??? (/.null))) - (pipe.case - {.#None} #1 - _ #0)) - (|> (is (Maybe java/lang/Object) (/.??? sample)) - (pipe.case - {.#Some _} #1 - _ #0)))) - (_.cover [/.!!!] - (and (/.null? (/.!!! (/.??? (/.null)))) - (not (/.null? (/.!!! (/.??? sample)))))) - ))) + (all _.and + (_.cover [/.null /.null?] + (and (/.null? (/.null)) + (not (/.null? sample)))) + (_.cover [/.???] + (and (|> (is (Maybe java/lang/Object) (/.??? (/.null))) + (pipe.case + {.#None} #1 + _ #0)) + (|> (is (Maybe java/lang/Object) (/.??? sample)) + (pipe.case + {.#Some _} #1 + _ #0)))) + (_.cover [/.!!!] + (and (/.null? (/.!!! (/.??? (/.null)))) + (not (/.null? (/.!!! (/.??? sample)))))) + ))) (def: miscellaneous Test @@ -200,44 +200,44 @@ [sample (random.ascii 1) counter random.int increase random.int] - ($_ _.and - (_.cover [/.as] - (and (case (/.as java/lang/String sample) {.#Some _} true {.#None} false) - (case (/.as java/lang/Long sample) {.#Some _} false {.#None} true) - (case (/.as java/lang/Object sample) {.#Some _} true {.#None} false) - (case (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true))) - (_.cover [/.synchronized] - (/.synchronized sample #1)) - (_.cover [/.class_for /.import:] - (|> (/.class_for java/lang/Class) - java/lang/Class::getName - (text#= "java.lang.Class"))) - (_.cover [/.class: /.do_to] - (|> (/.do_to (test/lux/ffi/TestClass::new increase counter) - (test/lux/ffi/TestClass::upC) - (test/lux/ffi/TestClass::upC) - (test/lux/ffi/TestClass::downC)) - test/lux/ffi/TestClass::currentC - (i.= (i.+ increase counter)))) - (_.cover [/.interface: /.object] - (|> (..test_object increase counter) - test/lux/ffi/TestInterface::up - test/lux/ffi/TestInterface::up - test/lux/ffi/TestInterface::down - test/lux/ffi/TestInterface::current - (i.= (i.+ increase counter)))) - (_.cover [/.type] - (and (type#= (Primitive "java.lang.Char") - (/.type java/lang/Char)) - (type#= (Primitive "java.util.List" [(Primitive "java.lang.Byte")]) - (/.type (java/util/List java/lang/Byte))))) - ))) + (all _.and + (_.cover [/.as] + (and (case (/.as java/lang/String sample) {.#Some _} true {.#None} false) + (case (/.as java/lang/Long sample) {.#Some _} false {.#None} true) + (case (/.as java/lang/Object sample) {.#Some _} true {.#None} false) + (case (/.as java/lang/Object (/.null)) {.#Some _} false {.#None} true))) + (_.cover [/.synchronized] + (/.synchronized sample #1)) + (_.cover [/.class_for /.import:] + (|> (/.class_for java/lang/Class) + java/lang/Class::getName + (text#= "java.lang.Class"))) + (_.cover [/.class: /.do_to] + (|> (/.do_to (test/lux/ffi/TestClass::new increase counter) + (test/lux/ffi/TestClass::upC) + (test/lux/ffi/TestClass::upC) + (test/lux/ffi/TestClass::downC)) + test/lux/ffi/TestClass::currentC + (i.= (i.+ increase counter)))) + (_.cover [/.interface: /.object] + (|> (..test_object increase counter) + test/lux/ffi/TestInterface::up + test/lux/ffi/TestInterface::up + test/lux/ffi/TestInterface::down + test/lux/ffi/TestInterface::current + (i.= (i.+ increase counter)))) + (_.cover [/.type] + (and (type#= (Primitive "java.lang.Char") + (/.type java/lang/Char)) + (type#= (Primitive "java.util.List" [(Primitive "java.lang.Byte")]) + (/.type (java/util/List java/lang/Byte))))) + ))) (def: .public test (<| (_.covering /._) - ($_ _.and - ..conversions - ..arrays - ..null - ..miscellaneous - ))) + (all _.and + ..conversions + ..arrays + ..null + ..miscellaneous + ))) diff --git a/stdlib/source/test/lux/ffi.py.lux b/stdlib/source/test/lux/ffi.py.lux index b3e8f9fa6..3166de641 100644 --- a/stdlib/source/test/lux/ffi.py.lux +++ b/stdlib/source/test/lux/ffi.py.lux @@ -26,42 +26,42 @@ float random.frac string (random.ascii/lower 1)] (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<type> <sample>] - [(_.cover [<type>] - (exec - (is <type> <sample>) - true))] + (`` (all _.and + (~~ (template [<type> <sample>] + [(_.cover [<type>] + (exec + (is <type> <sample>) + true))] - [/.Boolean boolean] - [/.Integer integer] - [/.Float float] - [/.String string] - )) - (_.for [/.Object] - ($_ _.and - (~~ (template [<type>] - [(_.cover [<type>] - (exec - (|> [] - (as <type>) - (is (Ex (_ a) (/.Object a)))) - true))] + [/.Boolean boolean] + [/.Integer integer] + [/.Float float] + [/.String string] + )) + (_.for [/.Object] + (all _.and + (~~ (template [<type>] + [(_.cover [<type>] + (exec + (|> [] + (as <type>) + (is (Ex (_ a) (/.Object a)))) + true))] - [/.None] - [/.Dict] - )))) - (_.cover [/.Function /.function] - (exec - (|> (/.function (_ [input/0 Nat]) - Int - (.int input/0)) - (is /.Function) - (is (Ex (_ a) (/.Object a)))) - true)) - (_.cover [/.import:] - (and (i.= (os::R_OK) (os::R_OK)) - (not (i.= (os::W_OK) (os::R_OK))))) + [/.None] + [/.Dict] + )))) + (_.cover [/.Function /.function] + (exec + (|> (/.function (_ [input/0 Nat]) + Int + (.int input/0)) + (is /.Function) + (is (Ex (_ a) (/.Object a)))) + true)) + (_.cover [/.import:] + (and (i.= (os::R_OK) (os::R_OK)) + (not (i.= (os::W_OK) (os::R_OK))))) - $/export.test - ))))) + $/export.test + ))))) diff --git a/stdlib/source/test/lux/ffi.rb.lux b/stdlib/source/test/lux/ffi.rb.lux index 49833b639..b58994cd4 100644 --- a/stdlib/source/test/lux/ffi.rb.lux +++ b/stdlib/source/test/lux/ffi.rb.lux @@ -23,34 +23,34 @@ float random.frac string (random.ascii/lower 1)] (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<type> <sample>] - [(_.cover [<type>] - (exec - (is <type> <sample>) - true))] + (`` (all _.and + (~~ (template [<type> <sample>] + [(_.cover [<type>] + (exec + (is <type> <sample>) + true))] - [/.Boolean boolean] - [/.Integer integer] - [/.Float float] - [/.String string] - )) - (_.for [/.Object] - ($_ _.and - (~~ (template [<type>] - [(_.cover [<type>] - (exec - (|> [] - (as <type>) - (is (Ex (_ a) (/.Object a)))) - true))] + [/.Boolean boolean] + [/.Integer integer] + [/.Float float] + [/.String string] + )) + (_.for [/.Object] + (all _.and + (~~ (template [<type>] + [(_.cover [<type>] + (exec + (|> [] + (as <type>) + (is (Ex (_ a) (/.Object a)))) + true))] - [/.Nil] - [/.Function] - )))) - (_.cover [/.import:] - (same? (..File::SEPARATOR) - (..File::SEPARATOR))) + [/.Nil] + [/.Function] + )))) + (_.cover [/.import:] + (same? (..File::SEPARATOR) + (..File::SEPARATOR))) - $/export.test - ))))) + $/export.test + ))))) diff --git a/stdlib/source/test/lux/ffi/export.js.lux b/stdlib/source/test/lux/ffi/export.js.lux index 67e276b8c..16eab39bb 100644 --- a/stdlib/source/test/lux/ffi/export.js.lux +++ b/stdlib/source/test/lux/ffi/export.js.lux @@ -25,9 +25,9 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.export:] - (and (n.= <nat> ..constant) - (n.= (n.+ <nat> <nat>) (..shift <nat>)))) - ))) + (all _.and + (_.cover [/.export:] + (and (n.= <nat> ..constant) + (n.= (n.+ <nat> <nat>) (..shift <nat>)))) + ))) ) diff --git a/stdlib/source/test/lux/ffi/export.jvm.lux b/stdlib/source/test/lux/ffi/export.jvm.lux index cde493f1f..570c5b98f 100644 --- a/stdlib/source/test/lux/ffi/export.jvm.lux +++ b/stdlib/source/test/lux/ffi/export.jvm.lux @@ -140,47 +140,47 @@ [double //.as_double ..tiny_frac] [string //.as_string (random.ascii/lower 1)] ))] - ($_ _.and - (_.cover [/.export:] - (and (bit#= (//.of_boolean ..expected_boolean) (//.of_boolean (Primitives::actual_boolean))) - (int#= (//.of_byte ..expected_byte) (//.of_byte (Primitives::actual_byte))) - (int#= (//.of_short ..expected_short) (//.of_short (Primitives::actual_short))) - (int#= (//.of_int ..expected_int) (//.of_int (Primitives::actual_int))) - (int#= (//.of_long ..expected_long) (//.of_long (Primitives::actual_long))) - (int#= (//.of_char ..expected_char) (//.of_char (Primitives::actual_char))) - (frac#= (//.of_float ..expected_float) (//.of_float (Primitives::actual_float))) - (frac#= (//.of_double ..expected_double) (//.of_double (Primitives::actual_double))) - - (~~ (template [<=> <+> <type>] - [(with_expansions [<left> (template.symbol ["left_" <type>]) - <right> (template.symbol ["right_" <type>]) - <of> (template.symbol [//._] ["of_" <type>]) - <method> (template.symbol ["Primitives::" <type> "_method"])] - (<=> (<+> (<of> <left>) (<of> <right>)) - (<of> (<method> <left> <right>))))] - - [bit#= and boolean] - [int#= int.+ byte] - [int#= int.+ short] - [int#= int.+ int] - [int#= int.+ long] - [int#= int.+ char] - [frac#= frac.+ float] - [frac#= frac.+ double] - )) - - (text#= (//.of_string ..expected_string) (//.of_string (Objects::actual_string))) - - (text#= (%.format (//.of_string left_string) (//.of_string right_string)) - (//.of_string (Objects::string_method left_string right_string))) - - (text#= (//.of_string left_string) - (//.of_string (Objects::left left_string right_string))) - (text#= (//.of_string right_string) - (//.of_string (Objects::right left_string right_string))) - (int#= (//.of_long left_long) - (//.of_long (Objects::left left_long right_long))) - (int#= (//.of_long right_long) - (//.of_long (Objects::right left_long right_long))) - )) - )))))) + (all _.and + (_.cover [/.export:] + (and (bit#= (//.of_boolean ..expected_boolean) (//.of_boolean (Primitives::actual_boolean))) + (int#= (//.of_byte ..expected_byte) (//.of_byte (Primitives::actual_byte))) + (int#= (//.of_short ..expected_short) (//.of_short (Primitives::actual_short))) + (int#= (//.of_int ..expected_int) (//.of_int (Primitives::actual_int))) + (int#= (//.of_long ..expected_long) (//.of_long (Primitives::actual_long))) + (int#= (//.of_char ..expected_char) (//.of_char (Primitives::actual_char))) + (frac#= (//.of_float ..expected_float) (//.of_float (Primitives::actual_float))) + (frac#= (//.of_double ..expected_double) (//.of_double (Primitives::actual_double))) + + (~~ (template [<=> <+> <type>] + [(with_expansions [<left> (template.symbol ["left_" <type>]) + <right> (template.symbol ["right_" <type>]) + <of> (template.symbol [//._] ["of_" <type>]) + <method> (template.symbol ["Primitives::" <type> "_method"])] + (<=> (<+> (<of> <left>) (<of> <right>)) + (<of> (<method> <left> <right>))))] + + [bit#= and boolean] + [int#= int.+ byte] + [int#= int.+ short] + [int#= int.+ int] + [int#= int.+ long] + [int#= int.+ char] + [frac#= frac.+ float] + [frac#= frac.+ double] + )) + + (text#= (//.of_string ..expected_string) (//.of_string (Objects::actual_string))) + + (text#= (%.format (//.of_string left_string) (//.of_string right_string)) + (//.of_string (Objects::string_method left_string right_string))) + + (text#= (//.of_string left_string) + (//.of_string (Objects::left left_string right_string))) + (text#= (//.of_string right_string) + (//.of_string (Objects::right left_string right_string))) + (int#= (//.of_long left_long) + (//.of_long (Objects::left left_long right_long))) + (int#= (//.of_long right_long) + (//.of_long (Objects::right left_long right_long))) + )) + )))))) diff --git a/stdlib/source/test/lux/ffi/export.lua.lux b/stdlib/source/test/lux/ffi/export.lua.lux index 63cc558ef..daaea870c 100644 --- a/stdlib/source/test/lux/ffi/export.lua.lux +++ b/stdlib/source/test/lux/ffi/export.lua.lux @@ -25,9 +25,9 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.export:] - (and (n.= <nat> (..constant)) - (n.= (n.+ <nat> <nat>) ((..shift) <nat>)))) - ))) + (all _.and + (_.cover [/.export:] + (and (n.= <nat> (..constant)) + (n.= (n.+ <nat> <nat>) ((..shift) <nat>)))) + ))) ) diff --git a/stdlib/source/test/lux/ffi/export.py.lux b/stdlib/source/test/lux/ffi/export.py.lux index 67e276b8c..16eab39bb 100644 --- a/stdlib/source/test/lux/ffi/export.py.lux +++ b/stdlib/source/test/lux/ffi/export.py.lux @@ -25,9 +25,9 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.export:] - (and (n.= <nat> ..constant) - (n.= (n.+ <nat> <nat>) (..shift <nat>)))) - ))) + (all _.and + (_.cover [/.export:] + (and (n.= <nat> ..constant) + (n.= (n.+ <nat> <nat>) (..shift <nat>)))) + ))) ) diff --git a/stdlib/source/test/lux/ffi/export.rb.lux b/stdlib/source/test/lux/ffi/export.rb.lux index 0ceaf7e00..3ab6e3c93 100644 --- a/stdlib/source/test/lux/ffi/export.rb.lux +++ b/stdlib/source/test/lux/ffi/export.rb.lux @@ -33,11 +33,11 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.export:] - (and (n.= <nat> (..nullary [])) - (n.= (n.+ <nat> <nat>) (..unary <nat>)) - (n.= <nat> (..CONSTANT)) - (n.= (n.+ <nat> <nat>) ((..$global) <nat>)))) - ))) + (all _.and + (_.cover [/.export:] + (and (n.= <nat> (..nullary [])) + (n.= (n.+ <nat> <nat>) (..unary <nat>)) + (n.= <nat> (..CONSTANT)) + (n.= (n.+ <nat> <nat>) ((..$global) <nat>)))) + ))) ) diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux index 2a7a76bf8..a4892aa3e 100644 --- a/stdlib/source/test/lux/locale.lux +++ b/stdlib/source/test/lux/locale.lux @@ -1,26 +1,26 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash]]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)]] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["[0]" encoding {"+" Encoding}]] - [collection - ["[0]" list]]]]] - ["[0]" / "_" - ["[1][0]" language] - ["[1][0]" territory]] - [\\library - ["[0]" / - ["[0]" language {"+" Language}] - ["[0]" territory {"+" Territory}]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["[0]" encoding {"+" Encoding}]] + [collection + ["[0]" list]]]]] + ["[0]" / "_" + ["[1][0]" language] + ["[1][0]" territory]] + [\\library + ["[0]" / + ["[0]" language {"+" Language}] + ["[0]" territory {"+" Territory}]]]) (def: random_language (Random Language) @@ -49,50 +49,50 @@ Test (<| (_.covering /._) (_.for [/.Locale]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random_locale)) - (_.for [/.hash] - (do [! random.monad] - [fixed_language ..random_language - fixed_territory ..random_territory - fixed_encoding ..random_encoding] - ($_ _.and - (|> ..random_language - (# ! each (function (_ language) - (/.locale language {.#Some fixed_territory} {.#Some fixed_encoding}))) - ($hash.spec /.hash)) - (|> ..random_territory - (# ! each (function (_ territory) - (/.locale fixed_language {.#Some territory} {.#Some fixed_encoding}))) - ($hash.spec /.hash)) - (|> ..random_encoding - (# ! each (function (_ encoding) - (/.locale fixed_language {.#Some fixed_territory} {.#Some encoding}))) - ($hash.spec /.hash)) - ))) - - (do random.monad - [language ..random_language - territory ..random_territory - encoding ..random_encoding - .let [l_locale (/.locale language {.#None} {.#None}) - lt_locale (/.locale language {.#Some territory} {.#None}) - le_locale (/.locale language {.#None} {.#Some encoding}) - lte_locale (/.locale language {.#Some territory} {.#Some encoding})] - .let [language_check (and (text#= (language.code language) - (/.code l_locale)) - (list.every? (|>> /.code (text.starts_with? (language.code language))) - (list lt_locale le_locale lte_locale))) - territory_check (list.every? (|>> /.code (text.contains? (territory.long_code territory))) - (list lt_locale lte_locale)) - encoding_check (list.every? (|>> /.code (text.ends_with? (encoding.name encoding))) - (list le_locale lte_locale))]] - (_.cover [/.locale /.code] - (and language_check - territory_check - encoding_check))) - - /language.test - /territory.test - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random_locale)) + (_.for [/.hash] + (do [! random.monad] + [fixed_language ..random_language + fixed_territory ..random_territory + fixed_encoding ..random_encoding] + (all _.and + (|> ..random_language + (# ! each (function (_ language) + (/.locale language {.#Some fixed_territory} {.#Some fixed_encoding}))) + ($hash.spec /.hash)) + (|> ..random_territory + (# ! each (function (_ territory) + (/.locale fixed_language {.#Some territory} {.#Some fixed_encoding}))) + ($hash.spec /.hash)) + (|> ..random_encoding + (# ! each (function (_ encoding) + (/.locale fixed_language {.#Some fixed_territory} {.#Some encoding}))) + ($hash.spec /.hash)) + ))) + + (do random.monad + [language ..random_language + territory ..random_territory + encoding ..random_encoding + .let [l_locale (/.locale language {.#None} {.#None}) + lt_locale (/.locale language {.#Some territory} {.#None}) + le_locale (/.locale language {.#None} {.#Some encoding}) + lte_locale (/.locale language {.#Some territory} {.#Some encoding})] + .let [language_check (and (text#= (language.code language) + (/.code l_locale)) + (list.every? (|>> /.code (text.starts_with? (language.code language))) + (list lt_locale le_locale lte_locale))) + territory_check (list.every? (|>> /.code (text.contains? (territory.long_code territory))) + (list lt_locale lte_locale)) + encoding_check (list.every? (|>> /.code (text.ends_with? (encoding.name encoding))) + (list le_locale lte_locale))]] + (_.cover [/.locale /.code] + (and language_check + territory_check + encoding_check))) + + /language.test + /territory.test + ))) diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index bf61cbc92..a95df8de0 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -201,17 +201,17 @@ list.reversed (list#each (the #test)) (list#mix _.and - (`` ($_ _.and - (~~ (template [<lens> <tag> <hash>] - [(let [[amount set] (..aggregate (the <tag>) <hash> ..languages)] - (_.cover [<lens>] - (n.= amount (set.size set))))] + (`` (all _.and + (~~ (template [<lens> <tag> <hash>] + [(let [[amount set] (..aggregate (the <tag>) <hash> ..languages)] + (_.cover [<lens>] + (n.= amount (set.size set))))] - [/.name #names text.hash] - [/.code #codes text.hash] - [/.equivalence #languages /.hash] - )) - ))))) + [/.name #names text.hash] + [/.code #codes text.hash] + [/.equivalence #languages /.hash] + )) + ))))) (template: (!aliases <reference> <aliases>) [(_.cover <aliases> @@ -220,61 +220,61 @@ (def: aliases_test/0 Test - ($_ _.and - ... A - (!aliases /.official_aramaic [/.imperial_aramaic]) - (!aliases /.asturian [/.bable /.leonese /.asturleonese]) - ... B - (!aliases /.bini [/.edo]) - (!aliases /.blin [/.bilin]) - ... C - (!aliases /.catalan [/.valencian]) - (!aliases /.church_slavic [/.old_slavonic /.church_slavonic /.old_bulgarian /.old_church_slavonic]) - ... D - (!aliases /.dhivehi [/.maldivian]) - ... G - (!aliases /.swiss_german [/.alemannic /.alsatian]) - ... I - (!aliases /.sichuan_yi [/.nuosu]) - ... K - (!aliases /.kachin [/.jingpho]) - (!aliases /.kalaallisut [/.greenlandic]) - (!aliases /.khotanese [/.sakan]) - )) + (all _.and + ... A + (!aliases /.official_aramaic [/.imperial_aramaic]) + (!aliases /.asturian [/.bable /.leonese /.asturleonese]) + ... B + (!aliases /.bini [/.edo]) + (!aliases /.blin [/.bilin]) + ... C + (!aliases /.catalan [/.valencian]) + (!aliases /.church_slavic [/.old_slavonic /.church_slavonic /.old_bulgarian /.old_church_slavonic]) + ... D + (!aliases /.dhivehi [/.maldivian]) + ... G + (!aliases /.swiss_german [/.alemannic /.alsatian]) + ... I + (!aliases /.sichuan_yi [/.nuosu]) + ... K + (!aliases /.kachin [/.jingpho]) + (!aliases /.kalaallisut [/.greenlandic]) + (!aliases /.khotanese [/.sakan]) + )) (def: aliases_test/1 Test - ($_ _.and - ... M - (!aliases /.mi'kmaq [/.micmac]) - ... N - (!aliases /.newari [/.nepal_bhasa]) - (!aliases /.dutch [/.flemish]) - (!aliases /.northern_sotho [/.pedi /.sepedi]) - (!aliases /.old_newari [/.classical_newari /.classical_nepal_bhasa]) - (!aliases /.nyanja [/.chichewa /.chewa]) - ... O - (!aliases /.occitan [/.provencal]) - ... P - (!aliases /.pampanga [/.kapampangan]) - ... R - (!aliases /.rarotongan [/.cook_islands_maori]) - (!aliases /.romanian [/.moldavian /.moldovan]) - (!aliases /.aromanian [/.arumanian /.macedo_romanian]) - ... S - (!aliases /.spanish [/.castilian]) - ... X - (!aliases /.kalmyk [/.oirat]) - ... Z - (!aliases /.zaza [/.dimili /.dimli /.kirdki /.kirmanjki /.zazaki]) - )) + (all _.and + ... M + (!aliases /.mi'kmaq [/.micmac]) + ... N + (!aliases /.newari [/.nepal_bhasa]) + (!aliases /.dutch [/.flemish]) + (!aliases /.northern_sotho [/.pedi /.sepedi]) + (!aliases /.old_newari [/.classical_newari /.classical_nepal_bhasa]) + (!aliases /.nyanja [/.chichewa /.chewa]) + ... O + (!aliases /.occitan [/.provencal]) + ... P + (!aliases /.pampanga [/.kapampangan]) + ... R + (!aliases /.rarotongan [/.cook_islands_maori]) + (!aliases /.romanian [/.moldavian /.moldovan]) + (!aliases /.aromanian [/.arumanian /.macedo_romanian]) + ... S + (!aliases /.spanish [/.castilian]) + ... X + (!aliases /.kalmyk [/.oirat]) + ... Z + (!aliases /.zaza [/.dimili /.dimli /.kirdki /.kirmanjki /.zazaki]) + )) (def: aliases_test Test - ($_ _.and - ..aliases_test/0 - ..aliases_test/1 - )) + (all _.and + ..aliases_test/0 + ..aliases_test/1 + )) (def: .public random (Random /.Language) @@ -290,10 +290,10 @@ Test (<| (_.covering /._) (_.for [/.Language]) - ($_ _.and - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - ..languages_test - ..aliases_test - ))) + (all _.and + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + ..languages_test + ..aliases_test + ))) diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index e16562e3c..b8d2b6e05 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -156,19 +156,19 @@ list.reversed (list#each (the #test)) (list#mix _.and - (`` ($_ _.and - (~~ (template [<lens> <tag> <hash>] - [(let [[amount set] (..aggregate (the <tag>) <hash> ..territories)] - (_.cover [<lens>] - (n.= amount (set.size set))))] + (`` (all _.and + (~~ (template [<lens> <tag> <hash>] + [(let [[amount set] (..aggregate (the <tag>) <hash> ..territories)] + (_.cover [<lens>] + (n.= amount (set.size set))))] - [/.name #names text.hash] - [/.short_code #shorts text.hash] - [/.long_code #longs text.hash] - [/.numeric_code #numbers n.hash] - [/.equivalence #territories /.hash] - )) - ))))) + [/.name #names text.hash] + [/.short_code #shorts text.hash] + [/.long_code #longs text.hash] + [/.numeric_code #numbers n.hash] + [/.equivalence #territories /.hash] + )) + ))))) (template: (!aliases <reference> <aliases>) [(_.cover <aliases> @@ -177,30 +177,30 @@ (def: aliases_test Test - ($_ _.and - ... A - (!aliases /.antigua [/.barbuda]) - ... B - (!aliases /.bonaire [/.sint_eustatius /.saba]) - (!aliases /.bosnia [/.herzegovina]) - ... H - (!aliases /.heard_island [/.mcdonald_islands]) - ... S - (!aliases /.saint_helena [/.ascension /.tristan_da_cunha]) - (!aliases /.saint_kitts [/.nevis]) - (!aliases /.saint_pierre [/.miquelon]) - (!aliases /.saint_vincent [/.the_grenadines]) - (!aliases /.sao_tome [/.principe]) - (!aliases /.south_georgia [/.south_sandwich_islands]) - (!aliases /.svalbard [/.jan_mayen]) - ... T - (!aliases /.trinidad [/.tobago]) - (!aliases /.turks [/.caicos_islands]) - ... U - (!aliases /.united_kingdom [/.northern_ireland]) - ... W - (!aliases /.wallis [/.futuna]) - )) + (all _.and + ... A + (!aliases /.antigua [/.barbuda]) + ... B + (!aliases /.bonaire [/.sint_eustatius /.saba]) + (!aliases /.bosnia [/.herzegovina]) + ... H + (!aliases /.heard_island [/.mcdonald_islands]) + ... S + (!aliases /.saint_helena [/.ascension /.tristan_da_cunha]) + (!aliases /.saint_kitts [/.nevis]) + (!aliases /.saint_pierre [/.miquelon]) + (!aliases /.saint_vincent [/.the_grenadines]) + (!aliases /.sao_tome [/.principe]) + (!aliases /.south_georgia [/.south_sandwich_islands]) + (!aliases /.svalbard [/.jan_mayen]) + ... T + (!aliases /.trinidad [/.tobago]) + (!aliases /.turks [/.caicos_islands]) + ... U + (!aliases /.united_kingdom [/.northern_ireland]) + ... W + (!aliases /.wallis [/.futuna]) + )) (def: .public random (Random /.Territory) @@ -216,10 +216,10 @@ Test (<| (_.covering /._) (_.for [/.Territory]) - ($_ _.and - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - ..territories_test - ..aliases_test - ))) + (all _.and + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + ..territories_test + ..aliases_test + ))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index e1927eedb..e6a1aa602 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -124,97 +124,97 @@ (..pow/2 (~ pow/1)))) full_expansion (` (n.* (n.* (~ pow/1) (~ pow/1)) (n.* (~ pow/1) (~ pow/1))))]] - (`` ($_ _.and - (~~ (template [<expander> <logger> <expansion>] - [(_.cover [<expander>] - (|> (<expander> (` (..pow/4 (~ pow/1)))) - (meta.result lux) - (try#each (# (list.equivalence code.equivalence) = - (list <expansion>))) - (try.else false))) - - (_.cover [<logger>] - (and (|> (/.single_expansion (` (<logger> "omit" (..pow/4 (~ pow/1))))) - (meta.result lux) - (try#each (# (list.equivalence code.equivalence) = (list))) - (try.else false)) - (|> (/.single_expansion (` (<logger> (..pow/4 (~ pow/1))))) - (meta.result lux) - (try#each (# (list.equivalence code.equivalence) = (list <expansion>))) - (try.else false))))] - - [/.single_expansion /.log_single_expansion! single_expansion] - [/.expansion /.log_expansion! expansion] - [/.full_expansion /.log_full_expansion! full_expansion] - )) - (_.cover [/.one_expansion] - (bit#= (not (n.= 1 repetitions)) - (|> (/.one_expansion (` (..repeated (~ (code.nat repetitions)) (~ pow/1)))) - (meta.result lux) - (!expect {try.#Failure _})))) - (_.cover [/.final] - (with_expansions [<expected> (static.random_nat) - <cycles> (static.random code.nat - (random#each (|>> (n.% 5) ++) random.nat)) - <actual> (/.final (..iterated <cycles> <expected>))] - (case (' <actual>) - [_ {.#Nat actual}] - (n.= <expected> actual) - - _ - false))) - (_.cover [/.times] - (with_expansions [<expected> (static.random_nat) - <max> (static.random code.nat - (random#each (|>> (n.% 10) (n.+ 2)) random.nat)) - <cycles> (static.random code.nat - (random#each (|>> (n.% <max>) ++) random.nat)) - <actual> (/.times <cycles> (..iterated <max> <expected>))] - (let [expected_remaining (n.- <cycles> <max>)] - (case (` <actual>) - (^.` (..iterated (~ [_ {.#Nat actual_remaining}]) (~ [_ {.#Nat actual}]))) - (and (n.= expected_remaining actual_remaining) - (n.= <expected> actual)) - - _ - false)))) - )))) + (`` (all _.and + (~~ (template [<expander> <logger> <expansion>] + [(_.cover [<expander>] + (|> (<expander> (` (..pow/4 (~ pow/1)))) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = + (list <expansion>))) + (try.else false))) + + (_.cover [<logger>] + (and (|> (/.single_expansion (` (<logger> "omit" (..pow/4 (~ pow/1))))) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = (list))) + (try.else false)) + (|> (/.single_expansion (` (<logger> (..pow/4 (~ pow/1))))) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = (list <expansion>))) + (try.else false))))] + + [/.single_expansion /.log_single_expansion! single_expansion] + [/.expansion /.log_expansion! expansion] + [/.full_expansion /.log_full_expansion! full_expansion] + )) + (_.cover [/.one_expansion] + (bit#= (not (n.= 1 repetitions)) + (|> (/.one_expansion (` (..repeated (~ (code.nat repetitions)) (~ pow/1)))) + (meta.result lux) + (!expect {try.#Failure _})))) + (_.cover [/.final] + (with_expansions [<expected> (static.random_nat) + <cycles> (static.random code.nat + (random#each (|>> (n.% 5) ++) random.nat)) + <actual> (/.final (..iterated <cycles> <expected>))] + (case (' <actual>) + [_ {.#Nat actual}] + (n.= <expected> actual) + + _ + false))) + (_.cover [/.times] + (with_expansions [<expected> (static.random_nat) + <max> (static.random code.nat + (random#each (|>> (n.% 10) (n.+ 2)) random.nat)) + <cycles> (static.random code.nat + (random#each (|>> (n.% <max>) ++) random.nat)) + <actual> (/.times <cycles> (..iterated <max> <expected>))] + (let [expected_remaining (n.- <cycles> <max>)] + (case (` <actual>) + (^.` (..iterated (~ [_ {.#Nat actual_remaining}]) (~ [_ {.#Nat actual}]))) + (and (n.= expected_remaining actual_remaining) + (n.= <expected> actual)) + + _ + false)))) + )))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do [! random.monad] - [[seed symbol_prefix lux] ..random_lux] - ($_ _.and - (_.cover [/.symbol] - (|> (/.symbol symbol_prefix) - (# meta.monad each %.code) - (meta.result lux) - (!expect (^.multi {try.#Success actual_symbol} - (and (text.contains? symbol_prefix actual_symbol) - (text.contains? (%.nat seed) actual_symbol)))))) - (_.cover [/.wrong_syntax_error] - (|> (/.single_expansion (` (/.log_single_expansion!))) - (meta.result lux) - (!expect (^.multi {try.#Failure error} - (text.contains? (/.wrong_syntax_error (symbol /.log_single_expansion!)) - error))))) - (_.cover [/.with_symbols] - (with_expansions [<expected> (fresh_symbol)] - (|> (/.with_symbols [<expected>] - (# meta.monad in <expected>)) + (all _.and + (do [! random.monad] + [[seed symbol_prefix lux] ..random_lux] + (all _.and + (_.cover [/.symbol] + (|> (/.symbol symbol_prefix) + (# meta.monad each %.code) + (meta.result lux) + (!expect (^.multi {try.#Success actual_symbol} + (and (text.contains? symbol_prefix actual_symbol) + (text.contains? (%.nat seed) actual_symbol)))))) + (_.cover [/.wrong_syntax_error] + (|> (/.single_expansion (` (/.log_single_expansion!))) (meta.result lux) - (!expect (^.multi {try.#Success [_ {.#Symbol ["" actual]}]} - (text.contains? (template.text [<expected>]) - actual)))))) - )) - - ..test|expansion - - /code.test - /local.test - /syntax.test - /template.test - /pattern.test - ))) + (!expect (^.multi {try.#Failure error} + (text.contains? (/.wrong_syntax_error (symbol /.log_single_expansion!)) + error))))) + (_.cover [/.with_symbols] + (with_expansions [<expected> (fresh_symbol)] + (|> (/.with_symbols [<expected>] + (# meta.monad in <expected>)) + (meta.result lux) + (!expect (^.multi {try.#Success [_ {.#Symbol ["" actual]}]} + (text.contains? (template.text [<expected>]) + actual)))))) + )) + + ..test|expansion + + /code.test + /local.test + /syntax.test + /template.test + /pattern.test + ))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index bf6fb83a6..bf3d3f79a 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -45,18 +45,18 @@ (Random Code) (random.rec (function (_ random) - ($_ random.either - (random#each /.bit random.bit) - (random#each /.nat random.nat) - (random#each /.int random.int) - (random#each /.rev random.rev) - (random#each /.frac random.safe_frac) - (random#each /.text ..random_text) - (random#each /.symbol ..random_symbol) - (random#each /.form (..random_sequence random)) - (random#each /.variant (..random_sequence random)) - (random#each /.tuple (..random_sequence random)) - )))) + (all random.either + (random#each /.bit random.bit) + (random#each /.nat random.nat) + (random#each /.int random.int) + (random#each /.rev random.rev) + (random#each /.frac random.safe_frac) + (random#each /.text ..random_text) + (random#each /.symbol ..random_symbol) + (random#each /.form (..random_sequence random)) + (random#each /.variant (..random_sequence random)) + (random#each /.tuple (..random_sequence random)) + )))) (def: (read source_code) (-> Text (Try Code)) @@ -83,92 +83,92 @@ [parts (..random_sequence replacement_simulation)] (in [(to_code (list#each product.left parts)) (to_code (list#each product.right parts))])))))] - ($_ random.either - (random#in [original substitute]) - (do [! random.monad] - [sample (random.only (|>> (# /.equivalence = original) not) - ($_ random.either - (random#each /.bit random.bit) - (random#each /.nat random.nat) - (random#each /.int random.int) - (random#each /.rev random.rev) - (random#each /.frac random.safe_frac) - (random#each /.text ..random_text) - (random#each /.symbol ..random_symbol)))] - (in [sample sample])) - (for_sequence /.form) - (for_sequence /.variant) - (for_sequence /.tuple) - ))))) + (all random.either + (random#in [original substitute]) + (do [! random.monad] + [sample (random.only (|>> (# /.equivalence = original) not) + (all random.either + (random#each /.bit random.bit) + (random#each /.nat random.nat) + (random#each /.int random.int) + (random#each /.rev random.rev) + (random#each /.frac random.safe_frac) + (random#each /.text ..random_text) + (random#each /.symbol ..random_symbol)))] + (in [sample sample])) + (for_sequence /.form) + (for_sequence /.variant) + (for_sequence /.tuple) + ))))) (def: for_format Test - (`` ($_ _.and - (~~ (template [<coverage> <random> <tag>] - [(do [! random.monad] - [expected <random>] - (_.cover [<coverage>] - (and (case (..read (/.format (<coverage> expected))) - {try.#Success actual} - (# /.equivalence = - actual - (<coverage> expected)) - - {try.#Failure error} - false) - (# /.equivalence = - [location.dummy {<tag> expected}] - (<coverage> expected)))))] + (`` (all _.and + (~~ (template [<coverage> <random> <tag>] + [(do [! random.monad] + [expected <random>] + (_.cover [<coverage>] + (and (case (..read (/.format (<coverage> expected))) + {try.#Success actual} + (# /.equivalence = + actual + (<coverage> expected)) + + {try.#Failure error} + false) + (# /.equivalence = + [location.dummy {<tag> expected}] + (<coverage> expected)))))] - [/.bit random.bit .#Bit] - [/.nat random.nat .#Nat] - [/.int random.int .#Int] - [/.rev random.rev .#Rev] - [/.frac random.safe_frac .#Frac] - [/.text ..random_text .#Text] - [/.symbol ..random_symbol .#Symbol] - [/.form (..random_sequence ..random) .#Form] - [/.variant (..random_sequence ..random) .#Variant] - [/.tuple (..random_sequence ..random) .#Tuple])) - (~~ (template [<coverage> <random> <tag>] - [(do [! random.monad] - [expected <random>] - (_.cover [<coverage>] - (and (case (..read (/.format (<coverage> expected))) - {try.#Success actual} - (# /.equivalence = - actual - (<coverage> expected)) - - {try.#Failure error} - false) - (# /.equivalence = - [location.dummy {<tag> ["" expected]}] - (<coverage> expected))) - ))] + [/.bit random.bit .#Bit] + [/.nat random.nat .#Nat] + [/.int random.int .#Int] + [/.rev random.rev .#Rev] + [/.frac random.safe_frac .#Frac] + [/.text ..random_text .#Text] + [/.symbol ..random_symbol .#Symbol] + [/.form (..random_sequence ..random) .#Form] + [/.variant (..random_sequence ..random) .#Variant] + [/.tuple (..random_sequence ..random) .#Tuple])) + (~~ (template [<coverage> <random> <tag>] + [(do [! random.monad] + [expected <random>] + (_.cover [<coverage>] + (and (case (..read (/.format (<coverage> expected))) + {try.#Success actual} + (# /.equivalence = + actual + (<coverage> expected)) + + {try.#Failure error} + false) + (# /.equivalence = + [location.dummy {<tag> ["" expected]}] + (<coverage> expected))) + ))] - [/.local ..random_text .#Symbol] - ))))) + [/.local ..random_text .#Symbol] + ))))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.for [/.format] - ..for_format) - - (do [! random.monad] - [[original substitute] (random.only (function (_ [original substitute]) - (not (# /.equivalence = original substitute))) - (random.and ..random ..random)) - [sample expected] (random.only (function (_ [sample expected]) - (not (# /.equivalence = sample expected))) - (..replacement_simulation [original substitute]))] - (_.cover [/.replaced] - (# /.equivalence = - expected - (/.replaced original substitute sample)))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.for [/.format] + ..for_format) + + (do [! random.monad] + [[original substitute] (random.only (function (_ [original substitute]) + (not (# /.equivalence = original substitute))) + (random.and ..random ..random)) + [sample expected] (random.only (function (_ [sample expected]) + (not (# /.equivalence = sample expected))) + (..replacement_simulation [original substitute]))] + (_.cover [/.replaced] + (# /.equivalence = + expected + (/.replaced original substitute sample)))) + ))) diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux index 88840d364..0f4d48263 100644 --- a/stdlib/source/test/lux/macro/local.lux +++ b/stdlib/source/test/lux/macro/local.lux @@ -69,23 +69,23 @@ (<| (_.covering /._) (do [! random.monad] [expected random.nat] - ($_ _.and - (_.cover [/.push] - (..with ["" "actual"] expected #0 - (n.= expected (..actual)))) - (_.cover [/.unknown_module] - (exception.match? /.unknown_module - (..macro_error - (..with ["123yolo456" "actual"] expected #0 - (n.= expected (..actual)))))) - (_.cover [/.cannot_shadow_definition] - (exception.match? /.cannot_shadow_definition - (..macro_error - (..with ["" "with"] expected #0 - (n.= expected (..actual)))))) - (_.cover [/.unknown_definition] - (exception.match? /.unknown_definition - (<| ..macro_error - (..with ["" "actual"] expected #1) - (n.= expected (..actual))))) - )))) + (all _.and + (_.cover [/.push] + (..with ["" "actual"] expected #0 + (n.= expected (..actual)))) + (_.cover [/.unknown_module] + (exception.match? /.unknown_module + (..macro_error + (..with ["123yolo456" "actual"] expected #0 + (n.= expected (..actual)))))) + (_.cover [/.cannot_shadow_definition] + (exception.match? /.cannot_shadow_definition + (..macro_error + (..with ["" "with"] expected #0 + (n.= expected (..actual)))))) + (_.cover [/.unknown_definition] + (exception.match? /.unknown_definition + (<| ..macro_error + (..with ["" "actual"] expected #1) + (n.= expected (..actual))))) + )))) diff --git a/stdlib/source/test/lux/macro/pattern.lux b/stdlib/source/test/lux/macro/pattern.lux index a0d4be149..ce57f48ea 100644 --- a/stdlib/source/test/lux/macro/pattern.lux +++ b/stdlib/source/test/lux/macro/pattern.lux @@ -38,61 +38,61 @@ (in +1.25)) expected_text (random.either (in "+0.5") (in "+1.25"))] - ($_ _.and - (do [! random.monad] - [sample (# ! each (n.% 5) random.nat)] - (_.cover [/.template] - (case sample - (/.template [<case>] - [<case> true]) - ([0] [1] [2] [3] [4]) + (all _.and + (do [! random.monad] + [sample (# ! each (n.% 5) random.nat)] + (_.cover [/.template] + (case sample + (/.template [<case>] + [<case> true]) + ([0] [1] [2] [3] [4]) - _ - false))) - (_.cover [/.or] - (and (/.case expected_rev - (/.or .5 .25) true - _ false) - (/.case expected_frac - (/.or +0.5 +1.25) true - _ false) - (/.case expected_text - (/.or "+0.5" "+1.25") true - _ false))) - (_.cover [/.let] - (let [expected_pair (is (Pair Nat Int) - [..#left expected_nat ..#right expected_int])] - (/.case expected_pair - (/.let actual_pair (/.pattern (!pair actual_left actual_right))) - (and (/.same? expected_pair actual_pair) - (/.same? expected_nat actual_left) - (/.same? expected_int actual_right))))) - (_.cover [/.multi] - (let [expected_pair (is (Pair Nat Int) - [..#left expected_nat ..#right expected_int])] - (and (/.case expected_pair - (/.multi (/.pattern (!pair 0 actual_right)) - [actual_right - +0]) - true + _ + false))) + (_.cover [/.or] + (and (/.case expected_rev + (/.or .5 .25) true + _ false) + (/.case expected_frac + (/.or +0.5 +1.25) true + _ false) + (/.case expected_text + (/.or "+0.5" "+1.25") true + _ false))) + (_.cover [/.let] + (let [expected_pair (is (Pair Nat Int) + [..#left expected_nat ..#right expected_int])] + (/.case expected_pair + (/.let actual_pair (/.pattern (!pair actual_left actual_right))) + (and (/.same? expected_pair actual_pair) + (/.same? expected_nat actual_left) + (/.same? expected_int actual_right))))) + (_.cover [/.multi] + (let [expected_pair (is (Pair Nat Int) + [..#left expected_nat ..#right expected_int])] + (and (/.case expected_pair + (/.multi (/.pattern (!pair 0 actual_right)) + [actual_right + +0]) + true - _ - false) - (/.case expected_pair - (/.multi (/.pattern (!pair 0 actual_right)) - (i.= +0 actual_right)) - true + _ + false) + (/.case expected_pair + (/.multi (/.pattern (!pair 0 actual_right)) + (i.= +0 actual_right)) + true - _ - false)))) - (_.cover [/.|>] - (case expected_frac - (/.|> actual_frac [(f.* +2.0) (f.* +2.0)]) - (f.= (f.* +4.0 expected_frac) - actual_frac))) - (_.cover [/.`] - (case (code.text expected_text) - (/.` "+0.5") true - (/.` "+1.25") true - _ false)) - )))) + _ + false)))) + (_.cover [/.|>] + (case expected_frac + (/.|> actual_frac [(f.* +2.0) (f.* +2.0)]) + (f.= (f.* +4.0 expected_frac) + actual_frac))) + (_.cover [/.`] + (case (code.text expected_text) + (/.` "+0.5") true + (/.` "+1.25") true + _ false)) + )))) diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index b8f102a18..6cf8db75c 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -1,48 +1,48 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - [parser - ["<[0]>" code]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]] - ["[0]" / "_" - ["[1][0]" check] - ["[1][0]" declaration] - ["[1][0]" definition] - ["[1][0]" export] - ["[1][0]" input] - ["[1][0]" type "_" - ["[1]/[0]" variable]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [parser + ["<[0]>" code]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" check] + ["[1][0]" declaration] + ["[1][0]" definition] + ["[1][0]" export] + ["[1][0]" input] + ["[1][0]" type "_" + ["[1]/[0]" variable]]]) (/.syntax: (+/3 [a <code>.any b <code>.any c <code>.any]) - (in (list (` ($_ n.+ (~ a) (~ b) (~ c)))))) + (in (list (` (all n.+ (~ a) (~ b) (~ c)))))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [x random.nat - y random.nat - z random.nat] - (_.cover [/.syntax:] - (n.= ($_ n.+ x y z) - (+/3 x y z)))) + (all _.and + (do random.monad + [x random.nat + y random.nat + z random.nat] + (_.cover [/.syntax:] + (n.= (all n.+ x y z) + (+/3 x y z)))) - /check.test - /declaration.test - /definition.test - /export.test - /input.test - /type/variable.test - ))) + /check.test + /declaration.test + /definition.test + /export.test + /input.test + /type/variable.test + ))) diff --git a/stdlib/source/test/lux/macro/syntax/check.lux b/stdlib/source/test/lux/macro/syntax/check.lux index 378fe6b35..c8ba8394c 100644 --- a/stdlib/source/test/lux/macro/syntax/check.lux +++ b/stdlib/source/test/lux/macro/syntax/check.lux @@ -21,28 +21,28 @@ (def: .public random (Random /.Check) - ($_ random.and - $///code.random - $///code.random - )) + (all random.and + $///code.random + $///code.random + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Check]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [[type value] ..random] - (_.cover [/.format /.parser] - (case (<code>.result /.parser - (list (/.format [/.#type type - /.#value value]))) - {try.#Failure _} - false - - {try.#Success check} - (and (code#= type (the /.#type check)) - (code#= value (the /.#value check))))))))) + (do random.monad + [[type value] ..random] + (_.cover [/.format /.parser] + (case (<code>.result /.parser + (list (/.format [/.#type type + /.#value value]))) + {try.#Failure _} + false + + {try.#Success check} + (and (code#= type (the /.#type check)) + (code#= value (the /.#value check))))))))) diff --git a/stdlib/source/test/lux/macro/syntax/declaration.lux b/stdlib/source/test/lux/macro/syntax/declaration.lux index 82687f829..15bc35f78 100644 --- a/stdlib/source/test/lux/macro/syntax/declaration.lux +++ b/stdlib/source/test/lux/macro/syntax/declaration.lux @@ -1,47 +1,47 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try] - [parser - ["<[0]>" code]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try] + [parser + ["<[0]>" code]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: .public random (Random /.Declaration) (let [word (random.ascii/alpha 10)] - ($_ random.and - word - (do [! random.monad] - [size (# ! each (n.% 10) random.nat)] - (random.list size word)) - ))) + (all random.and + word + (do [! random.monad] + [size (# ! each (n.% 10) random.nat)] + (random.list size word)) + ))) (def: .public test Test (<| (_.covering /._) (_.for [/.Declaration]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (case (<code>.result /.parser - (list (/.format expected))) - {try.#Failure _} - false - - {try.#Success actual} - (# /.equivalence = expected actual))))))) + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (case (<code>.result /.parser + (list (/.format expected))) + {try.#Failure _} + false + + {try.#Success actual} + (# /.equivalence = expected actual))))))) diff --git a/stdlib/source/test/lux/macro/syntax/definition.lux b/stdlib/source/test/lux/macro/syntax/definition.lux index d0b3cceb3..a4947439c 100644 --- a/stdlib/source/test/lux/macro/syntax/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/definition.lux @@ -26,12 +26,12 @@ (def: .public random (Random /.Definition) - ($_ random.and - (random.ascii/alpha 5) - (random.or $//check.random - $///code.random) - random.bit - )) + (all random.and + (random.ascii/alpha 5) + (random.or $//check.random + $///code.random) + random.bit + )) (def: compiler [.#info [.#target "FAKE" @@ -57,41 +57,41 @@ Test (<| (_.covering /._) (_.for [/.Definition]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random - - type $///code.random - untyped_value $///code.random] - ($_ _.and - (_.cover [/.format /.parser] - (case (<code>.result (/.parser compiler) - (list (/.format expected))) - {try.#Failure error} - false - - {try.#Success actual} - (# /.equivalence = expected actual))) - (_.cover [/.typed] - (let [expected (has /.#value {.#Left [type untyped_value]} expected)] - (case (<code>.result (/.typed compiler) + (do random.monad + [expected ..random + + type $///code.random + untyped_value $///code.random] + (all _.and + (_.cover [/.format /.parser] + (case (<code>.result (/.parser compiler) (list (/.format expected))) {try.#Failure error} false {try.#Success actual} - (# /.equivalence = expected actual)))) - (_.cover [/.lacks_type] - (let [expected (has /.#value {.#Right untyped_value} expected)] - (case (<code>.result (/.typed compiler) - (list (/.format expected))) - {try.#Failure error} - (exception.match? /.lacks_type error) - - {try.#Success actual} - false))) - ))) + (# /.equivalence = expected actual))) + (_.cover [/.typed] + (let [expected (has /.#value {.#Left [type untyped_value]} expected)] + (case (<code>.result (/.typed compiler) + (list (/.format expected))) + {try.#Failure error} + false + + {try.#Success actual} + (# /.equivalence = expected actual)))) + (_.cover [/.lacks_type] + (let [expected (has /.#value {.#Right untyped_value} expected)] + (case (<code>.result (/.typed compiler) + (list (/.format expected))) + {try.#Failure error} + (exception.match? /.lacks_type error) + + {try.#Success actual} + false))) + ))) )) diff --git a/stdlib/source/test/lux/macro/syntax/export.lux b/stdlib/source/test/lux/macro/syntax/export.lux index ab57afd6c..973842471 100644 --- a/stdlib/source/test/lux/macro/syntax/export.lux +++ b/stdlib/source/test/lux/macro/syntax/export.lux @@ -1,30 +1,30 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" maybe] - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" code]]] - [macro - ["[0]" code ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" maybe] + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" code]]] + [macro + ["[0]" code ("[1]#[0]" equivalence)]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: export (Random [(Maybe Code) Nat]) - ($_ random.and - (|> random.bit - (# random.monad each code.bit) - random.maybe) - random.nat)) + (all random.and + (|> random.bit + (# random.monad each code.bit) + random.maybe) + random.nat)) (def: .public test Test diff --git a/stdlib/source/test/lux/macro/syntax/input.lux b/stdlib/source/test/lux/macro/syntax/input.lux index a55c6d069..4e1008333 100644 --- a/stdlib/source/test/lux/macro/syntax/input.lux +++ b/stdlib/source/test/lux/macro/syntax/input.lux @@ -1,48 +1,48 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try] - [parser - ["<[0]>" code]]] - [data - [collection - ["[0]" list]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]] - ["$[0]" /// "_" - ["[1][0]" code]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try] + [parser + ["<[0]>" code]]] + [data + [collection + ["[0]" list]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]] + ["$[0]" /// "_" + ["[1][0]" code]]) (def: .public random (Random /.Input) - ($_ random.and - $///code.random - $///code.random - )) + (all random.and + $///code.random + $///code.random + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Input]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (case (<code>.result /.parser (list (/.format (list expected)))) - {try.#Failure _} - false - - {try.#Success actual} - (# (list.equivalence /.equivalence) = (list expected) actual))))))) + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (case (<code>.result /.parser (list (/.format (list expected)))) + {try.#Failure _} + false + + {try.#Success actual} + (# (list.equivalence /.equivalence) = (list expected) actual))))))) diff --git a/stdlib/source/test/lux/macro/syntax/type/variable.lux b/stdlib/source/test/lux/macro/syntax/type/variable.lux index 7b5b32baf..e7f3ff473 100644 --- a/stdlib/source/test/lux/macro/syntax/type/variable.lux +++ b/stdlib/source/test/lux/macro/syntax/type/variable.lux @@ -1,19 +1,19 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" code]]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" code]]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" /]]) (def: .public random (Random /.Variable) @@ -23,15 +23,15 @@ Test (<| (_.covering /._) (_.for [/.Variable]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (do random.monad - [expected ..random] - (_.cover [/.format /.parser] - (|> (list (/.format expected)) - (<code>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - ))) + (do random.monad + [expected ..random] + (_.cover [/.format /.parser] + (|> (list (/.format expected)) + (<code>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + ))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 6bdbc04fd..4d4424428 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -48,69 +48,69 @@ <module>' ".5-4+32#1#0cba" <short> (these ["a" b c #0 #1 2 +3 -4 .5]) <short>' "abc#0#12+3-4.5"] - ($_ _.and - (_.cover [/.spliced] - (# (list.equivalence nat.equivalence) = - (list left mid right) - (`` (list (~~ (/.spliced [left mid right])))))) - (_.cover [/.amount] - (case (/.amount [left mid right]) - 3 true - _ false)) - (_.cover [/.text] - (case (/.text <short>) - <short>' true - _ false)) - (_.cover [/.symbol] - (and (case (`` (symbol (~~ (/.symbol <short>)))) - ["" <short>'] true - _ false) - (case (`` (symbol (~~ (/.symbol <module> <short>)))) - [<module>' <short>'] true - _ false) - )) - (_.cover [/.with_locals] - (/.with_locals [var0 var1] - (let [var0 left - var1 right] - (and (nat.= left var0) - (nat.= right var1))))) - (do ! - [scalar random.nat] - (_.cover [/.let] - (let [can_use_with_statements! - (nat.= ($_ nat.* scalar scalar) - (..pow/2 scalar))] - (and can_use_with_statements! - (/.let [(pow/3 <scalar>) - [($_ nat.* <scalar> <scalar> <scalar>)] + (all _.and + (_.cover [/.spliced] + (# (list.equivalence nat.equivalence) = + (list left mid right) + (`` (list (~~ (/.spliced [left mid right])))))) + (_.cover [/.amount] + (case (/.amount [left mid right]) + 3 true + _ false)) + (_.cover [/.text] + (case (/.text <short>) + <short>' true + _ false)) + (_.cover [/.symbol] + (and (case (`` (symbol (~~ (/.symbol <short>)))) + ["" <short>'] true + _ false) + (case (`` (symbol (~~ (/.symbol <module> <short>)))) + [<module>' <short>'] true + _ false) + )) + (_.cover [/.with_locals] + (/.with_locals [var0 var1] + (let [var0 left + var1 right] + (and (nat.= left var0) + (nat.= right var1))))) + (do ! + [scalar random.nat] + (_.cover [/.let] + (let [can_use_with_statements! + (nat.= (all nat.* scalar scalar) + (..pow/2 scalar))] + (and can_use_with_statements! + (/.let [(pow/3 <scalar>) + [(all nat.* <scalar> <scalar> <scalar>)] - (pow/9 <scalar>) - [(pow/3 (pow/3 <scalar>))]] - (let [can_use_with_expressions! - (nat.= ($_ nat.* scalar scalar scalar) - (pow/3 scalar)) + (pow/9 <scalar>) + [(pow/3 (pow/3 <scalar>))]] + (let [can_use_with_expressions! + (nat.= (all nat.* scalar scalar scalar) + (pow/3 scalar)) - can_refer! - (nat.= ($_ nat.* - scalar scalar scalar - scalar scalar scalar - scalar scalar scalar) - (pow/9 scalar)) - - can_shadow! - (let [pow/3 (function (_ scalar) - ($_ nat.+ scalar scalar scalar))] - (nat.= ($_ nat.+ scalar scalar scalar) - (pow/3 scalar)))] - (and can_use_with_expressions! can_refer! - can_shadow!))) - )))) - (_.cover [/.irregular_arguments] - (/.let [(arity/3 <0> <1> <2>) - [""]] - (exception.match? /.irregular_arguments - (macro_error (arity/3 "a" "b"))))) - ))) + (nat.= (all nat.* + scalar scalar scalar + scalar scalar scalar + scalar scalar scalar) + (pow/9 scalar)) + + can_shadow! + (let [pow/3 (function (_ scalar) + (all nat.+ scalar scalar scalar))] + (nat.= (all nat.+ scalar scalar scalar) + (pow/3 scalar)))] + (and can_use_with_expressions! + can_refer! + can_shadow!))) + )))) + (_.cover [/.irregular_arguments] + (/.let [(arity/3 <0> <1> <2>) + [""]] + (exception.match? /.irregular_arguments + (macro_error (arity/3 "a" "b"))))) + ))) )) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 6b5c9749e..4aa96e6db 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -57,88 +57,88 @@ parameterC (random.only (|>> (complex.= complex/0) not) random.complex) subjectC random.complex]) - (`` ($_ _.and - (~~ (template [</> <scenarios>'] - [(_.cover [</>] - (with_expansions [<scenarios> (template.spliced <scenarios>')] - (`` (and (~~ (template [<=> <//> <parameter> <subject>] - [(<=> (<//> <parameter> <subject>) - (</> <parameter> <subject>))] - - <scenarios>))))))] + (`` (all _.and + (~~ (template [</> <scenarios>'] + [(_.cover [</>] + (with_expansions [<scenarios> (template.spliced <scenarios>')] + (`` (and (~~ (template [<=> <//> <parameter> <subject>] + [(<=> (<//> <parameter> <subject>) + (</> <parameter> <subject>))] + + <scenarios>))))))] - [/.+ [[n.= n.+ parameterN subjectN] - [i.= i.+ parameterI subjectI] - [r.= r.+ parameterR subjectR] - [f.= f.+ parameterF subjectF] - [ratio.= ratio.+ parameter/ subject/] - [complex.= complex.+ parameterC subjectC]]] - [/.- [[n.= n.- parameterN subjectN] - [i.= i.- parameterI subjectI] - [r.= r.- parameterR subjectR] - [f.= f.- parameterF subjectF] - [ratio.= ratio.- parameter/ subject/] - [complex.= complex.- parameterC subjectC]]] - [/.* [[n.= n.* parameterN subjectN] - [i.= i.* parameterI subjectI] - [r.= r.* parameterR subjectR] - [f.= f.* parameterF subjectF] - [ratio.= ratio.* parameter/ subject/] - [complex.= complex.* parameterC subjectC]]] - [/./ [[n.= n./ parameterN subjectN] - [i.= i./ parameterI subjectI] - [r.= r./ parameterR subjectR] - [f.= f./ parameterF subjectF] - [ratio.= ratio./ parameter/ subject/] - [complex.= complex./ parameterC subjectC]]] - [/.% [[n.= n.% parameterN subjectN] - [i.= i.% parameterI subjectI] - [r.= r.% parameterR subjectR] - [f.= f.% parameterF subjectF] - [ratio.= ratio.% parameter/ subject/] - [complex.= complex.% parameterC subjectC]]] - )) - (~~ (template [</> <scenarios>'] - [(_.cover [</>] - (with_expansions [<scenarios> (template.spliced <scenarios>')] - (`` (and (~~ (template [<//> <parameter> <subject>] - [(bit#= (<//> <parameter> <subject>) - (</> <parameter> <subject>))] - - <scenarios>))))))] + [/.+ [[n.= n.+ parameterN subjectN] + [i.= i.+ parameterI subjectI] + [r.= r.+ parameterR subjectR] + [f.= f.+ parameterF subjectF] + [ratio.= ratio.+ parameter/ subject/] + [complex.= complex.+ parameterC subjectC]]] + [/.- [[n.= n.- parameterN subjectN] + [i.= i.- parameterI subjectI] + [r.= r.- parameterR subjectR] + [f.= f.- parameterF subjectF] + [ratio.= ratio.- parameter/ subject/] + [complex.= complex.- parameterC subjectC]]] + [/.* [[n.= n.* parameterN subjectN] + [i.= i.* parameterI subjectI] + [r.= r.* parameterR subjectR] + [f.= f.* parameterF subjectF] + [ratio.= ratio.* parameter/ subject/] + [complex.= complex.* parameterC subjectC]]] + [/./ [[n.= n./ parameterN subjectN] + [i.= i./ parameterI subjectI] + [r.= r./ parameterR subjectR] + [f.= f./ parameterF subjectF] + [ratio.= ratio./ parameter/ subject/] + [complex.= complex./ parameterC subjectC]]] + [/.% [[n.= n.% parameterN subjectN] + [i.= i.% parameterI subjectI] + [r.= r.% parameterR subjectR] + [f.= f.% parameterF subjectF] + [ratio.= ratio.% parameter/ subject/] + [complex.= complex.% parameterC subjectC]]] + )) + (~~ (template [</> <scenarios>'] + [(_.cover [</>] + (with_expansions [<scenarios> (template.spliced <scenarios>')] + (`` (and (~~ (template [<//> <parameter> <subject>] + [(bit#= (<//> <parameter> <subject>) + (</> <parameter> <subject>))] + + <scenarios>))))))] - [/.= [[n.= parameterN subjectN] - [i.= parameterI subjectI] - [r.= parameterR subjectR] - [f.= parameterF subjectF] - [ratio.= parameter/ subject/] - [complex.= parameterC subjectC]]] - [/.< [[n.< parameterN subjectN] - [i.< parameterI subjectI] - [r.< parameterR subjectR] - [f.< parameterF subjectF] - [ratio.< parameter/ subject/]]] - [/.<= [[n.<= parameterN subjectN] - [i.<= parameterI subjectI] - [r.<= parameterR subjectR] - [f.<= parameterF subjectF] - [ratio.<= parameter/ subject/]]] - [/.> [[n.> parameterN subjectN] - [i.> parameterI subjectI] - [r.> parameterR subjectR] - [f.> parameterF subjectF] - [ratio.> parameter/ subject/]]] - [/.>= [[n.>= parameterN subjectN] - [i.>= parameterI subjectI] - [r.>= parameterR subjectR] - [f.>= parameterF subjectF] - [ratio.>= parameter/ subject/]]] - )) + [/.= [[n.= parameterN subjectN] + [i.= parameterI subjectI] + [r.= parameterR subjectR] + [f.= parameterF subjectF] + [ratio.= parameter/ subject/] + [complex.= parameterC subjectC]]] + [/.< [[n.< parameterN subjectN] + [i.< parameterI subjectI] + [r.< parameterR subjectR] + [f.< parameterF subjectF] + [ratio.< parameter/ subject/]]] + [/.<= [[n.<= parameterN subjectN] + [i.<= parameterI subjectI] + [r.<= parameterR subjectR] + [f.<= parameterF subjectF] + [ratio.<= parameter/ subject/]]] + [/.> [[n.> parameterN subjectN] + [i.> parameterI subjectI] + [r.> parameterR subjectR] + [f.> parameterF subjectF] + [ratio.> parameter/ subject/]]] + [/.>= [[n.>= parameterN subjectN] + [i.>= parameterI subjectI] + [r.>= parameterR subjectR] + [f.>= parameterF subjectF] + [ratio.>= parameter/ subject/]]] + )) - /infix.test - /modulus.test - /modular.test - /number.test - /logic/continuous.test - /logic/fuzzy.test - )))) + /infix.test + /modulus.test + /modular.test + /number.test + /logic/continuous.test + /logic/fuzzy.test + )))) diff --git a/stdlib/source/test/lux/math/logic/continuous.lux b/stdlib/source/test/lux/math/logic/continuous.lux index 6b313d6a8..b4d9993d5 100644 --- a/stdlib/source/test/lux/math/logic/continuous.lux +++ b/stdlib/source/test/lux/math/logic/continuous.lux @@ -1,17 +1,17 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" monoid]]] - [math - ["[0]" random] - [number - ["r" rev]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" monoid]]] + [math + ["[0]" random] + [number + ["r" rev]]]]] + [\\library + ["[0]" /]]) (def: .public test Test @@ -20,96 +20,96 @@ [left random.rev mid random.rev right random.rev] - (`` ($_ _.and - (~~ (template [<monoid>] - [(_.for [<monoid>] - ($monoid.spec r.= <monoid> random.rev))] - - [/.disjunction] - [/.conjunction] - )) - - (_.cover [/.true /.false] - (let [true=max! - (r.= /.false (++ /.true)) + (`` (all _.and + (~~ (template [<monoid>] + [(_.for [<monoid>] + ($monoid.spec r.= <monoid> random.rev))] + + [/.disjunction] + [/.conjunction] + )) + + (_.cover [/.true /.false] + (let [true=max! + (r.= /.false (++ /.true)) - false=min! - (r.= /.true (-- /.false))] - (and true=max! - false=min!))) - (_.cover [/.or] - (let [identity! - (r.= left (/.or /.false left)) + false=min! + (r.= /.true (-- /.false))] + (and true=max! + false=min!))) + (_.cover [/.or] + (let [identity! + (r.= left (/.or /.false left)) - annihilation! - (r.= /.true (/.or /.true left)) - - idempotence! - (r.= left (/.or left left)) - - associativity! - (r.= ($_ /.or left mid right) - (_$ /.or left mid right))] - (and identity! annihilation! + (r.= /.true (/.or /.true left)) + idempotence! - associativity! - (let [l|r (/.or left right)] - (and (r.>= left l|r) - (r.>= right l|r)))))) - (_.cover [/.and] - (let [identity! - (r.= left (/.and /.true left)) + (r.= left (/.or left left)) - annihilation! - (r.= /.false (/.and /.false left)) - - idempotence! - (r.= left (/.and left left)) + associativity! + (r.= (all /.or left mid right) + (.left /.or left mid right))] + (and identity! + annihilation! + idempotence! + associativity! + (let [l|r (/.or left right)] + (and (r.>= left l|r) + (r.>= right l|r)))))) + (_.cover [/.and] + (let [identity! + (r.= left (/.and /.true left)) - associativity! - (r.= ($_ /.and left mid right) - (_$ /.and left mid right))] - (and identity! annihilation! + (r.= /.false (/.and /.false left)) + idempotence! - associativity! - (let [l&r (/.and left right)] - (and (r.<= left l&r) - (r.<= right l&r)))))) - (_.cover [/.not] - (let [inverses! - (and (r.= /.false (/.not /.true)) - (r.= /.true (/.not /.false))) + (r.= left (/.and left left)) - double_negation! - (r.= left (/.not (/.not left))) + associativity! + (r.= (all /.and left mid right) + (.left /.and left mid right))] + (and identity! + annihilation! + idempotence! + associativity! + (let [l&r (/.and left right)] + (and (r.<= left l&r) + (r.<= right l&r)))))) + (_.cover [/.not] + (let [inverses! + (and (r.= /.false (/.not /.true)) + (r.= /.true (/.not /.false))) - de_morgan! - (and (r.= (/.not (/.or left right)) - (/.and (/.not left) (/.not right))) - (r.= (/.not (/.and left right)) - (/.or (/.not left) (/.not right))))] - (and inverses! double_negation! - de_morgan!))) - (_.cover [/.implies] - (let [modus_tollens! - (r.= (/.implies right left) - (/.implies (/.not left) (/.not right)))] - (and modus_tollens!))) - (_.cover [/.=] - (let [trivial! - (and (r.= /.true (/.= /.true /.true)) - (r.= /.true (/.= /.false /.false)) + (r.= left (/.not (/.not left))) + + de_morgan! + (and (r.= (/.not (/.or left right)) + (/.and (/.not left) (/.not right))) + (r.= (/.not (/.and left right)) + (/.or (/.not left) (/.not right))))] + (and inverses! + double_negation! + de_morgan!))) + (_.cover [/.implies] + (let [modus_tollens! + (r.= (/.implies right left) + (/.implies (/.not left) (/.not right)))] + (and modus_tollens!))) + (_.cover [/.=] + (let [trivial! + (and (r.= /.true (/.= /.true /.true)) + (r.= /.true (/.= /.false /.false)) - (r.= /.false (/.= /.true /.false))) + (r.= /.false (/.= /.true /.false))) - common! - (and (r.>= left - (/.= left left)) - (r.>= right - (/.= right right)))] - (and trivial! - common!))) - ))))) + common! + (and (r.>= left + (/.= left left)) + (r.>= right + (/.= right right)))] + (and trivial! + common!))) + ))))) diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index a79d72805..d954d22e7 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -27,12 +27,12 @@ Test (do random.monad [sample random.rev] - ($_ _.and - (_.cover [/.empty] - (r.= //.false (/.empty sample))) - (_.cover [/.full] - (r.= //.true (/.full sample))) - ))) + (all _.and + (_.cover [/.empty] + (r.= //.false (/.empty sample))) + (_.cover [/.full] + (r.= //.true (/.full sample))) + ))) (def: simple Test @@ -46,40 +46,40 @@ .let [bottom (r.min threshold_0 threshold_1) top (r.max threshold_0 threshold_1)]] - ($_ _.and - (_.cover [/.gradient] - (let [ascending! - (let [set (/.gradient bottom top)] - (and (r.= //.false (set bottom)) - (r.= //.true (set top)) - (let [membership (set sample)] - (cond (r.<= bottom sample) - (r.= //.false membership) - - (r.>= top sample) - (r.= //.true membership) - - (r.> //.false membership))))) - - descending! - (let [set (/.gradient top bottom)] - (and (r.= //.true (set bottom)) - (r.= //.false (set top)) - (let [membership (set sample)] - (cond (r.<= bottom sample) - (r.= //.true membership) - - (r.>= top sample) - (r.= //.false membership) - - (r.> //.false membership)))))] - (and ascending! - descending!))) - (_.cover [/.membership] - (let [set (/.gradient bottom top)] - (r.= (set sample) - (/.membership set sample)))) - ))) + (all _.and + (_.cover [/.gradient] + (let [ascending! + (let [set (/.gradient bottom top)] + (and (r.= //.false (set bottom)) + (r.= //.true (set top)) + (let [membership (set sample)] + (cond (r.<= bottom sample) + (r.= //.false membership) + + (r.>= top sample) + (r.= //.true membership) + + (r.> //.false membership))))) + + descending! + (let [set (/.gradient top bottom)] + (and (r.= //.true (set bottom)) + (r.= //.false (set top)) + (let [membership (set sample)] + (cond (r.<= bottom sample) + (r.= //.true membership) + + (r.>= top sample) + (r.= //.false membership) + + (r.> //.false membership)))))] + (and ascending! + descending!))) + (_.cover [/.membership] + (let [set (/.gradient bottom top)] + (r.= (set sample) + (/.membership set sample)))) + ))) (def: composition Test @@ -100,68 +100,68 @@ .let [bottom_set (/.gradient bottom middle_bottom) top_set (/.gradient middle_top top)]] - ($_ _.and - (_.cover [/.union] - (let [set (/.gradient bottom top)] - (and (r.= (/.membership set sample) - (/.membership (/.union /.empty set) sample)) - (r.= (/.membership /.full sample) - (/.membership (/.union /.full set) sample)) - - (r.>= (/.membership bottom_set sample) - (/.membership (/.union bottom_set top_set) sample)) - (r.>= (/.membership top_set sample) - (/.membership (/.union bottom_set top_set) sample))))) - (_.cover [/.intersection] - (let [set (/.gradient bottom top)] - (and (r.= (/.membership /.empty sample) - (/.membership (/.intersection /.empty set) sample)) - (r.= (/.membership set sample) - (/.membership (/.intersection /.full set) sample)) - - (r.<= (/.membership bottom_set sample) - (/.membership (/.intersection bottom_set top_set) sample)) - (r.<= (/.membership top_set sample) - (/.membership (/.intersection bottom_set top_set) sample))))) - (_.cover [/.complement] - (let [set (/.gradient bottom top) - - trivial! - (and (r.= (/.membership /.full sample) - (/.membership (/.complement /.empty) sample)) - (r.= (/.membership /.empty sample) - (/.membership (/.complement /.full) sample))) - - common! - (and (r.>= (/.membership set sample) - (/.membership (/.union set (/.complement set)) sample)) - (r.<= (/.membership set sample) - (/.membership (/.intersection set (/.complement set)) sample))) - - de_morgan! - (and (r.= (/.membership (/.complement (/.union bottom_set top_set)) - sample) - (/.membership (/.intersection (/.complement bottom_set) (/.complement top_set)) - sample)) - (r.= (/.membership (/.complement (/.intersection bottom_set top_set)) - sample) - (/.membership (/.union (/.complement bottom_set) (/.complement top_set)) - sample)))] - (and trivial! + (all _.and + (_.cover [/.union] + (let [set (/.gradient bottom top)] + (and (r.= (/.membership set sample) + (/.membership (/.union /.empty set) sample)) + (r.= (/.membership /.full sample) + (/.membership (/.union /.full set) sample)) + + (r.>= (/.membership bottom_set sample) + (/.membership (/.union bottom_set top_set) sample)) + (r.>= (/.membership top_set sample) + (/.membership (/.union bottom_set top_set) sample))))) + (_.cover [/.intersection] + (let [set (/.gradient bottom top)] + (and (r.= (/.membership /.empty sample) + (/.membership (/.intersection /.empty set) sample)) + (r.= (/.membership set sample) + (/.membership (/.intersection /.full set) sample)) + + (r.<= (/.membership bottom_set sample) + (/.membership (/.intersection bottom_set top_set) sample)) + (r.<= (/.membership top_set sample) + (/.membership (/.intersection bottom_set top_set) sample))))) + (_.cover [/.complement] + (let [set (/.gradient bottom top) + + trivial! + (and (r.= (/.membership /.full sample) + (/.membership (/.complement /.empty) sample)) + (r.= (/.membership /.empty sample) + (/.membership (/.complement /.full) sample))) + common! - de_morgan!))) - (_.cover [/.difference] - (let [set (/.gradient bottom top)] - (and (r.= (/.membership set sample) - (/.membership (/.difference /.empty set) sample)) - (r.= (/.membership /.empty sample) - (/.membership (/.difference /.full set) sample)) - - (r.<= (/.membership top_set sample) - (/.membership (/.difference bottom_set top_set) sample)) - (r.<= (/.membership bottom_set sample) - (/.membership (/.difference bottom_set top_set) sample))))) - ))) + (and (r.>= (/.membership set sample) + (/.membership (/.union set (/.complement set)) sample)) + (r.<= (/.membership set sample) + (/.membership (/.intersection set (/.complement set)) sample))) + + de_morgan! + (and (r.= (/.membership (/.complement (/.union bottom_set top_set)) + sample) + (/.membership (/.intersection (/.complement bottom_set) (/.complement top_set)) + sample)) + (r.= (/.membership (/.complement (/.intersection bottom_set top_set)) + sample) + (/.membership (/.union (/.complement bottom_set) (/.complement top_set)) + sample)))] + (and trivial! + common! + de_morgan!))) + (_.cover [/.difference] + (let [set (/.gradient bottom top)] + (and (r.= (/.membership set sample) + (/.membership (/.difference /.empty set) sample)) + (r.= (/.membership /.empty sample) + (/.membership (/.difference /.full set) sample)) + + (r.<= (/.membership top_set sample) + (/.membership (/.difference bottom_set top_set) sample)) + (r.<= (/.membership bottom_set sample) + (/.membership (/.difference bottom_set top_set) sample))))) + ))) (def: geometric Test @@ -181,111 +181,111 @@ _ {.#None}))))] - ($_ _.and - (_.cover [/.triangle] - (let [reference (/.triangle bottom middle_bottom top) - - irrelevant_order! - (list.every? (function (_ set) - (r.= (/.membership reference sample) - (/.membership set sample))) - (list (/.triangle bottom top middle_bottom) - (/.triangle middle_bottom bottom top) - (/.triangle middle_bottom top bottom) - (/.triangle top bottom middle_bottom) - (/.triangle top middle_bottom bottom))) - - middle_maximum! - (r.= //.true (/.membership reference middle_bottom)) - - boundary_minima! - (and (r.= //.false (/.membership reference bottom)) - (r.= //.false (/.membership reference top))) - - inside_range! - (bit#= (r.> //.false (/.membership reference sample)) - (and (r.> bottom sample) - (r.< top sample))) - - outside_range! - (bit#= (r.= //.false (/.membership reference sample)) - (or (r.<= bottom sample) - (r.>= top sample)))] - (and irrelevant_order! + (all _.and + (_.cover [/.triangle] + (let [reference (/.triangle bottom middle_bottom top) + + irrelevant_order! + (list.every? (function (_ set) + (r.= (/.membership reference sample) + (/.membership set sample))) + (list (/.triangle bottom top middle_bottom) + (/.triangle middle_bottom bottom top) + (/.triangle middle_bottom top bottom) + (/.triangle top bottom middle_bottom) + (/.triangle top middle_bottom bottom))) + middle_maximum! + (r.= //.true (/.membership reference middle_bottom)) + boundary_minima! + (and (r.= //.false (/.membership reference bottom)) + (r.= //.false (/.membership reference top))) + inside_range! - outside_range!))) - (_.cover [/.trapezoid] - (let [reference (/.trapezoid bottom middle_bottom middle_top top) - - irrelevant_order! - (list.every? (function (_ set) - (r.= (/.membership reference sample) - (/.membership set sample))) - (let [r0 bottom - r1 middle_bottom - r2 middle_top - r3 top] - (list (/.trapezoid r0 r1 r2 r3) - (/.trapezoid r0 r1 r3 r2) - (/.trapezoid r0 r2 r1 r3) - (/.trapezoid r0 r2 r3 r1) - (/.trapezoid r0 r3 r1 r2) - (/.trapezoid r0 r3 r2 r1) - - (/.trapezoid r1 r0 r2 r3) - (/.trapezoid r1 r0 r3 r2) - (/.trapezoid r1 r2 r0 r3) - (/.trapezoid r1 r2 r3 r0) - (/.trapezoid r1 r3 r0 r2) - (/.trapezoid r1 r3 r2 r0) - - (/.trapezoid r2 r0 r1 r3) - (/.trapezoid r2 r0 r3 r1) - (/.trapezoid r2 r1 r0 r3) - (/.trapezoid r2 r1 r3 r0) - (/.trapezoid r2 r3 r0 r1) - (/.trapezoid r2 r3 r1 r0) - - (/.trapezoid r3 r0 r1 r2) - (/.trapezoid r3 r0 r2 r1) - (/.trapezoid r3 r1 r0 r2) - (/.trapezoid r3 r1 r2 r0) - (/.trapezoid r3 r2 r0 r1) - (/.trapezoid r3 r2 r1 r0) - ))) - - middle_maxima! - (and (r.= //.true (/.membership reference middle_bottom)) - (r.= //.true (/.membership reference middle_top))) - - boundary_minima! - (and (r.= //.false (/.membership reference bottom)) - (r.= //.false (/.membership reference top))) - - inside_range! - (bit#= (r.> //.false (/.membership reference sample)) - (and (r.> bottom sample) - (r.< top sample))) - - outside_range! - (bit#= (r.= //.false (/.membership reference sample)) - (or (r.<= bottom sample) - (r.>= top sample))) - - - inside_inner_range! - (bit#= (r.= //.true (/.membership reference sample)) - (and (r.<= middle_top sample) - (r.>= middle_bottom sample)))] - (and irrelevant_order! + (bit#= (r.> //.false (/.membership reference sample)) + (and (r.> bottom sample) + (r.< top sample))) + + outside_range! + (bit#= (r.= //.false (/.membership reference sample)) + (or (r.<= bottom sample) + (r.>= top sample)))] + (and irrelevant_order! + middle_maximum! + boundary_minima! + inside_range! + outside_range!))) + (_.cover [/.trapezoid] + (let [reference (/.trapezoid bottom middle_bottom middle_top top) + + irrelevant_order! + (list.every? (function (_ set) + (r.= (/.membership reference sample) + (/.membership set sample))) + (let [r0 bottom + r1 middle_bottom + r2 middle_top + r3 top] + (list (/.trapezoid r0 r1 r2 r3) + (/.trapezoid r0 r1 r3 r2) + (/.trapezoid r0 r2 r1 r3) + (/.trapezoid r0 r2 r3 r1) + (/.trapezoid r0 r3 r1 r2) + (/.trapezoid r0 r3 r2 r1) + + (/.trapezoid r1 r0 r2 r3) + (/.trapezoid r1 r0 r3 r2) + (/.trapezoid r1 r2 r0 r3) + (/.trapezoid r1 r2 r3 r0) + (/.trapezoid r1 r3 r0 r2) + (/.trapezoid r1 r3 r2 r0) + + (/.trapezoid r2 r0 r1 r3) + (/.trapezoid r2 r0 r3 r1) + (/.trapezoid r2 r1 r0 r3) + (/.trapezoid r2 r1 r3 r0) + (/.trapezoid r2 r3 r0 r1) + (/.trapezoid r2 r3 r1 r0) + + (/.trapezoid r3 r0 r1 r2) + (/.trapezoid r3 r0 r2 r1) + (/.trapezoid r3 r1 r0 r2) + (/.trapezoid r3 r1 r2 r0) + (/.trapezoid r3 r2 r0 r1) + (/.trapezoid r3 r2 r1 r0) + ))) + middle_maxima! + (and (r.= //.true (/.membership reference middle_bottom)) + (r.= //.true (/.membership reference middle_top))) + boundary_minima! + (and (r.= //.false (/.membership reference bottom)) + (r.= //.false (/.membership reference top))) + inside_range! + (bit#= (r.> //.false (/.membership reference sample)) + (and (r.> bottom sample) + (r.< top sample))) + outside_range! - inside_inner_range!))) - )))) + (bit#= (r.= //.false (/.membership reference sample)) + (or (r.<= bottom sample) + (r.>= top sample))) + + + inside_inner_range! + (bit#= (r.= //.true (/.membership reference sample)) + (and (r.<= middle_top sample) + (r.>= middle_bottom sample)))] + (and irrelevant_order! + middle_maxima! + boundary_minima! + inside_range! + outside_range! + inside_inner_range!))) + )))) (def: discrete Test @@ -294,15 +294,15 @@ .let [under? (n.< threshold) set (set.of_list n.hash (list threshold))] sample random.nat] - ($_ _.and - (_.cover [/.of_predicate] - (bit#= (r.= //.true (/.membership (/.of_predicate under?) sample)) - (under? sample))) - (_.cover [/.of_set] - (and (r.= //.true (/.membership (/.of_set set) threshold)) - (bit#= (r.= //.true (/.membership (/.of_set set) sample)) - (set.member? set sample)))) - ))) + (all _.and + (_.cover [/.of_predicate] + (bit#= (r.= //.true (/.membership (/.of_predicate under?) sample)) + (under? sample))) + (_.cover [/.of_set] + (and (r.= //.true (/.membership (/.of_set set) threshold)) + (bit#= (r.= //.true (/.membership (/.of_set set) sample)) + (set.member? set sample)))) + ))) (def: gradient (Random [[Rev Rev] (Fuzzy Rev)]) @@ -323,14 +323,14 @@ [[_ set] ..gradient threshold random.rev sample random.rev] - ($_ _.and - (_.cover [/.predicate] - (bit#= (not ((/.predicate threshold set) sample)) - (r.< threshold (/.membership set sample)))) - (_.cover [/.cut] - (bit#= (r.= //.false (/.membership (/.cut threshold set) sample)) - (r.< threshold (/.membership set sample)))) - ))) + (all _.and + (_.cover [/.predicate] + (bit#= (not ((/.predicate threshold set) sample)) + (r.< threshold (/.membership set sample)))) + (_.cover [/.cut] + (bit#= (r.= //.false (/.membership (/.cut threshold set) sample)) + (r.< threshold (/.membership set sample)))) + ))) (def: .public test Test @@ -344,14 +344,14 @@ (def: (= left right) (r.= (left sample) (right sample)))))]] - ($_ _.and - (_.for [/.functor] - ($contravariant.spec equivalence fuzzy /.functor)) - - ..trivial - ..simple - ..composition - ..geometric - ..discrete - ..threshold - )))) + (all _.and + (_.for [/.functor] + ($contravariant.spec equivalence fuzzy /.functor)) + + ..trivial + ..simple + ..composition + ..geometric + ..discrete + ..threshold + )))) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 243603132..535ba1048 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -47,78 +47,78 @@ ($//.random +1,000,000)) subject (..random subject##%) another (..random subject##%)] - (`` ($_ _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence (..random subject##%))) - (_.for [/.order /.<] - ($order.spec /.order (..random subject##%))) - (~~ (template [<composite> <monoid>] - [(_.for [<monoid> <composite>] - ($monoid.spec /.equivalence (<monoid> subject##%) (..random subject##%)))] - - [/.+ /.addition] - [/.* /.multiplication] - )) - (_.for [/.codec] - ($codec.spec /.equivalence (/.codec subject##%) (..random subject##%))) + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence (..random subject##%))) + (_.for [/.order /.<] + ($order.spec /.order (..random subject##%))) + (~~ (template [<composite> <monoid>] + [(_.for [<monoid> <composite>] + ($monoid.spec /.equivalence (<monoid> subject##%) (..random subject##%)))] + + [/.+ /.addition] + [/.* /.multiplication] + )) + (_.for [/.codec] + ($codec.spec /.equivalence (/.codec subject##%) (..random subject##%))) - (_.cover [/.incorrect_modulus] - (case (|> param - (# (/.codec param##%) encoded) - (# (/.codec subject##%) decoded)) - {try.#Failure error} - (exception.match? /.incorrect_modulus error) - - {try.#Success _} - false)) - (_.cover [/.modulus] - (and (type#= (type_of (/.modulus subject)) - (type_of (/.modulus subject))) - (not (type#= (type_of (/.modulus subject)) - (type_of (/.modulus param)))))) - (_.cover [/.modular /.value] - (/.= subject - (/.modular (/.modulus subject) (/.value subject)))) - (_.cover [/.>] - (bit#= (/.> another subject) - (/.< subject another))) - (_.cover [/.<= /.>=] - (bit#= (/.<= another subject) - (/.>= subject another))) - (_.cover [/.-] - (let [zero (/.modular (/.modulus subject) +0)] - (and (/.= zero - (/.- subject subject)) - (/.= subject - (/.- zero subject))))) - (_.cover [/.inverse] - (let [one (/.modular (/.modulus subject) +1) - co_prime? (i.co_prime? (//.divisor (/.modulus subject)) - (/.value subject))] - (case (/.inverse subject) - {.#Some subject^-1} - (and co_prime? - (|> subject - (/.* subject^-1) - (/.= one))) - - {.#None} - (not co_prime?)))) - (_.cover [/.adapter] - (<| (try.else false) - (do try.monad - [copy##% (//.modulus (//.divisor subject##%)) - adapt (/.adapter subject##% copy##%)] - (in (|> subject - /.value - (/.modular copy##%) - adapt - (/.= subject)))))) - (_.cover [/.moduli_are_not_equal] - (case (/.adapter subject##% param##%) - {try.#Failure error} - (exception.match? /.moduli_are_not_equal error) - - {try.#Success _} - false)) - ))))) + (_.cover [/.incorrect_modulus] + (case (|> param + (# (/.codec param##%) encoded) + (# (/.codec subject##%) decoded)) + {try.#Failure error} + (exception.match? /.incorrect_modulus error) + + {try.#Success _} + false)) + (_.cover [/.modulus] + (and (type#= (type_of (/.modulus subject)) + (type_of (/.modulus subject))) + (not (type#= (type_of (/.modulus subject)) + (type_of (/.modulus param)))))) + (_.cover [/.modular /.value] + (/.= subject + (/.modular (/.modulus subject) (/.value subject)))) + (_.cover [/.>] + (bit#= (/.> another subject) + (/.< subject another))) + (_.cover [/.<= /.>=] + (bit#= (/.<= another subject) + (/.>= subject another))) + (_.cover [/.-] + (let [zero (/.modular (/.modulus subject) +0)] + (and (/.= zero + (/.- subject subject)) + (/.= subject + (/.- zero subject))))) + (_.cover [/.inverse] + (let [one (/.modular (/.modulus subject) +1) + co_prime? (i.co_prime? (//.divisor (/.modulus subject)) + (/.value subject))] + (case (/.inverse subject) + {.#Some subject^-1} + (and co_prime? + (|> subject + (/.* subject^-1) + (/.= one))) + + {.#None} + (not co_prime?)))) + (_.cover [/.adapter] + (<| (try.else false) + (do try.monad + [copy##% (//.modulus (//.divisor subject##%)) + adapt (/.adapter subject##% copy##%)] + (in (|> subject + /.value + (/.modular copy##%) + adapt + (/.= subject)))))) + (_.cover [/.moduli_are_not_equal] + (case (/.adapter subject##% param##%) + {try.#Failure error} + (exception.match? /.moduli_are_not_equal error) + + {try.#Success _} + false)) + ))))) diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index fbb7bd563..71dd3b81b 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -1,22 +1,22 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - ["[0]" meta] - [abstract - [monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception]] - [math - ["[0]" random {"+" Random}] - [number - ["i" int]]] - [macro - [syntax {"+" syntax:}] - ["[0]" code]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" meta] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception]] + [math + ["[0]" random {"+" Random}] + [number + ["i" int]]] + [macro + [syntax {"+" syntax:}] + ["[0]" code]]]] + [\\library + ["[0]" /]]) (syntax: (|divisor| []) (do meta.monad @@ -39,30 +39,30 @@ [divisor random.int modulus (..random +1,000,000) dividend random.int] - ($_ _.and - (_.cover [/.modulus /.divisor] - (case (/.modulus divisor) - {try.#Success modulus} - (i.= divisor (/.divisor modulus)) - - {try.#Failure error} - (i.= +0 divisor))) - (_.cover [/.zero_cannot_be_a_modulus] - (case (/.modulus +0) - {try.#Failure error} - (exception.match? /.zero_cannot_be_a_modulus error) + (all _.and + (_.cover [/.modulus /.divisor] + (case (/.modulus divisor) + {try.#Success modulus} + (i.= divisor (/.divisor modulus)) + + {try.#Failure error} + (i.= +0 divisor))) + (_.cover [/.zero_cannot_be_a_modulus] + (case (/.modulus +0) + {try.#Failure error} + (exception.match? /.zero_cannot_be_a_modulus error) - {try.#Success modulus} - false)) - (_.cover [/.literal] - (with_expansions [<divisor> (|divisor|)] - (i.= <divisor> (/.divisor (/.literal <divisor>))))) - (_.cover [/.=] - (with_expansions [<divisor> (|divisor|)] - (/.= (/.literal <divisor>) - (/.literal <divisor>)))) - (_.cover [/.congruent?] - (and (/.congruent? modulus dividend dividend) - (or (not (/.congruent? modulus dividend (++ dividend))) - (i.= +1 (/.divisor modulus))))) - )))) + {try.#Success modulus} + false)) + (_.cover [/.literal] + (with_expansions [<divisor> (|divisor|)] + (i.= <divisor> (/.divisor (/.literal <divisor>))))) + (_.cover [/.=] + (with_expansions [<divisor> (|divisor|)] + (/.= (/.literal <divisor>) + (/.literal <divisor>)))) + (_.cover [/.congruent?] + (and (/.congruent? modulus dividend dividend) + (or (not (/.congruent? modulus dividend (++ dividend))) + (i.= +1 (/.divisor modulus))))) + )))) diff --git a/stdlib/source/test/lux/math/number.lux b/stdlib/source/test/lux/math/number.lux index beaa84aa6..94df83848 100644 --- a/stdlib/source/test/lux/math/number.lux +++ b/stdlib/source/test/lux/math/number.lux @@ -1,28 +1,28 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [control - ["[0]" try]] - [data - ["[0]" text]]]] - [\\library - ["[0]" / - ["n" nat] - ["i" int] - ["r" rev] - ["f" frac]]] - ["[0]" / "_" - ["[1][0]" i8] - ["[1][0]" i16] - ["[1][0]" i32] - ["[1][0]" i64] - ["[1][0]" nat] - ["[1][0]" int] - ["[1][0]" rev] - ["[1][0]" frac] - ["[1][0]" ratio] - ["[1][0]" complex]]) + [library + [lux "*" + ["_" test {"+" Test}] + [control + ["[0]" try]] + [data + ["[0]" text]]]] + [\\library + ["[0]" / + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac]]] + ["[0]" / "_" + ["[1][0]" i8] + ["[1][0]" i16] + ["[1][0]" i32] + ["[1][0]" i64] + ["[1][0]" nat] + ["[1][0]" int] + ["[1][0]" rev] + ["[1][0]" frac] + ["[1][0]" ratio] + ["[1][0]" complex]]) (def: clean_commas (-> Text Text) @@ -31,73 +31,73 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.bin] - (`` (and (~~ (template [<=> <codec> <number>] - [(case (# <codec> decoded (..clean_commas <number>)) - {try.#Success actual} - (<=> (/.bin <number>) actual) - - {try.#Failure error} - false)] - - [n.= n.binary "11,00,10,01"] - - [i.= i.binary "+11,00,10,01"] - [i.= i.binary "-11,00,10,01"] - - [r.= r.binary ".11,00,10,01"] - - [f.= f.binary "+11,00.10,01"] - [f.= f.binary "-11,00.10,01"] - ))))) - (_.cover [/.oct] - (`` (and (~~ (template [<=> <codec> <number>] - [(case (# <codec> decoded (..clean_commas <number>)) - {try.#Success actual} - (<=> (/.oct <number>) actual) - - {try.#Failure error} - false)] - - [n.= n.octal "615,243"] - - [i.= i.octal "+615,243"] - [i.= i.octal "-615,243"] - - [r.= r.octal ".615,243"] - - [f.= f.octal "+61,52.43"] - [f.= f.octal "-61,52.43"] - ))))) - (_.cover [/.hex] - (`` (and (~~ (template [<=> <codec> <number>] - [(case (# <codec> decoded (..clean_commas <number>)) - {try.#Success actual} - (<=> (/.hex <number>) actual) - - {try.#Failure error} - false)] - - [n.= n.hex "dead,BEEF"] - - [i.= i.hex "+dead,BEEF"] - [i.= i.hex "-dead,BEEF"] - - [r.= r.hex ".dead,BEEF"] - - [f.= f.hex "+dead,BE.EF"] - [f.= f.hex "-dead,BE.EF"] - ))))) - - /i8.test - /i16.test - /i32.test - /i64.test - /nat.test - /int.test - /rev.test - /frac.test - /ratio.test - /complex.test - ))) + (all _.and + (_.cover [/.bin] + (`` (and (~~ (template [<=> <codec> <number>] + [(case (# <codec> decoded (..clean_commas <number>)) + {try.#Success actual} + (<=> (/.bin <number>) actual) + + {try.#Failure error} + false)] + + [n.= n.binary "11,00,10,01"] + + [i.= i.binary "+11,00,10,01"] + [i.= i.binary "-11,00,10,01"] + + [r.= r.binary ".11,00,10,01"] + + [f.= f.binary "+11,00.10,01"] + [f.= f.binary "-11,00.10,01"] + ))))) + (_.cover [/.oct] + (`` (and (~~ (template [<=> <codec> <number>] + [(case (# <codec> decoded (..clean_commas <number>)) + {try.#Success actual} + (<=> (/.oct <number>) actual) + + {try.#Failure error} + false)] + + [n.= n.octal "615,243"] + + [i.= i.octal "+615,243"] + [i.= i.octal "-615,243"] + + [r.= r.octal ".615,243"] + + [f.= f.octal "+61,52.43"] + [f.= f.octal "-61,52.43"] + ))))) + (_.cover [/.hex] + (`` (and (~~ (template [<=> <codec> <number>] + [(case (# <codec> decoded (..clean_commas <number>)) + {try.#Success actual} + (<=> (/.hex <number>) actual) + + {try.#Failure error} + false)] + + [n.= n.hex "dead,BEEF"] + + [i.= i.hex "+dead,BEEF"] + [i.= i.hex "-dead,BEEF"] + + [r.= r.hex ".dead,BEEF"] + + [f.= f.hex "+dead,BE.EF"] + [f.= f.hex "-dead,BE.EF"] + ))))) + + /i8.test + /i16.test + /i32.test + /i64.test + /nat.test + /int.test + /rev.test + /frac.test + /ratio.test + /complex.test + ))) diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index 7bdc17274..a705bbb0e 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -49,78 +49,78 @@ (do random.monad [real ..dimension imaginary ..dimension] - ($_ _.and - (_.cover [/.complex] - (and (let [r+i (/.complex real imaginary)] - (and (f.= real (the /.#real r+i)) - (f.= imaginary (the /.#imaginary r+i)))) - (let [r+i (/.complex real)] - (and (f.= real (the /.#real r+i)) - (f.= +0.0 (the /.#imaginary r+i)))))) - (_.cover [/.approximately?] - (/.approximately? ..margin_of_error - (/.complex real imaginary) - (/.complex real imaginary))) - (_.cover [/.not_a_number?] - (and (/.not_a_number? (/.complex f.not_a_number imaginary)) - (/.not_a_number? (/.complex real f.not_a_number)))) - ))) + (all _.and + (_.cover [/.complex] + (and (let [r+i (/.complex real imaginary)] + (and (f.= real (the /.#real r+i)) + (f.= imaginary (the /.#imaginary r+i)))) + (let [r+i (/.complex real)] + (and (f.= real (the /.#real r+i)) + (f.= +0.0 (the /.#imaginary r+i)))))) + (_.cover [/.approximately?] + (/.approximately? ..margin_of_error + (/.complex real imaginary) + (/.complex real imaginary))) + (_.cover [/.not_a_number?] + (and (/.not_a_number? (/.complex f.not_a_number imaginary)) + (/.not_a_number? (/.complex real f.not_a_number)))) + ))) (def: constant Test (do random.monad [sample ..random dimension ..dimension] - ($_ _.and - (_.cover [/.zero] - (/.= /.zero (/.* /.zero sample))) - (_.cover [/.+one] - (/.= sample (/.* /.+one sample))) - (_.cover [/.-one] - (and (/.= /.zero - (/.+ sample - (/.* /.-one sample))) - (/.= sample (/.* /.-one (/.* /.-one sample))))) - (_.cover [/.i] - (and (/.= (/.complex +0.0 dimension) - (/.* /.i (/.complex dimension))) - (/.= (/.* /.-one sample) - (/.* /.i (/.* /.i sample))))) - ))) + (all _.and + (_.cover [/.zero] + (/.= /.zero (/.* /.zero sample))) + (_.cover [/.+one] + (/.= sample (/.* /.+one sample))) + (_.cover [/.-one] + (and (/.= /.zero + (/.+ sample + (/.* /.-one sample))) + (/.= sample (/.* /.-one (/.* /.-one sample))))) + (_.cover [/.i] + (and (/.= (/.complex +0.0 dimension) + (/.* /.i (/.complex dimension))) + (/.= (/.* /.-one sample) + (/.* /.i (/.* /.i sample))))) + ))) (def: absolute_value&argument Test (do random.monad [real ..dimension imaginary ..dimension] - ($_ _.and - (_.cover [/.abs] - (let [normal! - (let [r+i (/.complex real imaginary)] - (and (f.>= (f.abs real) (/.abs r+i)) - (f.>= (f.abs imaginary) (/.abs r+i)))) + (all _.and + (_.cover [/.abs] + (let [normal! + (let [r+i (/.complex real imaginary)] + (and (f.>= (f.abs real) (/.abs r+i)) + (f.>= (f.abs imaginary) (/.abs r+i)))) - not_a_number! - (and (f.not_a_number? (/.abs (/.complex f.not_a_number imaginary))) - (f.not_a_number? (/.abs (/.complex real f.not_a_number)))) - - infinity! - (and (f.= f.positive_infinity (/.abs (/.complex f.positive_infinity imaginary))) - (f.= f.positive_infinity (/.abs (/.complex real f.positive_infinity))) - (f.= f.positive_infinity (/.abs (/.complex f.negative_infinity imaginary))) - (f.= f.positive_infinity (/.abs (/.complex real f.negative_infinity))))] - (and normal! not_a_number! - infinity!))) - ... https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities - (_.cover [/.argument] - (let [sample (/.complex real imaginary)] - (or (/.= /.zero sample) - (/.approximately? ..margin_of_error - sample - (/.*' (/.abs sample) - (/.exp (/.* /.i (/.complex (/.argument sample))))))))) - ))) + (and (f.not_a_number? (/.abs (/.complex f.not_a_number imaginary))) + (f.not_a_number? (/.abs (/.complex real f.not_a_number)))) + + infinity! + (and (f.= f.positive_infinity (/.abs (/.complex f.positive_infinity imaginary))) + (f.= f.positive_infinity (/.abs (/.complex real f.positive_infinity))) + (f.= f.positive_infinity (/.abs (/.complex f.negative_infinity imaginary))) + (f.= f.positive_infinity (/.abs (/.complex real f.negative_infinity))))] + (and normal! + not_a_number! + infinity!))) + ... https://en.wikipedia.org/wiki/Argument_(complex_analysis)#Identities + (_.cover [/.argument] + (let [sample (/.complex real imaginary)] + (or (/.= /.zero sample) + (/.approximately? ..margin_of_error + sample + (/.*' (/.abs sample) + (/.exp (/.* /.i (/.complex (/.argument sample))))))))) + ))) (def: number Test @@ -128,81 +128,81 @@ [x ..random y ..random factor ..dimension] - ($_ _.and - (_.cover [/.+] - (let [z (/.+ y x)] - (and (/.= z - (/.complex (f.+ (the /.#real y) - (the /.#real x)) - (f.+ (the /.#imaginary y) - (the /.#imaginary x))))))) - (_.cover [/.-] - (let [normal! - (let [z (/.- y x)] - (and (/.= z - (/.complex (f.- (the /.#real y) - (the /.#real x)) - (f.- (the /.#imaginary y) - (the /.#imaginary x)))))) + (all _.and + (_.cover [/.+] + (let [z (/.+ y x)] + (and (/.= z + (/.complex (f.+ (the /.#real y) + (the /.#real x)) + (f.+ (the /.#imaginary y) + (the /.#imaginary x))))))) + (_.cover [/.-] + (let [normal! + (let [z (/.- y x)] + (and (/.= z + (/.complex (f.- (the /.#real y) + (the /.#real x)) + (f.- (the /.#imaginary y) + (the /.#imaginary x)))))) - inverse! - (and (|> x (/.+ y) (/.- y) (/.approximately? ..margin_of_error x)) - (|> x (/.- y) (/.+ y) (/.approximately? ..margin_of_error x)))] - (and normal! - inverse!))) - (_.cover [/.* /./] - (|> x (/.* y) (/./ y) (/.approximately? ..margin_of_error x))) - (_.cover [/.*' /./'] - (|> x (/.*' factor) (/./' factor) (/.approximately? ..margin_of_error x))) - (_.cover [/.%] - (let [rem (/.% y x) - quotient (|> x (/.- rem) (/./ y)) - floored (|> quotient - (revised /.#real f.floor) - (revised /.#imaginary f.floor))] - (/.approximately? +0.000000000001 - x - (|> quotient (/.* y) (/.+ rem))))) - ))) + inverse! + (and (|> x (/.+ y) (/.- y) (/.approximately? ..margin_of_error x)) + (|> x (/.- y) (/.+ y) (/.approximately? ..margin_of_error x)))] + (and normal! + inverse!))) + (_.cover [/.* /./] + (|> x (/.* y) (/./ y) (/.approximately? ..margin_of_error x))) + (_.cover [/.*' /./'] + (|> x (/.*' factor) (/./' factor) (/.approximately? ..margin_of_error x))) + (_.cover [/.%] + (let [rem (/.% y x) + quotient (|> x (/.- rem) (/./ y)) + floored (|> quotient + (revised /.#real f.floor) + (revised /.#imaginary f.floor))] + (/.approximately? +0.000000000001 + x + (|> quotient (/.* y) (/.+ rem))))) + ))) (def: conjugate&reciprocal&signum&negation Test (do random.monad [x ..random] - ($_ _.and - (_.cover [/.conjugate] - (let [cx (/.conjugate x)] - (and (f.= (the /.#real x) - (the /.#real cx)) - (f.= (f.opposite (the /.#imaginary x)) - (the /.#imaginary cx))))) - (_.cover [/.reciprocal] - (let [reciprocal! - (|> x (/.* (/.reciprocal x)) (/.approximately? ..margin_of_error /.+one)) - - own_inverse! - (|> x /.reciprocal /.reciprocal (/.approximately? ..margin_of_error x))] - (and reciprocal! - own_inverse!))) - (_.cover [/.signum] - ... Absolute value of signum is always root_2(2), 1 or 0. - (let [signum_abs (|> x /.signum /.abs)] - (or (f.= +0.0 signum_abs) - (f.= +1.0 signum_abs) - (f.= (f.pow +0.5 +2.0) signum_abs)))) - (_.cover [/.opposite] - (let [own_inverse! - (let [there (/.opposite x) - back_again (/.opposite there)] - (and (not (/.= there x)) - (/.= back_again x))) + (all _.and + (_.cover [/.conjugate] + (let [cx (/.conjugate x)] + (and (f.= (the /.#real x) + (the /.#real cx)) + (f.= (f.opposite (the /.#imaginary x)) + (the /.#imaginary cx))))) + (_.cover [/.reciprocal] + (let [reciprocal! + (|> x (/.* (/.reciprocal x)) (/.approximately? ..margin_of_error /.+one)) + + own_inverse! + (|> x /.reciprocal /.reciprocal (/.approximately? ..margin_of_error x))] + (and reciprocal! + own_inverse!))) + (_.cover [/.signum] + ... Absolute value of signum is always root_2(2), 1 or 0. + (let [signum_abs (|> x /.signum /.abs)] + (or (f.= +0.0 signum_abs) + (f.= +1.0 signum_abs) + (f.= (f.pow +0.5 +2.0) signum_abs)))) + (_.cover [/.opposite] + (let [own_inverse! + (let [there (/.opposite x) + back_again (/.opposite there)] + (and (not (/.= there x)) + (/.= back_again x))) - absolute! - (f.= (/.abs x) - (/.abs (/.opposite x)))] - (and own_inverse! - absolute!))) - ))) + absolute! + (f.= (/.abs x) + (/.abs (/.opposite x)))] + (and own_inverse! + absolute!))) + ))) (def: (trigonometric_symmetry forward backward angle) (-> (-> /.Complex /.Complex) (-> /.Complex /.Complex) /.Complex Bit) @@ -213,45 +213,45 @@ Test (do [! random.monad] [angle ..angle] - ($_ _.and - (_.cover [/.sin /.asin] - (trigonometric_symmetry /.sin /.asin angle)) - (_.cover [/.cos /.acos] - (trigonometric_symmetry /.cos /.acos angle)) - (_.cover [/.tan /.atan] - (trigonometric_symmetry /.tan /.atan angle))))) + (all _.and + (_.cover [/.sin /.asin] + (trigonometric_symmetry /.sin /.asin angle)) + (_.cover [/.cos /.acos] + (trigonometric_symmetry /.cos /.acos angle)) + (_.cover [/.tan /.atan] + (trigonometric_symmetry /.tan /.atan angle))))) (def: hyperbolic Test (do [! random.monad] [angle ..angle] - ($_ _.and - (_.cover [/.sinh] - (/.approximately? ..margin_of_error - (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one)) - (/.sinh angle))) - (_.cover [/.cosh] - (/.approximately? ..margin_of_error - (|> angle (/.* /.i) /.cos) - (/.cosh angle))) - (_.cover [/.tanh] - (/.approximately? ..margin_of_error - (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one)) - (/.tanh angle))) - ))) + (all _.and + (_.cover [/.sinh] + (/.approximately? ..margin_of_error + (|> angle (/.* /.i) /.sin (/.* /.i) (/.* /.-one)) + (/.sinh angle))) + (_.cover [/.cosh] + (/.approximately? ..margin_of_error + (|> angle (/.* /.i) /.cos) + (/.cosh angle))) + (_.cover [/.tanh] + (/.approximately? ..margin_of_error + (|> angle (/.* /.i) /.tan (/.* /.i) (/.* /.-one)) + (/.tanh angle))) + ))) (def: exponentiation&logarithm Test (do random.monad [x ..random] - ($_ _.and - (_.cover [/.pow /.root_2] - (|> x (/.pow (/.complex +2.0)) /.root_2 (/.approximately? ..margin_of_error x))) - (_.cover [/.pow'] - (|> x (/.pow' +2.0) (/.pow' +0.5) (/.approximately? ..margin_of_error x))) - (_.cover [/.log /.exp] - (|> x /.log /.exp (/.approximately? ..margin_of_error x))) - ))) + (all _.and + (_.cover [/.pow /.root_2] + (|> x (/.pow (/.complex +2.0)) /.root_2 (/.approximately? ..margin_of_error x))) + (_.cover [/.pow'] + (|> x (/.pow' +2.0) (/.pow' +0.5) (/.approximately? ..margin_of_error x))) + (_.cover [/.log /.exp] + (|> x /.log /.exp (/.approximately? ..margin_of_error x))) + ))) (def: root Test @@ -268,17 +268,17 @@ Test (<| (_.covering /._) (_.for [/.Complex]) - ($_ _.and - (_.for [/.= /.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.= /.equivalence] + ($equivalence.spec /.equivalence ..random)) - ..construction - ..constant - ..absolute_value&argument - ..number - ..conjugate&reciprocal&signum&negation - ..trigonometry - ..hyperbolic - ..exponentiation&logarithm - ..root - ))) + ..construction + ..constant + ..absolute_value&argument + ..number + ..conjugate&reciprocal&signum&negation + ..trigonometry + ..hyperbolic + ..exponentiation&logarithm + ..root + ))) diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index 22f56af05..66334e80c 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -34,91 +34,91 @@ Test (do random.monad [sample random.safe_frac] - ($_ _.and - (_.cover [/.biggest] - (/.<= /.biggest sample)) - (_.cover [/.positive_infinity] - (/.< /.positive_infinity sample)) - (_.cover [/.smallest] - (bit#= (/.positive? sample) - (/.>= /.smallest sample))) - (_.cover [/.negative_infinity] - (/.> /.negative_infinity sample)) - (_.cover [/.not_a_number /.not_a_number?] - (and (/.not_a_number? /.not_a_number) - (not (or (/.= /.not_a_number sample) - (/.not_a_number? sample))))) - ))) + (all _.and + (_.cover [/.biggest] + (/.<= /.biggest sample)) + (_.cover [/.positive_infinity] + (/.< /.positive_infinity sample)) + (_.cover [/.smallest] + (bit#= (/.positive? sample) + (/.>= /.smallest sample))) + (_.cover [/.negative_infinity] + (/.> /.negative_infinity sample)) + (_.cover [/.not_a_number /.not_a_number?] + (and (/.not_a_number? /.not_a_number) + (not (or (/.= /.not_a_number sample) + (/.not_a_number? sample))))) + ))) (def: predicate Test (do [! random.monad] [sample ..random shift (# ! each /.abs ..random)] - ($_ _.and - (_.cover [/.negative?] - (bit#= (/.negative? sample) - (/.< +0.0 sample))) - (_.cover [/.positive?] - (bit#= (/.positive? sample) - (/.> +0.0 sample))) - (_.cover [/.zero?] - (bit#= (/.zero? sample) - (/.= +0.0 sample))) - (_.cover [/.approximately?] - (and (/.approximately? /.smallest sample sample) - (/.approximately? (/.+ +1.0 shift) sample (/.+ shift sample)))) - (_.cover [/.number?] - (and (not (/.number? /.not_a_number)) - (not (/.number? /.positive_infinity)) - (not (/.number? /.negative_infinity)) - (/.number? sample))) - ))) + (all _.and + (_.cover [/.negative?] + (bit#= (/.negative? sample) + (/.< +0.0 sample))) + (_.cover [/.positive?] + (bit#= (/.positive? sample) + (/.> +0.0 sample))) + (_.cover [/.zero?] + (bit#= (/.zero? sample) + (/.= +0.0 sample))) + (_.cover [/.approximately?] + (and (/.approximately? /.smallest sample sample) + (/.approximately? (/.+ +1.0 shift) sample (/.+ shift sample)))) + (_.cover [/.number?] + (and (not (/.number? /.not_a_number)) + (not (/.number? /.positive_infinity)) + (not (/.number? /.negative_infinity)) + (/.number? sample))) + ))) (def: conversion Test - ($_ _.and - (do [! random.monad] - [expected (# ! each (n.% 1,000,000) random.nat)] - (_.cover [/.nat] - (|> expected n.frac /.nat (n.= expected)))) - (do [! random.monad] - [expected (# ! each (i.% +1,000,000) random.int)] - (_.cover [/.int] - (|> expected i.frac /.int (i.= expected)))) - (do [! random.monad] - [expected (# ! each (|>> (i64.left_shifted 52) .rev) - random.nat)] - (_.cover [/.rev] - (|> expected r.frac /.rev (r.= expected)))) - )) + (all _.and + (do [! random.monad] + [expected (# ! each (n.% 1,000,000) random.nat)] + (_.cover [/.nat] + (|> expected n.frac /.nat (n.= expected)))) + (do [! random.monad] + [expected (# ! each (i.% +1,000,000) random.int)] + (_.cover [/.int] + (|> expected i.frac /.int (i.= expected)))) + (do [! random.monad] + [expected (# ! each (|>> (i64.left_shifted 52) .rev) + random.nat)] + (_.cover [/.rev] + (|> expected r.frac /.rev (r.= expected)))) + )) (def: signature Test - (`` ($_ _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence random.safe_frac)) - (_.for [/.hash] - ($hash.spec /.hash random.frac)) - (_.for [/.order /.<] - ($order.spec /.order random.safe_frac)) - (~~ (template [<composite> <monoid>] - [(_.for [<monoid> <composite>] - ($monoid.spec /.equivalence <monoid> ..random))] + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence random.safe_frac)) + (_.for [/.hash] + ($hash.spec /.hash random.frac)) + (_.for [/.order /.<] + ($order.spec /.order random.safe_frac)) + (~~ (template [<composite> <monoid>] + [(_.for [<monoid> <composite>] + ($monoid.spec /.equivalence <monoid> ..random))] - [/.+ /.addition] - [/.* /.multiplication] + [/.+ /.addition] + [/.* /.multiplication] - [/.min /.minimum] - [/.max /.maximum] - )) - (~~ (template [<codec>] - [(_.for [<codec>] - ($codec.spec /.equivalence <codec> random.safe_frac))] + [/.min /.minimum] + [/.max /.maximum] + )) + (~~ (template [<codec>] + [(_.for [<codec>] + ($codec.spec /.equivalence <codec> random.safe_frac))] - [/.binary] [/.octal] [/.decimal] [/.hex] - )) - ))) + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) (with_expansions [<jvm> (these (ffi.import: java/lang/Double "[1]::[0]" @@ -138,253 +138,253 @@ (def: test|math Test - ($_ _.and - (do [! random.monad] - [.let [~= (/.approximately? ..margin_of_error)] - angle (|> random.safe_frac (# ! each (/.* /.tau)))] - ($_ _.and - (_.cover [/.sin /.asin] - (trigonometric_symmetry /.sin /.asin angle)) - (_.cover [/.cos /.acos] - (trigonometric_symmetry /.cos /.acos angle)) - (_.cover [/.tan /.atan] - (trigonometric_symmetry /.tan /.atan angle)) - (_.cover [/.tau] - (and (and (~= +0.0 (/.sin /.tau)) - (~= +1.0 (/.cos /.tau))) - (and (~= +0.0 (/.sin (/./ +2.0 /.tau))) - (~= -1.0 (/.cos (/./ +2.0 /.tau)))) - (and (~= +1.0 (/.sin (/./ +4.0 /.tau))) - (~= +0.0 (/.cos (/./ +4.0 /.tau)))) - (and (~= -1.0 (/.sin (/.* +3.0 (/./ +4.0 /.tau)))) - (~= +0.0 (/.cos (/.* +3.0 (/./ +4.0 /.tau))))) - (let [x2+y2 (/.+ (/.pow +2.0 (/.sin angle)) - (/.pow +2.0 (/.cos angle)))] - (~= +1.0 x2+y2)))) - (_.cover [/.pi] - (~= (/./ +2.0 /.tau) /.pi)) - )) - (do [! random.monad] - [sample (|> random.safe_frac (# ! each (/.* +1000.0)))] - ($_ _.and - (_.cover [/.ceil] - (let [ceil'd (/.ceil sample)] - (and (|> ceil'd /.int i.frac (/.= ceil'd)) - (/.>= sample ceil'd) - (/.<= +1.0 (/.- sample ceil'd))))) - (_.cover [/.floor] - (let [floor'd (/.floor sample)] - (and (|> floor'd /.int i.frac (/.= floor'd)) - (/.<= sample floor'd) - (/.<= +1.0 (/.- floor'd sample))))) - (_.cover [/.round] - (let [round'd (/.round sample)] - (and (|> round'd /.int i.frac (/.= round'd)) - (/.<= +1.0 (/.abs (/.- sample round'd)))))) - (_.cover [/.root_2] - (let [sample (/.abs sample)] + (all _.and + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error)] + angle (|> random.safe_frac (# ! each (/.* /.tau)))] + (all _.and + (_.cover [/.sin /.asin] + (trigonometric_symmetry /.sin /.asin angle)) + (_.cover [/.cos /.acos] + (trigonometric_symmetry /.cos /.acos angle)) + (_.cover [/.tan /.atan] + (trigonometric_symmetry /.tan /.atan angle)) + (_.cover [/.tau] + (and (and (~= +0.0 (/.sin /.tau)) + (~= +1.0 (/.cos /.tau))) + (and (~= +0.0 (/.sin (/./ +2.0 /.tau))) + (~= -1.0 (/.cos (/./ +2.0 /.tau)))) + (and (~= +1.0 (/.sin (/./ +4.0 /.tau))) + (~= +0.0 (/.cos (/./ +4.0 /.tau)))) + (and (~= -1.0 (/.sin (/.* +3.0 (/./ +4.0 /.tau)))) + (~= +0.0 (/.cos (/.* +3.0 (/./ +4.0 /.tau))))) + (let [x2+y2 (/.+ (/.pow +2.0 (/.sin angle)) + (/.pow +2.0 (/.cos angle)))] + (~= +1.0 x2+y2)))) + (_.cover [/.pi] + (~= (/./ +2.0 /.tau) /.pi)) + )) + (do [! random.monad] + [sample (|> random.safe_frac (# ! each (/.* +1000.0)))] + (all _.and + (_.cover [/.ceil] + (let [ceil'd (/.ceil sample)] + (and (|> ceil'd /.int i.frac (/.= ceil'd)) + (/.>= sample ceil'd) + (/.<= +1.0 (/.- sample ceil'd))))) + (_.cover [/.floor] + (let [floor'd (/.floor sample)] + (and (|> floor'd /.int i.frac (/.= floor'd)) + (/.<= sample floor'd) + (/.<= +1.0 (/.- floor'd sample))))) + (_.cover [/.round] + (let [round'd (/.round sample)] + (and (|> round'd /.int i.frac (/.= round'd)) + (/.<= +1.0 (/.abs (/.- sample round'd)))))) + (_.cover [/.root_2] + (let [sample (/.abs sample)] + (|> sample + /.root_2 + (/.pow +2.0) + (/.approximately? ..margin_of_error sample)))) + (_.cover [/.root_3] (|> sample - /.root_2 - (/.pow +2.0) - (/.approximately? ..margin_of_error sample)))) - (_.cover [/.root_3] - (|> sample - /.root_3 - (/.pow +3.0) - (/.approximately? ..margin_of_error sample))) - )) - (do [! random.monad] - [.let [~= (/.approximately? ..margin_of_error)] - sample (# ! each (/.* +10.0) random.safe_frac) - power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)] - ($_ _.and - (_.cover [/.exp /.log] - (|> sample /.exp /.log (/.approximately? +0.000000000000001 sample))) - (_.cover [/.e] - (~= +1.0 (/.log /.e))) - (_.cover [/.pow /.log_by] - (let [sample (/.abs sample)] - (|> sample - (/.pow power) - (/.log_by sample) - (~= power)))) - )) - (do [! random.monad] - [.let [~= (/.approximately? ..margin_of_error)] - angle (# ! each (/.* /.tau) random.safe_frac) - sample (# ! each /.abs random.safe_frac) - big (# ! each (/.* +1,000,000,000.00) random.safe_frac)] - (template.let [(odd! <function>) - [(_.cover [<function>] - (~= (/.opposite (<function> angle)) - (<function> (/.opposite angle))))] + /.root_3 + (/.pow +3.0) + (/.approximately? ..margin_of_error sample))) + )) + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error)] + sample (# ! each (/.* +10.0) random.safe_frac) + power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)] + (all _.and + (_.cover [/.exp /.log] + (|> sample /.exp /.log (/.approximately? +0.000000000000001 sample))) + (_.cover [/.e] + (~= +1.0 (/.log /.e))) + (_.cover [/.pow /.log_by] + (let [sample (/.abs sample)] + (|> sample + (/.pow power) + (/.log_by sample) + (~= power)))) + )) + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error)] + angle (# ! each (/.* /.tau) random.safe_frac) + sample (# ! each /.abs random.safe_frac) + big (# ! each (/.* +1,000,000,000.00) random.safe_frac)] + (template.let [(odd! <function>) + [(_.cover [<function>] + (~= (/.opposite (<function> angle)) + (<function> (/.opposite angle))))] - (even! <function>) - [(_.cover [<function>] - (~= (<function> angle) - (<function> (/.opposite angle))))] + (even! <function>) + [(_.cover [<function>] + (~= (<function> angle) + (<function> (/.opposite angle))))] - (inverse! <left> <right> <input>) - [(_.cover [<left> <right>] - (~= (<right> <input>) - (<left> (/./ <input> +1.0))))]] - ($_ _.and - (odd! /.sinh) - (even! /.cosh) - (odd! /.tanh) - (odd! /.coth) - (even! /.sech) - (odd! /.csch) + (inverse! <left> <right> <input>) + [(_.cover [<left> <right>] + (~= (<right> <input>) + (<left> (/./ <input> +1.0))))]] + (all _.and + (odd! /.sinh) + (even! /.cosh) + (odd! /.tanh) + (odd! /.coth) + (even! /.sech) + (odd! /.csch) - (inverse! /.acosh /.asech sample) - (inverse! /.asinh /.acsch sample) - (inverse! /.atanh /.acoth big) - ))) - (do [! random.monad] - [x (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac) - y (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac)] - (_.cover [/.hypotenuse] - (let [h (/.hypotenuse x y)] - (and (/.>= x h) - (/.>= y h))))) - (do [! random.monad] - [.let [~= (/.approximately? ..margin_of_error) - tau/4 (/./ +4.0 /.tau)] - x (# ! each (/.* tau/4) random.safe_frac) - y (# ! each (/.* tau/4) random.safe_frac)] - (_.cover [/.atan_2] - (let [expected (/.atan_2 x y) - actual (if (/.> +0.0 x) - (/.atan (/./ x y)) - (if (/.< +0.0 y) - (/.- /.pi (/.atan (/./ x y))) - (/.+ /.pi (/.atan (/./ x y)))))] - (and (~= expected actual) - (~= tau/4 (/.atan_2 +0.0 (/.abs y))) - (~= (/.opposite tau/4) (/.atan_2 +0.0 (/.opposite (/.abs y)))) - (/.not_a_number? (/.atan_2 +0.0 +0.0)))))) - (do [! random.monad] - [of (# ! each (|>> (n.% 10) ++) random.nat)] - (_.cover [/.factorial] - (and (n.= 1 (/.factorial 0)) - (|> (/.factorial of) (n.% of) (n.= 0))))) - )) + (inverse! /.acosh /.asech sample) + (inverse! /.asinh /.acsch sample) + (inverse! /.atanh /.acoth big) + ))) + (do [! random.monad] + [x (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac) + y (# ! each (|>> (/.* +10.0) /.abs) random.safe_frac)] + (_.cover [/.hypotenuse] + (let [h (/.hypotenuse x y)] + (and (/.>= x h) + (/.>= y h))))) + (do [! random.monad] + [.let [~= (/.approximately? ..margin_of_error) + tau/4 (/./ +4.0 /.tau)] + x (# ! each (/.* tau/4) random.safe_frac) + y (# ! each (/.* tau/4) random.safe_frac)] + (_.cover [/.atan_2] + (let [expected (/.atan_2 x y) + actual (if (/.> +0.0 x) + (/.atan (/./ x y)) + (if (/.< +0.0 y) + (/.- /.pi (/.atan (/./ x y))) + (/.+ /.pi (/.atan (/./ x y)))))] + (and (~= expected actual) + (~= tau/4 (/.atan_2 +0.0 (/.abs y))) + (~= (/.opposite tau/4) (/.atan_2 +0.0 (/.opposite (/.abs y)))) + (/.not_a_number? (/.atan_2 +0.0 +0.0)))))) + (do [! random.monad] + [of (# ! each (|>> (n.% 10) ++) random.nat)] + (_.cover [/.factorial] + (and (n.= 1 (/.factorial 0)) + (|> (/.factorial of) (n.% of) (n.= 0))))) + )) (def: .public test Test (<| (_.covering /._) (_.for [.Frac]) - ($_ _.and - (do random.monad - [left random.safe_frac - right random.safe_frac] - ($_ _.and - (_.cover [/.>] - (bit#= (/.> left right) - (/.< right left))) - (_.cover [/.<= /.>=] - (bit#= (/.<= left right) - (/.>= right left))) - )) - (do random.monad - [sample random.safe_frac] - ($_ _.and - (_.cover [/.-] - (and (/.= +0.0 (/.- sample sample)) - (/.= sample (/.- +0.0 sample)) - (/.= (/.opposite sample) - (/.- sample +0.0)))) - (_.cover [/./] - (and (/.= +1.0 (/./ sample sample)) - (/.= sample (/./ +1.0 sample)))) - (_.cover [/.abs] - (bit#= (/.> sample (/.abs sample)) - (/.negative? sample))) - (_.cover [/.signum] - (/.= (/.abs sample) - (/.* (/.signum sample) sample))) - )) - (do random.monad - [left (random.only (|>> (/.= +0.0) not) - ..random) - right ..random] - ($_ _.and - (_.cover [/.%] - (let [rem (/.% left right) - div (|> right (/.- rem) (/./ left))] - (/.= right - (|> div (/.* left) (/.+ rem))))) - (_.cover [/./%] - (let [[div rem] (/./% left right)] - (and (/.= div (/./ left right)) - (/.= rem (/.% left right))))) - (_.cover [/.mod] - (or (and (/.= +0.0 (/.% left right)) - (/.= +0.0 (/.mod left right))) - (and (/.= (/.signum left) - (/.signum (/.mod left right))) - (/.= (/.signum right) - (/.signum (/.% left right))) - (if (/.= (/.signum left) (/.signum right)) - (/.= (/.% left right) - (/.mod left right)) - (/.= (/.+ left (/.% left right)) - (/.mod left right)))))) - )) - (with_expansions [<jvm> ($_ _.and - (let [test (is (-> Frac Bit) - (function (_ value) - (n.= (.nat (ffi.of_long (java/lang/Double::doubleToRawLongBits (ffi.as_double value)))) - (/.bits value))))] + (all _.and + (do random.monad + [left random.safe_frac + right random.safe_frac] + (all _.and + (_.cover [/.>] + (bit#= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit#= (/.<= left right) + (/.>= right left))) + )) + (do random.monad + [sample random.safe_frac] + (all _.and + (_.cover [/.-] + (and (/.= +0.0 (/.- sample sample)) + (/.= sample (/.- +0.0 sample)) + (/.= (/.opposite sample) + (/.- sample +0.0)))) + (_.cover [/./] + (and (/.= +1.0 (/./ sample sample)) + (/.= sample (/./ +1.0 sample)))) + (_.cover [/.abs] + (bit#= (/.> sample (/.abs sample)) + (/.negative? sample))) + (_.cover [/.signum] + (/.= (/.abs sample) + (/.* (/.signum sample) sample))) + )) + (do random.monad + [left (random.only (|>> (/.= +0.0) not) + ..random) + right ..random] + (all _.and + (_.cover [/.%] + (let [rem (/.% left right) + div (|> right (/.- rem) (/./ left))] + (/.= right + (|> div (/.* left) (/.+ rem))))) + (_.cover [/./%] + (let [[div rem] (/./% left right)] + (and (/.= div (/./ left right)) + (/.= rem (/.% left right))))) + (_.cover [/.mod] + (or (and (/.= +0.0 (/.% left right)) + (/.= +0.0 (/.mod left right))) + (and (/.= (/.signum left) + (/.signum (/.mod left right))) + (/.= (/.signum right) + (/.signum (/.% left right))) + (if (/.= (/.signum left) (/.signum right)) + (/.= (/.% left right) + (/.mod left right)) + (/.= (/.+ left (/.% left right)) + (/.mod left right)))))) + )) + (with_expansions [<jvm> (all _.and + (let [test (is (-> Frac Bit) + (function (_ value) + (n.= (.nat (ffi.of_long (java/lang/Double::doubleToRawLongBits (ffi.as_double value)))) + (/.bits value))))] + (do random.monad + [sample random.frac] + (_.cover [/.bits] + (and (test sample) + (test /.biggest) + (test /.smallest) + (test /.not_a_number) + (test /.positive_infinity) + (test /.negative_infinity))))) (do random.monad - [sample random.frac] - (_.cover [/.bits] - (and (test sample) - (test /.biggest) - (test /.smallest) - (test /.not_a_number) - (test /.positive_infinity) - (test /.negative_infinity))))) - (do random.monad - [sample random.i64] - (_.cover [/.of_bits] - (let [expected (ffi.of_double (java/lang/Double::longBitsToDouble (ffi.as_long sample))) - actual (/.of_bits sample)] - (or (/.= expected actual) - (and (/.not_a_number? expected) - (/.not_a_number? actual)))))) - )] - (for @.old <jvm> - @.jvm <jvm> - (let [test (is (-> Frac Bit) - (function (_ expected) - (let [actual (|> expected /.bits /.of_bits)] - (or (/.= expected actual) - (and (/.not_a_number? expected) - (/.not_a_number? actual))))))] - (do random.monad - [sample random.frac] - (_.cover [/.bits /.of_bits] - (and (test sample) - (test /.biggest) - (test /.smallest) - (test /.not_a_number) - (test /.positive_infinity) - (test /.negative_infinity))))))) - (do random.monad - [expected random.safe_frac] - (_.cover [/.opposite] - (let [subtraction! - (/.= +0.0 (/.+ (/.opposite expected) expected)) + [sample random.i64] + (_.cover [/.of_bits] + (let [expected (ffi.of_double (java/lang/Double::longBitsToDouble (ffi.as_long sample))) + actual (/.of_bits sample)] + (or (/.= expected actual) + (and (/.not_a_number? expected) + (/.not_a_number? actual)))))) + )] + (for @.old <jvm> + @.jvm <jvm> + (let [test (is (-> Frac Bit) + (function (_ expected) + (let [actual (|> expected /.bits /.of_bits)] + (or (/.= expected actual) + (and (/.not_a_number? expected) + (/.not_a_number? actual))))))] + (do random.monad + [sample random.frac] + (_.cover [/.bits /.of_bits] + (and (test sample) + (test /.biggest) + (test /.smallest) + (test /.not_a_number) + (test /.positive_infinity) + (test /.negative_infinity))))))) + (do random.monad + [expected random.safe_frac] + (_.cover [/.opposite] + (let [subtraction! + (/.= +0.0 (/.+ (/.opposite expected) expected)) - inverse! - (|> expected /.opposite /.opposite (/.= expected))] - (and subtraction! - inverse!)))) + inverse! + (|> expected /.opposite /.opposite (/.= expected))] + (and subtraction! + inverse!)))) - ..constant - ..predicate - ..conversion - ..signature - ..test|math - ))) + ..constant + ..predicate + ..conversion + ..signature + ..test|math + ))) diff --git a/stdlib/source/test/lux/math/number/i16.lux b/stdlib/source/test/lux/math/number/i16.lux index b8d99c061..8321376d8 100644 --- a/stdlib/source/test/lux/math/number/i16.lux +++ b/stdlib/source/test/lux/math/number/i16.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" / - ["/[1]" // "_" - ["i" int] - ["[1][0]" i64]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" / + ["/[1]" // "_" + ["i" int] + ["[1][0]" i64]]]]) (def: .public random (Random /.I16) @@ -28,11 +28,11 @@ .int ++)] expected (# ! each (i.% limit) random.int)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.i16 /.i64 /.width] - (let [actual (|> expected .i64 /.i16 /.i64)] - (# //i64.equivalence = expected actual))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.i16 /.i64 /.width] + (let [actual (|> expected .i64 /.i16 /.i64)] + (# //i64.equivalence = expected actual))) + )))) diff --git a/stdlib/source/test/lux/math/number/i32.lux b/stdlib/source/test/lux/math/number/i32.lux index 4d44e5d24..ed7e88201 100644 --- a/stdlib/source/test/lux/math/number/i32.lux +++ b/stdlib/source/test/lux/math/number/i32.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" / - ["/[1]" // "_" - ["i" int] - ["[1][0]" i64]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" / + ["/[1]" // "_" + ["i" int] + ["[1][0]" i64]]]]) (def: .public random (Random /.I32) @@ -28,11 +28,11 @@ .int ++)] expected (# ! each (i.% limit) random.int)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.i32 /.i64 /.width] - (let [actual (|> expected .i64 /.i32 /.i64)] - (# //i64.equivalence = expected actual))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.i32 /.i64 /.width] + (let [actual (|> expected .i64 /.i32 /.i64)] + (# //i64.equivalence = expected actual))) + )))) diff --git a/stdlib/source/test/lux/math/number/i64.lux b/stdlib/source/test/lux/math/number/i64.lux index ec6b56f7e..805c212b1 100644 --- a/stdlib/source/test/lux/math/number/i64.lux +++ b/stdlib/source/test/lux/math/number/i64.lux @@ -23,51 +23,51 @@ (do [! random.monad] [pattern random.nat idx (# ! each (n.% /.width) random.nat)] - ($_ _.and - (_.cover [/.one? /.one] - (if (/.one? idx pattern) - (#= pattern (/.one idx pattern)) - (not (#= pattern (/.one idx pattern))))) - (_.cover [/.zero? /.zero] - (if (/.zero? idx pattern) - (#= pattern (/.zero idx pattern)) - (not (#= pattern (/.zero idx pattern))))) - (_.cover [/.flipped] - (#= (/.flipped idx pattern) - (if (/.one? idx pattern) - (/.zero idx pattern) - (/.one idx pattern)))) - (_.cover [/.bit] - (bit#= (/.zero? idx pattern) - (#= /.false (/.and (/.bit idx) pattern)))) - ))) + (all _.and + (_.cover [/.one? /.one] + (if (/.one? idx pattern) + (#= pattern (/.one idx pattern)) + (not (#= pattern (/.one idx pattern))))) + (_.cover [/.zero? /.zero] + (if (/.zero? idx pattern) + (#= pattern (/.zero idx pattern)) + (not (#= pattern (/.zero idx pattern))))) + (_.cover [/.flipped] + (#= (/.flipped idx pattern) + (if (/.one? idx pattern) + (/.zero idx pattern) + (/.one idx pattern)))) + (_.cover [/.bit] + (bit#= (/.zero? idx pattern) + (#= /.false (/.and (/.bit idx) pattern)))) + ))) (def: shift Test (do [! random.monad] [pattern random.nat] - ($_ _.and - (do ! - [idx (# ! each (|>> (n.% (-- /.width)) ++) random.nat)] - (_.cover [/.left_shifted /.right_shifted] - (let [nullity! - (and (#= pattern (/.left_shifted 0 pattern)) - (#= pattern (/.right_shifted 0 pattern))) + (all _.and + (do ! + [idx (# ! each (|>> (n.% (-- /.width)) ++) random.nat)] + (_.cover [/.left_shifted /.right_shifted] + (let [nullity! + (and (#= pattern (/.left_shifted 0 pattern)) + (#= pattern (/.right_shifted 0 pattern))) - idempotency! - (and (#= pattern (/.left_shifted /.width pattern)) - (#= pattern (/.right_shifted /.width pattern))) - - movement! - (let [shift (n.- idx /.width)] - (#= (/.and (/.mask idx) pattern) - (|> pattern - (/.left_shifted shift) - (/.right_shifted shift))))] - (and nullity! idempotency! - movement!)))) - ))) + (and (#= pattern (/.left_shifted /.width pattern)) + (#= pattern (/.right_shifted /.width pattern))) + + movement! + (let [shift (n.- idx /.width)] + (#= (/.and (/.mask idx) pattern) + (|> pattern + (/.left_shifted shift) + (/.right_shifted shift))))] + (and nullity! + idempotency! + movement!)))) + ))) (def: mask Test @@ -76,47 +76,47 @@ [pattern random.nat idx (# ! each (n.% /.width) random.nat) signed random.int] - ($_ _.and - (_.cover [/.sign] - (bit#= (#= (.i64 0) (/.and /.sign signed)) - (i.positive? signed))) - (_.cover [/.mask] - (let [mask (/.mask idx) - idempotency! (#= (/.and mask pattern) - (/.and mask (/.and mask pattern))) + (all _.and + (_.cover [/.sign] + (bit#= (#= (.i64 0) (/.and /.sign signed)) + (i.positive? signed))) + (_.cover [/.mask] + (let [mask (/.mask idx) + idempotency! (#= (/.and mask pattern) + (/.and mask (/.and mask pattern))) - limit (++ (.nat mask)) - limit! (if (n.< limit pattern) - (#= pattern (/.and mask pattern)) - (n.< limit (/.and mask pattern))) + limit (++ (.nat mask)) + limit! (if (n.< limit pattern) + (#= pattern (/.and mask pattern)) + (n.< limit (/.and mask pattern))) - empty! (#= /.false (/.mask 0)) - full! (#= /.true (/.mask /.width))] - (and idempotency! - limit! + empty! (#= /.false (/.mask 0)) + full! (#= /.true (/.mask /.width))] + (and idempotency! + limit! - empty! - full!))) - (do ! - [size (# ! each (n.% /.width) random.nat) - .let [spare (n.- size /.width)] - offset (# ! each (n.% spare) random.nat)] - (_.cover [/.region] - (case size - 0 (#= /.false (/.region offset size)) - _ (#= (|> pattern - ... NNNNYYYYNNNN - (/.right_shifted offset) - ... ____NNNNYYYY - (/.left_shifted spare) - ... YYYY________ - (/.right_shifted spare) - ... ________YYYY - (/.left_shifted offset) - ... ____YYYY____ - ) - (/.and (/.region offset size) pattern))))) - )))) + empty! + full!))) + (do ! + [size (# ! each (n.% /.width) random.nat) + .let [spare (n.- size /.width)] + offset (# ! each (n.% spare) random.nat)] + (_.cover [/.region] + (case size + 0 (#= /.false (/.region offset size)) + _ (#= (|> pattern + ... NNNNYYYYNNNN + (/.right_shifted offset) + ... ____NNNNYYYY + (/.left_shifted spare) + ... YYYY________ + (/.right_shifted spare) + ... ________YYYY + (/.left_shifted offset) + ... ____YYYY____ + ) + (/.and (/.region offset size) pattern))))) + )))) (def: sub Test @@ -139,25 +139,25 @@ (-> (-> I64 (I64 size)) (Random (I64 size)))) (function (_ narrow) (# random.functor each narrow random.i64)))]] - ($_ _.and - ($equivalence.spec (# sub sub_equivalence) (random (# sub narrow))) - (_.cover [/.sub] - (let [actual (|> expected .i64 (# sub narrow) (# sub wide))] - (#= expected actual))) - )))))) + (all _.and + ($equivalence.spec (# sub sub_equivalence) (random (# sub narrow))) + (_.cover [/.sub] + (let [actual (|> expected .i64 (# sub narrow) (# sub wide))] + (#= expected actual))) + )))))) (def: signature Test - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.i64)) - (_.for [/.hash] - ($hash.spec /.hash random.i64)) - (_.for [/.disjunction] - ($monoid.spec n.equivalence /.disjunction random.nat)) - (_.for [/.conjunction] - ($monoid.spec n.equivalence /.conjunction random.nat)) - )) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.i64)) + (_.for [/.hash] + ($hash.spec /.hash random.i64)) + (_.for [/.disjunction] + ($monoid.spec n.equivalence /.disjunction random.nat)) + (_.for [/.conjunction] + ($monoid.spec n.equivalence /.conjunction random.nat)) + )) (def: .public test Test @@ -166,100 +166,100 @@ (do [! random.monad] [pattern random.nat idx (# ! each (n.% /.width) random.nat)] - ($_ _.and - (_.cover [/.width /.bits_per_byte /.bytes_per_i64] - (and (n.= /.bytes_per_i64 - (n./ /.bits_per_byte /.width)) - (n.= /.bits_per_byte - (n./ /.bytes_per_i64 /.width)))) - (_.cover [/.false] - (n.= 0 (/.ones /.false))) - (_.cover [/.or] - (and (#= /.true (/.or /.true pattern)) - (#= pattern (/.or /.false pattern)))) - (_.cover [/.true] - (n.= /.width (/.ones /.true))) - (_.cover [/.and] - (and (#= pattern (/.and /.true pattern)) - (#= /.false (/.and /.false pattern)))) - (_.cover [/.not] - (and (#= /.false - (/.and pattern - (/.not pattern))) - (#= /.true - (/.or pattern - (/.not pattern))))) - (_.cover [/.xor] - (and (#= /.true - (/.xor pattern - (/.not pattern))) - (#= /.false - (/.xor pattern - pattern)))) - (_.cover [/.ones] - (let [zero&one! - (if (/.one? idx pattern) - (n.= (-- (/.ones pattern)) (/.ones (/.zero idx pattern))) - (n.= (++ (/.ones pattern)) (/.ones (/.one idx pattern)))) - - complementarity! - (n.= /.width - (n.+ (/.ones pattern) - (/.ones (/.not pattern))))] - (and zero&one! - complementarity!))) - (_.cover [/.left_rotated /.right_rotated] - (let [false! - (and (#= /.false (/.left_rotated idx /.false)) - (#= /.false (/.right_rotated idx /.false))) - - true! - (and (#= /.true (/.left_rotated idx /.true)) - (#= /.true (/.right_rotated idx /.true))) - - inverse! - (and (|> pattern - (/.left_rotated idx) - (/.right_rotated idx) - (#= pattern)) - (|> pattern - (/.right_rotated idx) - (/.left_rotated idx) - (#= pattern))) + (all _.and + (_.cover [/.width /.bits_per_byte /.bytes_per_i64] + (and (n.= /.bytes_per_i64 + (n./ /.bits_per_byte /.width)) + (n.= /.bits_per_byte + (n./ /.bytes_per_i64 /.width)))) + (_.cover [/.false] + (n.= 0 (/.ones /.false))) + (_.cover [/.or] + (and (#= /.true (/.or /.true pattern)) + (#= pattern (/.or /.false pattern)))) + (_.cover [/.true] + (n.= /.width (/.ones /.true))) + (_.cover [/.and] + (and (#= pattern (/.and /.true pattern)) + (#= /.false (/.and /.false pattern)))) + (_.cover [/.not] + (and (#= /.false + (/.and pattern + (/.not pattern))) + (#= /.true + (/.or pattern + (/.not pattern))))) + (_.cover [/.xor] + (and (#= /.true + (/.xor pattern + (/.not pattern))) + (#= /.false + (/.xor pattern + pattern)))) + (_.cover [/.ones] + (let [zero&one! + (if (/.one? idx pattern) + (n.= (-- (/.ones pattern)) (/.ones (/.zero idx pattern))) + (n.= (++ (/.ones pattern)) (/.ones (/.one idx pattern)))) - nullity! - (and (|> pattern - (/.left_rotated 0) - (#= pattern)) - (|> pattern - (/.right_rotated 0) - (#= pattern))) + complementarity! + (n.= /.width + (n.+ (/.ones pattern) + (/.ones (/.not pattern))))] + (and zero&one! + complementarity!))) + (_.cover [/.left_rotated /.right_rotated] + (let [false! + (and (#= /.false (/.left_rotated idx /.false)) + (#= /.false (/.right_rotated idx /.false))) - futility! - (and (|> pattern - (/.left_rotated /.width) - (#= pattern)) - (|> pattern - (/.right_rotated /.width) - (#= pattern)))] - (and false! true! + (and (#= /.true (/.left_rotated idx /.true)) + (#= /.true (/.right_rotated idx /.true))) + inverse! + (and (|> pattern + (/.left_rotated idx) + (/.right_rotated idx) + (#= pattern)) + (|> pattern + (/.right_rotated idx) + (/.left_rotated idx) + (#= pattern))) + nullity! - futility!))) - (_.cover [/.reversed] - (and (|> pattern /.reversed /.reversed (#= pattern)) - (or (|> pattern /.reversed (#= pattern) not) - (let [high (/.and (hex "FFFFFFFF00000000") - pattern) - low (/.and (hex "00000000FFFFFFFF") - pattern)] - (#= (/.reversed high) - low))))) - - ..bit - ..shift - ..mask - ..sub - ..signature - )))) + (and (|> pattern + (/.left_rotated 0) + (#= pattern)) + (|> pattern + (/.right_rotated 0) + (#= pattern))) + + futility! + (and (|> pattern + (/.left_rotated /.width) + (#= pattern)) + (|> pattern + (/.right_rotated /.width) + (#= pattern)))] + (and false! + true! + inverse! + nullity! + futility!))) + (_.cover [/.reversed] + (and (|> pattern /.reversed /.reversed (#= pattern)) + (or (|> pattern /.reversed (#= pattern) not) + (let [high (/.and (hex "FFFFFFFF00000000") + pattern) + low (/.and (hex "00000000FFFFFFFF") + pattern)] + (#= (/.reversed high) + low))))) + + ..bit + ..shift + ..mask + ..sub + ..signature + )))) diff --git a/stdlib/source/test/lux/math/number/i8.lux b/stdlib/source/test/lux/math/number/i8.lux index 6e20a2117..3994b5433 100644 --- a/stdlib/source/test/lux/math/number/i8.lux +++ b/stdlib/source/test/lux/math/number/i8.lux @@ -1,18 +1,18 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" / - ["/[1]" // "_" - ["i" int] - ["[1][0]" i64]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" / + ["/[1]" // "_" + ["i" int] + ["[1][0]" i64]]]]) (def: .public random (Random /.I8) @@ -28,11 +28,11 @@ .int ++)] expected (# ! each (i.% limit) random.int)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.i8 /.i64 /.width] - (let [actual (|> expected .i64 /.i8 /.i64)] - (# //i64.equivalence = expected actual))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.i8 /.i64 /.width] + (let [actual (|> expected .i64 /.i8 /.i64)] + (# //i64.equivalence = expected actual))) + )))) diff --git a/stdlib/source/test/lux/math/number/int.lux b/stdlib/source/test/lux/math/number/int.lux index 4a6b893f4..9265507e7 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -25,230 +25,230 @@ (def: signature Test - (`` ($_ _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence random.int)) - (_.for [/.hash] - ($hash.spec /.hash random.int)) - (_.for [/.order /.<] - ($order.spec /.order random.int)) - (_.for [/.enum] - ($enum.spec /.enum random.int)) - (_.for [/.interval] - ($interval.spec /.interval random.int)) - (~~ (template [<monoid>] - [(_.for [<monoid>] - ($monoid.spec /.equivalence <monoid> random.int))] - - [/.addition] - [/.multiplication] + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence random.int)) + (_.for [/.hash] + ($hash.spec /.hash random.int)) + (_.for [/.order /.<] + ($order.spec /.order random.int)) + (_.for [/.enum] + ($enum.spec /.enum random.int)) + (_.for [/.interval] + ($interval.spec /.interval random.int)) + (~~ (template [<monoid>] + [(_.for [<monoid>] + ($monoid.spec /.equivalence <monoid> random.int))] + + [/.addition] + [/.multiplication] - [/.minimum] - [/.maximum] - )) - (~~ (template [<codec>] - [(_.for [<codec>] - ($codec.spec /.equivalence <codec> random.int))] + [/.minimum] + [/.maximum] + )) + (~~ (template [<codec>] + [(_.for [<codec>] + ($codec.spec /.equivalence <codec> random.int))] - [/.binary] [/.octal] [/.decimal] [/.hex] - )) - ))) + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) (def: predicate Test (do [! random.monad] [sample random.int] - ($_ _.and - (_.cover [/.negative?] - (bit#= (/.negative? sample) - (/.< +0 sample))) - (_.cover [/.positive?] - (bit#= (/.positive? sample) - (/.> +0 sample))) - (_.cover [/.zero?] - (bit#= (/.zero? sample) - (/.= +0 sample))) - (_.cover [/.even? /.odd?] - (bit#= (/.even? sample) - (not (/.odd? sample)))) - ))) + (all _.and + (_.cover [/.negative?] + (bit#= (/.negative? sample) + (/.< +0 sample))) + (_.cover [/.positive?] + (bit#= (/.positive? sample) + (/.> +0 sample))) + (_.cover [/.zero?] + (bit#= (/.zero? sample) + (/.= +0 sample))) + (_.cover [/.even? /.odd?] + (bit#= (/.even? sample) + (not (/.odd? sample)))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [.Int]) (let [(open "/#[0]") /.interval]) - ($_ _.and - (do random.monad - [sample random.int - left random.int - right random.int] - ($_ _.and - (_.cover [/.+] - (and (/.= (/.+ left right) - (/.+ right left)) - (/.= sample (/.+ +0 sample)))) - (_.cover [/.-] - (and (/.= +0 (/.- sample sample)) - (/.= sample (/.- +0 sample)) - (/.= (/.opposite sample) - (/.- sample +0)) - (/.= /#bottom - (/.- /#bottom +0)))) - (_.cover [/.*] - (and (/.= (/.* left right) - (/.* right left)) - (/.= sample (/.* +1 sample)) - (/.= /#bottom - (/.* -1 /#bottom)))) - (_.cover [/./] - (and (/.= +1 (/./ sample sample)) - (/.= sample (/./ +1 sample)) - (/.= /#bottom - (/./ -1 /#bottom)))) - (_.cover [/.abs] - (bit#= (/.> sample (/.abs sample)) - (/.negative? sample))) - (_.cover [/.signum] - (/.= (/.abs sample) - (/.* (/.signum sample) sample))) - (_.cover [/.min] - (and (/.= (/.min left right) - (/.min right left)) - (/.= sample - (/.min /#top sample)) - (/.= /#bottom - (/.min /#bottom sample)))) - (_.cover [/.max] - (and (/.= (/.max left right) - (/.max right left)) - (/.= /#top - (/.max /#top sample)) - (/.= sample - (/.max /#bottom sample)))) - )) - (do random.monad - [left random.int - right random.int] - ($_ _.and - (_.cover [/.>] - (bit#= (/.> left right) - (/.< right left))) - (_.cover [/.<= /.>=] - (bit#= (/.<= left right) - (/.>= right left))) - )) - (do random.monad - [left (random.only (|>> (/.= +0) not) - random.int) - right random.int] - ($_ _.and - (_.cover [/.%] - (let [rem (/.% left right) - div (|> right (/.- rem) (/./ left))] - (/.= right - (|> div (/.* left) (/.+ rem))))) - (_.cover [/./%] - (let [[div rem] (/./% left right)] - (and (/.= div (/./ left right)) - (/.= rem (/.% left right))))) - (_.cover [/.mod] - (and (/.= (/.signum left) - (/.signum (/.mod left right))) - (/.= (/.signum right) - (/.signum (/.% left right))) - (if (/.= (/.signum left) (/.signum right)) - (/.= (/.% left right) - (/.mod left right)) - (or (and (/.= +0 (/.% left right)) - (/.= +0 (/.mod left right))) - (/.= (/.+ left (/.% left right)) - (/.mod left right)))))) - )) - (do [! random.monad] - [.let [random (|> random.int - (# ! each (/.% +1,000)) - (random.only (|>> (/.= +0) not)))] - left random - right random] - ($_ _.and - (_.cover [/.gcd] - (let [gcd (/.gcd left right)] - (and (/.= +0 (/.% gcd left)) - (/.= +0 (/.% gcd right))))) - (_.cover [/.extended_gcd] - (let [[[left_k right_k] gcd] (/.extended_gcd left right) + (all _.and + (do random.monad + [sample random.int + left random.int + right random.int] + (all _.and + (_.cover [/.+] + (and (/.= (/.+ left right) + (/.+ right left)) + (/.= sample (/.+ +0 sample)))) + (_.cover [/.-] + (and (/.= +0 (/.- sample sample)) + (/.= sample (/.- +0 sample)) + (/.= (/.opposite sample) + (/.- sample +0)) + (/.= /#bottom + (/.- /#bottom +0)))) + (_.cover [/.*] + (and (/.= (/.* left right) + (/.* right left)) + (/.= sample (/.* +1 sample)) + (/.= /#bottom + (/.* -1 /#bottom)))) + (_.cover [/./] + (and (/.= +1 (/./ sample sample)) + (/.= sample (/./ +1 sample)) + (/.= /#bottom + (/./ -1 /#bottom)))) + (_.cover [/.abs] + (bit#= (/.> sample (/.abs sample)) + (/.negative? sample))) + (_.cover [/.signum] + (/.= (/.abs sample) + (/.* (/.signum sample) sample))) + (_.cover [/.min] + (and (/.= (/.min left right) + (/.min right left)) + (/.= sample + (/.min /#top sample)) + (/.= /#bottom + (/.min /#bottom sample)))) + (_.cover [/.max] + (and (/.= (/.max left right) + (/.max right left)) + (/.= /#top + (/.max /#top sample)) + (/.= sample + (/.max /#bottom sample)))) + )) + (do random.monad + [left random.int + right random.int] + (all _.and + (_.cover [/.>] + (bit#= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit#= (/.<= left right) + (/.>= right left))) + )) + (do random.monad + [left (random.only (|>> (/.= +0) not) + random.int) + right random.int] + (all _.and + (_.cover [/.%] + (let [rem (/.% left right) + div (|> right (/.- rem) (/./ left))] + (/.= right + (|> div (/.* left) (/.+ rem))))) + (_.cover [/./%] + (let [[div rem] (/./% left right)] + (and (/.= div (/./ left right)) + (/.= rem (/.% left right))))) + (_.cover [/.mod] + (and (/.= (/.signum left) + (/.signum (/.mod left right))) + (/.= (/.signum right) + (/.signum (/.% left right))) + (if (/.= (/.signum left) (/.signum right)) + (/.= (/.% left right) + (/.mod left right)) + (or (and (/.= +0 (/.% left right)) + (/.= +0 (/.mod left right))) + (/.= (/.+ left (/.% left right)) + (/.mod left right)))))) + )) + (do [! random.monad] + [.let [random (|> random.int + (# ! each (/.% +1,000)) + (random.only (|>> (/.= +0) not)))] + left random + right random] + (all _.and + (_.cover [/.gcd] + (let [gcd (/.gcd left right)] + (and (/.= +0 (/.% gcd left)) + (/.= +0 (/.% gcd right))))) + (_.cover [/.extended_gcd] + (let [[[left_k right_k] gcd] (/.extended_gcd left right) - same_gcd! - (/.= gcd - (/.gcd left right)) - - bezout_identity! - (/.= gcd - (/.+ (/.* left_k left) - (/.* right_k right)))] - (and same_gcd! - bezout_identity!))) - (_.cover [/.co_prime?] - (bit#= (/.= +1 (/.gcd left right)) - (/.co_prime? left right))) - (_.cover [/.lcm] - (let [lcm (/.lcm left right)] - (and (/.= +0 (/.% left lcm)) - (/.= +0 (/.% right lcm))))) - )) - (do random.monad - [expected random.int] - (_.cover [/.opposite] - (let [subtraction! - (/.= +0 (/.+ (/.opposite expected) expected)) + same_gcd! + (/.= gcd + (/.gcd left right)) + + bezout_identity! + (/.= gcd + (/.+ (/.* left_k left) + (/.* right_k right)))] + (and same_gcd! + bezout_identity!))) + (_.cover [/.co_prime?] + (bit#= (/.= +1 (/.gcd left right)) + (/.co_prime? left right))) + (_.cover [/.lcm] + (let [lcm (/.lcm left right)] + (and (/.= +0 (/.% left lcm)) + (/.= +0 (/.% right lcm))))) + )) + (do random.monad + [expected random.int] + (_.cover [/.opposite] + (let [subtraction! + (/.= +0 (/.+ (/.opposite expected) expected)) - inverse! - (|> expected /.opposite /.opposite (/.= expected))] - (and subtraction! - inverse!)))) - (do [! random.monad] - [expected (# ! each (/.% +1,000,000) random.int) - sample random.int] - (_.cover [/.frac] - (and (|> expected /.frac f.int (/.= expected)) - (f.number? (/.frac sample))))) - (do [! random.monad] - [pattern random.int - idx (# ! each (n.% i64.width) random.nat)] - (_.cover [/.right_shifted] - (let [nullity! - (/.= pattern (/.right_shifted 0 pattern)) + inverse! + (|> expected /.opposite /.opposite (/.= expected))] + (and subtraction! + inverse!)))) + (do [! random.monad] + [expected (# ! each (/.% +1,000,000) random.int) + sample random.int] + (_.cover [/.frac] + (and (|> expected /.frac f.int (/.= expected)) + (f.number? (/.frac sample))))) + (do [! random.monad] + [pattern random.int + idx (# ! each (n.% i64.width) random.nat)] + (_.cover [/.right_shifted] + (let [nullity! + (/.= pattern (/.right_shifted 0 pattern)) - idempotency! - (/.= pattern (/.right_shifted i64.width pattern)) - - sign_mask (i64.left_shifted (-- i64.width) 1) - mantissa_mask (-- (i64.left_shifted (n.- idx i64.width) 1)) - co_mantissa_mask (i64.not mantissa_mask) - - sign_preservation! - (/.= (i64.and sign_mask pattern) - (i64.and sign_mask (/.right_shifted idx pattern))) + idempotency! + (/.= pattern (/.right_shifted i64.width pattern)) - mantissa_parity! - (/.= (i64.and mantissa_mask (i64.right_shifted idx pattern)) - (i64.and mantissa_mask (/.right_shifted idx pattern))) + sign_mask (i64.left_shifted (-- i64.width) 1) + mantissa_mask (-- (i64.left_shifted (n.- idx i64.width) 1)) + co_mantissa_mask (i64.not mantissa_mask) - co_mantissa_disparity! - (or (n.= 0 idx) - (and (/.= +0 (i64.and co_mantissa_mask (i64.right_shifted idx pattern))) - (/.= (if (/.< +0 pattern) - (.int co_mantissa_mask) - +0) - (i64.and co_mantissa_mask (/.right_shifted idx pattern)))))] - (and nullity! - idempotency! sign_preservation! + (/.= (i64.and sign_mask pattern) + (i64.and sign_mask (/.right_shifted idx pattern))) + mantissa_parity! + (/.= (i64.and mantissa_mask (i64.right_shifted idx pattern)) + (i64.and mantissa_mask (/.right_shifted idx pattern))) + co_mantissa_disparity! - )))) + (or (n.= 0 idx) + (and (/.= +0 (i64.and co_mantissa_mask (i64.right_shifted idx pattern))) + (/.= (if (/.< +0 pattern) + (.int co_mantissa_mask) + +0) + (i64.and co_mantissa_mask (/.right_shifted idx pattern)))))] + (and nullity! + idempotency! + sign_preservation! + mantissa_parity! + co_mantissa_disparity! + )))) - ..predicate - ..signature - ))) + ..predicate + ..signature + ))) diff --git a/stdlib/source/test/lux/math/number/nat.lux b/stdlib/source/test/lux/math/number/nat.lux index f236a7aa6..05c248337 100644 --- a/stdlib/source/test/lux/math/number/nat.lux +++ b/stdlib/source/test/lux/math/number/nat.lux @@ -1,132 +1,132 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" interval] - ["$[0]" monoid] - ["$[0]" codec]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random]]]] - [\\library - ["[0]" / - [// - ["f" frac]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" interval] + ["$[0]" monoid] + ["$[0]" codec]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random]]]] + [\\library + ["[0]" / + [// + ["f" frac]]]]) (def: signature Test - (`` ($_ _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence random.nat)) - (_.for [/.hash] - ($hash.spec /.hash random.nat)) - (_.for [/.order /.<] - ($order.spec /.order random.nat)) - (_.for [/.enum] - ($enum.spec /.enum random.nat)) - (_.for [/.interval] - ($interval.spec /.interval random.nat)) - (~~ (template [<composite> <monoid>] - [(_.for [<monoid> <composite>] - ($monoid.spec /.equivalence <monoid> random.nat))] - - [/.+ /.addition] - [/.* /.multiplication] + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence random.nat)) + (_.for [/.hash] + ($hash.spec /.hash random.nat)) + (_.for [/.order /.<] + ($order.spec /.order random.nat)) + (_.for [/.enum] + ($enum.spec /.enum random.nat)) + (_.for [/.interval] + ($interval.spec /.interval random.nat)) + (~~ (template [<composite> <monoid>] + [(_.for [<monoid> <composite>] + ($monoid.spec /.equivalence <monoid> random.nat))] + + [/.+ /.addition] + [/.* /.multiplication] - [/.min /.minimum] - [/.max /.maximum] - )) - (~~ (template [<codec>] - [(_.for [<codec>] - ($codec.spec /.equivalence <codec> random.nat))] + [/.min /.minimum] + [/.max /.maximum] + )) + (~~ (template [<codec>] + [(_.for [<codec>] + ($codec.spec /.equivalence <codec> random.nat))] - [/.binary] [/.octal] [/.decimal] [/.hex] - )) - ))) + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) (def: predicate Test (do [! random.monad] [sample random.nat] - ($_ _.and - (_.cover [/.even? /.odd?] - (bit#= (/.even? sample) - (not (/.odd? sample)))) - ))) + (all _.and + (_.cover [/.even? /.odd?] + (bit#= (/.even? sample) + (not (/.odd? sample)))) + ))) (def: .public test Test (<| (_.covering /._) (_.for [.Nat]) - ($_ _.and - (do random.monad - [sample random.nat] - ($_ _.and - (_.cover [/.-] - (and (/.= 0 (/.- sample sample)) - (/.= sample (/.- 0 sample)))) - (_.cover [/./] - (and (/.= 1 (/./ sample sample)) - (/.= sample (/./ 1 sample)))) - )) - (do random.monad - [left random.nat - right random.nat] - ($_ _.and - (_.cover [/.>] - (bit#= (/.> left right) - (/.< right left))) - (_.cover [/.<= /.>=] - (bit#= (/.<= left right) - (/.>= right left))) - )) - (do random.monad - [left (random.only (|>> (/.= 0) not) - random.nat) - right random.nat] - ($_ _.and - (_.cover [/.%] - (let [rem (/.% left right) - div (|> right (/.- rem) (/./ left))] - (/.= right - (|> div (/.* left) (/.+ rem))))) - (_.cover [/./%] - (let [[div rem] (/./% left right)] - (and (/.= div (/./ left right)) - (/.= rem (/.% left right))))) - )) - (do [! random.monad] - [.let [random (# ! each (|>> (/.% 1,000) ++) random.nat)] - left random - right random] - ($_ _.and - (_.cover [/.gcd] - (let [gcd (/.gcd left right)] - (and (/.= 0 (/.% gcd left)) - (/.= 0 (/.% gcd right))))) - (_.cover [/.co_prime?] - (bit#= (/.= 1 (/.gcd left right)) - (/.co_prime? left right))) - (_.cover [/.lcm] - (let [lcm (/.lcm left right)] - (and (/.= 0 (/.% left lcm)) - (/.= 0 (/.% right lcm))))) - )) - (do [! random.monad] - [expected (# ! each (/.% 1,000,000) random.nat) - sample random.nat] - (_.cover [/.frac] - (and (|> expected /.frac f.nat (/.= expected)) - (f.number? (/.frac sample))))) + (all _.and + (do random.monad + [sample random.nat] + (all _.and + (_.cover [/.-] + (and (/.= 0 (/.- sample sample)) + (/.= sample (/.- 0 sample)))) + (_.cover [/./] + (and (/.= 1 (/./ sample sample)) + (/.= sample (/./ 1 sample)))) + )) + (do random.monad + [left random.nat + right random.nat] + (all _.and + (_.cover [/.>] + (bit#= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit#= (/.<= left right) + (/.>= right left))) + )) + (do random.monad + [left (random.only (|>> (/.= 0) not) + random.nat) + right random.nat] + (all _.and + (_.cover [/.%] + (let [rem (/.% left right) + div (|> right (/.- rem) (/./ left))] + (/.= right + (|> div (/.* left) (/.+ rem))))) + (_.cover [/./%] + (let [[div rem] (/./% left right)] + (and (/.= div (/./ left right)) + (/.= rem (/.% left right))))) + )) + (do [! random.monad] + [.let [random (# ! each (|>> (/.% 1,000) ++) random.nat)] + left random + right random] + (all _.and + (_.cover [/.gcd] + (let [gcd (/.gcd left right)] + (and (/.= 0 (/.% gcd left)) + (/.= 0 (/.% gcd right))))) + (_.cover [/.co_prime?] + (bit#= (/.= 1 (/.gcd left right)) + (/.co_prime? left right))) + (_.cover [/.lcm] + (let [lcm (/.lcm left right)] + (and (/.= 0 (/.% left lcm)) + (/.= 0 (/.% right lcm))))) + )) + (do [! random.monad] + [expected (# ! each (/.% 1,000,000) random.nat) + sample random.nat] + (_.cover [/.frac] + (and (|> expected /.frac f.nat (/.= expected)) + (f.number? (/.frac sample))))) - ..predicate - ..signature - ))) + ..predicate + ..signature + ))) diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index d9c1c1ba8..a5af79e0b 100644 --- a/stdlib/source/test/lux/math/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -38,90 +38,90 @@ Test (<| (_.covering /._) (_.for [/.Ratio]) - (`` ($_ _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.order /.<] - ($order.spec /.order ..random)) - (~~ (template [<composite> <monoid>] - [(_.for [<monoid> <composite>] - ($monoid.spec /.equivalence <monoid> ..random))] + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order /.<] + ($order.spec /.order ..random)) + (~~ (template [<composite> <monoid>] + [(_.for [<monoid> <composite>] + ($monoid.spec /.equivalence <monoid> ..random))] - [/.+ /.addition] - [/.* /.multiplication] - )) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + [/.+ /.addition] + [/.* /.multiplication] + )) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [.let [(open "#[0]") /.equivalence] - denom/0 ..part - denom/1 ..part] - (_.cover [/.ratio] - (#= (/.ratio 0 denom/0) - (/.ratio 0 denom/1)))) - (do random.monad - [numerator ..part - denominator (random.only (|>> (n#= 1) not) - ..part)] - (_.cover [/.nat] - (let [only_numerator! - (|> (/.ratio numerator) - /.nat - (maybe#each (n#= numerator)) - (maybe.else false)) + (do random.monad + [.let [(open "#[0]") /.equivalence] + denom/0 ..part + denom/1 ..part] + (_.cover [/.ratio] + (#= (/.ratio 0 denom/0) + (/.ratio 0 denom/1)))) + (do random.monad + [numerator ..part + denominator (random.only (|>> (n#= 1) not) + ..part)] + (_.cover [/.nat] + (let [only_numerator! + (|> (/.ratio numerator) + /.nat + (maybe#each (n#= numerator)) + (maybe.else false)) - denominator_1! - (|> (/.ratio numerator 1) - /.nat - (maybe#each (n#= numerator)) - (maybe.else false)) - - with_denominator! - (case (/.nat (/.ratio numerator denominator)) - {.#Some factor} - (and (n.= 0 (n.% denominator numerator)) - (n.= numerator (n.* factor denominator))) - - {.#None} - (not (n.= 0 (n.% denominator numerator))))] - (and only_numerator! denominator_1! - with_denominator!)))) - (do random.monad - [sample ..random] - ($_ _.and - (_.cover [/.-] - (and (/.= (/.ratio 0) (/.- sample sample)) - (/.= sample (/.- (/.ratio 0) sample)))) - (_.cover [/./] - (and (/.= (/.ratio 1) (/./ sample sample)) - (/.= sample (/./ (/.ratio 1) sample)))) - (_.cover [/.reciprocal] - (/.= (/.ratio 1) - (/.* sample (/.reciprocal sample)))) - )) - (do random.monad - [left (random.only (|>> (/.= (/.ratio 0)) not) - ..random) - right ..random] - (_.cover [/.%] - (let [rem (/.% left right) - div (|> right (/.- rem) (/./ left))] - (and (/.= right - (|> div (/.* left) (/.+ rem))) - (case (/.nat div) - {.#Some _} true - {.#None} false))))) - (do random.monad - [left ..random - right ..random] - ($_ _.and - (_.cover [/.>] - (bit#= (/.> left right) - (/.< right left))) - (_.cover [/.<= /.>=] - (bit#= (/.<= left right) - (/.>= right left))) - )) - )))) + (|> (/.ratio numerator 1) + /.nat + (maybe#each (n#= numerator)) + (maybe.else false)) + + with_denominator! + (case (/.nat (/.ratio numerator denominator)) + {.#Some factor} + (and (n.= 0 (n.% denominator numerator)) + (n.= numerator (n.* factor denominator))) + + {.#None} + (not (n.= 0 (n.% denominator numerator))))] + (and only_numerator! + denominator_1! + with_denominator!)))) + (do random.monad + [sample ..random] + (all _.and + (_.cover [/.-] + (and (/.= (/.ratio 0) (/.- sample sample)) + (/.= sample (/.- (/.ratio 0) sample)))) + (_.cover [/./] + (and (/.= (/.ratio 1) (/./ sample sample)) + (/.= sample (/./ (/.ratio 1) sample)))) + (_.cover [/.reciprocal] + (/.= (/.ratio 1) + (/.* sample (/.reciprocal sample)))) + )) + (do random.monad + [left (random.only (|>> (/.= (/.ratio 0)) not) + ..random) + right ..random] + (_.cover [/.%] + (let [rem (/.% left right) + div (|> right (/.- rem) (/./ left))] + (and (/.= right + (|> div (/.* left) (/.+ rem))) + (case (/.nat div) + {.#Some _} true + {.#None} false))))) + (do random.monad + [left ..random + right ..random] + (all _.and + (_.cover [/.>] + (bit#= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit#= (/.<= left right) + (/.>= right left))) + )) + )))) diff --git a/stdlib/source/test/lux/math/number/rev.lux b/stdlib/source/test/lux/math/number/rev.lux index 88473533d..7fe3c86dd 100644 --- a/stdlib/source/test/lux/math/number/rev.lux +++ b/stdlib/source/test/lux/math/number/rev.lux @@ -1,167 +1,167 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" interval] - ["$[0]" monoid] - ["$[0]" codec]]] - [data - ["[0]" bit ("[1]#[0]" equivalence)]] - [math - ["[0]" random]]]] - [\\library - ["[0]" / - [// {"+" hex} - ["n" nat] - ["f" frac] - ["[0]" i64 ("[1]#[0]" hash)]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" interval] + ["$[0]" monoid] + ["$[0]" codec]]] + [data + ["[0]" bit ("[1]#[0]" equivalence)]] + [math + ["[0]" random]]]] + [\\library + ["[0]" / + [// {"+" hex} + ["n" nat] + ["f" frac] + ["[0]" i64 ("[1]#[0]" hash)]]]]) (def: signature Test - (`` ($_ _.and - (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence random.rev)) - (_.for [/.hash] - ($hash.spec /.hash random.rev)) - (_.for [/.order /.<] - ($order.spec /.order random.rev)) - (_.for [/.enum] - ($enum.spec /.enum random.rev)) - (_.for [/.interval] - ($interval.spec /.interval random.rev)) - (~~ (template [<composite> <monoid>] - [(_.for [<monoid> <composite>] - ($monoid.spec /.equivalence <monoid> random.rev))] + (`` (all _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence random.rev)) + (_.for [/.hash] + ($hash.spec /.hash random.rev)) + (_.for [/.order /.<] + ($order.spec /.order random.rev)) + (_.for [/.enum] + ($enum.spec /.enum random.rev)) + (_.for [/.interval] + ($interval.spec /.interval random.rev)) + (~~ (template [<composite> <monoid>] + [(_.for [<monoid> <composite>] + ($monoid.spec /.equivalence <monoid> random.rev))] - [/.+ /.addition] + [/.+ /.addition] - [/.min /.minimum] - [/.max /.maximum] - )) - (~~ (template [<codec>] - [(_.for [<codec>] - ($codec.spec /.equivalence <codec> random.rev))] + [/.min /.minimum] + [/.max /.maximum] + )) + (~~ (template [<codec>] + [(_.for [<codec>] + ($codec.spec /.equivalence <codec> random.rev))] - [/.binary] [/.octal] [/.decimal] [/.hex] - )) - ))) + [/.binary] [/.octal] [/.decimal] [/.hex] + )) + ))) (def: .public test Test (<| (_.covering /._) (_.for [.Rev]) - (`` ($_ _.and - (~~ (template [<half> <whole>] - [(_.cover [<half>] - (/.= <whole> - (/.+ <half> <half>)))] + (`` (all _.and + (~~ (template [<half> <whole>] + [(_.cover [<half>] + (/.= <whole> + (/.+ <half> <half>)))] - [/./1 (-- /./1)] - [/./2 .0] - [/./4 /./2] - [/./8 /./4] - [/./16 /./8] - [/./32 /./16] - [/./64 /./32] - [/./128 /./64] - [/./256 /./128] - [/./512 /./256] - [/./1024 /./512] - [/./2048 /./1024] - [/./4096 /./2048] - )) - (do random.monad - [sample random.rev] - (_.cover [/.-] - (and (/.= .0 (/.- sample sample)) - (/.= sample (/.- .0 sample))))) - (do [! random.monad] - [left random.rev - right random.rev] - (_.cover [/.*] - (and (/.< left (/.* left right)) - (/.< right (/.* left right))))) - (do [! random.monad] - [.let [dividend (# ! each (i64.and (hex "FFFF")) - random.rev) - divisor (# ! each (|>> (i64.and (hex "F")) - (i64.or (hex "1")) - (i64.right_rotated 8) - .rev) - random.nat)] - dividend (random.only (/.> .0) dividend) - divisor/0 divisor - divisor/1 (random.only (|>> (/.= divisor/0) not) - divisor) - scale (# ! each (|>> (n.% 10) ++) - random.nat)] - ($_ _.and - (_.cover [/./] - (bit#= (/.< divisor/0 divisor/1) - (/.> (/./ divisor/0 dividend) (/./ divisor/1 dividend)))) - (_.cover [/.%] - (# i64.equivalence = - (.i64 (n.% (.nat divisor/0) (.nat dividend))) - (.i64 (/.% divisor/0 dividend)))) - (_.cover [/.up /.down] - (let [symmetry! - (|> dividend - (/.up scale) - (/.down scale) - (/.= dividend)) + [/./1 (-- /./1)] + [/./2 .0] + [/./4 /./2] + [/./8 /./4] + [/./16 /./8] + [/./32 /./16] + [/./64 /./32] + [/./128 /./64] + [/./256 /./128] + [/./512 /./256] + [/./1024 /./512] + [/./2048 /./1024] + [/./4096 /./2048] + )) + (do random.monad + [sample random.rev] + (_.cover [/.-] + (and (/.= .0 (/.- sample sample)) + (/.= sample (/.- .0 sample))))) + (do [! random.monad] + [left random.rev + right random.rev] + (_.cover [/.*] + (and (/.< left (/.* left right)) + (/.< right (/.* left right))))) + (do [! random.monad] + [.let [dividend (# ! each (i64.and (hex "FFFF")) + random.rev) + divisor (# ! each (|>> (i64.and (hex "F")) + (i64.or (hex "1")) + (i64.right_rotated 8) + .rev) + random.nat)] + dividend (random.only (/.> .0) dividend) + divisor/0 divisor + divisor/1 (random.only (|>> (/.= divisor/0) not) + divisor) + scale (# ! each (|>> (n.% 10) ++) + random.nat)] + (all _.and + (_.cover [/./] + (bit#= (/.< divisor/0 divisor/1) + (/.> (/./ divisor/0 dividend) (/./ divisor/1 dividend)))) + (_.cover [/.%] + (# i64.equivalence = + (.i64 (n.% (.nat divisor/0) (.nat dividend))) + (.i64 (/.% divisor/0 dividend)))) + (_.cover [/.up /.down] + (let [symmetry! + (|> dividend + (/.up scale) + (/.down scale) + (/.= dividend)) - discrete_division! - (/.= (/.% (.rev scale) dividend) - (/.- (|> dividend - (/.down scale) - (/.up scale)) - dividend))] - (and symmetry! - discrete_division!))) - (_.cover [/.ratio] - (|> dividend - (/.up scale) - (/.ratio dividend) - (n.= scale))) - )) - (do [! random.monad] - [dividend random.rev - divisor (random.only (|>> (/.= .0) not) - random.rev)] - (_.cover [/./%] - (let [[quotient remainder] (/./% divisor dividend)] - (and (/.= (/./ divisor dividend) quotient) - (/.= (/.% divisor dividend) remainder))))) - (do random.monad - [left random.rev - right random.rev] - ($_ _.and - (_.cover [/.>] - (bit#= (/.> left right) - (/.< right left))) - (_.cover [/.<= /.>=] - (bit#= (/.<= left right) - (/.>= right left))) - )) - (do random.monad - [sample random.nat] - (_.cover [/.reciprocal] - (/.= (/.reciprocal sample) - (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) - (do [! random.monad] - [expected (# ! each (|>> f.abs (f.% +1.0)) - random.safe_frac) - sample random.rev] - (_.cover [/.frac] - (and (|> expected f.rev /.frac (f.= expected)) - (f.number? (/.frac sample))))) + discrete_division! + (/.= (/.% (.rev scale) dividend) + (/.- (|> dividend + (/.down scale) + (/.up scale)) + dividend))] + (and symmetry! + discrete_division!))) + (_.cover [/.ratio] + (|> dividend + (/.up scale) + (/.ratio dividend) + (n.= scale))) + )) + (do [! random.monad] + [dividend random.rev + divisor (random.only (|>> (/.= .0) not) + random.rev)] + (_.cover [/./%] + (let [[quotient remainder] (/./% divisor dividend)] + (and (/.= (/./ divisor dividend) quotient) + (/.= (/.% divisor dividend) remainder))))) + (do random.monad + [left random.rev + right random.rev] + (all _.and + (_.cover [/.>] + (bit#= (/.> left right) + (/.< right left))) + (_.cover [/.<= /.>=] + (bit#= (/.<= left right) + (/.>= right left))) + )) + (do random.monad + [sample random.nat] + (_.cover [/.reciprocal] + (/.= (/.reciprocal sample) + (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) + (do [! random.monad] + [expected (# ! each (|>> f.abs (f.% +1.0)) + random.safe_frac) + sample random.rev] + (_.cover [/.frac] + (and (|> expected f.rev /.frac (f.= expected)) + (f.number? (/.frac sample))))) - ..signature - )))) + ..signature + )))) diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index b01cdd67a..3f69f4e5f 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -75,34 +75,34 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []]]] - ($_ _.and - (_.cover [/.result] - (|> (# /.monad in expected) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual} - (n.= expected actual))))) - (_.cover [/.result'] - (|> (# /.monad in expected) - (/.result' expected_lux) - (!expect (^.multi {try.#Success [actual_lux actual]} - (and (same? expected_lux actual_lux) - (n.= expected actual)))))) - (_.cover [/.compiler_state] - (|> /.compiler_state - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_lux} - (same? expected_lux actual_lux))))) - (_.cover [/.version] - (|> /.version - (/.result expected_lux) - (!expect (^.multi {try.#Success it} - (same? version it))))) - (_.cover [/.configuration] - (|> /.configuration - (/.result expected_lux) - (!expect (^.multi {try.#Success it} - (same? configuration it))))) - ))) + (all _.and + (_.cover [/.result] + (|> (# /.monad in expected) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual))))) + (_.cover [/.result'] + (|> (# /.monad in expected) + (/.result' expected_lux) + (!expect (^.multi {try.#Success [actual_lux actual]} + (and (same? expected_lux actual_lux) + (n.= expected actual)))))) + (_.cover [/.compiler_state] + (|> /.compiler_state + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_lux} + (same? expected_lux actual_lux))))) + (_.cover [/.version] + (|> /.version + (/.result expected_lux) + (!expect (^.multi {try.#Success it} + (same? version it))))) + (_.cover [/.configuration] + (|> /.configuration + (/.result expected_lux) + (!expect (^.multi {try.#Success it} + (same? configuration it))))) + ))) (def: error_handling Test @@ -134,61 +134,61 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []]]] - ($_ _.and - (_.cover [/.failure] - (|> (/.failure expected_error) - (is (Meta Any)) - (/.result expected_lux) - (!expect (^.multi {try.#Failure actual_error} - (text#= (location.with location.dummy expected_error) - actual_error))))) - (_.cover [/.assertion] - (and (|> (/.assertion expected_error true) - (is (Meta Any)) - (/.result expected_lux) - (!expect {try.#Success []})) - (|> (/.assertion expected_error false) - (/.result expected_lux) - (!expect (^.multi {try.#Failure actual_error} - (text#= expected_error actual_error)))))) - (_.cover [/.either] - (and (|> (/.either (# /.monad in expected) - (is (Meta Nat) - (/.failure expected_error))) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))) - (|> (/.either (is (Meta Nat) - (/.failure expected_error)) - (# /.monad in expected)) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))) - (|> (/.either (is (Meta Nat) - (/.failure expected_error)) - (is (Meta Nat) - (/.failure expected_error))) - (/.result expected_lux) - (!expect (^.multi {try.#Failure actual_error} - (text#= (location.with location.dummy expected_error) - actual_error)))) - (|> (/.either (# /.monad in expected) - (# /.monad in dummy)) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual} - (n.= expected actual)))) - )) - (_.cover [/.try] - (and (|> (/.try (/.failure expected_error)) - (/.result expected_lux) - (!expect (^.multi {try.#Success {try.#Failure actual_error}} - (text#= (location.with location.dummy expected_error) - actual_error)))) - (|> (/.try (# /.monad in expected)) - (/.result expected_lux) - (!expect (^.multi {try.#Success {try.#Success actual}} - (same? expected actual)))))) - ))) + (all _.and + (_.cover [/.failure] + (|> (/.failure expected_error) + (is (Meta Any)) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= (location.with location.dummy expected_error) + actual_error))))) + (_.cover [/.assertion] + (and (|> (/.assertion expected_error true) + (is (Meta Any)) + (/.result expected_lux) + (!expect {try.#Success []})) + (|> (/.assertion expected_error false) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= expected_error actual_error)))))) + (_.cover [/.either] + (and (|> (/.either (# /.monad in expected) + (is (Meta Nat) + (/.failure expected_error))) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (/.either (is (Meta Nat) + (/.failure expected_error)) + (# /.monad in expected)) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + (|> (/.either (is (Meta Nat) + (/.failure expected_error)) + (is (Meta Nat) + (/.failure expected_error))) + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual_error} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.either (# /.monad in expected) + (# /.monad in dummy)) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (n.= expected actual)))) + )) + (_.cover [/.try] + (and (|> (/.try (/.failure expected_error)) + (/.result expected_lux) + (!expect (^.multi {try.#Success {try.#Failure actual_error}} + (text#= (location.with location.dummy expected_error) + actual_error)))) + (|> (/.try (# /.monad in expected)) + (/.result expected_lux) + (!expect (^.multi {try.#Success {try.#Success actual}} + (same? expected actual)))))) + ))) (def: module_related Test @@ -241,72 +241,72 @@ .#eval (as (-> Type Code (Meta Any)) []) .#host []]]] (<| (_.for [.Module]) - ($_ _.and - (_.cover [/.current_module_name] - (|> /.current_module_name - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_current_module} - (text#= expected_current_module actual_current_module))))) - (_.cover [/.current_module] - (|> /.current_module - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_module} - (same? expected_module actual_module))))) - (_.cover [/.module] - (|> (/.module expected_current_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_module} - (same? expected_module actual_module))))) - (_.cover [/.module_exists?] - (and (|> (/.module_exists? expected_current_module) - (/.result expected_lux) - (!expect {try.#Success #1})) - (|> (/.module_exists? dummy_module) - (/.result expected_lux) - (!expect {try.#Success #0})))) - (_.cover [/.modules] - (|> /.modules - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_modules} - (same? expected_modules actual_modules))))) - (_.cover [/.imported_modules] - (and (|> (/.imported_modules expected_current_module) - (/.result expected_lux) - (try#each (# (list.equivalence text.equivalence) = - (list imported_module_name))) - (try.else false)) - (|> (/.imported_modules imported_module_name) - (/.result expected_lux) - (try#each (# (list.equivalence text.equivalence) = - (list))) - (try.else false)))) - (_.cover [/.imported_by?] - (|> (/.imported_by? imported_module_name expected_current_module) - (/.result expected_lux) - (try.else false))) - (_.cover [/.imported?] - (|> (/.imported? imported_module_name) - (/.result expected_lux) - (try.else false))) - (_.cover [/.normal] - (and (|> (/.normal ["" expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success [actual_module actual_short]} - (and (text#= expected_current_module actual_module) - (same? expected_short actual_short))))) - (|> (/.normal [dummy_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success [actual_module actual_short]} - (and (text#= dummy_module actual_module) - (same? expected_short actual_short))))))) - )))) + (all _.and + (_.cover [/.current_module_name] + (|> /.current_module_name + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_current_module} + (text#= expected_current_module actual_current_module))))) + (_.cover [/.current_module] + (|> /.current_module + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_module} + (same? expected_module actual_module))))) + (_.cover [/.module] + (|> (/.module expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_module} + (same? expected_module actual_module))))) + (_.cover [/.module_exists?] + (and (|> (/.module_exists? expected_current_module) + (/.result expected_lux) + (!expect {try.#Success #1})) + (|> (/.module_exists? dummy_module) + (/.result expected_lux) + (!expect {try.#Success #0})))) + (_.cover [/.modules] + (|> /.modules + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_modules} + (same? expected_modules actual_modules))))) + (_.cover [/.imported_modules] + (and (|> (/.imported_modules expected_current_module) + (/.result expected_lux) + (try#each (# (list.equivalence text.equivalence) = + (list imported_module_name))) + (try.else false)) + (|> (/.imported_modules imported_module_name) + (/.result expected_lux) + (try#each (# (list.equivalence text.equivalence) = + (list))) + (try.else false)))) + (_.cover [/.imported_by?] + (|> (/.imported_by? imported_module_name expected_current_module) + (/.result expected_lux) + (try.else false))) + (_.cover [/.imported?] + (|> (/.imported? imported_module_name) + (/.result expected_lux) + (try.else false))) + (_.cover [/.normal] + (and (|> (/.normal ["" expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_module actual_short]} + (and (text#= expected_current_module actual_module) + (same? expected_short actual_short))))) + (|> (/.normal [dummy_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_module actual_short]} + (and (text#= dummy_module actual_module) + (same? expected_short actual_short))))))) + )))) (def: random_location (Random Location) - ($_ random.and - (random.ascii/upper 1) - random.nat - random.nat)) + (all random.and + (random.ascii/upper 1) + random.nat + random.nat)) (def: context_related (do [! random.monad] @@ -340,37 +340,37 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []]]] - ($_ _.and - (_.cover [/.target] - (|> /.target - (/.result expected_lux) - (try#each (same? target)) - (try.else false))) - (_.cover [/.seed] - (|> (do /.monad - [pre /.seed - post /.seed] - (in [pre post])) - (/.result expected_lux) - (!expect (^.multi {try.#Success [actual_pre actual_post]} - (and (n.= expected_seed actual_pre) - (n.= (++ expected_seed) actual_post)))))) - (_.cover [/.location] - (|> /.location - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_location} - (same? expected_location actual_location))))) - (_.cover [/.expected_type] - (|> /.expected_type - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_type} - (same? expected_type actual_type))))) - (_.cover [.Type_Context /.type_context] - (|> /.type_context - (/.result expected_lux) - (try#each (same? type_context)) - (try.else false))) - ))) + (all _.and + (_.cover [/.target] + (|> /.target + (/.result expected_lux) + (try#each (same? target)) + (try.else false))) + (_.cover [/.seed] + (|> (do /.monad + [pre /.seed + post /.seed] + (in [pre post])) + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_pre actual_post]} + (and (n.= expected_seed actual_pre) + (n.= (++ expected_seed) actual_post)))))) + (_.cover [/.location] + (|> /.location + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_location} + (same? expected_location actual_location))))) + (_.cover [/.expected_type] + (|> /.expected_type + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_type} + (same? expected_type actual_type))))) + (_.cover [.Type_Context /.type_context] + (|> /.type_context + (/.result expected_lux) + (try#each (same? type_context)) + (try.else false))) + ))) (def: definition_related Test @@ -432,60 +432,60 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []]])))]] - ($_ _.and - (_.cover [.Global .Alias /.globals] - (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some .Macro}) - - current_globals! - (|> (/.globals expected_current_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_globals} - (same? current_globals actual_globals)))) + (all _.and + (_.cover [.Global .Alias /.globals] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro}) - macro_globals! - (|> (/.globals expected_macro_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_globals} - (same? macro_globals actual_globals))))] - (and current_globals! - macro_globals!))) - (_.cover [.Definition /.definitions] - (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some .Macro})] - (and (|> (/.definitions expected_current_module) + current_globals! + (|> (/.globals expected_current_module) (/.result expected_lux) - (!expect (^.multi {try.#Success actual_definitions} - (n.= 0 (list.size actual_definitions))))) - (|> (/.definitions expected_macro_module) + (!expect (^.multi {try.#Success actual_globals} + (same? current_globals actual_globals)))) + + macro_globals! + (|> (/.globals expected_macro_module) (/.result expected_lux) - (!expect (^.multi {try.#Success actual_definitions} - (n.= 1 (list.size actual_definitions))))) - ))) - (_.cover [/.exports] - (and (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some .Macro})] - (and (|> (/.exports expected_current_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_definitions} - (n.= 0 (list.size actual_definitions))))) - (|> (/.exports expected_macro_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_definitions} - (n.= 1 (list.size actual_definitions))))) - )) - (let [[current_globals macro_globals expected_lux] - (expected_lux false {.#Some .Macro})] - (and (|> (/.exports expected_current_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_definitions} - (n.= 0 (list.size actual_definitions))))) - (|> (/.exports expected_macro_module) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_definitions} - (n.= 0 (list.size actual_definitions))))) - )))) - ))) + (!expect (^.multi {try.#Success actual_globals} + (same? macro_globals actual_globals))))] + (and current_globals! + macro_globals!))) + (_.cover [.Definition /.definitions] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.definitions expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.definitions expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 1 (list.size actual_definitions))))) + ))) + (_.cover [/.exports] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.exports expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 1 (list.size actual_definitions))))) + )) + (let [[current_globals macro_globals expected_lux] + (expected_lux false {.#Some .Macro})] + (and (|> (/.exports expected_current_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_definitions} + (n.= 0 (list.size actual_definitions))))) + )))) + ))) (def: search_related Test @@ -548,118 +548,118 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []]])))]] - ($_ _.and - (_.cover [/.export] - (and (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some expected_type})] - (|> (/.export [expected_macro_module expected_short]) - (/.result expected_lux) - (!expect {try.#Success _}))) - (let [[current_globals macro_globals expected_lux] - (expected_lux false {.#Some expected_type})] - (|> (/.export [expected_macro_module expected_short]) - (/.result expected_lux) - (!expect {try.#Failure _}))))) - (_.cover [/.macro] - (let [same_module! - (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some .Macro})] - (|> (/.macro [expected_macro_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success {.#Some actual_value}} - (same? expected_value actual_value))))) - - not_macro! - (let [[current_globals macro_globals expected_lux] + (all _.and + (_.cover [/.export] + (and (let [[current_globals macro_globals expected_lux] (expected_lux true {.#Some expected_type})] - (|> (/.macro [expected_macro_module expected_short]) + (|> (/.export [expected_macro_module expected_short]) (/.result expected_lux) - (!expect {try.#Success {.#None}}))) - - not_found! + (!expect {try.#Success _}))) (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#None})] - (|> (/.macro [expected_macro_module expected_short]) + (expected_lux false {.#Some expected_type})] + (|> (/.export [expected_macro_module expected_short]) (/.result expected_lux) - (!expect {try.#Success {.#None}}))) + (!expect {try.#Failure _}))))) + (_.cover [/.macro] + (let [same_module! + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (|> (/.macro [expected_macro_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success {.#Some actual_value}} + (same? expected_value actual_value))))) - aliasing! - (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some .Macro})] - (|> (/.macro [expected_current_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success {.#Some actual_value}} - (same? expected_value actual_value)))))] - (and same_module! not_macro! + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some expected_type})] + (|> (/.macro [expected_macro_module expected_short]) + (/.result expected_lux) + (!expect {try.#Success {.#None}}))) + not_found! - aliasing!))) - (_.cover [/.de_aliased] - (let [[current_globals macro_globals expected_lux] - (expected_lux true {.#Some .Macro})] - (and (|> (/.de_aliased [expected_macro_module expected_short]) - (/.result expected_lux) - (try#each (symbol#= [expected_macro_module expected_short])) - (try.else false)) - (|> (/.de_aliased [expected_current_module expected_short]) + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#None})] + (|> (/.macro [expected_macro_module expected_short]) + (/.result expected_lux) + (!expect {try.#Success {.#None}}))) + + aliasing! + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (|> (/.macro [expected_current_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success {.#Some actual_value}} + (same? expected_value actual_value)))))] + (and same_module! + not_macro! + not_found! + aliasing!))) + (_.cover [/.de_aliased] + (let [[current_globals macro_globals expected_lux] + (expected_lux true {.#Some .Macro})] + (and (|> (/.de_aliased [expected_macro_module expected_short]) + (/.result expected_lux) + (try#each (symbol#= [expected_macro_module expected_short])) + (try.else false)) + (|> (/.de_aliased [expected_current_module expected_short]) + (/.result expected_lux) + (try#each (symbol#= [expected_macro_module expected_short])) + (try.else false))))) + (_.cover [/.definition] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? {.#Some expected_type}) + + definition! + (|> (/.definition [expected_macro_module expected_short]) (/.result expected_lux) - (try#each (symbol#= [expected_macro_module expected_short])) - (try.else false))))) - (_.cover [/.definition] - (let [[current_globals macro_globals expected_lux] - (expected_lux expected_exported? {.#Some expected_type}) - - definition! - (|> (/.definition [expected_macro_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success {.#Definition [actual_exported? actual_type actual_value]}} - (and (bit#= expected_exported? actual_exported?) - (same? expected_type actual_type) - (same? (as Any expected_value) actual_value))))) + (!expect (^.multi {try.#Success {.#Definition [actual_exported? actual_type actual_value]}} + (and (bit#= expected_exported? actual_exported?) + (same? expected_type actual_type) + (same? (as Any expected_value) actual_value))))) - alias! - (|> (/.definition [expected_current_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success {.#Alias [actual_module actual_short]}} - (and (same? expected_macro_module actual_module) - (same? expected_short actual_short)))))] - (and definition! - alias!))) - (_.cover [/.definition_type] - (let [[current_globals macro_globals expected_lux] - (expected_lux expected_exported? {.#Some expected_type}) - - definition! - (|> (/.definition_type [expected_macro_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_type} - (same? expected_type actual_type)))) + alias! + (|> (/.definition [expected_current_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success {.#Alias [actual_module actual_short]}} + (and (same? expected_macro_module actual_module) + (same? expected_short actual_short)))))] + (and definition! + alias!))) + (_.cover [/.definition_type] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? {.#Some expected_type}) + + definition! + (|> (/.definition_type [expected_macro_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_type} + (same? expected_type actual_type)))) - alias! - (|> (/.definition_type [expected_current_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_type} - (same? expected_type actual_type))))] - (and definition! - alias!))) - (_.cover [/.type_definition] - (let [[current_globals macro_globals expected_lux] - (expected_lux expected_exported? {.#Some .Type}) - - definition! - (|> (/.type_definition [expected_macro_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_value} - (same? (as .Type expected_value) actual_value)))) + alias! + (|> (/.definition_type [expected_current_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_type} + (same? expected_type actual_type))))] + (and definition! + alias!))) + (_.cover [/.type_definition] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? {.#Some .Type}) + + definition! + (|> (/.type_definition [expected_macro_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_value} + (same? (as .Type expected_value) actual_value)))) - alias! - (|> (/.type_definition [expected_current_module expected_short]) - (/.result expected_lux) - (!expect (^.multi {try.#Success actual_value} - (same? (as .Type expected_value) actual_value))))] - (and definition! - alias!))) - ))) + alias! + (|> (/.type_definition [expected_current_module expected_short]) + (/.result expected_lux) + (!expect (^.multi {try.#Success actual_value} + (same? (as .Type expected_value) actual_value))))] + (and definition! + alias!))) + ))) (def: label_related Test @@ -711,15 +711,15 @@ .#module_aliases (list) .#definitions (partial_list [name_0 {.#Type [true type_0 {.#Left tags_0}]}] [name_1 {.#Type [true type_1 {.#Right tags_1}]}] - ($_ list#composite - (|> {.#Item tags_0} - list.enumeration - (list#each (function (_ [index short]) - [short {.#Tag [true type_0 {.#Item tags_0} index]}]))) - (|> {.#Item tags_1} - list.enumeration - (list#each (function (_ [index short]) - [short {.#Slot [true type_1 {.#Item tags_1} index]}]))))) + (all list#composite + (|> {.#Item tags_0} + list.enumeration + (list#each (function (_ [index short]) + [short {.#Tag [true type_0 {.#Item tags_0} index]}]))) + (|> {.#Item tags_1} + list.enumeration + (list#each (function (_ [index short]) + [short {.#Slot [true type_1 {.#Item tags_1} index]}]))))) .#imports (list) .#module_state {.#Active}]]) .#scopes (list) @@ -732,73 +732,73 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []])]] - ($_ _.and - (_.cover [/.tag_lists] - (let [equivalence (list.equivalence - (product.equivalence - (list.equivalence symbol.equivalence) - type.equivalence))] - (|> (/.tag_lists label_module) - (/.result expected_lux) - (try#each (# equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0}) - type_0] - [(list#each (|>> [label_module]) {.#Item tags_1}) - type_1]))) - (try.else false)))) - (_.cover [/.tags_of] - (|> (/.tags_of [label_module name_1]) - (/.result expected_lux) - (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})})) - (try.else false))) - (_.cover [/.tag] - (|> {.#Item tags_0} - list.enumeration - (list.every? (function (_ [expected_index label]) - (|> [label_module label] - /.tag - (/.result expected_lux) - (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} - (let [correct_index! - (n.= expected_index - actual_index) - - correct_tags! - (# (list.equivalence symbol.equivalence) = - (list#each (|>> [label_module]) {.#Item tags_0}) - actual_tags) - - correct_type! - (type#= type_0 - actual_type)] - (and correct_index! + (all _.and + (_.cover [/.tag_lists] + (let [equivalence (list.equivalence + (product.equivalence + (list.equivalence symbol.equivalence) + type.equivalence))] + (|> (/.tag_lists label_module) + (/.result expected_lux) + (try#each (# equivalence = (list [(list#each (|>> [label_module]) {.#Item tags_0}) + type_0] + [(list#each (|>> [label_module]) {.#Item tags_1}) + type_1]))) + (try.else false)))) + (_.cover [/.tags_of] + (|> (/.tags_of [label_module name_1]) + (/.result expected_lux) + (try#each (# (maybe.equivalence (list.equivalence symbol.equivalence)) = {.#Some (list#each (|>> [label_module]) {.#Item tags_1})})) + (try.else false))) + (_.cover [/.tag] + (|> {.#Item tags_0} + list.enumeration + (list.every? (function (_ [expected_index label]) + (|> [label_module label] + /.tag + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} + (let [correct_index! + (n.= expected_index + actual_index) + correct_tags! - correct_type!)))) - ))))) - (_.cover [/.slot] - (|> {.#Item tags_1} - list.enumeration - (list.every? (function (_ [expected_index label]) - (|> [label_module label] - /.slot - (/.result expected_lux) - (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} - (let [correct_index! - (n.= expected_index - actual_index) - - correct_tags! - (# (list.equivalence symbol.equivalence) = - (list#each (|>> [label_module]) {.#Item tags_1}) - actual_tags) - - correct_type! - (type#= type_1 - actual_type)] - (and correct_index! + (# (list.equivalence symbol.equivalence) = + (list#each (|>> [label_module]) {.#Item tags_0}) + actual_tags) + + correct_type! + (type#= type_0 + actual_type)] + (and correct_index! + correct_tags! + correct_type!)))) + ))))) + (_.cover [/.slot] + (|> {.#Item tags_1} + list.enumeration + (list.every? (function (_ [expected_index label]) + (|> [label_module label] + /.slot + (/.result expected_lux) + (!expect (^.multi {try.#Success [actual_index actual_tags actual_type]} + (let [correct_index! + (n.= expected_index + actual_index) + correct_tags! - correct_type!)))) - ))))) - ))) + (# (list.equivalence symbol.equivalence) = + (list#each (|>> [label_module]) {.#Item tags_1}) + actual_tags) + + correct_type! + (type#= type_1 + actual_type)] + (and correct_index! + correct_tags! + correct_type!)))) + ))))) + ))) (def: locals_related Test @@ -868,63 +868,63 @@ .#extensions [] .#eval (as (-> Type Code (Meta Any)) []) .#host []])]] - ($_ _.and - (_.cover [.Scope /.locals] - (let [equivalence (is (Equivalence (List (List [Text Type]))) - (list.equivalence + (all _.and + (_.cover [.Scope /.locals] + (let [equivalence (is (Equivalence (List (List [Text Type]))) (list.equivalence - (product.equivalence - text.equivalence - type.equivalence))))] - (|> /.locals - (/.result expected_lux) - (try#each (# equivalence = (list (list [name_3 type_3]) - (list [name_1 type_1] - [name_2 type_2])))) - (try.else false)))) - (_.cover [/.var_type] - (and (|> (/.var_type name_0) - (/.result expected_lux) - (try#each (# type.equivalence = type_0)) - (try.else false)) - (|> (/.var_type name_1) - (/.result expected_lux) - (try#each (# type.equivalence = type_1)) - (try.else false)) - (|> (/.var_type name_2) - (/.result expected_lux) - (try#each (# type.equivalence = type_2)) - (try.else false)) - (|> (/.var_type name_3) - (/.result expected_lux) - (try#each (# type.equivalence = type_3)) - (try.else false)))) - (_.cover [/.type] - (and (|> (/.type ["" name_0]) - (/.result expected_lux) - (try#each (# type.equivalence = type_0)) - (try.else false)) - (|> (/.type ["" name_1]) - (/.result expected_lux) - (try#each (# type.equivalence = type_1)) - (try.else false)) - (|> (/.type ["" name_2]) - (/.result expected_lux) - (try#each (# type.equivalence = type_2)) - (try.else false)) - (|> (/.type ["" name_3]) - (/.result expected_lux) - (try#each (# type.equivalence = type_3)) - (try.else false)) - (|> (/.type [current_module name_4]) - (/.result expected_lux) - (try#each (# type.equivalence = type_4)) - (try.else false)) - (|> (/.type ["" name_4]) - (/.result expected_lux) - (try#each (# type.equivalence = type_4)) - (try.else false)))) - ))) + (list.equivalence + (product.equivalence + text.equivalence + type.equivalence))))] + (|> /.locals + (/.result expected_lux) + (try#each (# equivalence = (list (list [name_3 type_3]) + (list [name_1 type_1] + [name_2 type_2])))) + (try.else false)))) + (_.cover [/.var_type] + (and (|> (/.var_type name_0) + (/.result expected_lux) + (try#each (# type.equivalence = type_0)) + (try.else false)) + (|> (/.var_type name_1) + (/.result expected_lux) + (try#each (# type.equivalence = type_1)) + (try.else false)) + (|> (/.var_type name_2) + (/.result expected_lux) + (try#each (# type.equivalence = type_2)) + (try.else false)) + (|> (/.var_type name_3) + (/.result expected_lux) + (try#each (# type.equivalence = type_3)) + (try.else false)))) + (_.cover [/.type] + (and (|> (/.type ["" name_0]) + (/.result expected_lux) + (try#each (# type.equivalence = type_0)) + (try.else false)) + (|> (/.type ["" name_1]) + (/.result expected_lux) + (try#each (# type.equivalence = type_1)) + (try.else false)) + (|> (/.type ["" name_2]) + (/.result expected_lux) + (try#each (# type.equivalence = type_2)) + (try.else false)) + (|> (/.type ["" name_3]) + (/.result expected_lux) + (try#each (# type.equivalence = type_3)) + (try.else false)) + (|> (/.type [current_module name_4]) + (/.result expected_lux) + (try#each (# type.equivalence = type_4)) + (try.else false)) + (|> (/.type ["" name_4]) + (/.result expected_lux) + (try#each (# type.equivalence = type_4)) + (try.else false)))) + ))) (def: injection (Injection Meta) @@ -945,78 +945,78 @@ Test (<| (_.covering /._) (_.for [.Meta .Lux]) - ($_ _.and - (do [! random.monad] - [target (random.ascii/upper 1) - version (random.ascii/upper 1) - source_code (random.ascii/upper 1) - expected_current_module (random.ascii/upper 1) - expected_type (# ! each (function (_ name) - {.#Primitive name (list)}) - (random.ascii/upper 1)) - expected_seed random.nat - expected random.nat - dummy (random.only (|>> (n.= expected) not) random.nat) - expected_location ..random_location - .let [expected_lux [.#info [.#target target - .#version version - .#mode {.#Build} - .#configuration (list)] - .#source [expected_location 0 source_code] - .#location expected_location - .#current_module {.#Some expected_current_module} - .#modules (list) - .#scopes (list) - .#type_context [.#ex_counter 0 - .#var_counter 0 - .#var_bindings (list)] - .#expected {.#Some expected_type} - .#seed expected_seed - .#scope_type_vars (list) - .#extensions [] - .#eval (as (-> Type Code (Meta Any)) []) - .#host []]]] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection (..comparison expected_lux) /.functor)) - (_.for [/.apply] - ($apply.spec ..injection (..comparison expected_lux) /.apply)) - (_.for [/.monad] - ($monad.spec ..injection (..comparison expected_lux) /.monad)) - - (do random.monad - [expected_value random.nat - expected_error (random.ascii/upper 1)] - (_.cover [/.lifted] - (and (|> expected_error - {try.#Failure} - (is (Try Nat)) - /.lifted - (/.result expected_lux) - (!expect (^.multi {try.#Failure actual} - (text#= (location.with expected_location expected_error) - actual)))) - (|> expected_value - {try.#Success} - (is (Try Nat)) - /.lifted - (/.result expected_lux) - (!expect (^.multi {try.#Success actual} - (same? expected_value actual))))))) - - ..compiler_related - ..error_handling - ..module_related - ..context_related - ..definition_related - ..search_related - ..locals_related - (_.for [.Label] - ..label_related) - )) - - /location.test - /symbol.test - /configuration.test - /version.test - ))) + (all _.and + (do [! random.monad] + [target (random.ascii/upper 1) + version (random.ascii/upper 1) + source_code (random.ascii/upper 1) + expected_current_module (random.ascii/upper 1) + expected_type (# ! each (function (_ name) + {.#Primitive name (list)}) + (random.ascii/upper 1)) + expected_seed random.nat + expected random.nat + dummy (random.only (|>> (n.= expected) not) random.nat) + expected_location ..random_location + .let [expected_lux [.#info [.#target target + .#version version + .#mode {.#Build} + .#configuration (list)] + .#source [expected_location 0 source_code] + .#location expected_location + .#current_module {.#Some expected_current_module} + .#modules (list) + .#scopes (list) + .#type_context [.#ex_counter 0 + .#var_counter 0 + .#var_bindings (list)] + .#expected {.#Some expected_type} + .#seed expected_seed + .#scope_type_vars (list) + .#extensions [] + .#eval (as (-> Type Code (Meta Any)) []) + .#host []]]] + (all _.and + (_.for [/.functor] + ($functor.spec ..injection (..comparison expected_lux) /.functor)) + (_.for [/.apply] + ($apply.spec ..injection (..comparison expected_lux) /.apply)) + (_.for [/.monad] + ($monad.spec ..injection (..comparison expected_lux) /.monad)) + + (do random.monad + [expected_value random.nat + expected_error (random.ascii/upper 1)] + (_.cover [/.lifted] + (and (|> expected_error + {try.#Failure} + (is (Try Nat)) + /.lifted + (/.result expected_lux) + (!expect (^.multi {try.#Failure actual} + (text#= (location.with expected_location expected_error) + actual)))) + (|> expected_value + {try.#Success} + (is (Try Nat)) + /.lifted + (/.result expected_lux) + (!expect (^.multi {try.#Success actual} + (same? expected_value actual))))))) + + ..compiler_related + ..error_handling + ..module_related + ..context_related + ..definition_related + ..search_related + ..locals_related + (_.for [.Label] + ..label_related) + )) + + /location.test + /symbol.test + /configuration.test + /version.test + ))) diff --git a/stdlib/source/test/lux/meta/configuration.lux b/stdlib/source/test/lux/meta/configuration.lux index f3b4b2a5f..68fc30537 100644 --- a/stdlib/source/test/lux/meta/configuration.lux +++ b/stdlib/source/test/lux/meta/configuration.lux @@ -51,47 +51,47 @@ (_.for [/.Configuration]) (do [! random.monad] [expected (..random 5)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random 5))) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid (..random 5))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random 5))) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid (..random 5))) - (_.cover [/.empty] - (list.empty? /.empty)) - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.for] - (and (and (/.for ["left" "<<<" - "right" ">>>"] - true - ... else - false) - (/.for ["left" "<<<"] - true - ... else - false) - (/.for ["right" ">>>"] - true - ... else - false)) - (and (/.for ["yolo" ""] - false - ... else - true) - (/.for ["left" "yolo"] - false - ... else - true)))) - (_.cover [/.invalid] - (and (text.contains? (the exception.#label /.invalid) - (..failure (/.for))) - (text.contains? (the exception.#label /.invalid) - (..failure (/.for ["left" "yolo"] - ... else - false))))) - )))) + (_.cover [/.empty] + (list.empty? /.empty)) + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.for] + (and (and (/.for ["left" "<<<" + "right" ">>>"] + true + ... else + false) + (/.for ["left" "<<<"] + true + ... else + false) + (/.for ["right" ">>>"] + true + ... else + false)) + (and (/.for ["yolo" ""] + false + ... else + true) + (/.for ["left" "yolo"] + false + ... else + true)))) + (_.cover [/.invalid] + (and (text.contains? (the exception.#label /.invalid) + (..failure (/.for))) + (text.contains? (the exception.#label /.invalid) + (..failure (/.for ["left" "yolo"] + ... else + false))))) + )))) diff --git a/stdlib/source/test/lux/meta/location.lux b/stdlib/source/test/lux/meta/location.lux index 60dae3a45..6fea463bf 100644 --- a/stdlib/source/test/lux/meta/location.lux +++ b/stdlib/source/test/lux/meta/location.lux @@ -1,50 +1,50 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [data - ["[0]" text]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" /]] - ["$[0]" /// "_" - [macro - ["[1][0]" code]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [data + ["[0]" text]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" /]] + ["$[0]" /// "_" + [macro + ["[1][0]" code]]]) (def: .public random (Random Location) - ($_ random.and - (random.ascii/alpha 10) - random.nat - random.nat - )) + (all random.and + (random.ascii/alpha 10) + random.nat + random.nat + )) (def: .public test Test (<| (_.covering /._) (_.for [.Location]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (_.cover [/.here] - (not (# /.equivalence = (/.here) (/.here)))) - (do random.monad - [location ..random - error (random.ascii/alpha 10)] - (_.cover [/.format /.with] - (let [located_error (/.with location error)] - (and (text.contains? (/.format location) - located_error) - (text.contains? error - located_error))))) - (do random.monad - [[location _] $///code.random] - (_.cover [/.dummy] - (# /.equivalence = /.dummy location))) - ))) + (_.cover [/.here] + (not (# /.equivalence = (/.here) (/.here)))) + (do random.monad + [location ..random + error (random.ascii/alpha 10)] + (_.cover [/.format /.with] + (let [located_error (/.with location error)] + (and (text.contains? (/.format location) + located_error) + (text.contains? error + located_error))))) + (do random.monad + [[location _] $///code.random] + (_.cover [/.dummy] + (# /.equivalence = /.dummy location))) + ))) diff --git a/stdlib/source/test/lux/meta/symbol.lux b/stdlib/source/test/lux/meta/symbol.lux index e12f209d1..41a702d92 100644 --- a/stdlib/source/test/lux/meta/symbol.lux +++ b/stdlib/source/test/lux/meta/symbol.lux @@ -38,36 +38,36 @@ sizeS2 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) (^.let symbol2 [module2 short2]) (..random sizeM2 sizeS2)] (_.for [.Symbol] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) - (_.for [/.hash] - (|> (random.ascii 1) - (# ! each (|>> [""])) - ($hash.spec /.hash))) - (_.for [/.order] - ($order.spec /.order (..random sizeM1 sizeS1))) - (_.for [/.codec] - (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) - (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." - (if (text.empty? module1) - (same? short1 (# /.codec encoded symbol1)) - #1)))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) + (_.for [/.hash] + (|> (random.ascii 1) + (# ! each (|>> [""])) + ($hash.spec /.hash))) + (_.for [/.order] + ($order.spec /.order (..random sizeM1 sizeS1))) + (_.for [/.codec] + (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) + (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." + (if (text.empty? module1) + (same? short1 (# /.codec encoded symbol1)) + #1)))) - (_.cover [/.separator] - (let [it (# /.codec encoded symbol1)] - (if (text.empty? module1) - (same? short1 it) - (text.contains? /.separator it)))) - (_.cover [/.module /.short] - (and (same? module1 (/.module symbol1)) - (same? short1 (/.short symbol1)))) - (_.for [.symbol] - (let [(open "/#[0]") /.equivalence] - ($_ _.and - (_.test "Can obtain Symbol from a symbol." - (and (/#= [.prelude_module "yolo"] (.symbol .yolo)) - (/#= ["test/lux/meta/symbol" "yolo"] (.symbol ..yolo)) - (/#= ["" "yolo"] (.symbol yolo)) - (/#= ["library/lux/test" "yolo"] (.symbol library/lux/test.yolo))))))) - ))))) + (_.cover [/.separator] + (let [it (# /.codec encoded symbol1)] + (if (text.empty? module1) + (same? short1 it) + (text.contains? /.separator it)))) + (_.cover [/.module /.short] + (and (same? module1 (/.module symbol1)) + (same? short1 (/.short symbol1)))) + (_.for [.symbol] + (let [(open "/#[0]") /.equivalence] + (all _.and + (_.test "Can obtain Symbol from a symbol." + (and (/#= [.prelude_module "yolo"] (.symbol .yolo)) + (/#= ["test/lux/meta/symbol" "yolo"] (.symbol ..yolo)) + (/#= ["" "yolo"] (.symbol yolo)) + (/#= ["library/lux/test" "yolo"] (.symbol library/lux/test.yolo))))))) + ))))) diff --git a/stdlib/source/test/lux/meta/version.lux b/stdlib/source/test/lux/meta/version.lux index b5c2c0c97..00e1ac020 100644 --- a/stdlib/source/test/lux/meta/version.lux +++ b/stdlib/source/test/lux/meta/version.lux @@ -37,19 +37,19 @@ (<| (_.covering /._) (with_expansions [<current> (/.current) <fake> (static.random code.text (random.ascii/lower 1))]) - ($_ _.and - (_.cover [/.latest] - (n.> 0 /.latest)) - (_.cover [/.current] - (not (text.empty? (/.current)))) - (_.cover [/.for] - (and (/.for <current> true - false) - (/.for <fake> false - true))) - (_.cover [/.invalid] - (and (text.contains? (the exception.#label /.invalid) - (..failure (/.for))) - (text.contains? (the exception.#label /.invalid) - (..failure (/.for <fake> false))))) - ))) + (all _.and + (_.cover [/.latest] + (n.> 0 /.latest)) + (_.cover [/.current] + (not (text.empty? (/.current)))) + (_.cover [/.for] + (and (/.for <current> true + false) + (/.for <fake> false + true))) + (_.cover [/.invalid] + (and (text.contains? (the exception.#label /.invalid) + (..failure (/.for))) + (text.contains? (the exception.#label /.invalid) + (..failure (/.for <fake> false))))) + ))) diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux index 44413d5e0..71b690527 100644 --- a/stdlib/source/test/lux/static.lux +++ b/stdlib/source/test/lux/static.lux @@ -26,69 +26,69 @@ (<| (_.covering /._) (for @.old (_.test "PLACEHOLDER" true)) (_.for [meta.eval]) - (`` ($_ _.and - (~~ (template [<static> <random> <=> <+> <tag>] - [(_.cover [<static> <random>] - (with_expansions [<left> (<random>) - <right> (<random>) - <l+r> (<static> (<+> <left> <right>))] - (case (' <l+r>) - [_ {<tag> l+r}] - (<=> l+r (<+> <left> <right>)) + (`` (all _.and + (~~ (template [<static> <random> <=> <+> <tag>] + [(_.cover [<static> <random>] + (with_expansions [<left> (<random>) + <right> (<random>) + <l+r> (<static> (<+> <left> <right>))] + (case (' <l+r>) + [_ {<tag> l+r}] + (<=> l+r (<+> <left> <right>)) - _ - false)))] + _ + false)))] - [/.nat /.random_nat n.= n.+ .#Nat] - [/.int /.random_int i.= i.+ .#Int] - [/.rev /.random_rev r.= r.+ .#Rev] - )) - (_.cover [/.frac /.random_frac] - (with_expansions [<left> (/.random_frac) - <right> (/.random_frac) - <l+r> (/.frac (f.+ <left> <right>))] - (case (' <l+r>) - [_ {.#Frac l+r}] - (or (f.= l+r (f.+ <left> <right>)) - (and (f.not_a_number? l+r) - (f.not_a_number? (f.+ <left> <right>)) - (or (f.not_a_number? <left>) - (f.not_a_number? <right>)))) + [/.nat /.random_nat n.= n.+ .#Nat] + [/.int /.random_int i.= i.+ .#Int] + [/.rev /.random_rev r.= r.+ .#Rev] + )) + (_.cover [/.frac /.random_frac] + (with_expansions [<left> (/.random_frac) + <right> (/.random_frac) + <l+r> (/.frac (f.+ <left> <right>))] + (case (' <l+r>) + [_ {.#Frac l+r}] + (or (f.= l+r (f.+ <left> <right>)) + (and (f.not_a_number? l+r) + (f.not_a_number? (f.+ <left> <right>)) + (or (f.not_a_number? <left>) + (f.not_a_number? <right>)))) - _ - false))) - (_.cover [/.text /.random] - (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1)) - <right> (/.random code.text (random.ascii/alpha_num 1)) - <l+r> (/.text (format <left> <right>))] - (case (' <l+r>) - [_ {.#Text l+r}] - (text#= l+r (format <left> <right>)) + _ + false))) + (_.cover [/.text /.random] + (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1)) + <right> (/.random code.text (random.ascii/alpha_num 1)) + <l+r> (/.text (format <left> <right>))] + (case (' <l+r>) + [_ {.#Text l+r}] + (text#= l+r (format <left> <right>)) - _ - false))) - (_.cover [/.randoms] - (with_expansions [<amount> (/.random code.nat - (random#each (|>> (n.% 10) ++) random.nat)) - l/* (/.randoms code.nat (random.list <amount> random.nat))] - (and (n.= <amount> (list.size (list l/*))) - (n.= (list#mix n.+ 0 (list l/*)) - ($_ n.+ l/*))))) - (_.cover [/.literal] - (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1)) - <right> (/.random code.text (random.ascii/alpha_num 1)) - <l+r> (/.literal code.text (format <left> <right>))] - (case (' <l+r>) - [_ {.#Text l+r}] - (text#= l+r (format <left> <right>)) + _ + false))) + (_.cover [/.randoms] + (with_expansions [<amount> (/.random code.nat + (random#each (|>> (n.% 10) ++) random.nat)) + l/* (/.randoms code.nat (random.list <amount> random.nat))] + (and (n.= <amount> (list.size (list l/*))) + (n.= (list#mix n.+ 0 (list l/*)) + (all n.+ l/*))))) + (_.cover [/.literal] + (with_expansions [<left> (/.random code.text (random.ascii/alpha_num 1)) + <right> (/.random code.text (random.ascii/alpha_num 1)) + <l+r> (/.literal code.text (format <left> <right>))] + (case (' <l+r>) + [_ {.#Text l+r}] + (text#= l+r (format <left> <right>)) - _ - false))) - (_.cover [/.literals] - (with_expansions [l/0 (/.random_nat) - l/1 (/.random_nat) - l/2 (/.random_nat) - l/* (/.literals code.nat (list l/0 l/1 l/2))] - (n.= ($_ n.+ l/0 l/1 l/2) - ($_ n.+ l/*)))) - )))) + _ + false))) + (_.cover [/.literals] + (with_expansions [l/0 (/.random_nat) + l/1 (/.random_nat) + l/2 (/.random_nat) + l/* (/.literals code.nat (list l/0 l/1 l/2))] + (n.= (all n.+ l/0 l/1 l/2) + (all n.+ l/*)))) + )))) diff --git a/stdlib/source/test/lux/target.lux b/stdlib/source/test/lux/target.lux index 351271072..1f66a4f59 100644 --- a/stdlib/source/test/lux/target.lux +++ b/stdlib/source/test/lux/target.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" all} ["_" test {"+" Test}] [data ["[0]" text] @@ -39,8 +39,8 @@ Test (<| (_.covering /._) (_.for [/.Target]) - ($_ _.and - (_.cover [<targets>] - ..verdict) - ))) + (.all _.and + (_.cover [<targets>] + ..verdict) + ))) ) diff --git a/stdlib/source/test/lux/target/js.lux b/stdlib/source/test/lux/target/js.lux index df2857108..709939bfd 100644 --- a/stdlib/source/test/lux/target/js.lux +++ b/stdlib/source/test/lux/target/js.lux @@ -73,48 +73,48 @@ number random.frac int ..int_32 string (random.ascii/upper 5)] - ($_ _.and - (_.cover [/.null] - (|> /.null - ..eval - (try#each (function (_ it) - (case it - {.#None} true - {.#Some _} false))) - (try.else false))) - (_.cover [/.boolean] - (expression (|>> (as Bit) (bit#= boolean)) - (/.boolean boolean))) - (_.cover [/.number] - (expression (|>> (as Frac) (f.= number)) - (/.number number))) - (_.cover [/.int] - (expression (|>> (as Frac) f.int (i.= int)) - (/.int int))) - (_.cover [/.string] - (expression (|>> (as Text) (text#= string)) - (/.string string))) - ))) + (all _.and + (_.cover [/.null] + (|> /.null + ..eval + (try#each (function (_ it) + (case it + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.cover [/.boolean] + (expression (|>> (as Bit) (bit#= boolean)) + (/.boolean boolean))) + (_.cover [/.number] + (expression (|>> (as Frac) (f.= number)) + (/.number number))) + (_.cover [/.int] + (expression (|>> (as Frac) f.int (i.= int)) + (/.int int))) + (_.cover [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + ))) (def: test|boolean Test (do [! random.monad] [left random.bit right random.bit] - (`` ($_ _.and - (~~ (template [<js> <lux>] - [(_.cover [<js>] - (let [expected (<lux> left right)] - (expression (|>> (as Bit) (bit#= expected)) - (<js> (/.boolean left) (/.boolean right)))))] - - [/.or .or] - [/.and .and] - )) - (_.cover [/.not] - (expression (|>> (as Bit) (bit#= (not left))) - (/.not (/.boolean left)))) - )))) + (`` (all _.and + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (<js> (/.boolean left) (/.boolean right)))))] + + [/.or .or] + [/.and .and] + )) + (_.cover [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.boolean left)))) + )))) (def: test|number Test @@ -122,32 +122,32 @@ [parameter (random.only (|>> (f.= +0.0) not) random.safe_frac) subject random.safe_frac] - (`` ($_ _.and - (~~ (template [<js> <lux>] - [(_.cover [<js>] - (let [expected (<lux> parameter subject)] - (expression (|>> (as Frac) (f.= expected)) - (<js> (/.number parameter) (/.number subject)))))] - - [/.+ f.+] - [/.- f.-] - [/.* f.*] - [/./ f./] - [/.% f.%] - )) - (~~ (template [<js> <lux>] - [(_.cover [<js>] - (let [expected (<lux> parameter subject)] - (expression (|>> (as Bit) (bit#= expected)) - (<js> (/.number parameter) (/.number subject)))))] - - [/.< f.<] - [/.<= f.<=] - [/.> f.>] - [/.>= f.>=] - [/.= f.=] - )) - )))) + (`` (all _.and + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Frac) (f.= expected)) + (<js> (/.number parameter) (/.number subject)))))] + + [/.+ f.+] + [/.- f.-] + [/.* f.*] + [/./ f./] + [/.% f.%] + )) + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (<js> (/.number parameter) (/.number subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) (def: test|i32 Test @@ -158,49 +158,49 @@ i32 ..int_32 i16 ..int_16 shift (# ! each (n.% 16) random.nat)] - (`` ($_ _.and - (~~ (template [<js> <lux>] - [(_.cover [<js>] - (let [expected (<lux> left right)] - (expression (|>> (as Frac) f.int (i.= expected)) - (<js> (/.int left) (/.int right)))))] - - [/.bit_or i64.or] - [/.bit_xor i64.xor] - [/.bit_and i64.and] - )) - (_.cover [/.opposite] - (expression (|>> (as Frac) f.int (i.= (i.* -1 i32))) - (/.opposite (/.i32 i32)))) - - (_.cover [/.i32] - (expression (|>> (as Frac) f.int (i.= i32)) - (/.i32 i32))) - (_.cover [/.to_i32] - (expression (|>> (as Frac) f.int (i.= i32)) - (/.to_i32 (/.int i32)))) - (_.cover [/.left_shift] - (let [expected (i64.left_shifted shift i16)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.left_shift (/.int (.int shift)) - (/.i32 i16))))) - (_.cover [/.logic_right_shift] - (let [expected (i64.right_shifted shift (as_int_32 i16))] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.logic_right_shift (/.int (.int shift)) - (/.i32 i16))))) - (_.cover [/.arithmetic_right_shift] - (let [expected (i.right_shifted shift i16)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.arithmetic_right_shift (/.int (.int shift)) - (/.i32 i16))))) - (_.cover [/.bit_not] - (let [expected (if (i.< +0 i32) - (as_int_32 (i64.not i32)) - (i64.not (as_int_32 i32)))] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.bit_not (/.i32 i32))))) - )))) + (`` (all _.and + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (let [expected (<lux> left right)] + (expression (|>> (as Frac) f.int (i.= expected)) + (<js> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.cover [/.opposite] + (expression (|>> (as Frac) f.int (i.= (i.* -1 i32))) + (/.opposite (/.i32 i32)))) + + (_.cover [/.i32] + (expression (|>> (as Frac) f.int (i.= i32)) + (/.i32 i32))) + (_.cover [/.to_i32] + (expression (|>> (as Frac) f.int (i.= i32)) + (/.to_i32 (/.int i32)))) + (_.cover [/.left_shift] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.left_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.cover [/.logic_right_shift] + (let [expected (i64.right_shifted shift (as_int_32 i16))] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.logic_right_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.cover [/.arithmetic_right_shift] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.arithmetic_right_shift (/.int (.int shift)) + (/.i32 i16))))) + (_.cover [/.bit_not] + (let [expected (if (i.< +0 i32) + (as_int_32 (i64.not i32)) + (i64.not (as_int_32 i32)))] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_not (/.i32 i32))))) + )))) (def: test|array Test @@ -211,16 +211,16 @@ .let [expected (|> items (list.item index) (maybe.else f.not_a_number))]] - ($_ _.and - (_.cover [/.array /.at] - (and (expression (|>> (as Frac) (f.= expected)) - (/.at (/.int (.int index)) - (/.array (list#each /.number items)))) - (expression (|>> (as Bit)) - (|> (/.array (list#each /.number items)) - (/.at (/.int (.int size))) - (/.= /.undefined))))) - ))) + (all _.and + (_.cover [/.array /.at] + (and (expression (|>> (as Frac) (f.= expected)) + (/.at (/.int (.int index)) + (/.array (list#each /.number items)))) + (expression (|>> (as Bit)) + (|> (/.array (list#each /.number items)) + (/.at (/.int (.int size))) + (/.= /.undefined))))) + ))) (def: test|object Test @@ -233,23 +233,23 @@ size (# ! each (|>> (n.% 10) ++) random.nat) index (# ! each (n.% size) random.nat) items (random.list size random.safe_frac)] - ($_ _.and - (_.cover [/.object /.the] - (expression (|>> (as Frac) (f.= expected)) - (/.the field (/.object (list [field (/.number expected)]))))) - (let [expected (|> items - (list.item index) - (maybe.else f.not_a_number))] - (_.cover [/.do] - (expression (|>> (as Frac) f.int (i.= (.int index))) - (|> (/.array (list#each /.number items)) - (/.do "lastIndexOf" (list (/.number expected))))))) - (_.cover [/.undefined] - (expression (|>> (as Bit)) - (|> (/.object (list [field (/.number expected)])) - (/.the dummy) - (/.= /.undefined)))) - ))) + (all _.and + (_.cover [/.object /.the] + (expression (|>> (as Frac) (f.= expected)) + (/.the field (/.object (list [field (/.number expected)]))))) + (let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + (_.cover [/.do] + (expression (|>> (as Frac) f.int (i.= (.int index))) + (|> (/.array (list#each /.number items)) + (/.do "lastIndexOf" (list (/.number expected))))))) + (_.cover [/.undefined] + (expression (|>> (as Bit)) + (|> (/.object (list [field (/.number expected)])) + (/.the dummy) + (/.= /.undefined)))) + ))) (def: test|computation Test @@ -263,60 +263,60 @@ string (random.ascii/upper 5) comment (random.ascii/upper 10)] - ($_ _.and - ..test|boolean - ..test|number - ..test|i32 - ..test|array - ..test|object - (_.cover [/.?] - (let [expected (if test then else)] - (expression (|>> (as Frac) (f.= expected)) - (/.? (/.boolean test) - (/.number then) - (/.number else))))) - (_.cover [/.not_a_number?] - (and (expression (|>> (as Bit)) - (/.not_a_number? (/.number f.not_a_number))) - (expression (|>> (as Bit) not) - (/.not_a_number? (/.number then))))) - (_.cover [/.type_of] - (and (expression (|>> (as Text) (text#= "boolean")) - (/.type_of (/.boolean boolean))) - (expression (|>> (as Text) (text#= "number")) - (/.type_of (/.number number))) - (expression (|>> (as Text) (text#= "string")) - (/.type_of (/.string string))) - (expression (|>> (as Text) (text#= "object")) - (/.type_of /.null)) - (expression (|>> (as Text) (text#= "object")) - (/.type_of (/.object (list [string (/.number number)])))) - (expression (|>> (as Text) (text#= "object")) - (/.type_of (/.array (list (/.boolean boolean) - (/.number number) - (/.string string))))) - (expression (|>> (as Text) (text#= "undefined")) - (/.type_of /.undefined)))) - (_.cover [/.comment] - (expression (|>> (as Frac) (f.= then)) - (/.comment comment - (/.number then)))) - ))) + (all _.and + ..test|boolean + ..test|number + ..test|i32 + ..test|array + ..test|object + (_.cover [/.?] + (let [expected (if test then else)] + (expression (|>> (as Frac) (f.= expected)) + (/.? (/.boolean test) + (/.number then) + (/.number else))))) + (_.cover [/.not_a_number?] + (and (expression (|>> (as Bit)) + (/.not_a_number? (/.number f.not_a_number))) + (expression (|>> (as Bit) not) + (/.not_a_number? (/.number then))))) + (_.cover [/.type_of] + (and (expression (|>> (as Text) (text#= "boolean")) + (/.type_of (/.boolean boolean))) + (expression (|>> (as Text) (text#= "number")) + (/.type_of (/.number number))) + (expression (|>> (as Text) (text#= "string")) + (/.type_of (/.string string))) + (expression (|>> (as Text) (text#= "object")) + (/.type_of /.null)) + (expression (|>> (as Text) (text#= "object")) + (/.type_of (/.object (list [string (/.number number)])))) + (expression (|>> (as Text) (text#= "object")) + (/.type_of (/.array (list (/.boolean boolean) + (/.number number) + (/.string string))))) + (expression (|>> (as Text) (text#= "undefined")) + (/.type_of /.undefined)))) + (_.cover [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.number then)))) + ))) (def: test|expression Test (do [! random.monad] [dummy random.safe_frac expected random.safe_frac] - (`` ($_ _.and - (_.for [/.Literal] - ..test|literal) - (_.for [/.Computation] - ..test|computation) - (_.cover [/.,] - (expression (|>> (as Frac) (f.= expected)) - (/., (/.number dummy) (/.number expected)))) - )))) + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + (_.cover [/.,] + (expression (|>> (as Frac) (f.= expected)) + (/., (/.number dummy) (/.number expected)))) + )))) (def: test/var Test @@ -329,27 +329,27 @@ (random.ascii/lower 10)) .let [$foreign (/.var foreign) $local (/.var local)]] - ($_ _.and - (_.cover [/.var] - (expression (|>> (as Frac) (f.= number/0)) - (/.apply_* (/.closure (list $foreign) (/.return $foreign)) - (list (/.number number/0))))) - (_.cover [/.define] - (expression (|>> (as Frac) (f.= number/1)) - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.define $local (/.number number/1)) - (/.return $local))) - (list (/.number number/0))))) - (_.cover [/.declare] - (expression (|>> (as Frac) (f.= number/1)) - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.declare $local) - (/.set $local (/.number number/1)) - (/.return $local))) - (list (/.number number/0))))) - ))) + (all _.and + (_.cover [/.var] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_* (/.closure (list $foreign) (/.return $foreign)) + (list (/.number number/0))))) + (_.cover [/.define] + (expression (|>> (as Frac) (f.= number/1)) + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.define $local (/.number number/1)) + (/.return $local))) + (list (/.number number/0))))) + (_.cover [/.declare] + (expression (|>> (as Frac) (f.= number/1)) + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.declare $local) + (/.set $local (/.number number/1)) + (/.return $local))) + (list (/.number number/0))))) + ))) (def: test/location Test @@ -358,89 +358,89 @@ int/0 ..int_16 $foreign (# ! each /.var (random.ascii/lower 10)) field (random.ascii/upper 10)] - ($_ _.and - (_.cover [/.set] - (and (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.+ $foreign $foreign)) - (/.return $foreign))) - (list (/.number number/0)))) - (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) - (let [@ (/.at (/.int +0) $foreign)] - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.array (list $foreign))) - (/.set @ (/.+ @ @)) - (/.return @))) - (list (/.number number/0))))) - (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) - (let [@ (/.the field $foreign)] - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.object (list [field $foreign]))) - (/.set @ (/.+ @ @)) - (/.return @))) - (list (/.number number/0))))))) - (_.cover [/.delete] - (and (and (expression (|>> (as Bit)) - (/.apply_* (/.closure (list) - ($_ /.then - (/.set $foreign (/.number number/0)) - (/.return (/.delete $foreign)))) - (list))) - (expression (|>> (as Bit) not) - (/.apply_* (/.closure (list $foreign) - (/.return (/.delete $foreign))) - (list (/.number number/0))))) - (expression (|>> (as Bit)) - (let [@ (/.at (/.int +0) $foreign)] - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.array (list $foreign))) - (/.return (|> (/.= (/.boolean true) (/.delete @)) - (/.and (/.= /.undefined @)))))) - (list (/.number number/0))))) - (expression (|>> (as Bit)) - (let [@ (/.the field $foreign)] - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.object (list [field $foreign]))) - (/.return (|> (/.= (/.boolean true) (/.delete @)) - (/.and (/.= /.undefined @)))))) - (list (/.number number/0))))) - )) - (_.cover [/.Access] - (`` (and (~~ (template [<js> <lux>] - [(expression (|>> (as Frac) f.int (i.= (<lux> int/0))) - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.statement (<js> $foreign)) - (/.return $foreign))) - (list (/.int int/0)))) - (expression (|>> (as Frac) f.int (i.= (<lux> int/0))) - (let [@ (/.at (/.int +0) $foreign)] - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.array (list $foreign))) - (/.statement (<js> @)) - (/.return @))) - (list (/.int int/0))))) - (expression (|>> (as Frac) f.int (i.= (<lux> int/0))) - (let [@ (/.the field $foreign)] - (/.apply_* (/.closure (list $foreign) - ($_ /.then - (/.set $foreign (/.object (list [field $foreign]))) - (/.statement (<js> @)) - (/.return @))) - (list (/.int int/0)))))] - - [/.++ .++] - [/.-- .--] - ))))) - (_.for [/.Var] - ..test/var) - ))) + (all _.and + (_.cover [/.set] + (and (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.+ $foreign $foreign)) + (/.return $foreign))) + (list (/.number number/0)))) + (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.array (list $foreign))) + (/.set @ (/.+ @ @)) + (/.return @))) + (list (/.number number/0))))) + (expression (|>> (as Frac) (f.= (f.+ number/0 number/0))) + (let [@ (/.the field $foreign)] + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.object (list [field $foreign]))) + (/.set @ (/.+ @ @)) + (/.return @))) + (list (/.number number/0))))))) + (_.cover [/.delete] + (and (and (expression (|>> (as Bit)) + (/.apply_* (/.closure (list) + (all /.then + (/.set $foreign (/.number number/0)) + (/.return (/.delete $foreign)))) + (list))) + (expression (|>> (as Bit) not) + (/.apply_* (/.closure (list $foreign) + (/.return (/.delete $foreign))) + (list (/.number number/0))))) + (expression (|>> (as Bit)) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.array (list $foreign))) + (/.return (|> (/.= (/.boolean true) (/.delete @)) + (/.and (/.= /.undefined @)))))) + (list (/.number number/0))))) + (expression (|>> (as Bit)) + (let [@ (/.the field $foreign)] + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.object (list [field $foreign]))) + (/.return (|> (/.= (/.boolean true) (/.delete @)) + (/.and (/.= /.undefined @)))))) + (list (/.number number/0))))) + )) + (_.cover [/.Access] + (`` (and (~~ (template [<js> <lux>] + [(expression (|>> (as Frac) f.int (i.= (<lux> int/0))) + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.statement (<js> $foreign)) + (/.return $foreign))) + (list (/.int int/0)))) + (expression (|>> (as Frac) f.int (i.= (<lux> int/0))) + (let [@ (/.at (/.int +0) $foreign)] + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.array (list $foreign))) + (/.statement (<js> @)) + (/.return @))) + (list (/.int int/0))))) + (expression (|>> (as Frac) f.int (i.= (<lux> int/0))) + (let [@ (/.the field $foreign)] + (/.apply_* (/.closure (list $foreign) + (all /.then + (/.set $foreign (/.object (list [field $foreign]))) + (/.statement (<js> @)) + (/.return @))) + (list (/.int int/0)))))] + + [/.++ .++] + [/.-- .--] + ))))) + (_.for [/.Var] + ..test/var) + ))) (def: test|label Test @@ -458,96 +458,96 @@ $output (/.var "output") $inner_index (/.var "inner_index") $outer_index (/.var "outer_index")]] - ($_ _.and - (_.cover [/.break] - (let [expected (i.* (.int expected_inner_iterations) input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $inner_index (/.int +0)) - (/.define $output (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) - /.break) - (/.set $output (/.+ $input $output)) - (/.set $inner_index (/.+ (/.int +1) $inner_index)) - )) - (/.return $output))) - (list (/.int input)))))) - (_.cover [/.continue] - (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $inner_index (/.int +0)) - (/.define $output (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.set $inner_index (/.+ (/.int +1) $inner_index)) - (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) - /.continue) - (/.set $output (/.+ $input $output)) - )) - (/.return $output))) - (list (/.int input)))))) - (_.for [/.label /.with_label] - ($_ _.and - (_.cover [/.break_at] - (let [expected (i.* (.int (n.* expected_outer_iterations - expected_inner_iterations)) - input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $output (/.int +0)) - (/.define $outer_index (/.int +0)) - (/.with_label @outer - (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) - ($_ /.then - (/.define $inner_index (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.when (/.= (/.int (.int expected_outer_iterations)) $outer_index) - (/.break_at @outer)) - (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) - /.break) - (/.set $output (/.+ $input $output)) - (/.set $inner_index (/.+ (/.int +1) $inner_index)) - )) - (/.set $outer_index (/.+ (/.int +1) $outer_index)) - ))) - (/.return $output))) - (list (/.int input)))))) - (_.cover [/.continue_at] - (let [expected (i.* (.int (n.* (n.- expected_outer_iterations full_outer_iterations) - (n.- expected_inner_iterations full_inner_iterations))) - input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $output (/.int +0)) - (/.define $outer_index (/.int +0)) - (/.with_label @outer - (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) - ($_ /.then - (/.set $outer_index (/.+ (/.int +1) $outer_index)) - (/.define $inner_index (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.set $inner_index (/.+ (/.int +1) $inner_index)) - (/.when (/.<= (/.int (.int expected_outer_iterations)) $outer_index) - (/.continue_at @outer)) - (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) - /.continue) - (/.set $output (/.+ $input $output)) - )) - ) - )) - (/.return $output))) - (list (/.int input)))))) - )) - ))) + (all _.and + (_.cover [/.break] + (let [expected (i.* (.int expected_inner_iterations) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $inner_index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.set $output (/.+ $input $output)) + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + )) + (/.return $output))) + (list (/.int input)))))) + (_.cover [/.continue] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $inner_index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.continue) + (/.set $output (/.+ $input $output)) + )) + (/.return $output))) + (list (/.int input)))))) + (_.for [/.label /.with_label] + (all _.and + (_.cover [/.break_at] + (let [expected (i.* (.int (n.* expected_outer_iterations + expected_inner_iterations)) + input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $output (/.int +0)) + (/.define $outer_index (/.int +0)) + (/.with_label @outer + (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) + (all /.then + (/.define $inner_index (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.when (/.= (/.int (.int expected_outer_iterations)) $outer_index) + (/.break_at @outer)) + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.set $output (/.+ $input $output)) + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + )) + (/.set $outer_index (/.+ (/.int +1) $outer_index)) + ))) + (/.return $output))) + (list (/.int input)))))) + (_.cover [/.continue_at] + (let [expected (i.* (.int (n.* (n.- expected_outer_iterations full_outer_iterations) + (n.- expected_inner_iterations full_inner_iterations))) + input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $output (/.int +0)) + (/.define $outer_index (/.int +0)) + (/.with_label @outer + (/.while (/.< (/.int (.int full_outer_iterations)) $outer_index) + (all /.then + (/.set $outer_index (/.+ (/.int +1) $outer_index)) + (/.define $inner_index (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.set $inner_index (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_outer_iterations)) $outer_index) + (/.continue_at @outer)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.continue) + (/.set $output (/.+ $input $output)) + )) + ) + )) + (/.return $output))) + (list (/.int input)))))) + )) + ))) (def: test|loop Test @@ -559,47 +559,47 @@ $index (/.var "index") expected|while (i.* (.int iterations) input) expected|do_while (i.* (.int (n.max 1 iterations)) input)]] - ($_ _.and - (_.cover [/.while] - (expression (|>> (as Frac) f.int (i.= expected|while)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $index (/.int +0)) - (/.define $output (/.int +0)) - (/.while (/.< (/.int (.int iterations)) $index) - ($_ /.then - (/.set $output (/.+ $input $output)) - (/.set $index (/.+ (/.int +1) $index)) - )) - (/.return $output))) - (list (/.int input))))) - (_.cover [/.do_while] - (expression (|>> (as Frac) f.int (i.= expected|do_while)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $index (/.int +0)) - (/.define $output (/.int +0)) - (/.do_while (/.< (/.int (.int iterations)) $index) - ($_ /.then + (all _.and + (_.cover [/.while] + (expression (|>> (as Frac) f.int (i.= expected|while)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $index (/.int +0)) + (/.define $output (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + (all /.then (/.set $output (/.+ $input $output)) (/.set $index (/.+ (/.int +1) $index)) )) - (/.return $output))) - (list (/.int input))))) - (_.cover [/.for] - (expression (|>> (as Frac) f.int (i.= expected|while)) - (/.apply_* (/.closure (list $input) - ($_ /.then - (/.define $output (/.int +0)) - (/.for $index (/.int +0) - (/.< (/.int (.int iterations)) $index) - (/.++ $index) - (/.set $output (/.+ $input $output))) - (/.return $output))) - (list (/.int input))))) - (_.for [/.Label] - ..test|label) - ))) + (/.return $output))) + (list (/.int input))))) + (_.cover [/.do_while] + (expression (|>> (as Frac) f.int (i.= expected|do_while)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $index (/.int +0)) + (/.define $output (/.int +0)) + (/.do_while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.set $output (/.+ $input $output)) + (/.set $index (/.+ (/.int +1) $index)) + )) + (/.return $output))) + (list (/.int input))))) + (_.cover [/.for] + (expression (|>> (as Frac) f.int (i.= expected|while)) + (/.apply_* (/.closure (list $input) + (all /.then + (/.define $output (/.int +0)) + (/.for $index (/.int +0) + (/.< (/.int (.int iterations)) $index) + (/.++ $index) + (/.set $output (/.+ $input $output))) + (/.return $output))) + (list (/.int input))))) + (_.for [/.Label] + ..test|label) + ))) (def: test|exception Test @@ -608,22 +608,22 @@ dummy (random.only (|>> (f.= expected) not) random.safe_frac) $ex (# ! each /.var (random.ascii/lower 10))] - ($_ _.and - (_.cover [/.try] - (expression (|>> (as Frac) (f.= expected)) - (/.apply_* (/.closure (list) - (/.try (/.return (/.number expected)) - [$ex (/.return (/.number dummy))])) - (list)))) - (_.cover [/.throw] - (expression (|>> (as Frac) (f.= expected)) - (/.apply_* (/.closure (list) - (/.try ($_ /.then - (/.throw (/.number expected)) - (/.return (/.number dummy))) - [$ex (/.return $ex)])) - (list)))) - ))) + (all _.and + (_.cover [/.try] + (expression (|>> (as Frac) (f.= expected)) + (/.apply_* (/.closure (list) + (/.try (/.return (/.number expected)) + [$ex (/.return (/.number dummy))])) + (list)))) + (_.cover [/.throw] + (expression (|>> (as Frac) (f.= expected)) + (/.apply_* (/.closure (list) + (/.try (all /.then + (/.throw (/.number expected)) + (/.return (/.number dummy))) + [$ex (/.return $ex)])) + (list)))) + ))) (def: test|apply Test @@ -634,29 +634,29 @@ $arg/0 (# ! each /.var (random.ascii/lower 10)) $arg/1 (# ! each /.var (random.ascii/lower 11)) $arg/2 (# ! each /.var (random.ascii/lower 12))] - (`` ($_ _.and - (_.cover [/.apply_1] - (expression (|>> (as Frac) (f.= number/0)) - (/.apply_1 (/.closure (list $arg/0) (/.return $arg/0)) - (/.number number/0)))) - (_.cover [/.apply_2] - (expression (|>> (as Frac) (f.= ($_ f.+ number/0 number/1))) - (/.apply_2 (/.closure (list $arg/0 $arg/1) (/.return ($_ /.+ $arg/0 $arg/1))) - (/.number number/0) - (/.number number/1)))) - (_.cover [/.apply_3] - (expression (|>> (as Frac) (f.= ($_ f.+ number/0 number/1 number/2))) - (/.apply_3 (/.closure (list $arg/0 $arg/1 $arg/2) (/.return ($_ /.+ $arg/0 $arg/1 $arg/2))) - (/.number number/0) - (/.number number/1) - (/.number number/2)))) - (_.cover [/.apply_*] - (expression (|>> (as Frac) (f.= ($_ f.+ number/0 number/1 number/2))) - (/.apply_* (/.closure (list $arg/0 $arg/1 $arg/2) (/.return ($_ /.+ $arg/0 $arg/1 $arg/2))) - (list (/.number number/0) - (/.number number/1) - (/.number number/2))))) - )))) + (`` (all _.and + (_.cover [/.apply_1] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_1 (/.closure (list $arg/0) (/.return $arg/0)) + (/.number number/0)))) + (_.cover [/.apply_2] + (expression (|>> (as Frac) (f.= (all f.+ number/0 number/1))) + (/.apply_2 (/.closure (list $arg/0 $arg/1) (/.return (all /.+ $arg/0 $arg/1))) + (/.number number/0) + (/.number number/1)))) + (_.cover [/.apply_3] + (expression (|>> (as Frac) (f.= (all f.+ number/0 number/1 number/2))) + (/.apply_3 (/.closure (list $arg/0 $arg/1 $arg/2) (/.return (all /.+ $arg/0 $arg/1 $arg/2))) + (/.number number/0) + (/.number number/1) + (/.number number/2)))) + (_.cover [/.apply_*] + (expression (|>> (as Frac) (f.= (all f.+ number/0 number/1 number/2))) + (/.apply_* (/.closure (list $arg/0 $arg/1 $arg/2) (/.return (all /.+ $arg/0 $arg/1 $arg/2))) + (list (/.number number/0) + (/.number number/1) + (/.number number/2))))) + )))) (def: test|function Test @@ -667,39 +667,39 @@ $arg/0 (# ! each /.var (random.ascii/lower 2)) field (random.ascii/lower 3) $class (# ! each /.var (random.ascii/upper 4))] - ($_ _.and - (_.cover [/.closure /.return] - (expression (|>> (as Frac) (f.= number/0)) - (/.apply_* (/.closure (list) (/.return (/.number number/0))) - (list)))) - (_.cover [/.function] - (expression (|>> (as Frac) f.nat (n.= iterations)) - (/.apply_1 (/.function $self (list $arg/0) - (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) - (/.apply_1 $self (/.+ (/.int +1) $arg/0)) - $arg/0))) - (/.int +0)))) - (_.cover [/.function_definition] - (expression (|>> (as Frac) f.nat (n.= iterations)) - (/.apply_* (/.closure (list) - ($_ /.then - (/.function_definition $self (list $arg/0) - (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) - (/.apply_1 $self (/.+ (/.int +1) $arg/0)) - $arg/0))) - (/.return (/.apply_1 $self (/.int +0))))) - (list)))) - (_.cover [/.new] - (let [$this (/.var "this")] - (expression (|>> (as Frac) (f.= number/0)) - (/.apply_1 (/.closure (list $arg/0) - ($_ /.then - (/.function_definition $class (list) - (/.set (/.the field $this) $arg/0)) - (/.return (/.the field (/.new $class (list)))))) - (/.number number/0))))) - ..test|apply - ))) + (all _.and + (_.cover [/.closure /.return] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_* (/.closure (list) (/.return (/.number number/0))) + (list)))) + (_.cover [/.function] + (expression (|>> (as Frac) f.nat (n.= iterations)) + (/.apply_1 (/.function $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply_1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) + (/.int +0)))) + (_.cover [/.function_definition] + (expression (|>> (as Frac) f.nat (n.= iterations)) + (/.apply_* (/.closure (list) + (all /.then + (/.function_definition $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply_1 $self (/.+ (/.int +1) $arg/0)) + $arg/0))) + (/.return (/.apply_1 $self (/.int +0))))) + (list)))) + (_.cover [/.new] + (let [$this (/.var "this")] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_1 (/.closure (list $arg/0) + (all /.then + (/.function_definition $class (list) + (/.set (/.the field $this) $arg/0)) + (/.return (/.the field (/.new $class (list)))))) + (/.number number/0))))) + ..test|apply + ))) (def: test|branching Test @@ -718,49 +718,49 @@ $arg/2 (/.var arg/2)] ??? random.bit int ..int_16] - ($_ _.and - (_.cover [/.if] - (expression (|>> (as Frac) (f.= (if ??? number/0 number/1))) - (/.apply_* (/.closure (list) - (/.if (/.boolean ???) - (/.return (/.number number/0)) - (/.return (/.number number/1)))) - (list)))) - (_.cover [/.when] - (expression (|>> (as Frac) (f.= (if ??? number/0 number/1))) - (/.apply_* (/.closure (list) - ($_ /.then - (/.when (/.boolean ???) - (/.return (/.number number/0))) - (/.return (/.number number/1)))) - (list)))) - (_.cover [/.switch] - (let [number/0' (%.frac number/0) - number/1' (%.frac number/1) - number/2' (%.frac number/2)] - (and (expression (|>> (as Text) (text#= number/0')) - (/.apply_* (/.closure (list) - (/.switch (/.number number/0) - (list [(list (/.number number/0)) (/.return (/.string number/0'))] - [(list (/.number number/1)) (/.return (/.string number/1'))]) - {.#None})) - (list))) - (expression (|>> (as Text) (text#= number/1')) - (/.apply_* (/.closure (list) - (/.switch (/.number number/1) - (list [(list (/.number number/0)) (/.return (/.string number/0'))] - [(list (/.number number/1)) (/.return (/.string number/1'))]) - {.#Some (/.return (/.string number/2'))})) - (list))) - (expression (|>> (as Text) (text#= number/2')) - (/.apply_* (/.closure (list) - (/.switch (/.number number/2) - (list [(list (/.number number/0)) (/.return (/.string number/0'))] - [(list (/.number number/1)) (/.return (/.string number/1'))]) - {.#Some (/.return (/.string number/2'))})) - (list))) - ))) - ))) + (all _.and + (_.cover [/.if] + (expression (|>> (as Frac) (f.= (if ??? number/0 number/1))) + (/.apply_* (/.closure (list) + (/.if (/.boolean ???) + (/.return (/.number number/0)) + (/.return (/.number number/1)))) + (list)))) + (_.cover [/.when] + (expression (|>> (as Frac) (f.= (if ??? number/0 number/1))) + (/.apply_* (/.closure (list) + (all /.then + (/.when (/.boolean ???) + (/.return (/.number number/0))) + (/.return (/.number number/1)))) + (list)))) + (_.cover [/.switch] + (let [number/0' (%.frac number/0) + number/1' (%.frac number/1) + number/2' (%.frac number/2)] + (and (expression (|>> (as Text) (text#= number/0')) + (/.apply_* (/.closure (list) + (/.switch (/.number number/0) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#None})) + (list))) + (expression (|>> (as Text) (text#= number/1')) + (/.apply_* (/.closure (list) + (/.switch (/.number number/1) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#Some (/.return (/.string number/2'))})) + (list))) + (expression (|>> (as Text) (text#= number/2')) + (/.apply_* (/.closure (list) + (/.switch (/.number number/2) + (list [(list (/.number number/0)) (/.return (/.string number/0'))] + [(list (/.number number/1)) (/.return (/.string number/1'))]) + {.#Some (/.return (/.string number/2'))})) + (list))) + ))) + ))) (def: test|statement Test @@ -773,64 +773,64 @@ $arg/2 (# ! each /.var (random.ascii/lower 12)) ??? random.bit int ..int_16] - (`` ($_ _.and - (_.cover [/.statement] - (expression (|>> (as Frac) (f.= number/0)) - (/.apply_1 (/.closure (list $arg/0) - ($_ /.then - (/.statement (/.+ $arg/0 $arg/0)) - (/.return $arg/0))) - (/.number number/0)))) - (~~ (template [<js> <lux>] - [(_.cover [<js>] - (expression (|>> (as Frac) f.int (i.= (<lux> int))) - (/.apply_1 (/.closure (list $arg/0) - (/.return (/., (<js> $arg/0) - $arg/0))) - (/.int int))))] - - [/.++ .++] - [/.-- .--] - )) - (_.cover [/.then] - (expression (|>> (as Frac) (f.= number/0)) - (/.apply_2 (/.closure (list $arg/0 $arg/1) - ($_ /.then - (/.return $arg/0) - (/.return $arg/1))) - (/.number number/0) - (/.number number/1)))) - (_.cover [/.use_strict] - (and (expression (|>> (as Frac) (f.= number/0)) - (/.apply_* (/.closure (list) - ($_ /.then - /.use_strict - (/.declare $arg/0) - (/.set $arg/0 (/.number number/0)) - (/.return $arg/0))) - (list))) - (|> (/.apply_* (/.closure (list) - ($_ /.then - /.use_strict - ... (/.declare $arg/0) - (/.set $arg/0 (/.number number/0)) - (/.return $arg/0))) - (list)) - ..eval - (pipe.case - {try.#Success it} - false - - {try.#Failure error} - true)))) - ..test|exception - ..test|function - ..test|branching - (_.for [/.Location] - ..test/location) - (_.for [/.Loop] - ..test|loop) - )))) + (`` (all _.and + (_.cover [/.statement] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_1 (/.closure (list $arg/0) + (all /.then + (/.statement (/.+ $arg/0 $arg/0)) + (/.return $arg/0))) + (/.number number/0)))) + (~~ (template [<js> <lux>] + [(_.cover [<js>] + (expression (|>> (as Frac) f.int (i.= (<lux> int))) + (/.apply_1 (/.closure (list $arg/0) + (/.return (/., (<js> $arg/0) + $arg/0))) + (/.int int))))] + + [/.++ .++] + [/.-- .--] + )) + (_.cover [/.then] + (expression (|>> (as Frac) (f.= number/0)) + (/.apply_2 (/.closure (list $arg/0 $arg/1) + (all /.then + (/.return $arg/0) + (/.return $arg/1))) + (/.number number/0) + (/.number number/1)))) + (_.cover [/.use_strict] + (and (expression (|>> (as Frac) (f.= number/0)) + (/.apply_* (/.closure (list) + (all /.then + /.use_strict + (/.declare $arg/0) + (/.set $arg/0 (/.number number/0)) + (/.return $arg/0))) + (list))) + (|> (/.apply_* (/.closure (list) + (all /.then + /.use_strict + ... (/.declare $arg/0) + (/.set $arg/0 (/.number number/0)) + (/.return $arg/0))) + (list)) + ..eval + (pipe.case + {try.#Success it} + false + + {try.#Failure error} + true)))) + ..test|exception + ..test|function + ..test|branching + (_.for [/.Location] + ..test/location) + (_.for [/.Loop] + ..test|loop) + )))) (def: .public test Test @@ -838,9 +838,9 @@ [] (<| (_.covering /._) (_.for [/.Code /.code]) - (`` ($_ _.and - (_.for [/.Expression] - ..test|expression) - (_.for [/.Statement] - ..test|statement) - ))))) + (`` (all _.and + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + ))))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 57a6e56e1..86f53e099 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -55,9 +55,9 @@ ["[0]" category {"+" Value Object Class}]]]]) (def: method_modifier - ($_ /modifier#composite - /method.public - /method.static)) + (all /modifier#composite + /method.public + /method.static)) (import: java/lang/Boolean "[1]::[0]") @@ -409,44 +409,44 @@ [_ (..$Integer::literal subject) _ (..$Integer::literal parameter)] instruction))))) - literal ($_ _.and - (_.lifted "ICONST_M1" (int (ffi.long_to_int (as java/lang/Long -1)) /.iconst_m1)) - (_.lifted "ICONST_0" (int (ffi.long_to_int (as java/lang/Long +0)) /.iconst_0)) - (_.lifted "ICONST_1" (int (ffi.long_to_int (as java/lang/Long +1)) /.iconst_1)) - (_.lifted "ICONST_2" (int (ffi.long_to_int (as java/lang/Long +2)) /.iconst_2)) - (_.lifted "ICONST_3" (int (ffi.long_to_int (as java/lang/Long +3)) /.iconst_3)) - (_.lifted "ICONST_4" (int (ffi.long_to_int (as java/lang/Long +4)) /.iconst_4)) - (_.lifted "ICONST_5" (int (ffi.long_to_int (as java/lang/Long +5)) /.iconst_5)) - (_.lifted "LDC_W/INTEGER" - (do random.monad - [expected ..$Integer::random] - (int expected (..$Integer::literal expected))))) - arithmetic ($_ _.and - (_.lifted "IADD" (binary (int/2 "jvm iadd" "jvm int +") /.iadd)) - (_.lifted "ISUB" (binary (int/2 "jvm isub" "jvm int -") /.isub)) - (_.lifted "IMUL" (binary (int/2 "jvm imul" "jvm int *") /.imul)) - (_.lifted "IDIV" (binary (int/2 "jvm idiv" "jvm int /") /.idiv)) - (_.lifted "IREM" (binary (int/2 "jvm irem" "jvm int %") /.irem)) - (_.lifted "INEG" (unary (function (_ value) - ((int/2 "jvm isub" "jvm int -") - value - (ffi.long_to_int (as java/lang/Long +0)))) - /.ineg))) - bitwise ($_ _.and - (_.lifted "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) - (_.lifted "IOR" (binary (int/2 "jvm ior" "jvm int or") /.ior)) - (_.lifted "IXOR" (binary (int/2 "jvm ixor" "jvm int xor") /.ixor)) - (_.lifted "ISHL" (shift (int/2 "jvm ishl" "jvm int shl") /.ishl)) - (_.lifted "ISHR" (shift (int/2 "jvm ishr" "jvm int shr") /.ishr)) - (_.lifted "IUSHR" (shift (int/2 "jvm iushr" "jvm int ushr") /.iushr)))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "bitwise") - bitwise) - ))) + literal (all _.and + (_.lifted "ICONST_M1" (int (ffi.long_to_int (as java/lang/Long -1)) /.iconst_m1)) + (_.lifted "ICONST_0" (int (ffi.long_to_int (as java/lang/Long +0)) /.iconst_0)) + (_.lifted "ICONST_1" (int (ffi.long_to_int (as java/lang/Long +1)) /.iconst_1)) + (_.lifted "ICONST_2" (int (ffi.long_to_int (as java/lang/Long +2)) /.iconst_2)) + (_.lifted "ICONST_3" (int (ffi.long_to_int (as java/lang/Long +3)) /.iconst_3)) + (_.lifted "ICONST_4" (int (ffi.long_to_int (as java/lang/Long +4)) /.iconst_4)) + (_.lifted "ICONST_5" (int (ffi.long_to_int (as java/lang/Long +5)) /.iconst_5)) + (_.lifted "LDC_W/INTEGER" + (do random.monad + [expected ..$Integer::random] + (int expected (..$Integer::literal expected))))) + arithmetic (all _.and + (_.lifted "IADD" (binary (int/2 "jvm iadd" "jvm int +") /.iadd)) + (_.lifted "ISUB" (binary (int/2 "jvm isub" "jvm int -") /.isub)) + (_.lifted "IMUL" (binary (int/2 "jvm imul" "jvm int *") /.imul)) + (_.lifted "IDIV" (binary (int/2 "jvm idiv" "jvm int /") /.idiv)) + (_.lifted "IREM" (binary (int/2 "jvm irem" "jvm int %") /.irem)) + (_.lifted "INEG" (unary (function (_ value) + ((int/2 "jvm isub" "jvm int -") + value + (ffi.long_to_int (as java/lang/Long +0)))) + /.ineg))) + bitwise (all _.and + (_.lifted "IAND" (binary (int/2 "jvm iand" "jvm int and") /.iand)) + (_.lifted "IOR" (binary (int/2 "jvm ior" "jvm int or") /.ior)) + (_.lifted "IXOR" (binary (int/2 "jvm ixor" "jvm int xor") /.ixor)) + (_.lifted "ISHL" (shift (int/2 "jvm ishl" "jvm int shl") /.ishl)) + (_.lifted "ISHR" (shift (int/2 "jvm ishr" "jvm int shr") /.ishr)) + (_.lifted "IUSHR" (shift (int/2 "jvm iushr" "jvm int ushr") /.iushr)))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "bitwise") + bitwise) + ))) (def: long Test @@ -488,31 +488,31 @@ [_ (..$Long::literal subject) _ (..$Integer::literal (ffi.long_to_int parameter))] instruction))))) - literal ($_ _.and - (_.lifted "LCONST_0" (long (as java/lang/Long +0) /.lconst_0)) - (_.lifted "LCONST_1" (long (as java/lang/Long +1) /.lconst_1)) - (_.lifted "LDC2_W/LONG" - (do random.monad - [expected ..$Long::random] - (long expected (..$Long::literal expected))))) - arithmetic ($_ _.and - (_.lifted "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd)) - (_.lifted "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub)) - (_.lifted "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul)) - (_.lifted "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv)) - (_.lifted "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem)) - (_.lifted "LNEG" (unary (function (_ value) - ((long/2 "jvm lsub" "jvm long -") - value - (as java/lang/Long +0))) - /.lneg))) - bitwise ($_ _.and - (_.lifted "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) - (_.lifted "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor)) - (_.lifted "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor)) - (_.lifted "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl)) - (_.lifted "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr)) - (_.lifted "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr))) + literal (all _.and + (_.lifted "LCONST_0" (long (as java/lang/Long +0) /.lconst_0)) + (_.lifted "LCONST_1" (long (as java/lang/Long +1) /.lconst_1)) + (_.lifted "LDC2_W/LONG" + (do random.monad + [expected ..$Long::random] + (long expected (..$Long::literal expected))))) + arithmetic (all _.and + (_.lifted "LADD" (binary (long/2 "jvm ladd" "jvm long +") /.ladd)) + (_.lifted "LSUB" (binary (long/2 "jvm lsub" "jvm long -") /.lsub)) + (_.lifted "LMUL" (binary (long/2 "jvm lmul" "jvm long *") /.lmul)) + (_.lifted "LDIV" (binary (long/2 "jvm ldiv" "jvm long /") /.ldiv)) + (_.lifted "LREM" (binary (long/2 "jvm lrem" "jvm long %") /.lrem)) + (_.lifted "LNEG" (unary (function (_ value) + ((long/2 "jvm lsub" "jvm long -") + value + (as java/lang/Long +0))) + /.lneg))) + bitwise (all _.and + (_.lifted "LAND" (binary (long/2 "jvm land" "jvm long and") /.land)) + (_.lifted "LOR" (binary (long/2 "jvm lor" "jvm long or") /.lor)) + (_.lifted "LXOR" (binary (long/2 "jvm lxor" "jvm long xor") /.lxor)) + (_.lifted "LSHL" (shift (int+long/2 "jvm lshl" "jvm long shl") /.lshl)) + (_.lifted "LSHR" (shift (int+long/2 "jvm lshr" "jvm long shr") /.lshr)) + (_.lifted "LUSHR" (shift (int+long/2 "jvm lushr" "jvm long ushr") /.lushr))) comparison (_.lifted "LCMP" (do random.monad [reference ..$Long::random @@ -536,16 +536,16 @@ _ /.lcmp _ /.i2l] ..$Long::wrap))))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "bitwise") - bitwise) - (<| (_.context "comparison") - comparison) - ))) + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "bitwise") + bitwise) + (<| (_.context "comparison") + comparison) + ))) (def: float Test @@ -587,25 +587,25 @@ [_ (..$Float::literal subject) _ (..$Float::literal parameter)] instruction))))) - literal ($_ _.and - (_.lifted "FCONST_0" (float (ffi.double_to_float (as java/lang/Double +0.0)) /.fconst_0)) - (_.lifted "FCONST_1" (float (ffi.double_to_float (as java/lang/Double +1.0)) /.fconst_1)) - (_.lifted "FCONST_2" (float (ffi.double_to_float (as java/lang/Double +2.0)) /.fconst_2)) - (_.lifted "LDC_W/FLOAT" - (do random.monad - [expected ..$Float::random] - (float expected (..$Float::literal expected))))) - arithmetic ($_ _.and - (_.lifted "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd)) - (_.lifted "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub)) - (_.lifted "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul)) - (_.lifted "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv)) - (_.lifted "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem)) - (_.lifted "FNEG" (unary (function (_ value) - ((float/2 "jvm fsub" "jvm float -") - value - (ffi.double_to_float (as java/lang/Double +0.0)))) - /.fneg))) + literal (all _.and + (_.lifted "FCONST_0" (float (ffi.double_to_float (as java/lang/Double +0.0)) /.fconst_0)) + (_.lifted "FCONST_1" (float (ffi.double_to_float (as java/lang/Double +1.0)) /.fconst_1)) + (_.lifted "FCONST_2" (float (ffi.double_to_float (as java/lang/Double +2.0)) /.fconst_2)) + (_.lifted "LDC_W/FLOAT" + (do random.monad + [expected ..$Float::random] + (float expected (..$Float::literal expected))))) + arithmetic (all _.and + (_.lifted "FADD" (binary (float/2 "jvm fadd" "jvm float +") /.fadd)) + (_.lifted "FSUB" (binary (float/2 "jvm fsub" "jvm float -") /.fsub)) + (_.lifted "FMUL" (binary (float/2 "jvm fmul" "jvm float *") /.fmul)) + (_.lifted "FDIV" (binary (float/2 "jvm fdiv" "jvm float /") /.fdiv)) + (_.lifted "FREM" (binary (float/2 "jvm frem" "jvm float %") /.frem)) + (_.lifted "FNEG" (unary (function (_ value) + ((float/2 "jvm fsub" "jvm float -") + value + (ffi.double_to_float (as java/lang/Double +0.0)))) + /.fneg))) comparison (is (-> (Bytecode Any) (-> java/lang/Float java/lang/Float Bit) (Random Bit)) (function (_ instruction standard) (do random.monad @@ -636,17 +636,17 @@ @.jvm ("jvm float <" ("jvm object cast" subject) ("jvm object cast" reference))))) - comparison ($_ _.and - (_.lifted "FCMPL" (comparison /.fcmpl comparison_standard)) - (_.lifted "FCMPG" (comparison /.fcmpg comparison_standard)))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "comparison") - comparison) - ))) + comparison (all _.and + (_.lifted "FCMPL" (comparison /.fcmpl comparison_standard)) + (_.lifted "FCMPG" (comparison /.fcmpg comparison_standard)))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "comparison") + comparison) + ))) (def: double Test @@ -684,24 +684,24 @@ [_ (..$Double::literal subject) _ (..$Double::literal parameter)] instruction))))) - literal ($_ _.and - (_.lifted "DCONST_0" (double (as java/lang/Double +0.0) /.dconst_0)) - (_.lifted "DCONST_1" (double (as java/lang/Double +1.0) /.dconst_1)) - (_.lifted "LDC2_W/DOUBLE" - (do random.monad - [expected ..$Double::random] - (double expected (..$Double::literal expected))))) - arithmetic ($_ _.and - (_.lifted "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd)) - (_.lifted "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub)) - (_.lifted "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul)) - (_.lifted "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv)) - (_.lifted "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem)) - (_.lifted "DNEG" (unary (function (_ value) - ((double/2 "jvm dsub" "jvm double -") - value - (as java/lang/Double +0.0))) - /.dneg))) + literal (all _.and + (_.lifted "DCONST_0" (double (as java/lang/Double +0.0) /.dconst_0)) + (_.lifted "DCONST_1" (double (as java/lang/Double +1.0) /.dconst_1)) + (_.lifted "LDC2_W/DOUBLE" + (do random.monad + [expected ..$Double::random] + (double expected (..$Double::literal expected))))) + arithmetic (all _.and + (_.lifted "DADD" (binary (double/2 "jvm dadd" "jvm double +") /.dadd)) + (_.lifted "DSUB" (binary (double/2 "jvm dsub" "jvm double -") /.dsub)) + (_.lifted "DMUL" (binary (double/2 "jvm dmul" "jvm double *") /.dmul)) + (_.lifted "DDIV" (binary (double/2 "jvm ddiv" "jvm double /") /.ddiv)) + (_.lifted "DREM" (binary (double/2 "jvm drem" "jvm double %") /.drem)) + (_.lifted "DNEG" (unary (function (_ value) + ((double/2 "jvm dsub" "jvm double -") + value + (as java/lang/Double +0.0))) + /.dneg))) comparison (is (-> (Bytecode Any) (-> java/lang/Double java/lang/Double Bit) (Random Bit)) (function (_ instruction standard) (do random.monad @@ -731,34 +731,34 @@ @.jvm ("jvm double <" ("jvm object cast" subject) ("jvm object cast" reference))))) - comparison ($_ _.and - (_.lifted "DCMPL" (comparison /.dcmpl comparison_standard)) - (_.lifted "DCMPG" (comparison /.dcmpg comparison_standard)))] - ($_ _.and - (<| (_.context "literal") - literal) - (<| (_.context "arithmetic") - arithmetic) - (<| (_.context "comparison") - comparison) - ))) + comparison (all _.and + (_.lifted "DCMPL" (comparison /.dcmpl comparison_standard)) + (_.lifted "DCMPG" (comparison /.dcmpg comparison_standard)))] + (all _.and + (<| (_.context "literal") + literal) + (<| (_.context "arithmetic") + arithmetic) + (<| (_.context "comparison") + comparison) + ))) (def: primitive Test - ($_ _.and - (<| (_.context "byte") - ..byte) - (<| (_.context "short") - ..short) - (<| (_.context "int") - ..int) - (<| (_.context "long") - ..long) - (<| (_.context "float") - ..float) - (<| (_.context "double") - ..double) - )) + (all _.and + (<| (_.context "byte") + ..byte) + (<| (_.context "short") + ..short) + (<| (_.context "int") + ..int) + (<| (_.context "long") + ..long) + (<| (_.context "float") + ..float) + (<| (_.context "double") + ..double) + )) (def: object Test @@ -767,88 +767,88 @@ [_ (/.new ..$Object) _ /.dup] (/.invokespecial ..$Object "<init>" (/type.method [(list) (list) /type.void (list)]))))] - ($_ _.and - (<| (_.lifted "ACONST_NULL") - (..bytecode (|>> (as Bit) not)) - (do /.monad - [_ /.aconst_null - _ (/.instanceof ..$String)] - ..$Boolean::wrap)) - (<| (_.lifted "INSTANCEOF") - (do random.monad - [value ..$String::random]) - (..bytecode (|>> (as Bit))) - (do /.monad - [_ (/.string (as Text value)) - _ (/.instanceof ..$String)] - ..$Boolean::wrap)) - (<| (_.lifted "NEW & CHECKCAST") - (..bytecode (|>> (as Bit))) - (do /.monad - [_ !object - _ (/.checkcast ..$Object) - _ (/.instanceof ..$Object)] - ..$Boolean::wrap)) - (<| (_.lifted "MONITORENTER & MONITOREXIT") - (do random.monad - [value ..$String::random]) - (..bytecode (|>> (as Bit))) - (do /.monad - [_ (/.string (as Text value)) - _ /.dup _ /.monitorenter - _ /.dup _ /.monitorexit - _ (/.instanceof ..$String)] - ..$Boolean::wrap)) - ))) + (all _.and + (<| (_.lifted "ACONST_NULL") + (..bytecode (|>> (as Bit) not)) + (do /.monad + [_ /.aconst_null + _ (/.instanceof ..$String)] + ..$Boolean::wrap)) + (<| (_.lifted "INSTANCEOF") + (do random.monad + [value ..$String::random]) + (..bytecode (|>> (as Bit))) + (do /.monad + [_ (/.string (as Text value)) + _ (/.instanceof ..$String)] + ..$Boolean::wrap)) + (<| (_.lifted "NEW & CHECKCAST") + (..bytecode (|>> (as Bit))) + (do /.monad + [_ !object + _ (/.checkcast ..$Object) + _ (/.instanceof ..$Object)] + ..$Boolean::wrap)) + (<| (_.lifted "MONITORENTER & MONITOREXIT") + (do random.monad + [value ..$String::random]) + (..bytecode (|>> (as Bit))) + (do /.monad + [_ (/.string (as Text value)) + _ /.dup _ /.monitorenter + _ /.dup _ /.monitorexit + _ (/.instanceof ..$String)] + ..$Boolean::wrap)) + ))) (def: method Test - ($_ _.and - (<| (_.lifted "INVOKESTATIC") - (do random.monad - [expected (random.only (|>> (as Frac) f.not_a_number? not) - ..$Double::random)]) - (..bytecode (for @.old - (|>> (as java/lang/Double) ("jvm deq" expected)) - - @.jvm - (|>> (as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))))) - (do /.monad - [_ (/.double expected)] - (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)])))) - (<| (_.lifted "INVOKEVIRTUAL") - (do random.monad - [expected ..$Double::random]) - (..bytecode (|>> (as Bit) (bit#= (f.not_a_number? (as Frac expected))))) - (do /.monad - [_ (/.double expected) - _ ..$Double::wrap - _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) (list) /type.boolean (list)]))] - ..$Boolean::wrap)) - (<| (_.lifted "INVOKESPECIAL") - (do random.monad - [expected (random.only (|>> (as Frac) f.not_a_number? not) - ..$Double::random)]) - (..bytecode (for @.old - (|>> (as java/lang/Double) ("jvm deq" expected)) - - @.jvm - (|>> (as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))))) - (do /.monad - [_ (/.new ..$Double) - _ /.dup - _ (/.double expected)] - (/.invokespecial ..$Double "<init>" (/type.method [(list) (list /type.double) /type.void (list)])))) - (<| (_.lifted "INVOKEINTERFACE") - (do random.monad - [subject ..$String::random]) - (..bytecode (|>> (as Nat) (n.= (text.size (as Text subject))))) - (do /.monad - [_ (/.string (as Text subject)) - _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) (list) /type.int (list)])) - _ /.i2l] - ..$Long::wrap)) - )) + (all _.and + (<| (_.lifted "INVOKESTATIC") + (do random.monad + [expected (random.only (|>> (as Frac) f.not_a_number? not) + ..$Double::random)]) + (..bytecode (for @.old + (|>> (as java/lang/Double) ("jvm deq" expected)) + + @.jvm + (|>> (as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))))) + (do /.monad + [_ (/.double expected)] + (/.invokestatic ..$Double "valueOf" (/type.method [(list) (list /type.double) ..$Double (list)])))) + (<| (_.lifted "INVOKEVIRTUAL") + (do random.monad + [expected ..$Double::random]) + (..bytecode (|>> (as Bit) (bit#= (f.not_a_number? (as Frac expected))))) + (do /.monad + [_ (/.double expected) + _ ..$Double::wrap + _ (/.invokevirtual ..$Double "isNaN" (/type.method [(list) (list) /type.boolean (list)]))] + ..$Boolean::wrap)) + (<| (_.lifted "INVOKESPECIAL") + (do random.monad + [expected (random.only (|>> (as Frac) f.not_a_number? not) + ..$Double::random)]) + (..bytecode (for @.old + (|>> (as java/lang/Double) ("jvm deq" expected)) + + @.jvm + (|>> (as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" expected))))) + (do /.monad + [_ (/.new ..$Double) + _ /.dup + _ (/.double expected)] + (/.invokespecial ..$Double "<init>" (/type.method [(list) (list /type.double) /type.void (list)])))) + (<| (_.lifted "INVOKEINTERFACE") + (do random.monad + [subject ..$String::random]) + (..bytecode (|>> (as Nat) (n.= (text.size (as Text subject))))) + (do /.monad + [_ (/.string (as Text subject)) + _ (/.invokeinterface (/type.class "java.lang.CharSequence" (list)) "length" (/type.method [(list) (list) /type.int (list)])) + _ /.i2l] + ..$Long::wrap)) + )) (def: field Test @@ -889,9 +889,9 @@ _ /.lload_1 _ (/.putfield $Self object_field /type.long)] /.return)}) - (/method.method ($_ /modifier#composite - /method.public - /method.static) + (/method.method (all /modifier#composite + /method.public + /method.static) static_method #0 (/type.method [(list) (list) ..$Long (list)]) (list) @@ -965,96 +965,96 @@ (do [! random.monad] [size (# ! each (|>> (n.% 1024) (n.max 1)) random.nat) value random] - ($_ _.and - (<| (_.lifted "length") - (length size constructor)) - (<| (_.lifted "write and read") - (write_and_read size constructor value literal [*store *load *wrap] test))))))] - ($_ _.and - (_.context "boolean" - (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] - (function (_ expected) (|>> (as Bit) (bit#= (as Bit expected)))))) - (_.context "byte" - (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) - - @.jvm - (|>> (as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (as java/lang/Byte expected))))))))) - (_.context "short" - (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) - - @.jvm - (|>> (as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (as java/lang/Short expected))))))))) - (_.context "int" - (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Integer) ("jvm ieq" (as java/lang/Integer expected))) - - @.jvm - (|>> (as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (as java/lang/Integer expected)))))))) - (_.context "long" - (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Long) ("jvm leq" expected)) - - @.jvm - (|>> (as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (as java/lang/Long expected)))))))) - (_.context "float" - (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Float) ("jvm feq" expected)) - - @.jvm - (|>> (as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (as java/lang/Float expected)))))))) - (_.context "double" - (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Double) ("jvm deq" expected)) - - @.jvm - (|>> (as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (as java/lang/Double expected)))))))) - (_.context "char" - (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] - (function (_ expected) - (for @.old - (|>> (as java/lang/Character) ("jvm ceq" expected)) - - @.jvm - (|>> (as java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (as java/lang/Character expected)))))))) - (_.context "object" - (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] - (function (_ expected) (|>> (as Text) (text#= (as Text expected)))))) - (<| (_.context "multi") - (do [! random.monad] - [.let [size (# ! each (|>> (n.% 5) (n.+ 1)) - random.nat)] - dimensions size - sizesH size - sizesT (random.list (-- dimensions) size) - .let [type (loop (again [dimensions dimensions - type (is (Type Object) - ..$Object)]) - (case dimensions - 0 type - _ (again (-- dimensions) (/type.array type))))]] - (<| (_.lifted "MULTIANEWARRAY") - (..bytecode (|>> (as Nat) (n.= sizesH))) - (do [! /.monad] - [_ (monad.each ! (|>> (as java/lang/Long) ffi.long_to_int ..$Integer::literal) - {.#Item sizesH sizesT}) - _ (/.multianewarray type (|> dimensions /unsigned.u1 try.trusted)) - _ ?length] - $Long::wrap)))) - ))) + (all _.and + (<| (_.lifted "length") + (length size constructor)) + (<| (_.lifted "write and read") + (write_and_read size constructor value literal [*store *load *wrap] test))))))] + (all _.and + (_.context "boolean" + (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] + (function (_ expected) (|>> (as Bit) (bit#= (as Bit expected)))))) + (_.context "byte" + (array (/.newarray /instruction.t_byte) $Byte::random $Byte::literal [/.bastore /.baload $Byte::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + + @.jvm + (|>> (as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (as java/lang/Byte expected))))))))) + (_.context "short" + (array (/.newarray /instruction.t_short) $Short::random $Short::literal [/.sastore /.saload $Short::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + + @.jvm + (|>> (as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (as java/lang/Short expected))))))))) + (_.context "int" + (array (/.newarray /instruction.t_int) $Integer::random $Integer::literal [/.iastore /.iaload $Integer::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Integer) ("jvm ieq" (as java/lang/Integer expected))) + + @.jvm + (|>> (as java/lang/Integer) "jvm object cast" ("jvm int =" ("jvm object cast" (as java/lang/Integer expected)))))))) + (_.context "long" + (array (/.newarray /instruction.t_long) $Long::random $Long::literal [/.lastore /.laload $Long::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Long) ("jvm leq" expected)) + + @.jvm + (|>> (as java/lang/Long) "jvm object cast" ("jvm long =" ("jvm object cast" (as java/lang/Long expected)))))))) + (_.context "float" + (array (/.newarray /instruction.t_float) ..valid_float $Float::literal [/.fastore /.faload $Float::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Float) ("jvm feq" expected)) + + @.jvm + (|>> (as java/lang/Float) "jvm object cast" ("jvm float =" ("jvm object cast" (as java/lang/Float expected)))))))) + (_.context "double" + (array (/.newarray /instruction.t_double) ..valid_double $Double::literal [/.dastore /.daload $Double::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Double) ("jvm deq" expected)) + + @.jvm + (|>> (as java/lang/Double) "jvm object cast" ("jvm double =" ("jvm object cast" (as java/lang/Double expected)))))))) + (_.context "char" + (array (/.newarray /instruction.t_char) $Character::random $Character::literal [/.castore /.caload $Character::wrap] + (function (_ expected) + (for @.old + (|>> (as java/lang/Character) ("jvm ceq" expected)) + + @.jvm + (|>> (as java/lang/Character) "jvm object cast" ("jvm char =" ("jvm object cast" (as java/lang/Character expected)))))))) + (_.context "object" + (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] + (function (_ expected) (|>> (as Text) (text#= (as Text expected)))))) + (<| (_.context "multi") + (do [! random.monad] + [.let [size (# ! each (|>> (n.% 5) (n.+ 1)) + random.nat)] + dimensions size + sizesH size + sizesT (random.list (-- dimensions) size) + .let [type (loop (again [dimensions dimensions + type (is (Type Object) + ..$Object)]) + (case dimensions + 0 type + _ (again (-- dimensions) (/type.array type))))]] + (<| (_.lifted "MULTIANEWARRAY") + (..bytecode (|>> (as Nat) (n.= sizesH))) + (do [! /.monad] + [_ (monad.each ! (|>> (as java/lang/Long) ffi.long_to_int ..$Integer::literal) + {.#Item sizesH sizesT}) + _ (/.multianewarray type (|> dimensions /unsigned.u1 try.trusted)) + _ ?length] + $Long::wrap)))) + ))) (template: (!::= <type> <old> <new>) [(is (-> <type> Any Bit) @@ -1082,61 +1082,61 @@ long::= (!::= java/lang/Long "jvm leq" "jvm long =") float::= (!::= java/lang/Float "jvm feq" "jvm float =") double::= (!::= java/lang/Double "jvm deq" "jvm double =")] - ($_ _.and - (<| (_.context "int") - ($_ _.and - (_.lifted "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> ffi.int_to_long) long::=)) - (_.lifted "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> ffi.int_to_float) float::=)) - (_.lifted "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> ffi.int_to_double) double::=)) - (_.lifted "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) - (function (_ expected) - (for @.old - (|>> (as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) - - @.jvm - (|>> (as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (as java/lang/Byte expected))))))))) - (_.lifted "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) - (!::= java/lang/Character "jvm ceq" "jvm char ="))) - (_.lifted "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) - (function (_ expected) - (for @.old - (|>> (as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) - - @.jvm - (|>> (as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (as java/lang/Short expected))))))))))) - (<| (_.context "long") - ($_ _.and - (_.lifted "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) - (_.lifted "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> ffi.long_to_float) float::=)) - (_.lifted "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> ffi.long_to_double) double::=)))) - (<| (_.context "float") - ($_ _.and - (_.lifted "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> ffi.float_to_int) int::=)) - (_.lifted "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> ffi.float_to_long) long::=)) - (_.lifted "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> ffi.float_to_double) double::=)))) - (<| (_.context "double") - ($_ _.and - (_.lifted "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> ffi.double_to_int) int::=)) - (_.lifted "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> ffi.double_to_long) long::=)) - (_.lifted "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> ffi.double_to_float) float::=)))) - ))) + (all _.and + (<| (_.context "int") + (all _.and + (_.lifted "I2L" (conversion ..$Integer::primitive ..$Long::primitive /.i2l (|>> ffi.int_to_long) long::=)) + (_.lifted "I2F" (conversion ..$Integer::primitive ..$Float::primitive /.i2f (|>> ffi.int_to_float) float::=)) + (_.lifted "I2D" (conversion ..$Integer::primitive ..$Double::primitive /.i2d (|>> ffi.int_to_double) double::=)) + (_.lifted "I2B" (conversion ..$Integer::primitive ..$Byte::primitive /.i2b (|>> ffi.int_to_byte) + (function (_ expected) + (for @.old + (|>> (as java/lang/Byte) ffi.byte_to_long ("jvm leq" (ffi.byte_to_long expected))) + + @.jvm + (|>> (as java/lang/Byte) ffi.byte_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.byte_to_long (as java/lang/Byte expected))))))))) + (_.lifted "I2C" (conversion ..$Integer::primitive ..$Character::primitive /.i2c (|>> ffi.int_to_char) + (!::= java/lang/Character "jvm ceq" "jvm char ="))) + (_.lifted "I2S" (conversion ..$Integer::primitive ..$Short::primitive /.i2s (|>> ffi.int_to_short) + (function (_ expected) + (for @.old + (|>> (as java/lang/Short) ffi.short_to_long ("jvm leq" (ffi.short_to_long expected))) + + @.jvm + (|>> (as java/lang/Short) ffi.short_to_long "jvm object cast" ("jvm long =" ("jvm object cast" (ffi.short_to_long (as java/lang/Short expected))))))))))) + (<| (_.context "long") + (all _.and + (_.lifted "L2I" (conversion ..$Long::primitive ..$Integer::primitive /.l2i (|>> ffi.long_to_int) int::=)) + (_.lifted "L2F" (conversion ..$Long::primitive ..$Float::primitive /.l2f (|>> ffi.long_to_float) float::=)) + (_.lifted "L2D" (conversion ..$Long::primitive ..$Double::primitive /.l2d (|>> ffi.long_to_double) double::=)))) + (<| (_.context "float") + (all _.and + (_.lifted "F2I" (conversion ..$Float::primitive ..$Integer::primitive /.f2i (|>> ffi.float_to_int) int::=)) + (_.lifted "F2L" (conversion ..$Float::primitive ..$Long::primitive /.f2l (|>> ffi.float_to_long) long::=)) + (_.lifted "F2D" (conversion ..$Float::primitive ..$Double::primitive /.f2d (|>> ffi.float_to_double) double::=)))) + (<| (_.context "double") + (all _.and + (_.lifted "D2I" (conversion ..$Double::primitive ..$Integer::primitive /.d2i (|>> ffi.double_to_int) int::=)) + (_.lifted "D2L" (conversion ..$Double::primitive ..$Long::primitive /.d2l (|>> ffi.double_to_long) long::=)) + (_.lifted "D2F" (conversion ..$Double::primitive ..$Float::primitive /.d2f (|>> ffi.double_to_float) float::=)))) + ))) (def: value Test - ($_ _.and - (<| (_.context "primitive") - ..primitive) - (<| (_.context "object") - ..object) - (<| (_.context "method") - ..method) - (<| (_.context "field") - ..field) - (<| (_.context "array") - ..array) - (<| (_.context "conversion") - ..conversion) - )) + (all _.and + (<| (_.context "primitive") + ..primitive) + (<| (_.context "object") + ..object) + (<| (_.context "method") + ..method) + (<| (_.context "field") + ..field) + (<| (_.context "array") + ..array) + (<| (_.context "conversion") + ..conversion) + )) (def: registry Test @@ -1155,99 +1155,99 @@ _ (store register) _ (load register)] *wrap)))))] - ($_ _.and - (<| (_.context "int") - (let [test (!::= java/lang/Integer "jvm ieq" "jvm int =")] - ($_ _.and - (_.lifted "ISTORE_0/ILOAD_0" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_0) (function.constant /.iload_0)] test)) - (_.lifted "ISTORE_1/ILOAD_1" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_1) (function.constant /.iload_1)] test)) - (_.lifted "ISTORE_2/ILOAD_2" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_2) (function.constant /.iload_2)] test)) - (_.lifted "ISTORE_3/ILOAD_3" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_3) (function.constant /.iload_3)] test)) - (_.lifted "ISTORE/ILOAD" - (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) - (_.lifted "IINC" - (do [! random.monad] - [base ..$Byte::random - increment (# ! each (|>> (n.% 100) /unsigned.u1 try.trusted) - random.nat) - .let [expected (is java/lang/Long - (for @.old - ("jvm ladd" - (ffi.byte_to_long base) - (.int (/unsigned.value increment))) - - @.jvm - ("jvm object cast" - ("jvm long +" - ("jvm object cast" (ffi.byte_to_long base)) - ("jvm object cast" (as java/lang/Long (/unsigned.value increment)))))))]] - (..bytecode (|>> (as Int) (i.= (as Int expected))) - (do /.monad - [_ (..$Byte::literal base) - _ /.istore_0 - _ (/.iinc 0 increment) - _ /.iload_0 - _ /.i2l] - ..$Long::wrap))))))) - (<| (_.context "long") - (let [test (!::= java/lang/Long "jvm leq" "jvm long =")] - ($_ _.and - (_.lifted "LSTORE_0/LLOAD_0" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_0) (function.constant /.lload_0)] test)) - (_.lifted "LSTORE_1/LLOAD_1" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_1) (function.constant /.lload_1)] test)) - (_.lifted "LSTORE_2/LLOAD_2" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_2) (function.constant /.lload_2)] test)) - (_.lifted "LSTORE_3/LLOAD_3" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_3) (function.constant /.lload_3)] test)) - (_.lifted "LSTORE/LLOAD" - (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) - (<| (_.context "float") - (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] - ($_ _.and - (_.lifted "FSTORE_0/FLOAD_0" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_0) (function.constant /.fload_0)] test)) - (_.lifted "FSTORE_1/FLOAD_1" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_1) (function.constant /.fload_1)] test)) - (_.lifted "FSTORE_2/FLOAD_2" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_2) (function.constant /.fload_2)] test)) - (_.lifted "FSTORE_3/FLOAD_3" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_3) (function.constant /.fload_3)] test)) - (_.lifted "FSTORE/FLOAD" - (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) - (<| (_.context "double") - (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] - ($_ _.and - (_.lifted "DSTORE_0/DLOAD_0" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_0) (function.constant /.dload_0)] test)) - (_.lifted "DSTORE_1/DLOAD_1" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_1) (function.constant /.dload_1)] test)) - (_.lifted "DSTORE_2/DLOAD_2" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_2) (function.constant /.dload_2)] test)) - (_.lifted "DSTORE_3/DLOAD_3" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_3) (function.constant /.dload_3)] test)) - (_.lifted "DSTORE/DLOAD" - (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) - (<| (_.context "object") - (let [test (is (-> java/lang/String Any Bit) - (function (_ expected actual) - (|> actual (as Text) (text#= (as Text expected)))))] - ($_ _.and - (_.lifted "ASTORE_0/ALOAD_0" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) - (_.lifted "ASTORE_1/ALOAD_1" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_1) (function.constant /.aload_1)] test)) - (_.lifted "ASTORE_2/ALOAD_2" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_2) (function.constant /.aload_2)] test)) - (_.lifted "ASTORE_3/ALOAD_3" - (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_3) (function.constant /.aload_3)] test)) - (_.lifted "ASTORE/ALOAD" - (store_and_load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) - ))) + (all _.and + (<| (_.context "int") + (let [test (!::= java/lang/Integer "jvm ieq" "jvm int =")] + (all _.and + (_.lifted "ISTORE_0/ILOAD_0" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_0) (function.constant /.iload_0)] test)) + (_.lifted "ISTORE_1/ILOAD_1" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_1) (function.constant /.iload_1)] test)) + (_.lifted "ISTORE_2/ILOAD_2" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_2) (function.constant /.iload_2)] test)) + (_.lifted "ISTORE_3/ILOAD_3" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [(function.constant /.istore_3) (function.constant /.iload_3)] test)) + (_.lifted "ISTORE/ILOAD" + (store_and_load ..$Integer::random ..$Integer::literal ..$Integer::wrap [/.istore /.iload] test)) + (_.lifted "IINC" + (do [! random.monad] + [base ..$Byte::random + increment (# ! each (|>> (n.% 100) /unsigned.u1 try.trusted) + random.nat) + .let [expected (is java/lang/Long + (for @.old + ("jvm ladd" + (ffi.byte_to_long base) + (.int (/unsigned.value increment))) + + @.jvm + ("jvm object cast" + ("jvm long +" + ("jvm object cast" (ffi.byte_to_long base)) + ("jvm object cast" (as java/lang/Long (/unsigned.value increment)))))))]] + (..bytecode (|>> (as Int) (i.= (as Int expected))) + (do /.monad + [_ (..$Byte::literal base) + _ /.istore_0 + _ (/.iinc 0 increment) + _ /.iload_0 + _ /.i2l] + ..$Long::wrap))))))) + (<| (_.context "long") + (let [test (!::= java/lang/Long "jvm leq" "jvm long =")] + (all _.and + (_.lifted "LSTORE_0/LLOAD_0" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_0) (function.constant /.lload_0)] test)) + (_.lifted "LSTORE_1/LLOAD_1" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_1) (function.constant /.lload_1)] test)) + (_.lifted "LSTORE_2/LLOAD_2" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_2) (function.constant /.lload_2)] test)) + (_.lifted "LSTORE_3/LLOAD_3" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [(function.constant /.lstore_3) (function.constant /.lload_3)] test)) + (_.lifted "LSTORE/LLOAD" + (store_and_load ..$Long::random ..$Long::literal ..$Long::wrap [/.lstore /.lload] test))))) + (<| (_.context "float") + (let [test (!::= java/lang/Float "jvm feq" "jvm float =")] + (all _.and + (_.lifted "FSTORE_0/FLOAD_0" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_0) (function.constant /.fload_0)] test)) + (_.lifted "FSTORE_1/FLOAD_1" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_1) (function.constant /.fload_1)] test)) + (_.lifted "FSTORE_2/FLOAD_2" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_2) (function.constant /.fload_2)] test)) + (_.lifted "FSTORE_3/FLOAD_3" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [(function.constant /.fstore_3) (function.constant /.fload_3)] test)) + (_.lifted "FSTORE/FLOAD" + (store_and_load ..valid_float ..$Float::literal ..$Float::wrap [/.fstore /.fload] test))))) + (<| (_.context "double") + (let [test (!::= java/lang/Double "jvm deq" "jvm double =")] + (all _.and + (_.lifted "DSTORE_0/DLOAD_0" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_0) (function.constant /.dload_0)] test)) + (_.lifted "DSTORE_1/DLOAD_1" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_1) (function.constant /.dload_1)] test)) + (_.lifted "DSTORE_2/DLOAD_2" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_2) (function.constant /.dload_2)] test)) + (_.lifted "DSTORE_3/DLOAD_3" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [(function.constant /.dstore_3) (function.constant /.dload_3)] test)) + (_.lifted "DSTORE/DLOAD" + (store_and_load ..valid_double ..$Double::literal ..$Double::wrap [/.dstore /.dload] test))))) + (<| (_.context "object") + (let [test (is (-> java/lang/String Any Bit) + (function (_ expected actual) + (|> actual (as Text) (text#= (as Text expected)))))] + (all _.and + (_.lifted "ASTORE_0/ALOAD_0" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_0) (function.constant /.aload_0)] test)) + (_.lifted "ASTORE_1/ALOAD_1" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_1) (function.constant /.aload_1)] test)) + (_.lifted "ASTORE_2/ALOAD_2" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_2) (function.constant /.aload_2)] test)) + (_.lifted "ASTORE_3/ALOAD_3" + (store_and_load ..$String::random ..$String::literal /.nop [(function.constant /.astore_3) (function.constant /.aload_3)] test)) + (_.lifted "ASTORE/ALOAD" + (store_and_load ..$String::random ..$String::literal /.nop [/.astore /.aload] test))))) + ))) (def: stack Test @@ -1256,83 +1256,83 @@ .let [object_test (is (-> Any Bit) (|>> (as Text) (text#= (as Text expected/1))))] dummy/1 $String::random - .let [single ($_ _.and - (<| (_.lifted "DUP & POP") - (..bytecode object_test) - (do /.monad - [_ ($String::literal expected/1) - _ /.dup] - /.pop)) - (<| (_.lifted "DUP_X1 & POP2") - (..bytecode object_test) - (do /.monad - [_ ($String::literal dummy/1) - _ ($String::literal expected/1) - _ /.dup_x1] - /.pop2)) - (<| (_.lifted "DUP_X2") - (..bytecode object_test) - (do /.monad - [_ ($String::literal dummy/1) - _ ($String::literal dummy/1) - _ ($String::literal expected/1) - _ /.dup_x2 - _ /.pop2] - /.pop)) - (<| (_.lifted "SWAP") - (..bytecode object_test) - (do /.monad - [_ ($String::literal dummy/1) - _ ($String::literal expected/1) - _ /.swap] - /.pop)) - )] + .let [single (all _.and + (<| (_.lifted "DUP & POP") + (..bytecode object_test) + (do /.monad + [_ ($String::literal expected/1) + _ /.dup] + /.pop)) + (<| (_.lifted "DUP_X1 & POP2") + (..bytecode object_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($String::literal expected/1) + _ /.dup_x1] + /.pop2)) + (<| (_.lifted "DUP_X2") + (..bytecode object_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($String::literal dummy/1) + _ ($String::literal expected/1) + _ /.dup_x2 + _ /.pop2] + /.pop)) + (<| (_.lifted "SWAP") + (..bytecode object_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($String::literal expected/1) + _ /.swap] + /.pop)) + )] expected/2 $Long::random .let [long_test (is (-> Any Bit) (|>> (as Int) (i.= (as Int expected/2))))] dummy/2 $Long::random - .let [double ($_ _.and - (<| (_.lifted "DUP2") - (..bytecode long_test) - (do /.monad - [_ ($Long::literal expected/2) - _ /.dup2 - _ /.pop2] - ..$Long::wrap)) - (<| (_.lifted "DUP2_X1") - (..bytecode long_test) - (do /.monad - [_ ($String::literal dummy/1) - _ ($Long::literal expected/2) - _ /.dup2_x1 - _ /.pop2 - _ /.pop] - ..$Long::wrap)) - (<| (_.lifted "DUP2_X2") - (..bytecode long_test) - (do /.monad - [_ ($Long::literal dummy/2) - _ ($Long::literal expected/2) - _ /.dup2_x2 - _ /.pop2 - _ /.pop2] - ..$Long::wrap)) - )]] - ($_ _.and - (<| (_.context "single") - single) - (<| (_.context "double") - double) - ))) + .let [double (all _.and + (<| (_.lifted "DUP2") + (..bytecode long_test) + (do /.monad + [_ ($Long::literal expected/2) + _ /.dup2 + _ /.pop2] + ..$Long::wrap)) + (<| (_.lifted "DUP2_X1") + (..bytecode long_test) + (do /.monad + [_ ($String::literal dummy/1) + _ ($Long::literal expected/2) + _ /.dup2_x1 + _ /.pop2 + _ /.pop] + ..$Long::wrap)) + (<| (_.lifted "DUP2_X2") + (..bytecode long_test) + (do /.monad + [_ ($Long::literal dummy/2) + _ ($Long::literal expected/2) + _ /.dup2_x2 + _ /.pop2 + _ /.pop2] + ..$Long::wrap)) + )]] + (all _.and + (<| (_.context "single") + single) + (<| (_.context "double") + double) + ))) (def: resource Test - ($_ _.and - (<| (_.context "registry") - ..registry) - (<| (_.context "stack") - ..stack) - )) + (all _.and + (<| (_.context "registry") + ..registry) + (<| (_.context "stack") + ..stack) + )) (def: return Test @@ -1387,22 +1387,22 @@ {try.#Failure error} false) ))))] - ($_ _.and - (_.lifted "IRETURN" (primitive_return ..$Integer::primitive /.ireturn {.#None} (!::= java/lang/Integer "jvm ieq" "jvm int ="))) - (_.lifted "LRETURN" (primitive_return ..$Long::primitive /.lreturn {.#None} (!::= java/lang/Long "jvm leq" "jvm long ="))) - (_.lifted "FRETURN" (primitive_return ..$Float::primitive /.freturn {.#None} (!::= java/lang/Float "jvm feq" "jvm float ="))) - (_.lifted "DRETURN" (primitive_return ..$Double::primitive /.dreturn {.#None} (!::= java/lang/Double "jvm deq" "jvm double ="))) - (_.lifted "ARETURN" (primitive_return ..$String::primitive /.areturn {.#None} (function (_ expected actual) (text#= (as Text expected) (as Text actual))))) - (_.lifted "RETURN" (primitive_return (is (Primitive java/lang/String) - [#unboxed /type.void - #boxed ..$String - #wrap /.nop - #random ..$String::random - #literal (function.constant /.nop)]) - /.return - {.#Some ..$String::literal} - (function (_ expected actual) (text#= (as Text expected) (as Text actual))))) - ))) + (all _.and + (_.lifted "IRETURN" (primitive_return ..$Integer::primitive /.ireturn {.#None} (!::= java/lang/Integer "jvm ieq" "jvm int ="))) + (_.lifted "LRETURN" (primitive_return ..$Long::primitive /.lreturn {.#None} (!::= java/lang/Long "jvm leq" "jvm long ="))) + (_.lifted "FRETURN" (primitive_return ..$Float::primitive /.freturn {.#None} (!::= java/lang/Float "jvm feq" "jvm float ="))) + (_.lifted "DRETURN" (primitive_return ..$Double::primitive /.dreturn {.#None} (!::= java/lang/Double "jvm deq" "jvm double ="))) + (_.lifted "ARETURN" (primitive_return ..$String::primitive /.areturn {.#None} (function (_ expected actual) (text#= (as Text expected) (as Text actual))))) + (_.lifted "RETURN" (primitive_return (is (Primitive java/lang/String) + [#unboxed /type.void + #boxed ..$String + #wrap /.nop + #random ..$String::random + #literal (function.constant /.nop)]) + /.return + {.#Some ..$String::literal} + (function (_ expected actual) (text#= (as Text expected) (as Text actual))))) + ))) (def: branching Test @@ -1423,16 +1423,16 @@ _ (..$Long::literal expected) _ (/.set_label @end)] ..$Long::wrap)))) - comparison_against_zero ($_ _.and - (_.lifted "IFEQ" (if! /.ifeq /.iconst_0)) - (_.lifted "IFNE" (if! /.ifne /.iconst_1)) - (_.lifted "IFLT" (if! /.iflt /.iconst_m1)) - (_.lifted "IFLE" (if! /.ifle /.iconst_0)) - (_.lifted "IFGT" (if! /.ifgt /.iconst_1)) - (_.lifted "IFGE" (if! /.ifge /.iconst_0))) - null_test ($_ _.and - (_.lifted "IFNULL" (if! /.ifnull /.aconst_null)) - (_.lifted "IFNONNULL" (if! /.ifnonnull (/.string ""))))] + comparison_against_zero (all _.and + (_.lifted "IFEQ" (if! /.ifeq /.iconst_0)) + (_.lifted "IFNE" (if! /.ifne /.iconst_1)) + (_.lifted "IFLT" (if! /.iflt /.iconst_m1)) + (_.lifted "IFLE" (if! /.ifle /.iconst_0)) + (_.lifted "IFGT" (if! /.ifgt /.iconst_1)) + (_.lifted "IFGE" (if! /.ifge /.iconst_0))) + null_test (all _.and + (_.lifted "IFNULL" (if! /.ifnull /.aconst_null)) + (_.lifted "IFNONNULL" (if! /.ifnonnull (/.string ""))))] reference ..$Integer::random subject (|> ..$Integer::random (random.only (|>> ((!::= java/lang/Integer "jvm ieq" "jvm int =") reference) not))) @@ -1443,28 +1443,28 @@ ("jvm int <" ("jvm object cast" subject) ("jvm object cast" reference))) [reference subject] [subject reference]) - int_comparison ($_ _.and - (_.lifted "IF_ICMPEQ" (if! /.if_icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) - (_.lifted "IF_ICMPNE" (if! /.if_icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) - (_.lifted "IF_ICMPLT" (if! /.if_icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) - (_.lifted "IF_ICMPLE" (if! /.if_icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) - (_.lifted "IF_ICMPGT" (if! /.if_icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) - (_.lifted "IF_ICMPGE" (if! /.if_icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) + int_comparison (all _.and + (_.lifted "IF_ICMPEQ" (if! /.if_icmpeq (do /.monad [_ (..$Integer::literal reference)] /.dup))) + (_.lifted "IF_ICMPNE" (if! /.if_icmpne (do /.monad [_ (..$Integer::literal reference)] (..$Integer::literal subject)))) + (_.lifted "IF_ICMPLT" (if! /.if_icmplt (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lifted "IF_ICMPLE" (if! /.if_icmple (do /.monad [_ (..$Integer::literal lesser)] (..$Integer::literal greater)))) + (_.lifted "IF_ICMPGT" (if! /.if_icmpgt (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser)))) + (_.lifted "IF_ICMPGE" (if! /.if_icmpge (do /.monad [_ (..$Integer::literal greater)] (..$Integer::literal lesser))))) new_object (is (Bytecode Any) (do /.monad [_ (/.new ..$Object) _ /.dup] (/.invokespecial ..$Object "<init>" (/type.method [(list) (list) /type.void (list)])))) - reference_comparison ($_ _.and - (_.lifted "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) - (_.lifted "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) - )]] - ($_ _.and - comparison_against_zero - null_test - int_comparison - reference_comparison - ))) + reference_comparison (all _.and + (_.lifted "IF_ACMPEQ" (if! /.if_acmpeq (do /.monad [_ new_object] /.dup))) + (_.lifted "IF_ACMPNE" (if! /.if_acmpne (do /.monad [_ new_object] new_object))) + )]] + (all _.and + comparison_against_zero + null_test + int_comparison + reference_comparison + ))) (def: jump Test @@ -1486,64 +1486,64 @@ _ (..$Long::literal expected) _ (/.set_label @end)] ..$Long::wrap))))]] - ($_ _.and - (_.lifted "GOTO" (jump /.goto)) - (_.lifted "GOTO_W" (jump /.goto_w))))) + (all _.and + (_.lifted "GOTO" (jump /.goto)) + (_.lifted "GOTO_W" (jump /.goto_w))))) (def: switch Test - ($_ _.and - (<| (_.lifted "TABLESWITCH") - (do [! random.monad] - [expected ..$Long::random - dummy ..$Long::random - minimum (# ! each (|>> (n.% 100) .int /signed.s4 try.trusted) - random.nat) - afterwards (# ! each (n.% 10) random.nat)]) - (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) - (do /.monad - [@right /.new_label - @wrong /.new_label - @return /.new_label - _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.trusted)) - _ (/.tableswitch minimum @wrong [@right (list.repeated afterwards @wrong)]) - _ (/.set_label @wrong) - _ (..$Long::literal dummy) - _ (/.goto @return) - _ (/.set_label @right) - _ (..$Long::literal expected) - _ (/.set_label @return)] - ..$Long::wrap)) - (<| (_.lifted "LOOKUPSWITCH") - (do [! random.monad] - [options (# ! each (|>> (n.% 10) (n.+ 1)) - random.nat) - choice (# ! each (n.% options) random.nat) - options (|> random.int - (# ! each (|>> (as java/lang/Long) ffi.long_to_int ffi.int_to_long (as Int))) - (random.set i.hash options) - (# ! each set.list)) - .let [choice (maybe.trusted (list.item choice options))] - expected ..$Long::random - dummy ..$Long::random]) - (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) - (do /.monad - [@right /.new_label - @wrong /.new_label - @return /.new_label - _ (..$Integer::literal (ffi.long_to_int (as java/lang/Long choice))) - _ (/.lookupswitch @wrong (list#each (function (_ option) - [(|> option /signed.s4 try.trusted) - (if (i.= choice option) @right @wrong)]) - options)) - _ (/.set_label @wrong) - _ (..$Long::literal dummy) - _ (/.goto @return) - _ (/.set_label @right) - _ (..$Long::literal expected) - _ (/.set_label @return)] - ..$Long::wrap)) - )) + (all _.and + (<| (_.lifted "TABLESWITCH") + (do [! random.monad] + [expected ..$Long::random + dummy ..$Long::random + minimum (# ! each (|>> (n.% 100) .int /signed.s4 try.trusted) + random.nat) + afterwards (# ! each (n.% 10) random.nat)]) + (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) + (do /.monad + [@right /.new_label + @wrong /.new_label + @return /.new_label + _ (/.bipush (|> minimum /signed.value .int /signed.s1 try.trusted)) + _ (/.tableswitch minimum @wrong [@right (list.repeated afterwards @wrong)]) + _ (/.set_label @wrong) + _ (..$Long::literal dummy) + _ (/.goto @return) + _ (/.set_label @right) + _ (..$Long::literal expected) + _ (/.set_label @return)] + ..$Long::wrap)) + (<| (_.lifted "LOOKUPSWITCH") + (do [! random.monad] + [options (# ! each (|>> (n.% 10) (n.+ 1)) + random.nat) + choice (# ! each (n.% options) random.nat) + options (|> random.int + (# ! each (|>> (as java/lang/Long) ffi.long_to_int ffi.int_to_long (as Int))) + (random.set i.hash options) + (# ! each set.list)) + .let [choice (maybe.trusted (list.item choice options))] + expected ..$Long::random + dummy ..$Long::random]) + (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) + (do /.monad + [@right /.new_label + @wrong /.new_label + @return /.new_label + _ (..$Integer::literal (ffi.long_to_int (as java/lang/Long choice))) + _ (/.lookupswitch @wrong (list#each (function (_ option) + [(|> option /signed.s4 try.trusted) + (if (i.= choice option) @right @wrong)]) + options)) + _ (/.set_label @wrong) + _ (..$Long::literal dummy) + _ (/.goto @return) + _ (/.set_label @right) + _ (..$Long::literal expected) + _ (/.set_label @return)] + ..$Long::wrap)) + )) (def: exception Test @@ -1577,29 +1577,29 @@ (def: code Test - ($_ _.and - (<| (_.context "return") - ..return) - (<| (_.context "branching") - ..branching) - (<| (_.context "jump") - ..jump) - (<| (_.context "switch") - ..switch) - (<| (_.context "exception") - ..exception) - )) + (all _.and + (<| (_.context "return") + ..return) + (<| (_.context "branching") + ..branching) + (<| (_.context "jump") + ..jump) + (<| (_.context "switch") + ..switch) + (<| (_.context "exception") + ..exception) + )) (def: instruction Test - ($_ _.and - (<| (_.context "value") - ..value) - (<| (_.context "resource") - ..resource) - (<| (_.context "code") - ..code) - )) + (all _.and + (<| (_.context "value") + ..value) + (<| (_.context "resource") + ..resource) + (<| (_.context "code") + ..code) + )) (def: inheritance Test @@ -1617,12 +1617,12 @@ fake_part2 ..$Long::random part3 ..$Long::random part4 ..$Long::random - .let [expected ($_ i.+ - (as Int part0) - (as Int part1) - (as Int part2) - (as Int part3) - (as Int part4)) + .let [expected (all i.+ + (as Int part0) + (as Int part1) + (as Int part2) + (as Int part3) + (as Int part4)) $Concrete (/type.class concrete_class (list)) $Abstract (/type.class abstract_class (list)) $Interface (/type.class interface_class (list)) @@ -1647,18 +1647,18 @@ [_ (..$Long::literal value)] /.lreturn)}))) - interface_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract /class.interface) + interface_bytecode (|> (/class.class /version.v6_0 (all /modifier#composite /class.public /class.abstract /class.interface) (/name.internal interface_class) {.#None} (/name.internal "java.lang.Object") (list) (list) - (list (/method.method ($_ /modifier#composite /method.public /method.abstract) + (list (/method.method (all /modifier#composite /method.public /method.abstract) interface_method #0 method::type (list) {.#None})) (sequence.sequence)) try.trusted (format.result /class.writer)) - abstract_bytecode (|> (/class.class /version.v6_0 ($_ /modifier#composite /class.public /class.abstract) + abstract_bytecode (|> (/class.class /version.v6_0 (all /modifier#composite /class.public /class.abstract) (/name.internal abstract_class) {.#None} (/name.internal "java.lang.Object") @@ -1674,7 +1674,7 @@ /.return)}) (method inherited_method part0) (method overriden_method fake_part2) - (/method.method ($_ /modifier#composite /method.public /method.abstract) + (/method.method (all /modifier#composite /method.public /method.abstract) abstract_method #0 method::type (list) {.#None})) (sequence.sequence)) try.trusted @@ -1702,9 +1702,9 @@ (method overriden_method part2) (method abstract_method part3) (method interface_method part4) - (/method.method ($_ /modifier#composite - /method.public - /method.static) + (/method.method (all /modifier#composite + /method.public + /method.static) static_method #0 (/type.method [(list) (list) ..$Long (list)]) (list) @@ -1746,9 +1746,9 @@ (def: .public test Test (<| (_.context (%.symbol (symbol .._))) - ($_ _.and - (<| (_.context "instruction") - ..instruction) - (<| (_.context "inheritance") - ..inheritance) - ))) + (all _.and + (<| (_.context "instruction") + ..instruction) + (<| (_.context "inheritance") + ..inheritance) + ))) diff --git a/stdlib/source/test/lux/target/lua.lux b/stdlib/source/test/lux/target/lua.lux index 31d4a6f95..3ae103b3d 100644 --- a/stdlib/source/test/lux/target/lua.lux +++ b/stdlib/source/test/lux/target/lua.lux @@ -51,47 +51,47 @@ int random.int float random.frac string (random.ascii/upper 5)] - ($_ _.and - (_.cover [/.nil] - (|> /.nil - /.code - ..load - (pipe.case - {.#None} true - {.#Some _} false))) - (_.cover [/.boolean] - (expression (|>> (as Bit) (bit#= boolean)) - (/.boolean boolean))) - (_.cover [/.int] - (expression (|>> (as Int) (i.= int)) - (/.int int))) - (_.cover [/.float] - (expression (|>> (as Frac) (f.= float)) - (/.float float))) - (_.cover [/.string] - (expression (|>> (as Text) (text#= string)) - (/.string string))) - ))) + (all _.and + (_.cover [/.nil] + (|> /.nil + /.code + ..load + (pipe.case + {.#None} true + {.#Some _} false))) + (_.cover [/.boolean] + (expression (|>> (as Bit) (bit#= boolean)) + (/.boolean boolean))) + (_.cover [/.int] + (expression (|>> (as Int) (i.= int)) + (/.int int))) + (_.cover [/.float] + (expression (|>> (as Frac) (f.= float)) + (/.float float))) + (_.cover [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + ))) (def: test|boolean Test (do [! random.monad] [left random.bit right random.bit] - (`` ($_ _.and - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> left right)] - (expression (|>> (as Bit) (bit#= expected)) - (</> (/.boolean left) (/.boolean right)))))] - - [/.or .or] - [/.and .and] - )) - (_.cover [/.not] - (expression (|>> (as Bit) (bit#= (not left))) - (/.not (/.boolean left)))) - )))) + (`` (all _.and + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.boolean left) (/.boolean right)))))] + + [/.or .or] + [/.and .and] + )) + (_.cover [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.boolean left)))) + )))) (template [<bits>] [(`` (def: (~~ (template.symbol [int_ <bits>])) @@ -113,38 +113,38 @@ parameter (random.only (|>> (i.= +0) not) random.int) subject random.int] - (`` ($_ _.and - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> left right)] - (expression (|>> (as Int) (i.= expected)) - (</> (/.int left) (/.int right)))))] - - [/.bit_or i64.or] - [/.bit_xor i64.xor] - [/.bit_and i64.and] - )) - (_.cover [/.opposite] - (expression (|>> (as Int) (i.= (i.- left +0))) - (/.opposite (/.int left)))) - (_.cover [/.bit_shl] - (let [expected (i64.left_shifted shift left)] - (expression (|>> (as Int) (i.= expected)) - (/.bit_shl (/.int (.int shift)) - (/.int left))))) - (_.cover [/.bit_shr] - (let [expected (i64.right_shifted shift left)] - (expression (|>> (as Int) (i.= expected)) - (/.bit_shr (/.int (.int shift)) - (/.int left))))) - (_.cover [/.//] - (let [expected (if (or (i.= (i.signum parameter) (i.signum subject)) - (i.= +0 (i.% parameter subject))) - (i./ parameter subject) - (-- (i./ parameter subject)))] - (expression (|>> (as Int) (i.= expected)) - (/.// (/.int parameter) (/.int subject))))) - )))) + (`` (all _.and + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Int) (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.cover [/.opposite] + (expression (|>> (as Int) (i.= (i.- left +0))) + (/.opposite (/.int left)))) + (_.cover [/.bit_shl] + (let [expected (i64.left_shifted shift left)] + (expression (|>> (as Int) (i.= expected)) + (/.bit_shl (/.int (.int shift)) + (/.int left))))) + (_.cover [/.bit_shr] + (let [expected (i64.right_shifted shift left)] + (expression (|>> (as Int) (i.= expected)) + (/.bit_shr (/.int (.int shift)) + (/.int left))))) + (_.cover [/.//] + (let [expected (if (or (i.= (i.signum parameter) (i.signum subject)) + (i.= +0 (i.% parameter subject))) + (i./ parameter subject) + (-- (i./ parameter subject)))] + (expression (|>> (as Int) (i.= expected)) + (/.// (/.int parameter) (/.int subject))))) + )))) (def: test|float Test @@ -152,33 +152,33 @@ [parameter (random.only (|>> (f.= +0.0) not) random.safe_frac) subject random.safe_frac] - (`` ($_ _.and - (~~ (template [</> <lux> <pre>] - [(_.cover [</>] - (let [expected (<lux> (<pre> parameter) (<pre> subject))] - (expression (|>> (as Frac) (f.= expected)) - (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] - - [/.+ f.+ |>] - [/.- f.- |>] - [/.* f.* |>] - [/./ f./ |>] - [/.% f.mod |>] - [/.^ f.pow f.abs] - )) - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> parameter subject)] - (expression (|>> (as Bit) (bit#= expected)) - (</> (/.float parameter) (/.float subject)))))] - - [/.< f.<] - [/.<= f.<=] - [/.> f.>] - [/.>= f.>=] - [/.= f.=] - )) - )))) + (`` (all _.and + (~~ (template [</> <lux> <pre>] + [(_.cover [</>] + (let [expected (<lux> (<pre> parameter) (<pre> subject))] + (expression (|>> (as Frac) (f.= expected)) + (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] + + [/.+ f.+ |>] + [/.- f.- |>] + [/.* f.* |>] + [/./ f./ |>] + [/.% f.mod |>] + [/.^ f.pow f.abs] + )) + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.float parameter) (/.float subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) (def: test|string Test @@ -186,12 +186,12 @@ [left (random.ascii/lower 8) right (random.ascii/lower 8) .let [expected (format left right)]] - ($_ _.and - (_.cover [/.concat] - (expression (|>> (as Text) (text#= expected)) - (|> (/.string left) - (/.concat (/.string right))))) - ))) + (all _.and + (_.cover [/.concat] + (expression (|>> (as Text) (text#= expected)) + (|> (/.string left) + (/.concat (/.string right))))) + ))) (def: test|array Test @@ -202,19 +202,19 @@ .let [expected (|> items (list.item index) maybe.trusted)]] - ($_ _.and - (_.cover [/.array /.item] - (and (expression (|>> (as Frac) (f.= expected)) - (/.item (/.int (.int (++ index))) - (/.array (list#each /.float items)))) - (expression (|>> (as Bit)) - (|> (/.array (list#each /.float items)) - (/.item (/.int (.int (++ size)))) - (/.= /.nil))))) - (_.cover [/.length] - (expression (|>> (as Int) (i.= (.int size))) - (/.length (/.array (list#each /.float items))))) - ))) + (all _.and + (_.cover [/.array /.item] + (and (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int (++ index))) + (/.array (list#each /.float items)))) + (expression (|>> (as Bit)) + (|> (/.array (list#each /.float items)) + (/.item (/.int (.int (++ size)))) + (/.= /.nil))))) + (_.cover [/.length] + (expression (|>> (as Int) (i.= (.int size))) + (/.length (/.array (list#each /.float items))))) + ))) (def: test|table Test @@ -234,26 +234,26 @@ non_field (random.only (|>> (text#= field) not) (random.ascii/upper 5)) method (random.ascii/upper 6)] - ($_ _.and - (_.cover [/.table /.the] - (and (expression (|>> (as Frac) (f.= expected)) - (/.the field (/.table (list [field (/.float expected)])))) - (expression (|>> (as Bit)) - (|> (/.table (list [field (/.float expected)])) - (/.the non_field) - (/.= /.nil))))) - (_.cover [/.do /.function] - (expression (|>> (as Frac) (f.= expected)) - (|> ($_ /.then - (/.local/1 $table (/.table (list [field (/.float expected)]))) - (/.function (/.the method $table) (list $self $arg) - (/.if (/.= (/.float dummy) $arg) - (/.return (/.the field $self)) - (/.return $arg))) - (/.return (/.do method (list (/.float dummy)) $table))) - (/.closure (list)) - (/.apply (list))))) - ))) + (all _.and + (_.cover [/.table /.the] + (and (expression (|>> (as Frac) (f.= expected)) + (/.the field (/.table (list [field (/.float expected)])))) + (expression (|>> (as Bit)) + (|> (/.table (list [field (/.float expected)])) + (/.the non_field) + (/.= /.nil))))) + (_.cover [/.do /.function] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.local/1 $table (/.table (list [field (/.float expected)]))) + (/.function (/.the method $table) (list $self $arg) + (/.if (/.= (/.float dummy) $arg) + (/.return (/.the field $self)) + (/.return $arg))) + (/.return (/.do method (list (/.float dummy)) $table))) + (/.closure (list)) + (/.apply (list))))) + ))) (def: test|computation Test @@ -268,50 +268,50 @@ string (random.ascii/upper 5) comment (random.ascii/upper 10)] - ($_ _.and - ..test|boolean - ..test|int - ..test|float - ..test|string - ..test|array - ..test|table - (_.cover [/.type/1] - (and (expression (|>> (as Text) (text#= "boolean")) - (/.type/1 (/.boolean boolean))) - (expression (|>> (as Text) (text#= "number")) - (/.type/1 (/.int int))) - (expression (|>> (as Text) (text#= "number")) - (/.type/1 (/.float float))) - (expression (|>> (as Text) (text#= "string")) - (/.type/1 (/.string string))) - (expression (|>> (as Text) (text#= "nil")) - (/.type/1 /.nil)) - (expression (|>> (as Text) (text#= "table")) - (/.type/1 (/.table (list [string (/.float float)])))) - (expression (|>> (as Text) (text#= "table")) - (/.type/1 (/.array (list (/.boolean boolean) - (/.float float) - (/.string string))))) - )) - (_.cover [/.require/1] - (expression (|>> (as Int) (i.= (i.abs int))) - (|> (/.require/1 (/.string "math")) - (/.the "abs") - (/.apply (list (/.int int)))))) - (_.cover [/.comment] - (expression (|>> (as Frac) (f.= then)) - (/.comment comment - (/.float then)))) - ))) + (all _.and + ..test|boolean + ..test|int + ..test|float + ..test|string + ..test|array + ..test|table + (_.cover [/.type/1] + (and (expression (|>> (as Text) (text#= "boolean")) + (/.type/1 (/.boolean boolean))) + (expression (|>> (as Text) (text#= "number")) + (/.type/1 (/.int int))) + (expression (|>> (as Text) (text#= "number")) + (/.type/1 (/.float float))) + (expression (|>> (as Text) (text#= "string")) + (/.type/1 (/.string string))) + (expression (|>> (as Text) (text#= "nil")) + (/.type/1 /.nil)) + (expression (|>> (as Text) (text#= "table")) + (/.type/1 (/.table (list [string (/.float float)])))) + (expression (|>> (as Text) (text#= "table")) + (/.type/1 (/.array (list (/.boolean boolean) + (/.float float) + (/.string string))))) + )) + (_.cover [/.require/1] + (expression (|>> (as Int) (i.= (i.abs int))) + (|> (/.require/1 (/.string "math")) + (/.the "abs") + (/.apply (list (/.int int)))))) + (_.cover [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.float then)))) + ))) (def: test|expression Test - (`` ($_ _.and - (_.for [/.Literal] - ..test|literal) - (_.for [/.Computation] - ..test|computation) - ))) + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + ))) (def: test/var Test @@ -324,35 +324,35 @@ (random.ascii/lower 10)) .let [$foreign (/.var foreign) $local (/.var local)]] - ($_ _.and - (_.cover [/.var] - (expression (|>> (as Frac) (f.= float/0)) - (|> (/.return $foreign) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))) - (_.cover [/.let] - (expression (|>> (as Frac) (f.= float/1)) - (|> ($_ /.then - (/.let (list $local) (/.float float/1)) - (/.return $local)) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))) - (_.cover [/.local/1] - (expression (|>> (as Frac) (f.= float/1)) - (|> ($_ /.then - (/.local/1 $local (/.float float/1)) - (/.return $local)) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))) - (_.cover [/.local] - (expression (|>> (as Frac) (f.= float/1)) - (|> ($_ /.then - (/.local (list $local)) - (/.set (list $local) (/.float float/1)) - (/.return $local)) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))) - ))) + (all _.and + (_.cover [/.var] + (expression (|>> (as Frac) (f.= float/0)) + (|> (/.return $foreign) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.cover [/.let] + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.let (list $local) (/.float float/1)) + (/.return $local)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.cover [/.local/1] + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.local/1 $local (/.float float/1)) + (/.return $local)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.cover [/.local] + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.local (list $local)) + (/.set (list $local) (/.float float/1)) + (/.return $local)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + ))) (def: test/location Test @@ -364,47 +364,47 @@ $arg/0 (# ! each /.var (random.ascii/lower 11)) $arg/1 (# ! each /.var (random.ascii/lower 12)) field (random.ascii/upper 10)] - ($_ _.and - (_.cover [/.set] - (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (|> ($_ /.then - (/.set (list $foreign) (/.+ $foreign $foreign)) - (/.return $foreign)) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))) - (_.cover [/.multi] - (and (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.set (list $arg/0 $arg/1) (/.multi (list (/.float float/0) (/.float float/1)))) - (/.return $arg/0)) - (/.closure (list)) - (/.apply (list)))) - (expression (|>> (as Frac) (f.= float/1)) - (|> ($_ /.then - (/.set (list $arg/0 $arg/1) (/.multi (list (/.float float/0) (/.float float/1)))) - (/.return $arg/1)) - (/.closure (list)) - (/.apply (list)))))) - (_.cover [/.Access] - (and (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (let [@ (/.item (/.int +1) $foreign)] - (|> ($_ /.then - (/.set (list $foreign) (/.array (list $foreign))) - (/.set (list @) (/.+ @ @)) - (/.return @)) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))) - (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (let [@ (/.the field $foreign)] - (|> ($_ /.then - (/.set (list $foreign) (/.table (list [field $foreign]))) - (/.set (list @) (/.+ @ @)) - (/.return @)) - (/.closure (list $foreign)) - (/.apply (list (/.float float/0)))))))) - (_.for [/.Var] - ..test/var) - ))) + (all _.and + (_.cover [/.set] + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (|> (all /.then + (/.set (list $foreign) (/.+ $foreign $foreign)) + (/.return $foreign)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (_.cover [/.multi] + (and (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $arg/0 $arg/1) (/.multi (list (/.float float/0) (/.float float/1)))) + (/.return $arg/0)) + (/.closure (list)) + (/.apply (list)))) + (expression (|>> (as Frac) (f.= float/1)) + (|> (all /.then + (/.set (list $arg/0 $arg/1) (/.multi (list (/.float float/0) (/.float float/1)))) + (/.return $arg/1)) + (/.closure (list)) + (/.apply (list)))))) + (_.cover [/.Access] + (and (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.item (/.int +1) $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.array (list $foreign))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))) + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.the field $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.table (list [field $foreign]))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + (/.closure (list $foreign)) + (/.apply (list (/.float float/0)))))))) + (_.for [/.Var] + ..test/var) + ))) (def: test|label Test @@ -422,79 +422,79 @@ .let [expected (i.* expected_iterations input) expected_iterations (/.int expected_iterations)]] - ($_ _.and - (_.cover [/.break] - (let [=for_in (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $output (/.int +0)) - (/.for_in (list $index $input) (/.ipairs/1 (/.array (list.repeated full_iterations $input))) - ($_ /.then - (/.when (/.> expected_iterations $index) - /.break) - (/.set (list $output) (/.+ $input $output)))) - (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input))))) - - full_iterations (/.int (.int full_iterations)) - =while (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $index (/.int +0)) - (/.local/1 $output (/.int +0)) - (/.while (/.< full_iterations $index) - ($_ /.then - (/.when (/.= expected_iterations $index) - /.break) - (/.set (list $output) (/.+ $input $output)) - (/.set (list $index) (/.+ (/.int +1) $index)) - )) - (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input))))) - =repeat (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $index (/.int +0)) - (/.local/1 $output (/.int +0)) - (/.repeat (/.= full_iterations $index) - ($_ /.then - (/.when (/.= expected_iterations $index) - /.break) - (/.set (list $output) (/.+ $input $output)) - (/.set (list $index) (/.+ (/.int +1) $index)) - )) - (/.return $output)) + (all _.and + (_.cover [/.break] + (let [=for_in (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_in (list $index $input) (/.ipairs/1 (/.array (list.repeated full_iterations $input))) + (all /.then + (/.when (/.> expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input))))) + + full_iterations (/.int (.int full_iterations)) + =while (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.while (/.< full_iterations $index) + (all /.then + (/.when (/.= expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) (/.closure (list $input)) (/.apply (list (/.int input))))) - =for_step (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then + =repeat (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) (/.local/1 $output (/.int +0)) - (/.for_step $index (/.int +0) full_iterations (/.int +1) - ($_ /.then - (/.when (/.= expected_iterations $index) - /.break) - (/.set (list $output) (/.+ $input $output)))) + (/.repeat (/.= full_iterations $index) + (all /.then + (/.when (/.= expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input)))))] - (and =while - =repeat - =for_step - =for_in))) - (_.cover [/.label /.set_label /.go_to] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $index (/.int +0)) - (/.local/1 $output (/.int +0)) - (/.set_label @loop) - (/.if (/.< expected_iterations $index) - ($_ /.then - (/.set (list $output) (/.+ $input $output)) - (/.set (list $index) (/.+ (/.int +1) $index)) - (/.go_to @loop)) - (/.return $output))) - (/.closure (list $input)) - (/.apply (list (/.int input)))))) - ))) + (/.closure (list $input)) + (/.apply (list (/.int input))))) + =for_step (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_step $index (/.int +0) full_iterations (/.int +1) + (all /.then + (/.when (/.= expected_iterations $index) + /.break) + (/.set (list $output) (/.+ $input $output)))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))] + (and =while + =repeat + =for_step + =for_in))) + (_.cover [/.label /.set_label /.go_to] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.set_label @loop) + (/.if (/.< expected_iterations $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + (/.go_to @loop)) + (/.return $output))) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + ))) (def: test|loop Test @@ -505,54 +505,54 @@ $output (/.var "output") $index (/.var "index") expected (i.* (.int iterations) input)]] - ($_ _.and - (_.cover [/.while] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $index (/.int +0)) - (/.local/1 $output (/.int +0)) - (/.while (/.< (/.int (.int iterations)) $index) - ($_ /.then - (/.set (list $output) (/.+ $input $output)) - (/.set (list $index) (/.+ (/.int +1) $index)) - )) - (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input)))))) - (_.cover [/.repeat] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $index (/.int +0)) - (/.local/1 $output (/.int +0)) - (/.repeat (/.= (/.int (.int iterations)) $index) - ($_ /.then - (/.set (list $output) (/.+ $input $output)) - (/.set (list $index) (/.+ (/.int +1) $index)) - )) - (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input)))))) - (_.cover [/.for_step] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $output (/.int +0)) - (/.for_step $index (/.int +0) (/.int (.int (-- iterations))) (/.int +1) + (all _.and + (_.cover [/.while] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.cover [/.repeat] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $index (/.int +0)) + (/.local/1 $output (/.int +0)) + (/.repeat (/.= (/.int (.int iterations)) $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.cover [/.for_step] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_step $index (/.int +0) (/.int (.int (-- iterations))) (/.int +1) + (/.set (list $output) (/.+ $input $output))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.cover [/.for_in /.ipairs/1] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.local/1 $output (/.int +0)) + (/.for_in (list $index $input) (/.ipairs/1 (/.array (list.repeated iterations $input))) (/.set (list $output) (/.+ $input $output))) - (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input)))))) - (_.cover [/.for_in /.ipairs/1] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.local/1 $output (/.int +0)) - (/.for_in (list $index $input) (/.ipairs/1 (/.array (list.repeated iterations $input))) - (/.set (list $output) (/.+ $input $output))) - (/.return $output)) - (/.closure (list $input)) - (/.apply (list (/.int input)))))) - (_.for [/.Label] - ..test|label) - ))) + (/.return $output)) + (/.closure (list $input)) + (/.apply (list (/.int input)))))) + (_.for [/.Label] + ..test|label) + ))) (def: test|exception Test @@ -562,42 +562,42 @@ random.safe_frac) $verdict (# ! each /.var (random.ascii/lower 10)) $outcome (# ! each /.var (random.ascii/lower 11))] - ($_ _.and - (_.cover [/.pcall/1] - (expression (|>> (as Frac) (f.= expected)) - (|> ($_ /.then - (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) - (/.return (/.float expected))))) - (/.if $verdict - (/.return $outcome) - (/.return (/.float dummy)))) - (/.closure (list)) - (/.apply (list))))) - (_.cover [/.error/1] - (expression (|>> (as Frac) (f.= expected)) - (|> ($_ /.then - (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) - ($_ /.then - (/.statement (/.error/1 (/.float expected))) - (/.return (/.float dummy)))))) - (/.if $verdict - (/.return (/.float dummy)) - (/.return $outcome))) - (/.closure (list)) - (/.apply (list))))) - (_.cover [/.error/2] - (expression (|>> (as Frac) (f.= expected)) - (|> ($_ /.then - (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) - ($_ /.then - (/.statement (/.error/2 (/.float expected) (/.int +2))) - (/.return (/.float dummy)))))) - (/.if $verdict - (/.return (/.float dummy)) - (/.return $outcome))) - (/.closure (list)) - (/.apply (list))))) - ))) + (all _.and + (_.cover [/.pcall/1] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) + (/.return (/.float expected))))) + (/.if $verdict + (/.return $outcome) + (/.return (/.float dummy)))) + (/.closure (list)) + (/.apply (list))))) + (_.cover [/.error/1] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) + (all /.then + (/.statement (/.error/1 (/.float expected))) + (/.return (/.float dummy)))))) + (/.if $verdict + (/.return (/.float dummy)) + (/.return $outcome))) + (/.closure (list)) + (/.apply (list))))) + (_.cover [/.error/2] + (expression (|>> (as Frac) (f.= expected)) + (|> (all /.then + (/.let (list $verdict $outcome) (/.pcall/1 (/.closure (list) + (all /.then + (/.statement (/.error/2 (/.float expected) (/.int +2))) + (/.return (/.float dummy)))))) + (/.if $verdict + (/.return (/.float dummy)) + (/.return $outcome))) + (/.closure (list)) + (/.apply (list))))) + ))) (def: test|function Test @@ -608,37 +608,37 @@ $arg/0 (# ! each /.var (random.ascii/lower 2)) field (random.ascii/lower 3) $class (# ! each /.var (random.ascii/upper 4))] - ($_ _.and - (_.cover [/.closure /.return] - (expression (|>> (as Frac) (f.= float/0)) - (/.apply (list) - (/.closure (list) (/.return (/.float float/0)))))) - (_.cover [/.local_function] - (expression (|>> (as Int) .nat (n.= iterations)) - (|> ($_ /.then - (/.local_function $self (list $arg/0) - (/.if (/.< (/.int (.int iterations)) $arg/0) - (/.return (/.apply (list (/.+ (/.int +1) $arg/0)) $self)) - (/.return $arg/0))) - (/.return (/.apply (list (/.int +0)) $self))) - (/.closure (list)) - (/.apply (list))))) - (do [! random.monad] - [float/0 random.safe_frac - float/1 random.safe_frac - float/2 random.safe_frac - $arg/0 (# ! each /.var (random.ascii/lower 10)) - $arg/1 (# ! each /.var (random.ascii/lower 11)) - $arg/2 (# ! each /.var (random.ascii/lower 12))] - (`` ($_ _.and - (_.cover [/.apply] - (expression (|>> (as Frac) (f.= ($_ f.+ float/0 float/1 float/2))) - (/.apply (list (/.float float/0) - (/.float float/1) - (/.float float/2)) - (/.closure (list $arg/0 $arg/1 $arg/2) (/.return ($_ /.+ $arg/0 $arg/1 $arg/2)))))) - ))) - ))) + (all _.and + (_.cover [/.closure /.return] + (expression (|>> (as Frac) (f.= float/0)) + (/.apply (list) + (/.closure (list) (/.return (/.float float/0)))))) + (_.cover [/.local_function] + (expression (|>> (as Int) .nat (n.= iterations)) + (|> (all /.then + (/.local_function $self (list $arg/0) + (/.if (/.< (/.int (.int iterations)) $arg/0) + (/.return (/.apply (list (/.+ (/.int +1) $arg/0)) $self)) + (/.return $arg/0))) + (/.return (/.apply (list (/.int +0)) $self))) + (/.closure (list)) + (/.apply (list))))) + (do [! random.monad] + [float/0 random.safe_frac + float/1 random.safe_frac + float/2 random.safe_frac + $arg/0 (# ! each /.var (random.ascii/lower 10)) + $arg/1 (# ! each /.var (random.ascii/lower 11)) + $arg/2 (# ! each /.var (random.ascii/lower 12))] + (`` (all _.and + (_.cover [/.apply] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (/.apply (list (/.float float/0) + (/.float float/1) + (/.float float/2)) + (/.closure (list $arg/0 $arg/1 $arg/2) (/.return (all /.+ $arg/0 $arg/1 $arg/2)))))) + ))) + ))) (def: test|branching Test @@ -646,39 +646,39 @@ [float/0 random.safe_frac float/1 random.safe_frac ??? random.bit] - ($_ _.and - (_.cover [/.if] - (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) - (|> (/.if (/.boolean ???) - (/.return (/.float float/0)) - (/.return (/.float float/1))) - (/.closure (list)) - (/.apply (list))))) - (_.cover [/.when] - (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) - (|> ($_ /.then - (/.when (/.boolean ???) - (/.return (/.float float/0))) - (/.return (/.float float/1))) - (/.closure (list)) - (/.apply (list))))) - ))) + (all _.and + (_.cover [/.if] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (/.if (/.boolean ???) + (/.return (/.float float/0)) + (/.return (/.float float/1))) + (/.closure (list)) + (/.apply (list))))) + (_.cover [/.when] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (all /.then + (/.when (/.boolean ???) + (/.return (/.float float/0))) + (/.return (/.float float/1))) + (/.closure (list)) + (/.apply (list))))) + ))) (def: test|binding Test - ($_ _.and - ..test|function - (_.for [/.Location] - ..test/location) - )) + (all _.and + ..test|function + (_.for [/.Location] + ..test/location) + )) (def: test|control Test - ($_ _.and - ..test|branching - ..test|loop - ..test|exception - )) + (all _.and + ..test|branching + ..test|loop + ..test|exception + )) (def: test|statement Test @@ -687,17 +687,17 @@ float/1 random.safe_frac $arg/0 (# ! each /.var (random.ascii/lower 10)) $arg/1 (# ! each /.var (random.ascii/lower 11))] - (`` ($_ _.and - (_.cover [/.statement /.then /.print/1] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.statement (/.print/1 $arg/0)) - (/.return $arg/0)) - (/.closure (list $arg/0)) - (/.apply (list (/.float float/0)))))) - ..test|binding - ..test|control - )))) + (`` (all _.and + (_.cover [/.statement /.then /.print/1] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.statement (/.print/1 $arg/0)) + (/.return $arg/0)) + (/.closure (list $arg/0)) + (/.apply (list (/.float float/0)))))) + ..test|binding + ..test|control + )))) (def: .public test Test @@ -706,17 +706,17 @@ expected random.int] (<| (_.covering /._) (_.for [/.Code /.code]) - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random)) - (_.for [/.hash] - ($hash.spec /.hash random)) - - (_.cover [/.manual] - (expression (|>> (as Int) (i.= expected)) - (/.manual (/.code (/.int expected))))) - (_.for [/.Expression] - ..test|expression) - (_.for [/.Statement] - ..test|statement) - ))))) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random)) + (_.for [/.hash] + ($hash.spec /.hash random)) + + (_.cover [/.manual] + (expression (|>> (as Int) (i.= expected)) + (/.manual (/.code (/.int expected))))) + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + ))))) diff --git a/stdlib/source/test/lux/target/python.lux b/stdlib/source/test/lux/target/python.lux index bddebfde0..5e54809a1 100644 --- a/stdlib/source/test/lux/target/python.lux +++ b/stdlib/source/test/lux/target/python.lux @@ -50,55 +50,55 @@ float random.frac int random.int string (random.ascii/upper 1)] - ($_ _.and - (_.cover [/.none] - (|> /.none - /.code - ..eval - (try#each (function (_ it) - (case it - {.#None} true - {.#Some _} false))) - (try.else false))) - (_.cover [/.bool] - (expression (|>> (as Bit) (bit#= bool)) - (/.bool bool))) - (_.cover [/.int] - (expression (|>> (as Int) (i.= int)) - (/.int int))) - ... (_.cover [/.long] - ... (expression (|>> (as Int) (i.= int)) - ... (/.long int))) - (_.cover [/.float] - (expression (|>> (as Frac) (f.= float)) - (/.float float))) - (_.cover [/.string] - (expression (|>> (as Text) (text#= string)) - (/.string string))) - (_.cover [/.unicode] - (expression (|>> (as Text) (text#= string)) - (/.unicode string))) - ))) + (all _.and + (_.cover [/.none] + (|> /.none + /.code + ..eval + (try#each (function (_ it) + (case it + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.cover [/.bool] + (expression (|>> (as Bit) (bit#= bool)) + (/.bool bool))) + (_.cover [/.int] + (expression (|>> (as Int) (i.= int)) + (/.int int))) + ... (_.cover [/.long] + ... (expression (|>> (as Int) (i.= int)) + ... (/.long int))) + (_.cover [/.float] + (expression (|>> (as Frac) (f.= float)) + (/.float float))) + (_.cover [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + (_.cover [/.unicode] + (expression (|>> (as Text) (text#= string)) + (/.unicode string))) + ))) (def: test|bool Test (do [! random.monad] [left random.bit right random.bit] - (`` ($_ _.and - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> left right)] - (expression (|>> (as Bit) (bit#= expected)) - (</> (/.bool left) (/.bool right)))))] - - [/.or .or] - [/.and .and] - )) - (_.cover [/.not] - (expression (|>> (as Bit) (bit#= (not left))) - (/.not (/.bool left)))) - )))) + (`` (all _.and + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.bool left) (/.bool right)))))] + + [/.or .or] + [/.and .and] + )) + (_.cover [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.bool left)))) + )))) (def: test|float Test @@ -106,39 +106,39 @@ [parameter (random.only (|>> (f.= +0.0) not) random.safe_frac) subject random.safe_frac] - (`` ($_ _.and - (~~ (template [</> <lux> <pre>] - [(_.cover [</>] - (let [expected (<lux> (<pre> parameter) (<pre> subject))] - (expression (|>> (as Frac) (f.= expected)) - (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] - - [/.+ f.+ |>] - [/.- f.- |>] - [/.* f.* |>] - [/./ f./ |>] - [/.% f.mod |>] - [/.** f.pow f.abs] - )) - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> parameter subject)] - (expression (|>> (as Bit) (bit#= expected)) - (</> (/.float parameter) (/.float subject)))))] - - [/.< f.<] - [/.<= f.<=] - [/.> f.>] - [/.>= f.>=] - [/.= f.=] - )) - (_.cover [/.float/1] - (expression (|>> (as Frac) (f.= subject)) - (/.float/1 (/.string (%.frac subject))))) - (_.cover [/.repr/1] - (expression (|>> (as Text) (text#= (text.replaced "+" "" (%.frac subject)))) - (/.repr/1 (/.float subject)))) - )))) + (`` (all _.and + (~~ (template [</> <lux> <pre>] + [(_.cover [</>] + (let [expected (<lux> (<pre> parameter) (<pre> subject))] + (expression (|>> (as Frac) (f.= expected)) + (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] + + [/.+ f.+ |>] + [/.- f.- |>] + [/.* f.* |>] + [/./ f./ |>] + [/.% f.mod |>] + [/.** f.pow f.abs] + )) + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.float parameter) (/.float subject)))))] + + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + (_.cover [/.float/1] + (expression (|>> (as Frac) (f.= subject)) + (/.float/1 (/.string (%.frac subject))))) + (_.cover [/.repr/1] + (expression (|>> (as Text) (text#= (text.replaced "+" "" (%.frac subject)))) + (/.repr/1 (/.float subject)))) + )))) (def: python_3? (/.Expression Any) @@ -159,70 +159,70 @@ i16 (# ! each ..int_16 random.int) shift (# ! each (n.% 16) random.nat)] - (`` ($_ _.and - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> left right)] - (expression (|>> (as Frac) f.int (i.= expected)) - (</> (/.int left) (/.int right)))))] - - [/.bit_or i64.or] - [/.bit_xor i64.xor] - [/.bit_and i64.and] - )) - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [left (.int shift) - right (i.* (.int shift) i16) - expected (<lux> left right)] - (expression (|>> (as Int) (i.= expected)) - (</> (/.int left) (/.int right)))))] - - [/.// i./] - )) - (_.cover [/.opposite] - (expression (|>> (as Int) (i.= (i.* -1 left))) - (/.opposite (/.int left)))) - (_.cover [/.bit_shl] - (let [expected (i64.left_shifted shift i16)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.bit_shl (/.int (.int shift)) - (/.int i16))))) - (_.cover [/.bit_shr] - (let [expected (i.right_shifted shift i16)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.bit_shr (/.int (.int shift)) - (/.int i16))))) - (_.cover [/.int/1] - (expression (|>> (as Int) (i.= left)) - (/.int/1 (/.string (%.int left))))) - (_.cover [/.str/1] - (expression (|>> (as Text) (text#= (text.replaced "+" "" (%.int left)))) - (/.str/1 (/.int left)))) - (_.cover [/.long] - (or (expression (|>> (as Bit)) - ..python_3?) - (expression (|>> (as Int) (i.= left)) - (/.long left)))) - )))) + (`` (all _.and + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Frac) f.int (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [left (.int shift) + right (i.* (.int shift) i16) + expected (<lux> left right)] + (expression (|>> (as Int) (i.= expected)) + (</> (/.int left) (/.int right)))))] + + [/.// i./] + )) + (_.cover [/.opposite] + (expression (|>> (as Int) (i.= (i.* -1 left))) + (/.opposite (/.int left)))) + (_.cover [/.bit_shl] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shl (/.int (.int shift)) + (/.int i16))))) + (_.cover [/.bit_shr] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shr (/.int (.int shift)) + (/.int i16))))) + (_.cover [/.int/1] + (expression (|>> (as Int) (i.= left)) + (/.int/1 (/.string (%.int left))))) + (_.cover [/.str/1] + (expression (|>> (as Text) (text#= (text.replaced "+" "" (%.int left)))) + (/.str/1 (/.int left)))) + (_.cover [/.long] + (or (expression (|>> (as Bit)) + ..python_3?) + (expression (|>> (as Int) (i.= left)) + (/.long left)))) + )))) (def: test|text Test (do [! random.monad] [expected_code (# ! each (n.% 128) random.nat) .let [expected_char (text.of_char expected_code)]] - ($_ _.and - (_.cover [/.chr/1 /.ord/1 - /.unichr/1 /.unicode/1] - (and (expression (|>> (as Int) .nat (n.= expected_code)) - (/.? python_3? - (/.ord/1 (/.chr/1 (/.int (.int expected_code)))) - (/.unicode/1 (/.unichr/1 (/.int (.int expected_code)))))) - (expression (|>> (as Text) (text#= expected_char)) - (/.? python_3? - (/.chr/1 (/.ord/1 (/.string expected_char))) - (/.unichr/1 (/.unicode/1 (/.string expected_char))))))) - ))) + (all _.and + (_.cover [/.chr/1 /.ord/1 + /.unichr/1 /.unicode/1] + (and (expression (|>> (as Int) .nat (n.= expected_code)) + (/.? python_3? + (/.ord/1 (/.chr/1 (/.int (.int expected_code)))) + (/.unicode/1 (/.unichr/1 (/.int (.int expected_code)))))) + (expression (|>> (as Text) (text#= expected_char)) + (/.? python_3? + (/.chr/1 (/.ord/1 (/.string expected_char))) + (/.unichr/1 (/.unicode/1 (/.string expected_char))))))) + ))) (def: test|array Test @@ -238,28 +238,28 @@ .let [slice_from|size (n.- from size) to (/.int (.int (n.+ plus from))) from (/.int (.int from))]] - ($_ _.and - (_.for [/.item] - ($_ _.and - (_.cover [/.list] - (expression (|>> (as Frac) (f.= expected)) - (/.item (/.int (.int index)) - (/.list (list#each /.float items))))) - (_.cover [/.tuple] - (expression (|>> (as Frac) (f.= expected)) - (/.item (/.int (.int index)) - (/.tuple (list#each /.float items))))))) - (_.cover [/.slice /.len/1] - (expression (|>> (as Int) (i.= (.int plus))) - (|> (/.list (list#each /.float items)) - (/.slice from to) - /.len/1))) - (_.cover [/.slice_from] - (expression (|>> (as Int) (i.= (.int slice_from|size))) - (|> (/.list (list#each /.float items)) - (/.slice_from from) - /.len/1))) - ))) + (all _.and + (_.for [/.item] + (all _.and + (_.cover [/.list] + (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.list (list#each /.float items))))) + (_.cover [/.tuple] + (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.tuple (list#each /.float items))))))) + (_.cover [/.slice /.len/1] + (expression (|>> (as Int) (i.= (.int plus))) + (|> (/.list (list#each /.float items)) + (/.slice from to) + /.len/1))) + (_.cover [/.slice_from] + (expression (|>> (as Int) (i.= (.int slice_from|size))) + (|> (/.list (list#each /.float items)) + (/.slice_from from) + /.len/1))) + ))) (def: test|dict Test @@ -270,16 +270,16 @@ (random.ascii/upper 5)) .let [field (/.string field) dummy (/.string dummy)]] - ($_ _.and - (_.cover [/.dict] - (expression (|>> (as Frac) (f.= expected)) - (/.item field (/.dict (list [field (/.float expected)]))))) - (_.cover [/.in?] - (and (expression (|>> (as Bit) not) - (/.in? (/.dict (list)) field)) - (expression (|>> (as Bit)) - (/.in? (/.dict (list [field (/.float expected)])) field)))) - ))) + (all _.and + (_.cover [/.dict] + (expression (|>> (as Frac) (f.= expected)) + (/.item field (/.dict (list [field (/.float expected)]))))) + (_.cover [/.in?] + (and (expression (|>> (as Bit) not) + (/.in? (/.dict (list)) field)) + (expression (|>> (as Bit)) + (/.in? (/.dict (list [field (/.float expected)])) field)))) + ))) (def: test|computation Test @@ -295,41 +295,41 @@ comment (random.ascii/upper 10) $arg/0 (# ! each /.var (random.ascii/lower 10)) $arg/1 (# ! each /.var (random.ascii/lower 11))] - ($_ _.and - ..test|bool - ..test|float - ..test|int - ..test|text - ..test|array - ..test|dict - (_.cover [/.?] - (let [expected (if test then else)] - (expression (|>> (as Frac) (f.= expected)) - (/.? (/.bool test) - (/.float then) - (/.float else))))) - (_.cover [/.comment] - (expression (|>> (as Frac) (f.= then)) - (/.comment comment - (/.float then)))) - (_.cover [/.__import__/1] - (expression (function.constant true) - (/.__import__/1 (/.string "math")))) - (_.cover [/.do] - (expression (|>> (as Frac) (f.= (f.ceil float))) - (|> (/.__import__/1 (/.string "math")) - (/.do "ceil" (list (/.float float)))))) - (_.cover [/.is] - (and (expression (|>> (as Bit)) - (/.apply/* (list (/.string (format string string))) - (/.lambda (list $arg/0) - (/.is $arg/0 $arg/0)))) - (expression (|>> (as Bit) not) - (/.apply/* (list (/.string (format string string)) - (/.string string)) - (/.lambda (list $arg/0 $arg/1) - (/.is $arg/0 (/.+ $arg/1 $arg/1))))))) - ))) + (all _.and + ..test|bool + ..test|float + ..test|int + ..test|text + ..test|array + ..test|dict + (_.cover [/.?] + (let [expected (if test then else)] + (expression (|>> (as Frac) (f.= expected)) + (/.? (/.bool test) + (/.float then) + (/.float else))))) + (_.cover [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.float then)))) + (_.cover [/.__import__/1] + (expression (function.constant true) + (/.__import__/1 (/.string "math")))) + (_.cover [/.do] + (expression (|>> (as Frac) (f.= (f.ceil float))) + (|> (/.__import__/1 (/.string "math")) + (/.do "ceil" (list (/.float float)))))) + (_.cover [/.is] + (and (expression (|>> (as Bit)) + (/.apply/* (list (/.string (format string string))) + (/.lambda (list $arg/0) + (/.is $arg/0 $arg/0)))) + (expression (|>> (as Bit) not) + (/.apply/* (list (/.string (format string string)) + (/.string string)) + (/.lambda (list $arg/0 $arg/1) + (/.is $arg/0 (/.+ $arg/1 $arg/1))))))) + ))) (def: test|function Test @@ -340,18 +340,18 @@ $arg/0 (# ! each /.var (random.ascii/lower 10)) $arg/1 (# ! each /.var (random.ascii/lower 11)) $arg/2 (# ! each /.var (random.ascii/lower 12))] - ($_ _.and - (_.cover [/.lambda] - (expression (|>> (as Frac) (f.= float/0)) - (/.apply/* (list) - (/.lambda (list) - (/.float float/0))))) - (_.cover [/.apply/*] - (expression (|>> (as Frac) (f.= ($_ f.+ float/0 float/1 float/2))) - (/.apply/* (list (/.float float/0) (/.float float/1) (/.float float/2)) - (/.lambda (list $arg/0 $arg/1 $arg/2) - ($_ /.+ $arg/0 $arg/1 $arg/2))))) - ))) + (all _.and + (_.cover [/.lambda] + (expression (|>> (as Frac) (f.= float/0)) + (/.apply/* (list) + (/.lambda (list) + (/.float float/0))))) + (_.cover [/.apply/*] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (/.apply/* (list (/.float float/0) (/.float float/1) (/.float float/2)) + (/.lambda (list $arg/0 $arg/1 $arg/2) + (all /.+ $arg/0 $arg/1 $arg/2))))) + ))) (def: test|var Test @@ -368,64 +368,64 @@ _ expected/1)] $var (# ! each (|>> %.nat (format "v") /.var) random.nat) $choice (# ! each (|>> %.nat (format "c") /.var) random.nat)] - ($_ _.and - (_.cover [/.Single /.SVar /.var] - (expression (|>> (as Frac) (f.= expected/0)) - (/.apply/* (list (/.float expected/0)) - (/.lambda (list $var) $var)))) - (_.for [/.Poly /.PVar] - ($_ _.and - (_.cover [/.poly] - (expression (|>> (as Frac) (f.= expected/?)) - (/.apply/* (list (/.int (.int poly_choice)) - (/.float expected/0) - (/.float expected/1)) - (/.lambda (list $choice (/.poly $var)) - (/.item $choice $var))))) - (_.cover [/.splat_poly] - (expression (|>> (as Frac) (f.= expected/?)) - (/.apply/* (list (/.int (.int poly_choice)) - (/.splat_poly - (/.list (list (/.float expected/0) - (/.float expected/1))))) - (/.lambda (list $choice (/.poly $var)) - (/.item $choice $var))))) - )) - (_.for [/.Keyword /.KVar] - ($_ _.and - (_.cover [/.keyword] - (expression (|>> (as Nat) (n.= 2)) - (/.apply/* (list keyword_choice - (/.splat_keyword - (/.dict (list [keyword/0 (/.float expected/0)] - [keyword/1 (/.float expected/1)])))) - (/.lambda (list $choice (/.keyword $var)) - (/.len/1 $var))))) - (_.cover [/.splat_keyword] - (expression (|>> (as Frac) (f.= expected/?)) - (/.apply/* (list keyword_choice - (/.splat_keyword - (/.dict (list [keyword/0 (/.float expected/0)] - [keyword/1 (/.float expected/1)])))) - (/.lambda (list $choice (/.keyword $var)) - (/.item $choice $var))))) - )) - ))) + (all _.and + (_.cover [/.Single /.SVar /.var] + (expression (|>> (as Frac) (f.= expected/0)) + (/.apply/* (list (/.float expected/0)) + (/.lambda (list $var) $var)))) + (_.for [/.Poly /.PVar] + (all _.and + (_.cover [/.poly] + (expression (|>> (as Frac) (f.= expected/?)) + (/.apply/* (list (/.int (.int poly_choice)) + (/.float expected/0) + (/.float expected/1)) + (/.lambda (list $choice (/.poly $var)) + (/.item $choice $var))))) + (_.cover [/.splat_poly] + (expression (|>> (as Frac) (f.= expected/?)) + (/.apply/* (list (/.int (.int poly_choice)) + (/.splat_poly + (/.list (list (/.float expected/0) + (/.float expected/1))))) + (/.lambda (list $choice (/.poly $var)) + (/.item $choice $var))))) + )) + (_.for [/.Keyword /.KVar] + (all _.and + (_.cover [/.keyword] + (expression (|>> (as Nat) (n.= 2)) + (/.apply/* (list keyword_choice + (/.splat_keyword + (/.dict (list [keyword/0 (/.float expected/0)] + [keyword/1 (/.float expected/1)])))) + (/.lambda (list $choice (/.keyword $var)) + (/.len/1 $var))))) + (_.cover [/.splat_keyword] + (expression (|>> (as Frac) (f.= expected/?)) + (/.apply/* (list keyword_choice + (/.splat_keyword + (/.dict (list [keyword/0 (/.float expected/0)] + [keyword/1 (/.float expected/1)])))) + (/.lambda (list $choice (/.keyword $var)) + (/.item $choice $var))))) + )) + ))) (def: test|expression Test (do [! random.monad] [dummy random.safe_frac expected random.safe_frac] - (`` ($_ _.and - (_.for [/.Literal] - ..test|literal) - (_.for [/.Computation] - ..test|computation) - ..test|function - (_.for [/.Var] - ..test|var) - )))) + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + ..test|function + (_.for [/.Var] + ..test|var) + )))) (ffi.import: Dict "[1]::[0]" @@ -449,36 +449,36 @@ expected/0 random.safe_frac dummy/0 random.safe_frac field (# ! each /.string (random.ascii/upper 1))] - ($_ _.and - (_.cover [/.item] - (`` (and (~~ (template [<seq>] - [(expression (|>> (as Frac) (f.= expected/0)) - (/.item (/.int +0) - (<seq> (list (/.float expected/0)))))] - - [/.list] - [/.tuple] - )) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.list (list (/.float dummy/0)))) - (/.set (list (/.item (/.int +0) $var/0)) (/.float expected/0)) - (/.set (list $output) (/.item (/.int +0) $var/0))))) - (as Frac) - (f.= expected/0)) - - (expression (|>> (as Frac) (f.= expected/0)) - (/.item field (/.dict (list [field (/.float expected/0)])))) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.dict (list [field (/.float dummy/0)]))) - (/.set (list (/.item field $var/0)) (/.float expected/0)) - (/.set (list $output) (/.item field $var/0))))) - (as Frac) - (f.= expected/0))))) - ))) + (all _.and + (_.cover [/.item] + (`` (and (~~ (template [<seq>] + [(expression (|>> (as Frac) (f.= expected/0)) + (/.item (/.int +0) + (<seq> (list (/.float expected/0)))))] + + [/.list] + [/.tuple] + )) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0)))) + (/.set (list (/.item (/.int +0) $var/0)) (/.float expected/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + + (expression (|>> (as Frac) (f.= expected/0)) + (/.item field (/.dict (list [field (/.float expected/0)])))) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.dict (list [field (/.float dummy/0)]))) + (/.set (list (/.item field $var/0)) (/.float expected/0)) + (/.set (list $output) (/.item field $var/0))))) + (as Frac) + (f.= expected/0))))) + ))) (def: test|location Test @@ -490,106 +490,106 @@ expected/1 random.safe_frac dummy/0 random.safe_frac field/0 (# ! each /.string (random.ascii/upper 1))] - ($_ _.and - (_.cover [/.set] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.float expected/0)) - (/.set (list $output) $var/0)))) - (as Frac) - (f.= expected/0))) - (_.cover [/.multi] - (`` (and (~~ (template [<var> <value>] - [(|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0 $var/1) (/.multi (list (/.float expected/0) (/.float expected/1)))) - (/.set (list $output) <var>)))) - (as Frac) - (f.= <value>))] - - [$var/0 expected/0] - [$var/1 expected/1] - ))))) - (_.cover [/.delete] - (and (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0)))) - (/.delete (/.item (/.int +0) $var/0)) - (/.set (list $output) (/.item (/.int +0) $var/0))))) - (as Frac) - (f.= expected/0)) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0)))) - (/.delete (/.slice (/.int +0) (/.int +1) $var/0)) - (/.set (list $output) (/.item (/.int +0) $var/0))))) - (as Frac) - (f.= expected/0)) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float dummy/0)))) - (/.delete (/.slice_from (/.int +0) $var/0)) - (/.statement (/.do "append" (list (/.float expected/0)) $var/0)) - (/.set (list $output) (/.item (/.int +0) $var/0))))) - (as Frac) - (f.= expected/0)) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.dict (list [field/0 (/.float dummy/0)]))) - (/.delete (/.item field/0 $var/0)) - (/.set (list $output) (/.in? $var/0 field/0))))) - (as Bit) - not) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $var/0) (/.float dummy/0)) - (/.delete $var/0) - (/.set (list $output) (/.or (/.in? /.locals/0 (/.string (/.code $var/0))) - (/.in? /.globals/0 (/.string (/.code $var/0)))))))) - (as Bit) - not) - )) - (_.cover [/.globals/0] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.def $def (list $var/0) - (/.return (/.in? /.globals/0 (/.string (/.code $var/0))))) - (/.set (list $output) (/.and (/.not (/.in? /.globals/0 (/.string (/.code $var/0)))) - (/.not (/.apply/* (list (/.float dummy/0)) $def)))) - (/.set (list $var/0) (/.float dummy/0)) - (/.set (list $output) (/.and $output - (/.in? /.globals/0 (/.string (/.code $var/0)))))))) - (as Bit))) - (_.cover [/.locals/0] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.def $def (list $var/0) - (/.return (/.in? /.locals/0 (/.string (/.code $var/0))))) - (/.set (list $output) (/.and (/.not (/.in? /.locals/0 (/.string (/.code $var/0)))) - (/.apply/* (list (/.float dummy/0)) $def))) - (/.set (list $var/0) (/.float dummy/0)) - (/.set (list $output) (/.and $output - (/.in? /.locals/0 (/.string (/.code $var/0)))))))) - (as Bit))) - (_.cover [/.import] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.import "math") - (/.set (list $output) (/.in? /.globals/0 (/.string "math")))))) - (as Bit))) - (_.for [/.Access] - ..test|access) - ))) + (all _.and + (_.cover [/.set] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.float expected/0)) + (/.set (list $output) $var/0)))) + (as Frac) + (f.= expected/0))) + (_.cover [/.multi] + (`` (and (~~ (template [<var> <value>] + [(|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0 $var/1) (/.multi (list (/.float expected/0) (/.float expected/1)))) + (/.set (list $output) <var>)))) + (as Frac) + (f.= <value>))] + + [$var/0 expected/0] + [$var/1 expected/1] + ))))) + (_.cover [/.delete] + (and (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0)))) + (/.delete (/.item (/.int +0) $var/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float expected/0)))) + (/.delete (/.slice (/.int +0) (/.int +1) $var/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.list (list (/.float dummy/0) (/.float dummy/0)))) + (/.delete (/.slice_from (/.int +0) $var/0)) + (/.statement (/.do "append" (list (/.float expected/0)) $var/0)) + (/.set (list $output) (/.item (/.int +0) $var/0))))) + (as Frac) + (f.= expected/0)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.dict (list [field/0 (/.float dummy/0)]))) + (/.delete (/.item field/0 $var/0)) + (/.set (list $output) (/.in? $var/0 field/0))))) + (as Bit) + not) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $var/0) (/.float dummy/0)) + (/.delete $var/0) + (/.set (list $output) (/.or (/.in? /.locals/0 (/.string (/.code $var/0))) + (/.in? /.globals/0 (/.string (/.code $var/0)))))))) + (as Bit) + not) + )) + (_.cover [/.globals/0] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list $var/0) + (/.return (/.in? /.globals/0 (/.string (/.code $var/0))))) + (/.set (list $output) (/.and (/.not (/.in? /.globals/0 (/.string (/.code $var/0)))) + (/.not (/.apply/* (list (/.float dummy/0)) $def)))) + (/.set (list $var/0) (/.float dummy/0)) + (/.set (list $output) (/.and $output + (/.in? /.globals/0 (/.string (/.code $var/0)))))))) + (as Bit))) + (_.cover [/.locals/0] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list $var/0) + (/.return (/.in? /.locals/0 (/.string (/.code $var/0))))) + (/.set (list $output) (/.and (/.not (/.in? /.locals/0 (/.string (/.code $var/0)))) + (/.apply/* (list (/.float dummy/0)) $def))) + (/.set (list $var/0) (/.float dummy/0)) + (/.set (list $output) (/.and $output + (/.in? /.locals/0 (/.string (/.code $var/0)))))))) + (as Bit))) + (_.cover [/.import] + (|> (..statement + (function (_ $output) + (all /.then + (/.import "math") + (/.set (list $output) (/.in? /.globals/0 (/.string "math")))))) + (as Bit))) + (_.for [/.Access] + ..test|access) + ))) (def: test|exception Test @@ -599,43 +599,43 @@ dummy (random.only (|>> (f.= expected) not) random.safe_frac) $ex (# ! each (|>> %.nat (format "ex_") /.var) random.nat)] - ($_ _.and - (_.cover [/.raise /.Exception/1] - (case (try (..statement - (function (_ $output) - ($_ /.then - (/.raise (/.Exception/1 (/.string expected_error))) - (/.set (list $output) (/.float dummy)))))) - {try.#Failure actual_error} - (text#= expected_error actual_error) - - {try.#Success _} - false)) - (_.cover [/.try /.Except] - (and (|> (..statement - (function (_ $output) - (/.try ($_ /.then - (/.raise (/.Exception/1 (/.string expected_error))) - (/.set (list $output) (/.float dummy))) - (list [/.#classes (list "Exception") - /.#exception $ex - /.#handler (/.set (list $output) (/.float expected))])))) - (as Frac) - (f.= expected)) - (case (try (..statement - (function (_ $output) - (/.try ($_ /.then - (/.raise (/.Exception/1 (/.string expected_error))) - (/.set (list $output) (/.float dummy))) - (list [/.#classes (list) - /.#exception $ex - /.#handler (/.set (list $output) (/.float expected))]))))) - {try.#Failure actual_error} - (text#= expected_error actual_error) - - {try.#Success actual} - false))) - ))) + (all _.and + (_.cover [/.raise /.Exception/1] + (case (try (..statement + (function (_ $output) + (all /.then + (/.raise (/.Exception/1 (/.string expected_error))) + (/.set (list $output) (/.float dummy)))))) + {try.#Failure actual_error} + (text#= expected_error actual_error) + + {try.#Success _} + false)) + (_.cover [/.try /.Except] + (and (|> (..statement + (function (_ $output) + (/.try (all /.then + (/.raise (/.Exception/1 (/.string expected_error))) + (/.set (list $output) (/.float dummy))) + (list [/.#classes (list "Exception") + /.#exception $ex + /.#handler (/.set (list $output) (/.float expected))])))) + (as Frac) + (f.= expected)) + (case (try (..statement + (function (_ $output) + (/.try (all /.then + (/.raise (/.Exception/1 (/.string expected_error))) + (/.set (list $output) (/.float dummy))) + (list [/.#classes (list) + /.#exception $ex + /.#handler (/.set (list $output) (/.float expected))]))))) + {try.#Failure actual_error} + (text#= expected_error actual_error) + + {try.#Success actual} + false))) + ))) (def: test|loop Test @@ -646,101 +646,101 @@ .let [expected (n.* factor base)] $iteration (# ! each (|>> %.nat (format "iteration_") /.var) random.nat) $temp (# ! each (|>> %.nat (format "temp_") /.var) random.nat)] - ($_ _.and - (_.cover [/.while] - (and (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $output) (/.int +0)) - (/.set (list $iteration) (/.int +0)) - (/.while (/.< (/.int (.int factor)) $iteration) - ($_ /.then + (all _.and + (_.cover [/.while] + (and (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int factor)) $iteration) + (all /.then + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + ) + {.#None})))) + (as Nat) + (n.= expected)) + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $temp) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int factor)) $iteration) + (all /.then + (/.set (list $temp) (/.+ (/.int (.int base)) + $temp)) + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + ) + {.#Some (/.set (list $output) $temp)})))) + (as Nat) + (n.= expected)))) + (_.cover [/.for_in] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.for_in $iteration + (/.list (list.repeated factor (/.int (.int base)))) + (/.set (list $output) (/.+ $iteration + $output)))))) + (as Nat) + (n.= expected))) + (_.cover [/.pass] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + (all /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int extra)) $iteration) (/.set (list $output) (/.+ (/.int (.int base)) $output)) - (/.set (list $iteration) (/.+ (/.int +1) - $iteration)) - ) - {.#None})))) - (as Nat) - (n.= expected)) - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $temp) (/.int +0)) - (/.set (list $iteration) (/.int +0)) - (/.while (/.< (/.int (.int factor)) $iteration) - ($_ /.then - (/.set (list $temp) (/.+ (/.int (.int base)) - $temp)) - (/.set (list $iteration) (/.+ (/.int +1) - $iteration)) - ) - {.#Some (/.set (list $output) $temp)})))) - (as Nat) - (n.= expected)))) - (_.cover [/.for_in] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $output) (/.int +0)) - (/.for_in $iteration - (/.list (list.repeated factor (/.int (.int base)))) - (/.set (list $output) (/.+ $iteration - $output)))))) - (as Nat) - (n.= expected))) - (_.cover [/.pass] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $output) (/.int +0)) - (/.set (list $iteration) (/.int +0)) - (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) - ($_ /.then - (/.set (list $iteration) (/.+ (/.int +1) - $iteration)) - (/.if (/.> (/.int (.int extra)) $iteration) - (/.set (list $output) (/.+ (/.int (.int base)) - $output)) - /.pass)) - {.#None})))) - (as Nat) - (n.= expected))) - (_.cover [/.continue] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $output) (/.int +0)) - (/.set (list $iteration) (/.int +0)) - (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) - ($_ /.then - (/.set (list $iteration) (/.+ (/.int +1) - $iteration)) - (/.if (/.> (/.int (.int extra)) $iteration) - (/.set (list $output) (/.+ (/.int (.int base)) - $output)) - /.continue)) - {.#None})))) - (as Nat) - (n.= expected))) - (_.cover [/.break] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.set (list $output) (/.int +0)) - (/.set (list $iteration) (/.int +0)) - (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) - ($_ /.then - (/.set (list $iteration) (/.+ (/.int +1) - $iteration)) - (/.if (/.> (/.int (.int factor)) $iteration) - /.break - (/.set (list $output) (/.+ (/.int (.int base)) - $output)))) - {.#None})))) - (as Nat) - (n.= expected))) - ))) + /.pass)) + {.#None})))) + (as Nat) + (n.= expected))) + (_.cover [/.continue] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + (all /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int extra)) $iteration) + (/.set (list $output) (/.+ (/.int (.int base)) + $output)) + /.continue)) + {.#None})))) + (as Nat) + (n.= expected))) + (_.cover [/.break] + (|> (..statement + (function (_ $output) + (all /.then + (/.set (list $output) (/.int +0)) + (/.set (list $iteration) (/.int +0)) + (/.while (/.< (/.int (.int (n.+ extra factor))) $iteration) + (all /.then + (/.set (list $iteration) (/.+ (/.int +1) + $iteration)) + (/.if (/.> (/.int (.int factor)) $iteration) + /.break + (/.set (list $output) (/.+ (/.int (.int base)) + $output)))) + {.#None})))) + (as Nat) + (n.= expected))) + ))) (def: test|statement Test @@ -752,72 +752,72 @@ then random.safe_frac else random.safe_frac .let [expected/? (if test then else)]] - ($_ _.and - (_.cover [/.def /.return] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.def $def (list $input/0) - (/.return $input/0)) - (/.set (list $output) (/.apply/* (list (/.float expected/0)) $def))))) - (as Frac) - (f.= expected/0))) - (_.cover [/.if] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.def $def (list) - (/.if (/.bool test) - (/.return (/.float then)) - (/.return (/.float else)))) - (/.set (list $output) (/.apply/* (list) $def))))) - (as Frac) - (f.= expected/?))) - (_.cover [/.when /.then] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.def $def (list) - ($_ /.then - (/.when (/.bool test) - (/.return (/.float then))) + (all _.and + (_.cover [/.def /.return] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list $input/0) + (/.return $input/0)) + (/.set (list $output) (/.apply/* (list (/.float expected/0)) $def))))) + (as Frac) + (f.= expected/0))) + (_.cover [/.if] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list) + (/.if (/.bool test) + (/.return (/.float then)) (/.return (/.float else)))) - (/.set (list $output) (/.apply/* (list) $def))))) - (as Frac) - (f.= expected/?))) - (_.cover [/.statement] - (|> (..statement - (function (_ $output) - ($_ /.then - (/.def $def (list) - ($_ /.then - (/.statement (/.+ (/.float expected/0) (/.float expected/0))) - (/.return (/.float expected/0)))) - (/.set (list $output) (/.apply/* (list) $def))))) - (as Frac) - (f.= expected/0))) - (_.cover [/.exec] - (|> (..statement - (function (_ $output) - (/.exec {.#Some /.globals/0} - (/.string (/.code (/.set (list $output) (/.float expected/0))))))) - (as Frac) - (f.= expected/0))) - ..test|exception - (_.for [/.Location] - ..test|location) - (_.for [/.Loop] - ..test|loop) - ))) + (/.set (list $output) (/.apply/* (list) $def))))) + (as Frac) + (f.= expected/?))) + (_.cover [/.when /.then] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list) + (all /.then + (/.when (/.bool test) + (/.return (/.float then))) + (/.return (/.float else)))) + (/.set (list $output) (/.apply/* (list) $def))))) + (as Frac) + (f.= expected/?))) + (_.cover [/.statement] + (|> (..statement + (function (_ $output) + (all /.then + (/.def $def (list) + (all /.then + (/.statement (/.+ (/.float expected/0) (/.float expected/0))) + (/.return (/.float expected/0)))) + (/.set (list $output) (/.apply/* (list) $def))))) + (as Frac) + (f.= expected/0))) + (_.cover [/.exec] + (|> (..statement + (function (_ $output) + (/.exec {.#Some /.globals/0} + (/.string (/.code (/.set (list $output) (/.float expected/0))))))) + (as Frac) + (f.= expected/0))) + ..test|exception + (_.for [/.Location] + ..test|location) + (_.for [/.Loop] + ..test|loop) + ))) (def: random_expression (Random /.Literal) - ($_ random.either - (random#each /.bool random.bit) - (random#each /.float random.frac) - (random#each /.int random.int) - (random#each /.string (random.ascii/lower 1)) - )) + (all random.either + (random#each /.bool random.bit) + (random#each /.float random.frac) + (random#each /.int random.int) + (random#each /.string (random.ascii/lower 1)) + )) (def: .public test Test @@ -825,18 +825,18 @@ [expected ..random_expression] (<| (_.covering /._) (_.for [/.Code]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random_expression)) - (_.for [/.hash] - ($hash.spec /.hash ..random_expression)) - - (_.cover [/.code /.manual] - (|> (/.manual (/.code expected)) - (is /.Expression) - (/#= expected))) - (_.for [/.Expression] - ..test|expression) - (_.for [/.Statement] - ..test|statement) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random_expression)) + (_.for [/.hash] + ($hash.spec /.hash ..random_expression)) + + (_.cover [/.code /.manual] + (|> (/.manual (/.code expected)) + (is /.Expression) + (/#= expected))) + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + )))) diff --git a/stdlib/source/test/lux/target/ruby.lux b/stdlib/source/test/lux/target/ruby.lux index 22dee2512..b3324189d 100644 --- a/stdlib/source/test/lux/target/ruby.lux +++ b/stdlib/source/test/lux/target/ruby.lux @@ -64,45 +64,45 @@ float random.frac int random.int string (random.ascii/upper 5)] - ($_ _.and - (_.cover [/.nil] - (..nil /.nil)) - (_.cover [/.bool] - (expression (|>> (as Bit) (bit#= bool)) - (/.bool bool))) - (_.cover [/.int] - (expression (|>> (as Int) (i.= int)) - (/.int int))) - (_.cover [/.float] - (expression (|>> (as Frac) (f.= float)) - (/.float float))) - (_.cover [/.string] - (expression (|>> (as Text) (text#= string)) - (/.string string))) - (_.cover [/.symbol] - (expression (|>> (as Text) (text#= string)) - (/.do "id2name" (list) {.#None} (/.symbol string)))) - ))) + (all _.and + (_.cover [/.nil] + (..nil /.nil)) + (_.cover [/.bool] + (expression (|>> (as Bit) (bit#= bool)) + (/.bool bool))) + (_.cover [/.int] + (expression (|>> (as Int) (i.= int)) + (/.int int))) + (_.cover [/.float] + (expression (|>> (as Frac) (f.= float)) + (/.float float))) + (_.cover [/.string] + (expression (|>> (as Text) (text#= string)) + (/.string string))) + (_.cover [/.symbol] + (expression (|>> (as Text) (text#= string)) + (/.do "id2name" (list) {.#None} (/.symbol string)))) + ))) (def: test|bool Test (do [! random.monad] [left random.bit right random.bit] - (`` ($_ _.and - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> left right)] - (expression (|>> (as Bit) (bit#= expected)) - (</> (/.bool left) (/.bool right)))))] + (`` (all _.and + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.bool left) (/.bool right)))))] - [/.or .or] - [/.and .and] - )) - (_.cover [/.not] - (expression (|>> (as Bit) (bit#= (not left))) - (/.not (/.bool left)))) - )))) + [/.or .or] + [/.and .and] + )) + (_.cover [/.not] + (expression (|>> (as Bit) (bit#= (not left))) + (/.not (/.bool left)))) + )))) (def: test|float Test @@ -110,33 +110,33 @@ [parameter (random.only (|>> (f.= +0.0) not) random.safe_frac) subject random.safe_frac] - (`` ($_ _.and - (~~ (template [</> <lux> <pre>] - [(_.cover [</>] - (let [expected (<lux> (<pre> parameter) (<pre> subject))] - (expression (|>> (as Frac) (f.= expected)) - (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] + (`` (all _.and + (~~ (template [</> <lux> <pre>] + [(_.cover [</>] + (let [expected (<lux> (<pre> parameter) (<pre> subject))] + (expression (|>> (as Frac) (f.= expected)) + (</> (/.float (<pre> parameter)) (/.float (<pre> subject))))))] - [/.+ f.+ |>] - [/.- f.- |>] - [/.* f.* |>] - [/./ f./ |>] - [/.% f.mod |>] - [/.pow f.pow f.abs] - )) - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> parameter subject)] - (expression (|>> (as Bit) (bit#= expected)) - (</> (/.float parameter) (/.float subject)))))] + [/.+ f.+ |>] + [/.- f.- |>] + [/.* f.* |>] + [/./ f./ |>] + [/.% f.mod |>] + [/.pow f.pow f.abs] + )) + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> parameter subject)] + (expression (|>> (as Bit) (bit#= expected)) + (</> (/.float parameter) (/.float subject)))))] - [/.< f.<] - [/.<= f.<=] - [/.> f.>] - [/.>= f.>=] - [/.= f.=] - )) - )))) + [/.< f.<] + [/.<= f.<=] + [/.> f.>] + [/.>= f.>=] + [/.= f.=] + )) + )))) (def: int_16 (-> Int Int) @@ -150,34 +150,34 @@ i16 (# ! each ..int_16 random.int) shift (# ! each (n.% 16) random.nat)] - (`` ($_ _.and - (~~ (template [</> <lux>] - [(_.cover [</>] - (let [expected (<lux> left right)] - (expression (|>> (as Frac) f.int (i.= expected)) - (</> (/.int left) (/.int right)))))] + (`` (all _.and + (~~ (template [</> <lux>] + [(_.cover [</>] + (let [expected (<lux> left right)] + (expression (|>> (as Frac) f.int (i.= expected)) + (</> (/.int left) (/.int right)))))] - [/.bit_or i64.or] - [/.bit_xor i64.xor] - [/.bit_and i64.and] - )) - (_.cover [/.bit_not] - (expression (|>> (as Int) (i.= (i64.not left))) - (/.bit_not (/.int left)))) - (_.cover [/.opposite] - (expression (|>> (as Int) (i.= (i.* -1 left))) - (/.opposite (/.int left)))) - (_.cover [/.bit_shl] - (let [expected (i64.left_shifted shift i16)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.bit_shl (/.int (.int shift)) - (/.int i16))))) - (_.cover [/.bit_shr] - (let [expected (i.right_shifted shift i16)] - (expression (|>> (as Frac) f.int (i.= expected)) - (/.bit_shr (/.int (.int shift)) - (/.int i16))))) - )))) + [/.bit_or i64.or] + [/.bit_xor i64.xor] + [/.bit_and i64.and] + )) + (_.cover [/.bit_not] + (expression (|>> (as Int) (i.= (i64.not left))) + (/.bit_not (/.int left)))) + (_.cover [/.opposite] + (expression (|>> (as Int) (i.= (i.* -1 left))) + (/.opposite (/.int left)))) + (_.cover [/.bit_shl] + (let [expected (i64.left_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shl (/.int (.int shift)) + (/.int i16))))) + (_.cover [/.bit_shr] + (let [expected (i.right_shifted shift i16)] + (expression (|>> (as Frac) f.int (i.= expected)) + (/.bit_shr (/.int (.int shift)) + (/.int i16))))) + )))) (def: test|array Test @@ -192,21 +192,21 @@ plus (# ! each (n.% (n.- from size)) random.nat) .let [to (/.int (.int (n.+ plus from))) from (/.int (.int from))]] - ($_ _.and - (_.cover [/.array /.item] - (and (expression (|>> (as Frac) (f.= expected)) - (/.item (/.int (.int index)) - (/.array (list#each /.float items)))) - (expression (|>> (as Bit)) - (|> (/.array (list#each /.float items)) - (/.item (/.int (.int size))) - (/.= /.nil))))) - (_.cover [/.array_range] - (expression (|>> (as Int) (i.= (.int (++ plus)))) - (|> (/.array (list#each /.float items)) - (/.array_range from to) - (/.the "length")))) - ))) + (all _.and + (_.cover [/.array /.item] + (and (expression (|>> (as Frac) (f.= expected)) + (/.item (/.int (.int index)) + (/.array (list#each /.float items)))) + (expression (|>> (as Bit)) + (|> (/.array (list#each /.float items)) + (/.item (/.int (.int size))) + (/.= /.nil))))) + (_.cover [/.array_range] + (expression (|>> (as Int) (i.= (.int (++ plus)))) + (|> (/.array (list#each /.float items)) + (/.array_range from to) + (/.the "length")))) + ))) (def: test|hash Test @@ -217,15 +217,15 @@ (random.ascii/upper 5)) .let [field (/.string field) dummy (/.string dummy)]] - ($_ _.and - (_.cover [/.hash] - (and (expression (|>> (as Frac) (f.= expected)) - (/.item field (/.hash (list [field (/.float expected)])))) - (expression (|>> (as Bit)) - (|> (/.hash (list [field (/.float expected)])) - (/.item dummy) - (/.= /.nil))))) - ))) + (all _.and + (_.cover [/.hash] + (and (expression (|>> (as Frac) (f.= expected)) + (/.item field (/.hash (list [field (/.float expected)])))) + (expression (|>> (as Bit)) + (|> (/.hash (list [field (/.float expected)])) + (/.item dummy) + (/.= /.nil))))) + ))) (def: test|object Test @@ -249,83 +249,83 @@ single random.safe_frac .let [double (/.function $method/0 (list $arg/0) (/.return (/.+ $arg/0 $arg/0)))]] - ($_ _.and - (_.cover [/.the] - (expression (|>> (as Int) (i.= (.int size))) - (|> (/.array (list#each /.float items)) - (/.the "length")))) - (_.cover [/.do] - (expression (let [expected (|> items - (list.item index) - (maybe.else f.not_a_number))] - (|>> (as Frac) (f.= expected))) - (|> (/.array (list#each /.float items)) - (/.do "at" (list (/.int (.int index))) {.#None})))) - (_.cover [/.class] - (expression (|>> (as Frac) (f.= (f.+ single single))) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body double])) - (/.return (|> $class - (/.new (list) {.#None}) - (/.do (/.code $method/0) (list (/.float single)) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.new /.initialize] - (expression (|>> (as Frac) (f.= single)) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body ($_ /.then - (/.function /.initialize (list $arg/0) - (/.set (list $state) $arg/0)) - (/.function $method/0 (list) - (/.return $state)) - )])) - (/.return (|> $class - (/.new (list (/.float single)) {.#None}) - (/.do (/.code $method/0) (list) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.alias_method/2] - (expression (|>> (as Frac) (f.= (f.+ single single))) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body ($_ /.then - double - (/.statement (/.alias_method/2 (/.string (/.code $method/1)) - (/.string (/.code $method/0)))))])) - (/.return (|> $class - (/.new (list) {.#None}) - (/.do (/.code $method/1) (list (/.float single)) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.for [/.module] - ($_ _.and - (_.cover [/.include/1] - (expression (|>> (as Frac) (f.= (f.+ single single))) - (|> ($_ /.then - (/.set (list $class) (/.module [/.#parameters (list) - /.#body double])) - (/.set (list $sub_class) (/.class [/.#parameters (list) - /.#body (/.statement (/.include/1 $class))])) - (/.return (|> $sub_class - (/.new (list) {.#None}) - (/.do (/.code $method/0) (list (/.float single)) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.extend/1] - (expression (|>> (as Frac) (f.= (f.+ single single))) - (|> ($_ /.then - (/.set (list $class) (/.module [/.#parameters (list) - /.#body double])) - (/.set (list $sub_class) (/.class [/.#parameters (list) - /.#body (/.statement (/.extend/1 $class))])) - (/.return (|> $sub_class - (/.do (/.code $method/0) (list (/.float single)) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - )) - ))) + (all _.and + (_.cover [/.the] + (expression (|>> (as Int) (i.= (.int size))) + (|> (/.array (list#each /.float items)) + (/.the "length")))) + (_.cover [/.do] + (expression (let [expected (|> items + (list.item index) + (maybe.else f.not_a_number))] + (|>> (as Frac) (f.= expected))) + (|> (/.array (list#each /.float items)) + (/.do "at" (list (/.int (.int index))) {.#None})))) + (_.cover [/.class] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body double])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.new /.initialize] + (expression (|>> (as Frac) (f.= single)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.function /.initialize (list $arg/0) + (/.set (list $state) $arg/0)) + (/.function $method/0 (list) + (/.return $state)) + )])) + (/.return (|> $class + (/.new (list (/.float single)) {.#None}) + (/.do (/.code $method/0) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.alias_method/2] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + double + (/.statement (/.alias_method/2 (/.string (/.code $method/1)) + (/.string (/.code $method/0)))))])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method/1) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.for [/.module] + (all _.and + (_.cover [/.include/1] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.then + (/.set (list $class) (/.module [/.#parameters (list) + /.#body double])) + (/.set (list $sub_class) (/.class [/.#parameters (list) + /.#body (/.statement (/.include/1 $class))])) + (/.return (|> $sub_class + (/.new (list) {.#None}) + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.extend/1] + (expression (|>> (as Frac) (f.= (f.+ single single))) + (|> (all /.then + (/.set (list $class) (/.module [/.#parameters (list) + /.#body double])) + (/.set (list $sub_class) (/.class [/.#parameters (list) + /.#body (/.statement (/.extend/1 $class))])) + (/.return (|> $sub_class + (/.do (/.code $method/0) (list (/.float single)) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + )) + ))) (def: test|io Test @@ -336,66 +336,66 @@ $new (# ! each /.local (random.ascii/upper 2)) $it (# ! each /.local (random.ascii/upper 3)) .let [expected (format left right)]]) - ($_ _.and - (_.for [/.stdout] - ($_ _.and - (_.cover [/.print/1] - (expression (|>> (as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdout) - (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) - (/.set (list /.stdout) $new) - (/.statement (/.print/1 (/.string left))) - (/.statement (/.print/1 (/.string right))) - (/.set (list /.stdout) $old) - (/.return (/.the "string" $new))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.print/2] - (expression (|>> (as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdout) - (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) - (/.set (list /.stdout) $new) - (/.statement (/.print/2 (/.string left) (/.string right))) - (/.set (list /.stdout) $old) - (/.return (/.the "string" $new))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - )) - (_.for [/.stdin] - ($_ _.and - (_.cover [/.gets/0] - (expression (|>> (as Text) (text#= (format left text.\n))) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdin) - (/.set (list /.stdin) (/.new (list (/.string (format left text.\n))) {.#None} - (/.manual "StringIO"))) - (/.set (list $it) /.gets/0) - (/.set (list /.stdin) $old) - (/.return $it)) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.last_string_read] - (expression (|>> (as Text) (text#= (format right text.\n))) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "stringio"))) - (/.set (list $old) /.stdin) - (/.set (list /.stdin) (/.new (list (/.string (format right text.\n))) {.#None} - (/.manual "StringIO"))) - (/.set (list $it) /.gets/0) - (/.set (list /.stdin) $old) - (/.return /.last_string_read)) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.last_line_number_read] - (expression (|>> (as Nat) (n.= 2)) - /.last_line_number_read)) - )) - ))) + (all _.and + (_.for [/.stdout] + (all _.and + (_.cover [/.print/1] + (expression (|>> (as Text) (text#= expected)) + (|> (all /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/1 (/.string left))) + (/.statement (/.print/1 (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.print/2] + (expression (|>> (as Text) (text#= expected)) + (|> (all /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdout) + (/.set (list $new) (/.new (list) {.#None} (/.manual "StringIO"))) + (/.set (list /.stdout) $new) + (/.statement (/.print/2 (/.string left) (/.string right))) + (/.set (list /.stdout) $old) + (/.return (/.the "string" $new))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + )) + (_.for [/.stdin] + (all _.and + (_.cover [/.gets/0] + (expression (|>> (as Text) (text#= (format left text.\n))) + (|> (all /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdin) + (/.set (list /.stdin) (/.new (list (/.string (format left text.\n))) {.#None} + (/.manual "StringIO"))) + (/.set (list $it) /.gets/0) + (/.set (list /.stdin) $old) + (/.return $it)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_string_read] + (expression (|>> (as Text) (text#= (format right text.\n))) + (|> (all /.then + (/.statement (/.require/1 (/.string "stringio"))) + (/.set (list $old) /.stdin) + (/.set (list /.stdin) (/.new (list (/.string (format right text.\n))) {.#None} + (/.manual "StringIO"))) + (/.set (list $it) /.gets/0) + (/.set (list /.stdin) $old) + (/.return /.last_string_read)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_line_number_read] + (expression (|>> (as Nat) (n.= 2)) + /.last_line_number_read)) + )) + ))) (def: test|computation Test @@ -409,25 +409,25 @@ string (random.ascii/upper 5) comment (random.ascii/upper 10)] - ($_ _.and - ..test|bool - ..test|float - ..test|int - ..test|array - ..test|hash - ..test|object - ..test|io - (_.cover [/.?] - (let [expected (if test then else)] - (expression (|>> (as Frac) (f.= expected)) - (/.? (/.bool test) - (/.float then) - (/.float else))))) - (_.cover [/.comment] - (expression (|>> (as Frac) (f.= then)) - (/.comment comment - (/.float then)))) - ))) + (all _.and + ..test|bool + ..test|float + ..test|int + ..test|array + ..test|hash + ..test|object + ..test|io + (_.cover [/.?] + (let [expected (if test then else)] + (expression (|>> (as Frac) (f.= expected)) + (/.? (/.bool test) + (/.float then) + (/.float else))))) + (_.cover [/.comment] + (expression (|>> (as Frac) (f.= then)) + (/.comment comment + (/.float then)))) + ))) (def: test|global Test @@ -435,73 +435,73 @@ [float/0 random.safe_frac $global (# ! each /.global (random.ascii/lower 10)) pattern (# ! each /.string (random.ascii/lower 11))] - ($_ _.and - (_.cover [/.global] - (expression (|>> (as Text) (text#= "global-variable")) - (|> ($_ /.then - (/.set (list $global) (/.float float/0)) - (/.return (/.defined?/1 $global))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.script_name] - (expression (let [file (format (# file.default separator) packager.main_file)] - (|>> (as Text) - (text.ends_with? file))) - /.script_name)) - (_.cover [/.input_record_separator] - (expression (|>> (as Text) - (text#= text.\n)) - /.input_record_separator)) - (_.cover [/.output_record_separator] - (..nil /.output_record_separator)) - (_.cover [/.process_id] - (expression (|>> (as Nat) (n.= 0) not) - /.process_id)) - (_.cover [/.case_insensitivity_flag] - (expression (|>> (as Bit) (bit#= false)) - /.case_insensitivity_flag)) - (_.cover [/.command_line_arguments] - (expression (|>> (as Int) (i.= +0)) - (/.the "length" /.command_line_arguments))) - (_.cover [/.last_string_matched] - (expression (|>> (as Bit)) - (|> ($_ /.then - (/.statement - (|> (/.manual "Regexp") - (/.new (list pattern) {.#None}) - (/.do "match" (list pattern) {.#None}))) - (/.return (/.= pattern /.last_string_matched))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.last_regexp_match] - (expression (|>> (as Bit)) - (|> (/.return (|> (/.manual "Regexp") - (/.new (list pattern) {.#None}) - (/.do "match" (list pattern) {.#None}) - (/.= /.last_regexp_match))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - ))) + (all _.and + (_.cover [/.global] + (expression (|>> (as Text) (text#= "global-variable")) + (|> (all /.then + (/.set (list $global) (/.float float/0)) + (/.return (/.defined?/1 $global))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.script_name] + (expression (let [file (format (# file.default separator) packager.main_file)] + (|>> (as Text) + (text.ends_with? file))) + /.script_name)) + (_.cover [/.input_record_separator] + (expression (|>> (as Text) + (text#= text.\n)) + /.input_record_separator)) + (_.cover [/.output_record_separator] + (..nil /.output_record_separator)) + (_.cover [/.process_id] + (expression (|>> (as Nat) (n.= 0) not) + /.process_id)) + (_.cover [/.case_insensitivity_flag] + (expression (|>> (as Bit) (bit#= false)) + /.case_insensitivity_flag)) + (_.cover [/.command_line_arguments] + (expression (|>> (as Int) (i.= +0)) + (/.the "length" /.command_line_arguments))) + (_.cover [/.last_string_matched] + (expression (|>> (as Bit)) + (|> (all /.then + (/.statement + (|> (/.manual "Regexp") + (/.new (list pattern) {.#None}) + (/.do "match" (list pattern) {.#None}))) + (/.return (/.= pattern /.last_string_matched))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.last_regexp_match] + (expression (|>> (as Bit)) + (|> (/.return (|> (/.manual "Regexp") + (/.new (list pattern) {.#None}) + (/.do "match" (list pattern) {.#None}) + (/.= /.last_regexp_match))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) (def: test|local_var Test (do [! random.monad] [float/0 random.safe_frac $foreign (# ! each /.local (random.ascii/lower 10))] - ($_ _.and - (_.cover [/.local] - (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (|> (/.return (/.+ $foreign $foreign)) - [(list $foreign)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0)))))) - (_.cover [/.set] - (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (|> ($_ /.then - (/.set (list $foreign) (/.float float/0)) - (/.return (/.+ $foreign $foreign))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - ))) + (all _.and + (_.cover [/.local] + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (|> (/.return (/.+ $foreign $foreign)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0)))))) + (_.cover [/.set] + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (|> (all /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.+ $foreign $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) (def: test|instance_var Test @@ -516,64 +516,64 @@ random.nat) $object (# ! each (|>> %.nat (format "object_") /.local) random.nat)] - ($_ _.and - (_.cover [/.instance] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body ($_ /.then - (/.function /.initialize (list) - (/.set (list $instance) (/.float float/0))) - (/.function $method (list) - (/.return $instance)) - )])) - (/.return (|> $class - (/.new (list) {.#None}) - (/.do (/.code $method) (list) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.attr_reader/*] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body ($_ /.then - (/.attr_reader/* (list instance)) - (/.function /.initialize (list) - (/.set (list $instance) (/.float float/0))) - )])) - (/.return (|> $class - (/.new (list) {.#None}) - (/.the instance)))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.attr_writer/*] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body ($_ /.then - (/.attr_writer/* (list instance)) - (/.function $method (list) - (/.return $instance)) - )])) - (/.set (list $object) (|> $class - (/.new (list) {.#None}))) - (/.set (list (/.the instance $object)) (/.float float/0)) - (/.return (|> $object - (/.do (/.code $method) (list) {.#None})))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.attr_accessor/*] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body (/.attr_accessor/* (list instance))])) - (/.set (list $object) (|> $class - (/.new (list) {.#None}))) - (/.set (list (/.the instance $object)) (/.float float/0)) - (/.return (/.the instance $object))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - ))) + (all _.and + (_.cover [/.instance] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + (/.function $method (list) + (/.return $instance)) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_reader/*] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.attr_reader/* (list instance)) + (/.function /.initialize (list) + (/.set (list $instance) (/.float float/0))) + )])) + (/.return (|> $class + (/.new (list) {.#None}) + (/.the instance)))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_writer/*] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (all /.then + (/.attr_writer/* (list instance)) + (/.function $method (list) + (/.return $instance)) + )])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (|> $object + (/.do (/.code $method) (list) {.#None})))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.attr_accessor/*] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.attr_accessor/* (list instance))])) + (/.set (list $object) (|> $class + (/.new (list) {.#None}))) + (/.set (list (/.the instance $object)) (/.float float/0)) + (/.return (/.the instance $object))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) (def: test|static_var Test @@ -588,18 +588,18 @@ random.nat) $class (# ! each (|>> %.nat (format "class_") /.local) random.nat)] - ($_ _.and - (_.cover [/.static /.class_variable_set /.class_variable_get] - (expression (|>> (as Int) (i.= int/0)) - (|> ($_ /.then - (/.set (list $class) (/.class [/.#parameters (list) - /.#body (/.function $method (list) - (/.return (/.int +0)))])) - (/.statement (/.class_variable_set $static (/.int int/0) $class)) - (/.return (/.class_variable_get $static $class))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - ))) + (all _.and + (_.cover [/.static /.class_variable_set /.class_variable_get] + (expression (|>> (as Int) (i.= int/0)) + (|> (all /.then + (/.set (list $class) (/.class [/.#parameters (list) + /.#body (/.function $method (list) + (/.return (/.int +0)))])) + (/.statement (/.class_variable_set $static (/.int int/0) $class)) + (/.return (/.class_variable_get $static $class))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) (def: test|variadic Test @@ -612,26 +612,26 @@ keys (|> (random.ascii/lower 1) (random.set text.hash arity) (# ! each (|>> set.list (list#each /.string))))] - ($_ _.and - (<| (_.for [/.LVar*]) - ($_ _.and - (_.cover [/.variadic] - (expression (|>> (as Int) .nat (n.= arity)) - (|> (/.return (/.the "length" $inputs)) - [(list (/.variadic $inputs))] (/.lambda {.#None}) - (/.apply_lambda/* vals)))) - (_.cover [/.splat] - (expression (|>> (as Int) .nat (n.= arity)) - (|> (/.return (/.the "length" (/.array (list (/.splat $inputs))))) - [(list (/.variadic $inputs))] (/.lambda {.#None}) - (/.apply_lambda/* vals)))))) - (<| (_.for [/.LVar**]) - (_.cover [/.variadic_kv /.double_splat] - (expression (|>> (as Int) .nat (n.= arity)) - (|> (/.return (/.the "length" $inputs)) - [(list (/.variadic_kv $inputs))] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped_2 keys vals))))))))) - ))) + (all _.and + (<| (_.for [/.LVar*]) + (all _.and + (_.cover [/.variadic] + (expression (|>> (as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* vals)))) + (_.cover [/.splat] + (expression (|>> (as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" (/.array (list (/.splat $inputs))))) + [(list (/.variadic $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* vals)))))) + (<| (_.for [/.LVar**]) + (_.cover [/.variadic_kv /.double_splat] + (expression (|>> (as Int) .nat (n.= arity)) + (|> (/.return (/.the "length" $inputs)) + [(list (/.variadic_kv $inputs))] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.double_splat (/.hash (list.zipped_2 keys vals))))))))) + ))) (def: test|var Test @@ -640,35 +640,35 @@ $foreign (# ! each /.local (random.ascii/lower 10)) $constant (# ! each /.constant (random.ascii/lower 10))] - ($_ _.and - (_.cover [/.defined?/1] - (and (expression (|>> (as Bit)) - (|> (/.defined?/1 $foreign) - (/.= /.nil))) - (expression (|>> (as Text) (text#= "local-variable")) - (|> ($_ /.then - (/.set (list $foreign) (/.float float/0)) - (/.return (/.defined?/1 $foreign))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)))))) - (_.for [/.CVar] - (_.cover [/.constant] - (expression (|>> (as Text) (text#= "constant")) - (|> ($_ /.then - (/.set (list $constant) (/.float float/0)) - (/.return (/.defined?/1 $constant))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)))))) - (_.for [/.GVar] - ..test|global) - (_.for [/.LVar] - ..test|local_var) - (_.for [/.IVar] - ..test|instance_var) - (_.for [/.SVar] - ..test|static_var) - ..test|variadic - ))) + (all _.and + (_.cover [/.defined?/1] + (and (expression (|>> (as Bit)) + (|> (/.defined?/1 $foreign) + (/.= /.nil))) + (expression (|>> (as Text) (text#= "local-variable")) + (|> (all /.then + (/.set (list $foreign) (/.float float/0)) + (/.return (/.defined?/1 $foreign))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + (_.for [/.CVar] + (_.cover [/.constant] + (expression (|>> (as Text) (text#= "constant")) + (|> (all /.then + (/.set (list $constant) (/.float float/0)) + (/.return (/.defined?/1 $constant))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + (_.for [/.GVar] + ..test|global) + (_.for [/.LVar] + ..test|local_var) + (_.for [/.IVar] + ..test|instance_var) + (_.for [/.SVar] + ..test|static_var) + ..test|variadic + ))) (def: test|location Test @@ -676,42 +676,42 @@ [float/0 random.safe_frac $foreign (# ! each /.local (random.ascii/lower 10)) field (# ! each /.string (random.ascii/upper 10))] - ($_ _.and - (<| (_.for [/.Var]) - ..test|var) - (_.cover [/.Access] - (and (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (let [@ (/.item (/.int +0) $foreign)] - (|> ($_ /.then - (/.set (list $foreign) (/.array (list $foreign))) - (/.set (list @) (/.+ @ @)) - (/.return @)) - [(list $foreign)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0)))))) - (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) - (let [@ (/.item field $foreign)] - (|> ($_ /.then - (/.set (list $foreign) (/.hash (list [field $foreign]))) - (/.set (list @) (/.+ @ @)) - (/.return @)) - [(list $foreign)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0)))))) - )) - ))) + (all _.and + (<| (_.for [/.Var]) + ..test|var) + (_.cover [/.Access] + (and (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.item (/.int +0) $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.array (list $foreign))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0)))))) + (expression (|>> (as Frac) (f.= (f.+ float/0 float/0))) + (let [@ (/.item field $foreign)] + (|> (all /.then + (/.set (list $foreign) (/.hash (list [field $foreign]))) + (/.set (list @) (/.+ @ @)) + (/.return @)) + [(list $foreign)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0)))))) + )) + ))) (def: test|expression Test (do [! random.monad] [dummy random.safe_frac expected random.safe_frac] - (`` ($_ _.and - (_.for [/.Literal] - ..test|literal) - (_.for [/.Computation] - ..test|computation) - (_.for [/.Location] - ..test|location) - )))) + (`` (all _.and + (_.for [/.Literal] + ..test|literal) + (_.for [/.Computation] + ..test|computation) + (_.for [/.Location] + ..test|location) + )))) (def: test|label Test @@ -728,56 +728,56 @@ $output (/.local "output") $inner_index (/.local "inner_index") $outer_index (/.local "outer_index")]] - ($_ _.and - (_.cover [/.break] - (let [expected (i.* (.int expected_inner_iterations) input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (|> ($_ /.then - (/.set (list $inner_index) (/.int +0)) - (/.set (list $output) (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) - /.break) - (/.set (list $output) (/.+ $input $output)) - (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) - )) - (/.return $output)) - [(list $input)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.int input))))))) - (_.cover [/.next] - (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (|> ($_ /.then - (/.set (list $inner_index) (/.int +0)) - (/.set (list $output) (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) - (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) - /.next) - (/.set (list $output) (/.+ $input $output)) - )) - (/.return $output)) - [(list $input)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.int input))))))) - (_.cover [/.redo] - (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] - (expression (|>> (as Frac) f.int (i.= expected)) - (|> ($_ /.then - (/.set (list $inner_index) (/.int +0)) - (/.set (list $output) (/.int +0)) - (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) - ($_ /.then - (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) - (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) - /.redo) - (/.set (list $output) (/.+ $input $output)) - )) - (/.return $output)) - [(list $input)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.int input))))))) - ))) + (all _.and + (_.cover [/.break] + (let [expected (i.* (.int expected_inner_iterations) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (|> (all /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.when (/.= (/.int (.int expected_inner_iterations)) $inner_index) + /.break) + (/.set (list $output) (/.+ $input $output)) + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.int input))))))) + (_.cover [/.next] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (|> (all /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.next) + (/.set (list $output) (/.+ $input $output)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.int input))))))) + (_.cover [/.redo] + (let [expected (i.* (.int (n.- expected_inner_iterations full_inner_iterations)) input)] + (expression (|>> (as Frac) f.int (i.= expected)) + (|> (all /.then + (/.set (list $inner_index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int full_inner_iterations)) $inner_index) + (all /.then + (/.set (list $inner_index) (/.+ (/.int +1) $inner_index)) + (/.when (/.<= (/.int (.int expected_inner_iterations)) $inner_index) + /.redo) + (/.set (list $output) (/.+ $input $output)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.int input))))))) + ))) (def: test|loop Test @@ -788,31 +788,31 @@ $output (/.local "output") $index (/.local "index") expected (i.* (.int iterations) input)]] - ($_ _.and - (_.cover [/.while] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.set (list $index) (/.int +0)) - (/.set (list $output) (/.int +0)) - (/.while (/.< (/.int (.int iterations)) $index) - ($_ /.then - (/.set (list $output) (/.+ $input $output)) - (/.set (list $index) (/.+ (/.int +1) $index)) - )) - (/.return $output)) - [(list $input)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.int input)))))) - (_.cover [/.for_in] - (expression (|>> (as Int) (i.= expected)) - (|> ($_ /.then - (/.set (list $output) (/.int +0)) - (/.for_in $index (/.array (list.repeated iterations (/.int input))) - (/.set (list $output) (/.+ $index $output))) - (/.return $output)) - [(list $input)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.int input)))))) - ..test|label - ))) + (all _.and + (_.cover [/.while] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.set (list $index) (/.int +0)) + (/.set (list $output) (/.int +0)) + (/.while (/.< (/.int (.int iterations)) $index) + (all /.then + (/.set (list $output) (/.+ $input $output)) + (/.set (list $index) (/.+ (/.int +1) $index)) + )) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.int input)))))) + (_.cover [/.for_in] + (expression (|>> (as Int) (i.= expected)) + (|> (all /.then + (/.set (list $output) (/.int +0)) + (/.for_in $index (/.array (list.repeated iterations (/.int input))) + (/.set (list $output) (/.+ $index $output))) + (/.return $output)) + [(list $input)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.int input)))))) + ..test|label + ))) (def: random_tag (Random Int) @@ -833,73 +833,73 @@ ..random_tag) .let [expected_tag (/.int expected_tag) dummy_tag (/.int dummy_tag)]] - ($_ _.and - (_.cover [/.begin] - (expression (|>> (as Frac) (f.= expected)) - (|> (/.begin (/.return (/.float expected)) - (list [(list) $ex (/.return (/.float dummy))])) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.Rescue /.throw/1] - (expression (|>> (as Frac) (f.= expected)) - (|> (/.begin ($_ /.then - (/.throw/1 (/.string error)) - (/.return (/.float dummy))) - (list [(list) $ex (/.return (/.float expected))])) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.raise] - (expression (|>> (as Frac) (f.= expected)) - (|> (/.begin ($_ /.then - (/.statement (/.raise (/.string error))) - (/.return (/.float dummy))) - (list [(list) $ex (/.return (/.float expected))])) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.catch /.throw/2] - (and (expression (|>> (as Frac) (f.= expected)) - (<| (/.apply_lambda/* (list)) - (/.lambda {.#None}) [(list)] - /.return - (/.catch expected_tag) [(list)] - (/.throw/2 expected_tag (/.float expected)))) - (expression (|>> (as Frac) (f.= expected)) - (<| (/.apply_lambda/* (list)) - (/.lambda {.#None}) [(list)] - /.return - (/.catch expected_tag) [(list)] - /.statement (/.catch dummy_tag) [(list)] - (/.throw/2 expected_tag (/.float expected)))) - (expression (|>> (as Frac) (f.= expected)) - (<| (/.apply_lambda/* (list)) - (/.lambda {.#None}) [(list)] - /.return - (/.catch dummy_tag) [(list)] - /.statement (/.catch expected_tag) [(list)] - (/.throw/2 expected_tag (/.float expected)))))) - (_.cover [/.latest_error_message] - (expression (|>> (as Text) (text#= error)) - (|> (/.begin ($_ /.then - (/.statement (/.raise (/.string error))) - (/.return (/.float dummy))) - (list [(list) $ex (/.return (/.the "message" /.latest_error_message))])) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.latest_error_location] - (and (|> (/.return /.latest_error_location) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)) - ..nil) - (expression (|>> (as Bit) (bit#= true)) - (|> (/.begin ($_ /.then - (/.statement (/.raise (/.string error))) - (/.return (/.float dummy))) - (list [(list) $ex (/.return ($_ /.and - (/.do "kind_of?" (list (is /.CVar (/.manual "Array"))) {.#None} /.latest_error_location) - (/.> (/.int +0) (/.the "length" /.latest_error_location))))])) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)))))) - ))) + (all _.and + (_.cover [/.begin] + (expression (|>> (as Frac) (f.= expected)) + (|> (/.begin (/.return (/.float expected)) + (list [(list) $ex (/.return (/.float dummy))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.Rescue /.throw/1] + (expression (|>> (as Frac) (f.= expected)) + (|> (/.begin (all /.then + (/.throw/1 (/.string error)) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.float expected))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.raise] + (expression (|>> (as Frac) (f.= expected)) + (|> (/.begin (all /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.float expected))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.catch /.throw/2] + (and (expression (|>> (as Frac) (f.= expected)) + (<| (/.apply_lambda/* (list)) + (/.lambda {.#None}) [(list)] + /.return + (/.catch expected_tag) [(list)] + (/.throw/2 expected_tag (/.float expected)))) + (expression (|>> (as Frac) (f.= expected)) + (<| (/.apply_lambda/* (list)) + (/.lambda {.#None}) [(list)] + /.return + (/.catch expected_tag) [(list)] + /.statement (/.catch dummy_tag) [(list)] + (/.throw/2 expected_tag (/.float expected)))) + (expression (|>> (as Frac) (f.= expected)) + (<| (/.apply_lambda/* (list)) + (/.lambda {.#None}) [(list)] + /.return + (/.catch dummy_tag) [(list)] + /.statement (/.catch expected_tag) [(list)] + (/.throw/2 expected_tag (/.float expected)))))) + (_.cover [/.latest_error_message] + (expression (|>> (as Text) (text#= error)) + (|> (/.begin (all /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (/.the "message" /.latest_error_message))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.latest_error_location] + (and (|> (/.return /.latest_error_location) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)) + ..nil) + (expression (|>> (as Bit) (bit#= true)) + (|> (/.begin (all /.then + (/.statement (/.raise (/.string error))) + (/.return (/.float dummy))) + (list [(list) $ex (/.return (all /.and + (/.do "kind_of?" (list (is /.CVar (/.manual "Array"))) {.#None} /.latest_error_location) + (/.> (/.int +0) (/.the "length" /.latest_error_location))))])) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))))) + ))) (def: test|function Test @@ -915,42 +915,42 @@ $arg/0 (# ! each /.local (random.ascii/lower 10)) $arg/1 (# ! each /.local (random.ascii/lower 11)) $arg/2 (# ! each /.local (random.ascii/lower 12))] - ($_ _.and - (_.cover [/.lambda /.return] - (and (expression (|>> (as Frac) (f.= float/0)) - (|> (/.return (/.float float/0)) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list)))) - (expression (|>> (as Frac) f.nat (n.= iterations)) - (|> (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) - (/.apply_lambda/* (list (/.+ (/.int +1) $arg/0)) $self) - $arg/0)) - [(list $arg/0)] (/.lambda {.#Some $self}) - (/.apply_lambda/* (list (/.int +0))))))) - (_.cover [/.apply_lambda/*] - (expression (|>> (as Frac) (f.= ($_ f.+ float/0 float/1 float/2))) - (|> (/.return ($_ /.+ $arg/0 $arg/1 $arg/2)) - [(list $arg/0 $arg/1 $arg/2)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0) (/.float float/1) (/.float float/2)))))) - (_.cover [/.function] - (expression (|>> (as Frac) f.nat (n.= iterations)) - (|> ($_ /.then - (/.function $self (list $arg/0) - (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) - (/.apply/* (list (/.+ (/.int +1) $arg/0)) {.#None} $self) - $arg/0))) - (/.return (/.apply/* (list (/.int +0)) {.#None} $self))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.apply/*] - (expression (|>> (as Frac) (f.= ($_ f.+ float/0 float/1 float/2))) - (|> ($_ /.then - (/.function $self (list $arg/0 $arg/1 $arg/2) - (/.return ($_ /.+ $arg/0 $arg/1 $arg/2))) - (/.return (/.apply/* (list (/.float float/0) (/.float float/1) (/.float float/2)) {.#None} $self))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - ))) + (all _.and + (_.cover [/.lambda /.return] + (and (expression (|>> (as Frac) (f.= float/0)) + (|> (/.return (/.float float/0)) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list)))) + (expression (|>> (as Frac) f.nat (n.= iterations)) + (|> (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply_lambda/* (list (/.+ (/.int +1) $arg/0)) $self) + $arg/0)) + [(list $arg/0)] (/.lambda {.#Some $self}) + (/.apply_lambda/* (list (/.int +0))))))) + (_.cover [/.apply_lambda/*] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (|> (/.return (all /.+ $arg/0 $arg/1 $arg/2)) + [(list $arg/0 $arg/1 $arg/2)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0) (/.float float/1) (/.float float/2)))))) + (_.cover [/.function] + (expression (|>> (as Frac) f.nat (n.= iterations)) + (|> (all /.then + (/.function $self (list $arg/0) + (/.return (/.? (/.< (/.int (.int iterations)) $arg/0) + (/.apply/* (list (/.+ (/.int +1) $arg/0)) {.#None} $self) + $arg/0))) + (/.return (/.apply/* (list (/.int +0)) {.#None} $self))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.apply/*] + (expression (|>> (as Frac) (f.= (all f.+ float/0 float/1 float/2))) + (|> (all /.then + (/.function $self (list $arg/0 $arg/1 $arg/2) + (/.return (all /.+ $arg/0 $arg/1 $arg/2))) + (/.return (/.apply/* (list (/.float float/0) (/.float float/1) (/.float float/2)) {.#None} $self))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) (def: test|branching Test @@ -968,23 +968,23 @@ $arg/1 (/.local arg/1) $arg/2 (/.local arg/2)] ??? random.bit] - ($_ _.and - (_.cover [/.if] - (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) - (|> (/.if (/.bool ???) - (/.return (/.float float/0)) - (/.return (/.float float/1))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - (_.cover [/.when] - (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) - (|> ($_ /.then - (/.when (/.bool ???) - (/.return (/.float float/0))) - (/.return (/.float float/1))) - [(list)] (/.lambda {.#None}) - (/.apply_lambda/* (list))))) - ))) + (all _.and + (_.cover [/.if] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (/.if (/.bool ???) + (/.return (/.float float/0)) + (/.return (/.float float/1))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + (_.cover [/.when] + (expression (|>> (as Frac) (f.= (if ??? float/0 float/1))) + (|> (all /.then + (/.when (/.bool ???) + (/.return (/.float float/0))) + (/.return (/.float float/1))) + [(list)] (/.lambda {.#None}) + (/.apply_lambda/* (list))))) + ))) (def: test|statement Test @@ -997,49 +997,49 @@ $arg/2 (# ! each /.local (random.ascii/lower 12)) expected (# ! each (|>> %.int (text.replaced "+" "")) random.int)] - ($_ _.and - (_.cover [/.statement] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.statement (/.+ $arg/0 $arg/0)) - (/.return $arg/0)) - [(list $arg/0)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0)))))) - (_.cover [/.then] - (expression (|>> (as Frac) (f.= float/0)) - (|> ($_ /.then - (/.return $arg/0) - (/.return $arg/1)) - [(list $arg/0 $arg/1)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.float float/0) (/.float float/1)))))) - (_.cover [/.require/1] - (let [$JSON (is /.CVar (/.manual "JSON"))] - (expression (|>> (as Text) (text#= expected)) - (|> ($_ /.then - (/.statement (/.require/1 (/.string "json"))) - (/.return (let [json (/.do "parse" (list $arg/0) {.#None} $JSON)] - (/.do "generate" (list json) {.#None} $JSON)))) - [(list $arg/0)] (/.lambda {.#None}) - (/.apply_lambda/* (list (/.string expected))))))) - ..test|exception - ..test|branching - ..test|loop - (_.for [/.Block] - ..test|function) - ))) + (all _.and + (_.cover [/.statement] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.statement (/.+ $arg/0 $arg/0)) + (/.return $arg/0)) + [(list $arg/0)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0)))))) + (_.cover [/.then] + (expression (|>> (as Frac) (f.= float/0)) + (|> (all /.then + (/.return $arg/0) + (/.return $arg/1)) + [(list $arg/0 $arg/1)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.float float/0) (/.float float/1)))))) + (_.cover [/.require/1] + (let [$JSON (is /.CVar (/.manual "JSON"))] + (expression (|>> (as Text) (text#= expected)) + (|> (all /.then + (/.statement (/.require/1 (/.string "json"))) + (/.return (let [json (/.do "parse" (list $arg/0) {.#None} $JSON)] + (/.do "generate" (list json) {.#None} $JSON)))) + [(list $arg/0)] (/.lambda {.#None}) + (/.apply_lambda/* (list (/.string expected))))))) + ..test|exception + ..test|branching + ..test|loop + (_.for [/.Block] + ..test|function) + ))) (def: random_expression (Random /.Expression) (let [literal (is (Random /.Literal) - ($_ random.either - (random#each /.bool random.bit) - (random#each /.float random.frac) - (random#each /.int random.int) - (random#each /.string (random.ascii/lower 5)) - ))] - ($_ random.either - literal - ))) + (all random.either + (random#each /.bool random.bit) + (random#each /.float random.frac) + (random#each /.int random.int) + (random#each /.string (random.ascii/lower 5)) + ))] + (all random.either + literal + ))) (def: .public test Test @@ -1047,16 +1047,16 @@ [expected ..random_expression] (<| (_.covering /._) (_.for [/.Code]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random_expression)) - - (_.cover [/.code /.manual] - (|> (/.manual (/.code expected)) - (is /.Expression) - (/#= expected))) - (_.for [/.Expression] - ..test|expression) - (_.for [/.Statement] - ..test|statement) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random_expression)) + + (_.cover [/.code /.manual] + (|> (/.manual (/.code expected)) + (is /.Expression) + (/#= expected))) + (_.for [/.Expression] + ..test|expression) + (_.for [/.Statement] + ..test|statement) + )))) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index 3e3c8e268..676290e8e 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -35,32 +35,32 @@ [expected_message/0 (random.ascii/lower 5) expected_message/1 (random.only (|>> (text#= expected_message/0) not) (random.ascii/lower 5))] - ($_ /.and - (in (do async.monad - [[success_tally success_message] (/.assertion expected_message/0 true) - [failure_tally failure_message] (/.assertion expected_message/0 false)] - (/.cover' [/.assertion /.Tally] - (and (text.ends_with? expected_message/0 success_message) - (text.ends_with? expected_message/0 failure_message) - (and (n.= 1 (the /.#successes success_tally)) - (n.= 0 (the /.#failures success_tally))) - (and (n.= 0 (the /.#successes failure_tally)) - (n.= 1 (the /.#failures failure_tally))))))) - (in (do async.monad - [tt (/.and' (/.assertion expected_message/0 true) - (/.assertion expected_message/1 true)) - ff (/.and' (/.assertion expected_message/0 false) - (/.assertion expected_message/1 false)) - tf (/.and' (/.assertion expected_message/0 true) - (/.assertion expected_message/1 false)) - ft (/.and' (/.assertion expected_message/0 false) - (/.assertion expected_message/1 true))] - (/.cover' [/.and'] - (and (..verify expected_message/0 expected_message/1 2 0 tt) - (..verify expected_message/0 expected_message/1 0 2 ff) - (..verify expected_message/0 expected_message/1 1 1 tf) - (..verify expected_message/0 expected_message/1 1 1 ft))))) - ))) + (all /.and + (in (do async.monad + [[success_tally success_message] (/.assertion expected_message/0 true) + [failure_tally failure_message] (/.assertion expected_message/0 false)] + (/.cover' [/.assertion /.Tally] + (and (text.ends_with? expected_message/0 success_message) + (text.ends_with? expected_message/0 failure_message) + (and (n.= 1 (the /.#successes success_tally)) + (n.= 0 (the /.#failures success_tally))) + (and (n.= 0 (the /.#successes failure_tally)) + (n.= 1 (the /.#failures failure_tally))))))) + (in (do async.monad + [tt (/.and' (/.assertion expected_message/0 true) + (/.assertion expected_message/1 true)) + ff (/.and' (/.assertion expected_message/0 false) + (/.assertion expected_message/1 false)) + tf (/.and' (/.assertion expected_message/0 true) + (/.assertion expected_message/1 false)) + ft (/.and' (/.assertion expected_message/0 false) + (/.assertion expected_message/1 true))] + (/.cover' [/.and'] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft))))) + ))) (def: seed /.Test @@ -90,131 +90,131 @@ (def: times /.Test - ($_ /.and - (do [! random.monad] - [times_assertion (/.times 0 (/.test "" true))] - (in (do async.monad - [[tally error] times_assertion] - (/.cover' [/.must_try_test_at_least_once] - (and (text.contains? (the exception.#label /.must_try_test_at_least_once) error) - (n.= 0 (the /.#successes tally)) - (n.= 1 (the /.#failures tally))))))) - (do [! random.monad] - [expected (# ! each (|>> (n.% 10) ++) random.nat) - .let [counter (is (Atom Nat) - (atom.atom 0))] - times_assertion (<| (/.times expected) - (do ! - [_ (in []) - .let [_ (io.run! (atom.update! ++ counter))]] - (/.test "" true)))] - (in (do async.monad - [[tally error] times_assertion - actual (async.future (atom.read! counter))] - (/.cover' [/.times] - (and (n.= expected actual) - (n.= 1 (the /.#successes tally)) - (n.= 0 (the /.#failures tally))))))) - )) + (all /.and + (do [! random.monad] + [times_assertion (/.times 0 (/.test "" true))] + (in (do async.monad + [[tally error] times_assertion] + (/.cover' [/.must_try_test_at_least_once] + (and (text.contains? (the exception.#label /.must_try_test_at_least_once) error) + (n.= 0 (the /.#successes tally)) + (n.= 1 (the /.#failures tally))))))) + (do [! random.monad] + [expected (# ! each (|>> (n.% 10) ++) random.nat) + .let [counter (is (Atom Nat) + (atom.atom 0))] + times_assertion (<| (/.times expected) + (do ! + [_ (in []) + .let [_ (io.run! (atom.update! ++ counter))]] + (/.test "" true)))] + (in (do async.monad + [[tally error] times_assertion + actual (async.future (atom.read! counter))] + (/.cover' [/.times] + (and (n.= expected actual) + (n.= 1 (the /.#successes tally)) + (n.= 0 (the /.#failures tally))))))) + )) (def: in_parallel /.Test - ($_ /.and - (do [! random.monad] - [expected (# ! each (|>> (n.% 10) ++) random.nat) - .let [counter (is (Atom Nat) - (atom.atom 0))] - assertion (<| /.in_parallel - (list.repeated expected) - (is /.Test) - (do ! - [_ (in []) - .let [_ (io.run! (atom.update! ++ counter))]] - (/.test "" true)))] - (in (do async.monad - [[tally error] assertion - actual (async.future (atom.read! counter))] - (/.cover' [/.in_parallel] - (and (n.= expected actual) - (n.= expected (the /.#successes tally)) - (n.= 0 (the /.#failures tally))))))) - (do [! random.monad] - [expected (# ! each (|>> (n.% 10) ++) random.nat) - .let [counter (is (Atom Nat) - (atom.atom 0))] - assertion (<| /.in_parallel - (list.repeated expected) - (is /.Test) - (do ! - [_ (in []) - .let [_ (undefined) - _ (io.run! (atom.update! ++ counter))]] - (/.test "" true)))] - (in (do async.monad - [[tally error] assertion - actual (async.future (atom.read! counter))] - (/.cover' [/.error_during_execution] - (let [correct_error! (text.contains? (the exception.#label /.error_during_execution) error) - no_complete_run! (n.= 0 actual) - no_successes! (n.= 0 (the /.#successes tally)) - ran_all_tests! (n.= expected (the /.#failures tally))] - (and correct_error! - no_complete_run! - no_successes! - ran_all_tests!)))))) - )) + (all /.and + (do [! random.monad] + [expected (# ! each (|>> (n.% 10) ++) random.nat) + .let [counter (is (Atom Nat) + (atom.atom 0))] + assertion (<| /.in_parallel + (list.repeated expected) + (is /.Test) + (do ! + [_ (in []) + .let [_ (io.run! (atom.update! ++ counter))]] + (/.test "" true)))] + (in (do async.monad + [[tally error] assertion + actual (async.future (atom.read! counter))] + (/.cover' [/.in_parallel] + (and (n.= expected actual) + (n.= expected (the /.#successes tally)) + (n.= 0 (the /.#failures tally))))))) + (do [! random.monad] + [expected (# ! each (|>> (n.% 10) ++) random.nat) + .let [counter (is (Atom Nat) + (atom.atom 0))] + assertion (<| /.in_parallel + (list.repeated expected) + (is /.Test) + (do ! + [_ (in []) + .let [_ (undefined) + _ (io.run! (atom.update! ++ counter))]] + (/.test "" true)))] + (in (do async.monad + [[tally error] assertion + actual (async.future (atom.read! counter))] + (/.cover' [/.error_during_execution] + (let [correct_error! (text.contains? (the exception.#label /.error_during_execution) error) + no_complete_run! (n.= 0 actual) + no_successes! (n.= 0 (the /.#successes tally)) + ran_all_tests! (n.= expected (the /.#failures tally))] + (and correct_error! + no_complete_run! + no_successes! + ran_all_tests!)))))) + )) (def: .public dummy_target "YOLO") (def: coverage /.Test - ($_ /.and - (do random.monad - [not_covering (/.test "" true) - covering (/.covering .._ (/.test "" true))] - (in (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.covering] - (and (and (set.empty? (the /.#expected_coverage not_covering)) - (set.empty? (the /.#actual_coverage not_covering))) - (and (not (set.empty? (the /.#expected_coverage covering))) - (set.empty? (the /.#actual_coverage covering)))))))) - (do random.monad - [not_covering (/.covering .._ (/.test "" true)) - covering (/.covering .._ (/.cover [..dummy_target] true))] - (in (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.cover] - (and (and (not (set.empty? (the /.#expected_coverage not_covering))) - (not (set.member? (the /.#actual_coverage not_covering) (symbol ..dummy_target)))) - (and (not (set.empty? (the /.#expected_coverage covering))) - (set.member? (the /.#actual_coverage covering) (symbol ..dummy_target)))))))) - (do random.monad - [not_covering (/.covering .._ (/.test "" true)) - covering (/.covering .._ (in (/.cover' [..dummy_target] true)))] - (in (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.cover'] - (and (and (not (set.empty? (the /.#expected_coverage not_covering))) - (not (set.member? (the /.#actual_coverage not_covering) (symbol ..dummy_target)))) - (and (not (set.empty? (the /.#expected_coverage covering))) - (set.member? (the /.#actual_coverage covering) (symbol ..dummy_target)))))))) - (do random.monad - [not_covering (/.covering .._ (/.test "" true)) - covering (/.covering .._ (/.for [..dummy_target] (/.test "" true)))] - (in (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (/.cover' [/.for] - (and (and (not (set.empty? (the /.#expected_coverage not_covering))) - (not (set.member? (the /.#actual_coverage not_covering) (symbol ..dummy_target)))) - (and (not (set.empty? (the /.#expected_coverage covering))) - (set.member? (the /.#actual_coverage covering) (symbol ..dummy_target)))))))) - )) + (all /.and + (do random.monad + [not_covering (/.test "" true) + covering (/.covering .._ (/.test "" true))] + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.covering] + (and (and (set.empty? (the /.#expected_coverage not_covering)) + (set.empty? (the /.#actual_coverage not_covering))) + (and (not (set.empty? (the /.#expected_coverage covering))) + (set.empty? (the /.#actual_coverage covering)))))))) + (do random.monad + [not_covering (/.covering .._ (/.test "" true)) + covering (/.covering .._ (/.cover [..dummy_target] true))] + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.cover] + (and (and (not (set.empty? (the /.#expected_coverage not_covering))) + (not (set.member? (the /.#actual_coverage not_covering) (symbol ..dummy_target)))) + (and (not (set.empty? (the /.#expected_coverage covering))) + (set.member? (the /.#actual_coverage covering) (symbol ..dummy_target)))))))) + (do random.monad + [not_covering (/.covering .._ (/.test "" true)) + covering (/.covering .._ (in (/.cover' [..dummy_target] true)))] + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.cover'] + (and (and (not (set.empty? (the /.#expected_coverage not_covering))) + (not (set.member? (the /.#actual_coverage not_covering) (symbol ..dummy_target)))) + (and (not (set.empty? (the /.#expected_coverage covering))) + (set.member? (the /.#actual_coverage covering) (symbol ..dummy_target)))))))) + (do random.monad + [not_covering (/.covering .._ (/.test "" true)) + covering (/.covering .._ (/.for [..dummy_target] (/.test "" true)))] + (in (do async.monad + [[not_covering _] not_covering + [covering _] covering] + (/.cover' [/.for] + (and (and (not (set.empty? (the /.#expected_coverage not_covering))) + (not (set.member? (the /.#actual_coverage not_covering) (symbol ..dummy_target)))) + (and (not (set.empty? (the /.#expected_coverage covering))) + (set.member? (the /.#actual_coverage covering) (symbol ..dummy_target)))))))) + )) (def: .public test /.Test @@ -226,80 +226,80 @@ (random.ascii/lower 5)) expected_message/1 (random.only (|>> (text#= expected_message/0) not) (random.ascii/lower 5))] - ($_ /.and - (/.for [/.Assertion] - ..assertion) - (/.for [/.Seed] - seed) - (do ! - [success_assertion (/.test expected_message/0 true) - failure_assertion (/.test expected_message/0 false)] - (in (do async.monad - [[success_tally success_message] success_assertion - [failure_tally failure_message] failure_assertion] - (/.cover' [/.test] - (and (text.ends_with? (%.text expected_message/0) success_message) - (text.ends_with? (%.text expected_message/0) failure_message) - (and (n.= 1 (the /.#successes success_tally)) - (n.= 0 (the /.#failures success_tally))) - (and (n.= 0 (the /.#successes failure_tally)) - (n.= 1 (the /.#failures failure_tally)))))))) - (do ! - [tt (/.and (/.test expected_message/0 true) - (/.test expected_message/1 true)) - ff (/.and (/.test expected_message/0 false) - (/.test expected_message/1 false)) - tf (/.and (/.test expected_message/0 true) - (/.test expected_message/1 false)) - ft (/.and (/.test expected_message/0 false) - (/.test expected_message/1 true))] - (in (do async.monad - [tt tt - ff ff - tf tf - ft ft] - (/.cover' [/.and] - (and (..verify expected_message/0 expected_message/1 2 0 tt) - (..verify expected_message/0 expected_message/1 0 2 ff) - (..verify expected_message/0 expected_message/1 1 1 tf) - (..verify expected_message/0 expected_message/1 1 1 ft)))))) - (do ! - [success_assertion (/.context expected_context (/.test expected_message/0 true)) - failure_assertion (/.context expected_context (/.test expected_message/0 false))] - (in (do async.monad - [[success_tally success_message] success_assertion - [failure_tally failure_message] failure_assertion] - (/.cover' [/.context] - (and (and (text.contains? expected_context success_message) - (text.contains? expected_message/0 success_message)) - (and (text.contains? expected_context failure_message) - (text.contains? expected_message/0 failure_message)) - (and (n.= 1 (the /.#successes success_tally)) - (n.= 0 (the /.#failures success_tally))) - (and (n.= 0 (the /.#successes failure_tally)) - (n.= 1 (the /.#failures failure_tally)))))))) - (do ! - [failure_assertion (/.failure expected_message/0)] - (in (do async.monad - [[failure_tally failure_message] failure_assertion] - (/.cover' [/.failure] - (and (text.contains? expected_message/0 failure_message) - (and (n.= 0 (the /.#successes failure_tally)) - (n.= 1 (the /.#failures failure_tally)))))))) - (do ! - [success_assertion (/.lifted expected_message/0 (in true)) - failure_assertion (/.lifted expected_message/0 (in false))] - (in (do async.monad - [[success_tally success_message] success_assertion - [failure_tally failure_message] failure_assertion] - (/.cover' [/.lifted] - (and (text.contains? expected_message/0 success_message) - (text.contains? expected_message/0 failure_message) - (and (n.= 1 (the /.#successes success_tally)) - (n.= 0 (the /.#failures success_tally))) - (and (n.= 0 (the /.#successes failure_tally)) - (n.= 1 (the /.#failures failure_tally)))))))) - ..times - ..in_parallel - ..coverage - )))) + (all /.and + (/.for [/.Assertion] + ..assertion) + (/.for [/.Seed] + seed) + (do ! + [success_assertion (/.test expected_message/0 true) + failure_assertion (/.test expected_message/0 false)] + (in (do async.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.test] + (and (text.ends_with? (%.text expected_message/0) success_message) + (text.ends_with? (%.text expected_message/0) failure_message) + (and (n.= 1 (the /.#successes success_tally)) + (n.= 0 (the /.#failures success_tally))) + (and (n.= 0 (the /.#successes failure_tally)) + (n.= 1 (the /.#failures failure_tally)))))))) + (do ! + [tt (/.and (/.test expected_message/0 true) + (/.test expected_message/1 true)) + ff (/.and (/.test expected_message/0 false) + (/.test expected_message/1 false)) + tf (/.and (/.test expected_message/0 true) + (/.test expected_message/1 false)) + ft (/.and (/.test expected_message/0 false) + (/.test expected_message/1 true))] + (in (do async.monad + [tt tt + ff ff + tf tf + ft ft] + (/.cover' [/.and] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft)))))) + (do ! + [success_assertion (/.context expected_context (/.test expected_message/0 true)) + failure_assertion (/.context expected_context (/.test expected_message/0 false))] + (in (do async.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.context] + (and (and (text.contains? expected_context success_message) + (text.contains? expected_message/0 success_message)) + (and (text.contains? expected_context failure_message) + (text.contains? expected_message/0 failure_message)) + (and (n.= 1 (the /.#successes success_tally)) + (n.= 0 (the /.#failures success_tally))) + (and (n.= 0 (the /.#successes failure_tally)) + (n.= 1 (the /.#failures failure_tally)))))))) + (do ! + [failure_assertion (/.failure expected_message/0)] + (in (do async.monad + [[failure_tally failure_message] failure_assertion] + (/.cover' [/.failure] + (and (text.contains? expected_message/0 failure_message) + (and (n.= 0 (the /.#successes failure_tally)) + (n.= 1 (the /.#failures failure_tally)))))))) + (do ! + [success_assertion (/.lifted expected_message/0 (in true)) + failure_assertion (/.lifted expected_message/0 (in false))] + (in (do async.monad + [[success_tally success_message] success_assertion + [failure_tally failure_message] failure_assertion] + (/.cover' [/.lifted] + (and (text.contains? expected_message/0 success_message) + (text.contains? expected_message/0 failure_message) + (and (n.= 1 (the /.#successes success_tally)) + (n.= 0 (the /.#failures success_tally))) + (and (n.= 0 (the /.#successes failure_tally)) + (n.= 1 (the /.#failures failure_tally)))))))) + ..times + ..in_parallel + ..coverage + )))) diff --git a/stdlib/source/test/lux/time.lux b/stdlib/source/test/lux/time.lux index 074e2ebf4..74bdeb3f4 100644 --- a/stdlib/source/test/lux/time.lux +++ b/stdlib/source/test/lux/time.lux @@ -35,15 +35,15 @@ (def: for_implementation Test - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.time)) - (_.for [/.order] - ($order.spec /.order random.time)) - (_.for [/.enum] - ($enum.spec /.enum random.time)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.time)))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.time)) + (_.for [/.order] + ($order.spec /.order random.time)) + (_.for [/.enum] + ($enum.spec /.enum random.time)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.time)))) (def: for_clock Test @@ -67,47 +67,47 @@ .let [invalid_hour (|> valid_hour (n.+ /.hours)) invalid_minute (|> valid_minute (n.+ /.minutes) (n.min 99)) invalid_second (|> valid_second (n.+ /.seconds) (n.min 99))]] - (`` ($_ _.and - (~~ (template [<cap> <exception> <prefix> <suffix> <valid> <invalid>] - [(_.cover [<cap> <exception>] - (let [valid! - (|> <valid> - %.nat - (text.prefix <prefix>) - (text.suffix <suffix>) - (# /.codec decoded) - (pipe.case - {try.#Success _} true - {try.#Failure error} false)) - - invalid! - (|> <invalid> - %.nat - (text.prefix <prefix>) - (text.suffix <suffix>) - (# /.codec decoded) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (exception.match? <exception> error)))] - (and valid! - invalid!)))] + (`` (all _.and + (~~ (template [<cap> <exception> <prefix> <suffix> <valid> <invalid>] + [(_.cover [<cap> <exception>] + (let [valid! + (|> <valid> + %.nat + (text.prefix <prefix>) + (text.suffix <suffix>) + (# /.codec decoded) + (pipe.case + {try.#Success _} true + {try.#Failure error} false)) + + invalid! + (|> <invalid> + %.nat + (text.prefix <prefix>) + (text.suffix <suffix>) + (# /.codec decoded) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (exception.match? <exception> error)))] + (and valid! + invalid!)))] - [/.hours /.invalid_hour "" ":00:00.000" valid_hour invalid_hour] - [/.minutes /.invalid_minute "00:" ":00.000" valid_minute invalid_minute] - [/.seconds /.invalid_second "00:00:" ".000" valid_second invalid_second] - )) - (_.cover [/.milli_seconds] - (|> valid_milli_second - %.nat - (format "00:00:00.") - (# /.codec decoded) - (pipe.case - {try.#Success _} true - {try.#Failure error} false))) - )))) + [/.hours /.invalid_hour "" ":00:00.000" valid_hour invalid_hour] + [/.minutes /.invalid_minute "00:" ":00.000" valid_minute invalid_minute] + [/.seconds /.invalid_second "00:00:" ".000" valid_second invalid_second] + )) + (_.cover [/.milli_seconds] + (|> valid_milli_second + %.nat + (format "00:00:00.") + (# /.codec decoded) + (pipe.case + {try.#Success _} true + {try.#Failure error} false))) + )))) (def: .public test Test @@ -119,40 +119,40 @@ out_of_bounds (# ! each (|>> /.millis (n.+ day)) random.time)] - (`` ($_ _.and - ..for_implementation + (`` (all _.and + ..for_implementation - (_.cover [/.millis /.of_millis] - (|> expected - /.millis - /.of_millis - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.time_exceeds_a_day] - (case (/.of_millis out_of_bounds) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.time_exceeds_a_day error))) - (_.cover [/.midnight] - (|> /.midnight - /.millis - (n.= 0))) - (_.cover [/.parser] - (|> expected - (# /.codec encoded) - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) - ..for_ranges - (_.for [/.Clock] - ..for_clock) + (_.cover [/.millis /.of_millis] + (|> expected + /.millis + /.of_millis + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.time_exceeds_a_day] + (case (/.of_millis out_of_bounds) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.time_exceeds_a_day error))) + (_.cover [/.midnight] + (|> /.midnight + /.millis + (n.= 0))) + (_.cover [/.parser] + (|> expected + (# /.codec encoded) + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false))) + ..for_ranges + (_.for [/.Clock] + ..for_clock) - /date.test - /day.test - /duration.test - /instant.test - /month.test - /year.test - ))))) + /date.test + /day.test + /duration.test + /instant.test + /month.test + /year.test + ))))) diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux index ceabc66f1..e24194825 100644 --- a/stdlib/source/test/lux/time/date.lux +++ b/stdlib/source/test/lux/time/date.lux @@ -1,96 +1,96 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" try ("[1]#[0]" functor)] - ["[0]" exception] - [parser - ["<[0]>" text]]] - [data - [text - ["%" format {"+" format}]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception] + [parser + ["<[0]>" text]]] + [data + [text + ["%" format {"+" format}]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" /]]) (def: .public test Test (<| (_.covering /._) (_.for [/.Date]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.date)) - (_.for [/.order] - ($order.spec /.order random.date)) - (_.for [/.enum] - ($enum.spec /.enum random.date)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.date)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.date)) + (_.for [/.order] + ($order.spec /.order random.date)) + (_.for [/.enum] + ($enum.spec /.enum random.date)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.date)) - (do random.monad - [expected random.date] - (_.cover [/.date /.year /.month /.day_of_month] - (|> (/.date (/.year expected) - (/.month expected) - (/.day_of_month expected)) - (try#each (# /.equivalence = expected)) - (try.else false)))) - (do random.monad - [expected random.date] - (_.cover [/.invalid_day] - (case (/.date (/.year expected) - (/.month expected) - (n.+ 31 (/.day_of_month expected))) - {try.#Failure error} - (exception.match? /.invalid_day error) - - {try.#Success _} - false))) - (do random.monad - [expected random.date] - (_.cover [/.days /.of_days] - (|> expected - /.days - /.of_days - (# /.equivalence = expected)))) - (_.cover [/.epoch] - (|> /.epoch - /.days - (i.= +0))) - (do random.monad - [expected random.date] - (_.cover [/.parser] - (|> (# /.codec encoded expected) - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false)))) - (do [! random.monad] - [year (# ! each (|>> (n.% 10,000) ++) - random.nat) - month (# ! each (|>> (n.% 10) (n.+ 13)) + (do random.monad + [expected random.date] + (_.cover [/.date /.year /.month /.day_of_month] + (|> (/.date (/.year expected) + (/.month expected) + (/.day_of_month expected)) + (try#each (# /.equivalence = expected)) + (try.else false)))) + (do random.monad + [expected random.date] + (_.cover [/.invalid_day] + (case (/.date (/.year expected) + (/.month expected) + (n.+ 31 (/.day_of_month expected))) + {try.#Failure error} + (exception.match? /.invalid_day error) + + {try.#Success _} + false))) + (do random.monad + [expected random.date] + (_.cover [/.days /.of_days] + (|> expected + /.days + /.of_days + (# /.equivalence = expected)))) + (_.cover [/.epoch] + (|> /.epoch + /.days + (i.= +0))) + (do random.monad + [expected random.date] + (_.cover [/.parser] + (|> (# /.codec encoded expected) + (<text>.result /.parser) + (try#each (# /.equivalence = expected)) + (try.else false)))) + (do [! random.monad] + [year (# ! each (|>> (n.% 10,000) ++) random.nat) - day (# ! each (|>> (n.% 10) (n.+ 10)) - random.nat) - .let [input (format (%.nat year) - "-" (%.nat month) - "-" (%.nat day))]] - (_.cover [/.invalid_month] - (case (<text>.result /.parser input) - {try.#Failure error} - (exception.match? /.invalid_month error) - - {try.#Success _} - false))) - ))) + month (# ! each (|>> (n.% 10) (n.+ 13)) + random.nat) + day (# ! each (|>> (n.% 10) (n.+ 10)) + random.nat) + .let [input (format (%.nat year) + "-" (%.nat month) + "-" (%.nat day))]] + (_.cover [/.invalid_month] + (case (<text>.result /.parser input) + {try.#Failure error} + (exception.match? /.invalid_month error) + + {try.#Success _} + false))) + ))) diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index 35791236f..34e221efb 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -1,29 +1,29 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - ["[0]" predicate] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" try ("[1]#[0]" functor)] - ["[0]" exception]] - [data - [collection - ["[0]" list] - ["[0]" set]]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + ["[0]" predicate] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + [collection + ["[0]" list] + ["[0]" set]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: .public random (Random /.Day) @@ -44,45 +44,45 @@ invalid (random.only (predicate.or (n.< (/.number {/.#Sunday})) (n.> (/.number {/.#Saturday}))) random.nat)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.enum] - ($enum.spec /.enum ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [not_a_day (random.ascii/upper 1)] - (_.cover [/.not_a_day_of_the_week] - (case (# /.codec decoded not_a_day) - {try.#Failure error} - (exception.match? /.not_a_day_of_the_week error) - - {try.#Success _} - false))) - (_.cover [/.number /.by_number] - (|> expected - /.number - /.by_number - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.invalid_day] - (case (/.by_number invalid) - {try.#Failure error} - (exception.match? /.invalid_day error) - - {try.#Success _} - false)) - (_.cover [/.week] - (let [all (list.size /.week) - uniques (set.size (set.of_list /.hash /.week))] - (and (n.= (/.number {/.#Saturday}) - all) - (n.= all - uniques)))) - )))) + (do random.monad + [not_a_day (random.ascii/upper 1)] + (_.cover [/.not_a_day_of_the_week] + (case (# /.codec decoded not_a_day) + {try.#Failure error} + (exception.match? /.not_a_day_of_the_week error) + + {try.#Success _} + false))) + (_.cover [/.number /.by_number] + (|> expected + /.number + /.by_number + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.invalid_day] + (case (/.by_number invalid) + {try.#Failure error} + (exception.match? /.invalid_day error) + + {try.#Success _} + false)) + (_.cover [/.week] + (let [all (list.size /.week) + uniques (set.size (set.of_list /.hash /.week))] + (and (n.= (/.number {/.#Saturday}) + all) + (n.= all + uniques)))) + )))) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 0ff2471d8..74c05500e 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -24,77 +24,77 @@ Test (<| (_.covering /._) (_.for [/.Duration]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.duration)) - (_.for [/.order] - ($order.spec /.order random.duration)) - (_.for [/.enum] - ($enum.spec /.enum random.duration)) - (_.for [/.monoid] - ($monoid.spec /.equivalence /.monoid random.duration)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.duration)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.duration)) + (_.for [/.order] + ($order.spec /.order random.duration)) + (_.for [/.enum] + ($enum.spec /.enum random.duration)) + (_.for [/.monoid] + ($monoid.spec /.equivalence /.monoid random.duration)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.duration)) - (do random.monad - [duration random.duration] - (_.cover [/.of_millis /.millis] - (|> duration /.millis /.of_millis (# /.equivalence = duration)))) - (do random.monad - [.let [(open "#[0]") /.equivalence] - expected random.duration - parameter random.duration] - ($_ _.and - (_.cover [/.composite /.difference] - (|> expected (/.composite parameter) (/.difference parameter) (#= expected))) - (_.cover [/.empty] - (|> expected (/.composite /.empty) (#= expected))) - (_.cover [/.inverse] - (and (|> expected /.inverse /.inverse (#= expected)) - (|> expected (/.composite (/.inverse expected)) (#= /.empty)))) - (_.cover [/.positive? /.negative? /.neutral?] - (or (bit#= (/.positive? expected) - (/.negative? (/.inverse expected))) - (bit#= (/.neutral? expected) - (/.neutral? (/.inverse expected))))) - )) - (do random.monad - [.let [(open "#[0]") /.equivalence] - factor random.nat] - (_.cover [/.up /.down] - (|> /.milli_second (/.up factor) (/.down factor) (#= /.milli_second)))) - (do [! random.monad] - [.let [(open "#[0]") /.order - positive (|> random.duration - (random.only (|>> (#= /.empty) not)) - (# ! each (function (_ duration) - (if (/.positive? duration) - duration - (/.inverse duration)))))] - sample positive - frame positive] - (`` ($_ _.and - (_.cover [/.framed] - (let [sample' (/.framed frame sample)] - (and (#< frame sample') - (bit#= (#< frame sample) - (#= sample sample'))))) - (_.cover [/.ticks] - (i.= +1 (/.ticks sample sample))) - (_.cover [/.milli_second] - (#= /.empty (# /.enum pred /.milli_second))) - (~~ (template [<factor> <big> <small>] - [(_.cover [<big>] - (|> <big> (/.ticks <small>) (i.= <factor>)))] + (do random.monad + [duration random.duration] + (_.cover [/.of_millis /.millis] + (|> duration /.millis /.of_millis (# /.equivalence = duration)))) + (do random.monad + [.let [(open "#[0]") /.equivalence] + expected random.duration + parameter random.duration] + (all _.and + (_.cover [/.composite /.difference] + (|> expected (/.composite parameter) (/.difference parameter) (#= expected))) + (_.cover [/.empty] + (|> expected (/.composite /.empty) (#= expected))) + (_.cover [/.inverse] + (and (|> expected /.inverse /.inverse (#= expected)) + (|> expected (/.composite (/.inverse expected)) (#= /.empty)))) + (_.cover [/.positive? /.negative? /.neutral?] + (or (bit#= (/.positive? expected) + (/.negative? (/.inverse expected))) + (bit#= (/.neutral? expected) + (/.neutral? (/.inverse expected))))) + )) + (do random.monad + [.let [(open "#[0]") /.equivalence] + factor random.nat] + (_.cover [/.up /.down] + (|> /.milli_second (/.up factor) (/.down factor) (#= /.milli_second)))) + (do [! random.monad] + [.let [(open "#[0]") /.order + positive (|> random.duration + (random.only (|>> (#= /.empty) not)) + (# ! each (function (_ duration) + (if (/.positive? duration) + duration + (/.inverse duration)))))] + sample positive + frame positive] + (`` (all _.and + (_.cover [/.framed] + (let [sample' (/.framed frame sample)] + (and (#< frame sample') + (bit#= (#< frame sample) + (#= sample sample'))))) + (_.cover [/.ticks] + (i.= +1 (/.ticks sample sample))) + (_.cover [/.milli_second] + (#= /.empty (# /.enum pred /.milli_second))) + (~~ (template [<factor> <big> <small>] + [(_.cover [<big>] + (|> <big> (/.ticks <small>) (i.= <factor>)))] - [+1,000 /.second /.milli_second] - [+60 /.minute /.second] - [+60 /.hour /.minute] - [+24 /.day /.hour] + [+1,000 /.second /.milli_second] + [+60 /.minute /.second] + [+60 /.hour /.minute] + [+24 /.day /.hour] - [+7 /.week /.day] - [+365 /.normal_year /.day] - [+366 /.leap_year /.day] - )) - ))) - ))) + [+7 /.week /.day] + [+365 /.normal_year /.day] + [+366 /.leap_year /.day] + )) + ))) + ))) diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index 77d6e0a1f..16299a1a4 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -28,79 +28,79 @@ Test (<| (_.covering /._) (_.for [/.Instant]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence random.instant)) - (_.for [/.order] - ($order.spec /.order random.instant)) - (_.for [/.enum] - ($enum.spec /.enum random.instant)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec random.instant)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence random.instant)) + (_.for [/.order] + ($order.spec /.order random.instant)) + (_.for [/.enum] + ($enum.spec /.enum random.instant)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec random.instant)) - (do random.monad - [.let [(open "#[0]") /.equivalence] - expected random.instant] - ($_ _.and - (_.cover [/.millis /.of_millis] - (|> expected /.millis /.of_millis (#= expected))) - (_.cover [/.relative /.absolute] - (|> expected /.relative /.absolute (#= expected))) - (_.cover [/.date /.time /.of_date_time] - (#= expected - (/.of_date_time (/.date expected) - (/.time expected)))) - )) - (do random.monad - [.let [(open "#[0]") /.equivalence - (open "duration#[0]") duration.equivalence] - from random.instant - to random.instant] - ($_ _.and - (_.cover [/.span] - (|> from (/.span from) (duration#= duration.empty))) - (_.cover [/.after] - (|> from (/.after (/.span from to)) (#= to))) - (_.cover [/.epoch] - (duration#= (/.relative to) - (/.span /.epoch to))) - )) - (do random.monad - [instant random.instant - .let [d0 (/.day_of_week instant)]] - (_.cover [/.day_of_week] - (let [apply (is (-> (-> Duration Duration) (-> Day Day) Nat Bit) - (function (_ polarity move steps) - (let [day_shift (list#mix (function.constant move) - d0 - (list.repeated steps [])) - instant_shift (|> instant - (/.after (polarity (duration.up steps duration.day))) - /.day_of_week)] - (day#= day_shift - instant_shift))))] - (and (apply function.identity day#succ 0) - (apply function.identity day#succ 1) - (apply function.identity day#succ 2) - (apply function.identity day#succ 3) - (apply function.identity day#succ 4) - (apply function.identity day#succ 5) - (apply function.identity day#succ 6) - (apply function.identity day#succ 7) + (do random.monad + [.let [(open "#[0]") /.equivalence] + expected random.instant] + (all _.and + (_.cover [/.millis /.of_millis] + (|> expected /.millis /.of_millis (#= expected))) + (_.cover [/.relative /.absolute] + (|> expected /.relative /.absolute (#= expected))) + (_.cover [/.date /.time /.of_date_time] + (#= expected + (/.of_date_time (/.date expected) + (/.time expected)))) + )) + (do random.monad + [.let [(open "#[0]") /.equivalence + (open "duration#[0]") duration.equivalence] + from random.instant + to random.instant] + (all _.and + (_.cover [/.span] + (|> from (/.span from) (duration#= duration.empty))) + (_.cover [/.after] + (|> from (/.after (/.span from to)) (#= to))) + (_.cover [/.epoch] + (duration#= (/.relative to) + (/.span /.epoch to))) + )) + (do random.monad + [instant random.instant + .let [d0 (/.day_of_week instant)]] + (_.cover [/.day_of_week] + (let [apply (is (-> (-> Duration Duration) (-> Day Day) Nat Bit) + (function (_ polarity move steps) + (let [day_shift (list#mix (function.constant move) + d0 + (list.repeated steps [])) + instant_shift (|> instant + (/.after (polarity (duration.up steps duration.day))) + /.day_of_week)] + (day#= day_shift + instant_shift))))] + (and (apply function.identity day#succ 0) + (apply function.identity day#succ 1) + (apply function.identity day#succ 2) + (apply function.identity day#succ 3) + (apply function.identity day#succ 4) + (apply function.identity day#succ 5) + (apply function.identity day#succ 6) + (apply function.identity day#succ 7) - (apply duration.inverse day#pred 0) - (apply duration.inverse day#pred 1) - (apply duration.inverse day#pred 2) - (apply duration.inverse day#pred 3) - (apply duration.inverse day#pred 4) - (apply duration.inverse day#pred 5) - (apply duration.inverse day#pred 6) - (apply duration.inverse day#pred 7))))) - (_.cover [/.now] - (case (try (io.run! /.now)) - {try.#Success _} - true - - {try.#Failure _} - false)) - ))) + (apply duration.inverse day#pred 0) + (apply duration.inverse day#pred 1) + (apply duration.inverse day#pred 2) + (apply duration.inverse day#pred 3) + (apply duration.inverse day#pred 4) + (apply duration.inverse day#pred 5) + (apply duration.inverse day#pred 6) + (apply duration.inverse day#pred 7))))) + (_.cover [/.now] + (case (try (io.run! /.now)) + {try.#Success _} + true + + {try.#Failure _} + false)) + ))) diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index e1fbff23f..e52a077fc 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -1,31 +1,31 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - ["[0]" predicate] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" enum] - ["$[0]" codec]]] - [control - ["[0]" try ("[1]#[0]" functor)] - ["[0]" exception]] - [data - [collection - ["[0]" set] - ["[0]" list ("[1]#[0]" functor mix)]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" / - [// - ["[0]" duration]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + ["[0]" predicate] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" enum] + ["$[0]" codec]]] + [control + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception]] + [data + [collection + ["[0]" set] + ["[0]" list ("[1]#[0]" functor mix)]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + [// + ["[0]" duration]]]]) (def: .public random (Random /.Month) @@ -38,63 +38,63 @@ Test (<| (_.covering /._) (_.for [/.Month]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.enum] - ($enum.spec /.enum ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [expected ..random - invalid (random.only (predicate.or (n.< (/.number {/.#January})) - (n.> (/.number {/.#December}))) - random.nat)] - ($_ _.and - (_.cover [/.number /.by_number] - (|> expected - /.number - /.by_number - (try#each (# /.equivalence = expected)) - (try.else false))) - (_.cover [/.invalid_month] - (case (/.by_number invalid) - {try.#Failure error} - (exception.match? /.invalid_month error) - - {try.#Success _} - false)) - (_.cover [/.year] - (let [all (list.size /.year) - uniques (set.size (set.of_list /.hash /.year))] - (and (n.= (/.number {/.#December}) - all) - (n.= all - uniques)))) - (_.cover [/.days] - (let [expected (.nat (duration.ticks duration.day duration.normal_year))] - (|> /.year - (list#each /.days) - (list#mix n.+ 0) - (n.= expected)))) - (_.cover [/.leap_year_days] - (let [expected (.nat (duration.ticks duration.day duration.leap_year))] - (|> /.year - (list#each /.leap_year_days) - (list#mix n.+ 0) - (n.= expected)))) - (do random.monad - [not_a_month (random.ascii/upper 1)] - (_.cover [/.not_a_month_of_the_year] - (case (# /.codec decoded not_a_month) + (do random.monad + [expected ..random + invalid (random.only (predicate.or (n.< (/.number {/.#January})) + (n.> (/.number {/.#December}))) + random.nat)] + (all _.and + (_.cover [/.number /.by_number] + (|> expected + /.number + /.by_number + (try#each (# /.equivalence = expected)) + (try.else false))) + (_.cover [/.invalid_month] + (case (/.by_number invalid) {try.#Failure error} - (exception.match? /.not_a_month_of_the_year error) + (exception.match? /.invalid_month error) {try.#Success _} - false))) - ))))) + false)) + (_.cover [/.year] + (let [all (list.size /.year) + uniques (set.size (set.of_list /.hash /.year))] + (and (n.= (/.number {/.#December}) + all) + (n.= all + uniques)))) + (_.cover [/.days] + (let [expected (.nat (duration.ticks duration.day duration.normal_year))] + (|> /.year + (list#each /.days) + (list#mix n.+ 0) + (n.= expected)))) + (_.cover [/.leap_year_days] + (let [expected (.nat (duration.ticks duration.day duration.leap_year))] + (|> /.year + (list#each /.leap_year_days) + (list#mix n.+ 0) + (n.= expected)))) + (do random.monad + [not_a_month (random.ascii/upper 1)] + (_.cover [/.not_a_month_of_the_year] + (case (# /.codec decoded not_a_month) + {try.#Failure error} + (exception.match? /.not_a_month_of_the_year error) + + {try.#Success _} + false))) + ))))) diff --git a/stdlib/source/test/lux/time/year.lux b/stdlib/source/test/lux/time/year.lux index 0e3cdc10d..e7c316e65 100644 --- a/stdlib/source/test/lux/time/year.lux +++ b/stdlib/source/test/lux/time/year.lux @@ -1,31 +1,31 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" order] - ["$[0]" codec]]] - [control - ["[0]" try] - ["[0]" exception]] - [data - ["[0]" bit ("[1]#[0]" equivalence)] - [text - ["%" format {"+" format}]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat] - ["i" int]]]]] - [\\library - ["[0]" / - ["/[1]" // - ["[1][0]" duration] - ["[1][0]" instant] - ["[1][0]" date]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" order] + ["$[0]" codec]]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" bit ("[1]#[0]" equivalence)] + [text + ["%" format {"+" format}]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat] + ["i" int]]]]] + [\\library + ["[0]" / + ["/[1]" // + ["[1][0]" duration] + ["[1][0]" instant] + ["[1][0]" date]]]]) (def: .public random (Random /.Year) @@ -35,63 +35,63 @@ Test (<| (_.covering /._) (_.for [/.Year]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.codec /.parser] - ($codec.spec /.equivalence /.codec ..random)) - - (do random.monad - [expected random.int] - ($_ _.and - (_.cover [/.year] - (bit#= (i.= +0 expected) - (case (/.year expected) - {try.#Success _} - false + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.codec /.parser] + ($codec.spec /.equivalence /.codec ..random)) + + (do random.monad + [expected random.int] + (all _.and + (_.cover [/.year] + (bit#= (i.= +0 expected) + (case (/.year expected) + {try.#Success _} + false - {try.#Failure _} - true))) - (_.cover [/.value] - (case (/.year expected) - {try.#Success year} - (i.= expected (/.value year)) + {try.#Failure _} + true))) + (_.cover [/.value] + (case (/.year expected) + {try.#Success year} + (i.= expected (/.value year)) - {try.#Failure _} - (i.= +0 expected))) - )) - (_.cover [/.there_is_no_year_0] - (case (/.year +0) - {try.#Success _} - false + {try.#Failure _} + (i.= +0 expected))) + )) + (_.cover [/.there_is_no_year_0] + (case (/.year +0) + {try.#Success _} + false - {try.#Failure error} - (exception.match? /.there_is_no_year_0 error))) - (_.cover [/.days] - (n.= (.nat (//duration.ticks //duration.day //duration.normal_year)) - /.days)) - (_.cover [/.epoch] - (# /.equivalence = - (//date.year (//instant.date //instant.epoch)) - /.epoch)) - (_.for [/.Period] - (_.cover [/.leap /.century /.era] - (n.= /.leap (n./ /.century /.era)))) - (let [leap (try.trusted (/.year (.int /.leap))) - century (try.trusted (/.year (.int /.century))) - era (try.trusted (/.year (.int /.era)))] - ($_ _.and - (_.cover [/.leap?] - (and (/.leap? leap) - (not (/.leap? century)) - (/.leap? era))) - (_.cover [/.leaps] - (and (i.= +1 (/.leaps leap)) - (i.= (.int (n./ /.leap /.century)) - (/.leaps century)) - (i.= (++ (i.* +4 (-- (/.leaps century)))) - (/.leaps era)))) - )) - ))) + {try.#Failure error} + (exception.match? /.there_is_no_year_0 error))) + (_.cover [/.days] + (n.= (.nat (//duration.ticks //duration.day //duration.normal_year)) + /.days)) + (_.cover [/.epoch] + (# /.equivalence = + (//date.year (//instant.date //instant.epoch)) + /.epoch)) + (_.for [/.Period] + (_.cover [/.leap /.century /.era] + (n.= /.leap (n./ /.century /.era)))) + (let [leap (try.trusted (/.year (.int /.leap))) + century (try.trusted (/.year (.int /.century))) + era (try.trusted (/.year (.int /.era)))] + (all _.and + (_.cover [/.leap?] + (and (/.leap? leap) + (not (/.leap? century)) + (/.leap? era))) + (_.cover [/.leaps] + (and (i.= +1 (/.leaps leap)) + (i.= (.int (n./ /.leap /.century)) + (/.leaps century)) + (i.= (++ (i.* +4 (-- (/.leaps century)))) + (/.leaps era)))) + )) + ))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index d21012a13..1388dd52e 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -31,22 +31,22 @@ (def: .public test Test - ($_ _.and - /arity.test - /version.test - /reference.test - /phase.test - /analysis.test - /synthesis/simple.test - /synthesis/access.test - /meta/archive.test - /meta/cli.test - /meta/export.test - /meta/import.test - /meta/context.test - /meta/cache.test - /phase/extension.test - /phase/analysis.test - ... /syntax.test - ... /synthesis.test - )) + (all _.and + /arity.test + /version.test + /reference.test + /phase.test + /analysis.test + /synthesis/simple.test + /synthesis/access.test + /meta/archive.test + /meta/cli.test + /meta/export.test + /meta/import.test + /meta/context.test + /meta/cache.test + /phase/extension.test + /phase/analysis.test + ... /syntax.test + ... /synthesis.test + )) diff --git a/stdlib/source/test/lux/tool/compiler/arity.lux b/stdlib/source/test/lux/tool/compiler/arity.lux index 0e9f3f25d..cd39f3380 100644 --- a/stdlib/source/test/lux/tool/compiler/arity.lux +++ b/stdlib/source/test/lux/tool/compiler/arity.lux @@ -19,11 +19,11 @@ (_.for [/.Arity]) (do [! random.monad] [arity (# ! each (n.% 3) random.nat)] - ($_ _.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))) - )))) + (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))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux index 02c25c3e6..27302b091 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis.lux @@ -57,47 +57,47 @@ (def: (random_branch random) (All (_ a) (-> (Random a) (Random (/.Branch' a)))) - ($_ random.and - /pattern.random - random - )) + (all random.and + /pattern.random + random + )) (def: (random_match multiplicity random) (All (_ a) (-> Nat (Random a) (Random (/.Match' a)))) - ($_ random.and - (..random_branch random) - (random.list multiplicity (..random_branch random)) - )) + (all random.and + (..random_branch random) + (random.list multiplicity (..random_branch random)) + )) (def: .public (random multiplicity) (-> Nat (Random /.Analysis)) (<| random.rec (function (_ random)) - (let [random|case ($_ random.and - random - (..random_match multiplicity random) - ) - random|function ($_ random.and - (random.list multiplicity random) - random - ) - random|apply ($_ random.and - random + (let [random|case (all random.and random + (..random_match multiplicity random) ) - random|extension ($_ random.and - (random.ascii/lower 1) + random|function (all random.and (random.list multiplicity random) - )]) - ($_ random.or - /simple.random - (/complex.random multiplicity random) - /reference.random - random|case - random|function - random|apply - random|extension - ))) + random + ) + random|apply (all random.and + random + random + ) + random|extension (all random.and + (random.ascii/lower 1) + (random.list multiplicity random) + )]) + (all random.or + /simple.random + (/complex.random multiplicity random) + /reference.random + random|case + random|function + random|apply + random|extension + ))) (def: test|simple Test @@ -108,30 +108,30 @@ rev random.rev frac random.frac text (random.ascii/lower 1)] - (`` ($_ _.and - (_.cover [/.unit] - (case (/.unit) - (pattern (/.unit)) - true - - _ - false)) - (~~ (template [<tag> <expected>] - [(_.cover [<tag>] - (case (<tag> <expected>) - (pattern (<tag> actual)) - (same? <expected> actual) - - _ - false))] - - [/.bit bit] - [/.nat nat] - [/.int int] - [/.rev rev] - [/.frac frac] - [/.text text])) - )))) + (`` (all _.and + (_.cover [/.unit] + (case (/.unit) + (pattern (/.unit)) + true + + _ + false)) + (~~ (template [<tag> <expected>] + [(_.cover [<tag>] + (case (<tag> <expected>) + (pattern (<tag> actual)) + (same? <expected> actual) + + _ + false))] + + [/.bit bit] + [/.nat nat] + [/.int int] + [/.rev rev] + [/.frac frac] + [/.text text])) + )))) (def: test|complex Test @@ -140,28 +140,28 @@ expected_right (..random 2) expected_lefts random.nat expected_right? random.bit] - ($_ _.and - (_.cover [/.variant] - (let [expected (if expected_right? - expected_right - expected_left)] - (case (/.variant [expected_lefts expected_right? expected]) - (pattern (/.variant [actual_lefts actual_right? actual])) - (and (same? expected_lefts actual_lefts) - (same? expected_right? actual_right?) - (same? expected actual)) - - _ - false))) - (_.cover [/.tuple] - (case (/.tuple (list expected_left expected_right)) - (pattern (/.tuple (list actual_left actual_right))) - (and (same? expected_left actual_left) - (same? expected_right actual_right)) - - _ - false)) - ))) + (all _.and + (_.cover [/.variant] + (let [expected (if expected_right? + expected_right + expected_left)] + (case (/.variant [expected_lefts expected_right? expected]) + (pattern (/.variant [actual_lefts actual_right? actual])) + (and (same? expected_lefts actual_lefts) + (same? expected_right? actual_right?) + (same? expected actual)) + + _ + false))) + (_.cover [/.tuple] + (case (/.tuple (list expected_left expected_right)) + (pattern (/.tuple (list actual_left actual_right))) + (and (same? expected_left actual_left) + (same? expected_right actual_right)) + + _ + false)) + ))) (def: test|reference Test @@ -169,22 +169,22 @@ [expected_register random.nat expected_constant (/symbol.random 1 1) expected_variable /variable.random] - (`` ($_ _.and - (~~ (template [<tag> <expected>] - [(_.cover [<tag>] - (case (<tag> <expected>) - (pattern (<tag> actual)) - (same? <expected> actual) - - _ - false))] - - [/.local expected_register] - [/.foreign expected_register] - [/.constant expected_constant] - [/.variable expected_variable] - )) - )))) + (`` (all _.and + (~~ (template [<tag> <expected>] + [(_.cover [<tag>] + (case (<tag> <expected>) + (pattern (<tag> actual)) + (same? <expected> actual) + + _ + false))] + + [/.local expected_register] + [/.foreign expected_register] + [/.constant expected_constant] + [/.variable expected_variable] + )) + )))) (template: (tagged? <tag> <it>) [(case <it> @@ -201,42 +201,42 @@ (..random 2)) expected_parameter/0 (..random 2) expected_parameter/1 (..random 2)] - ($_ _.and - (_.cover [/.reified /.reification] - (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)] - /.reified - /.reification) - (pattern [actual_abstraction (list actual_parameter/0 actual_parameter/1)]) - (and (same? expected_abstraction actual_abstraction) - (same? expected_parameter/0 actual_parameter/0) - (same? expected_parameter/1 actual_parameter/1)) - - _ - false)) - (_.cover [/.no_op] - (case (/.no_op expected_parameter/0) - (pattern (/.no_op actual)) - (same? expected_parameter/0 actual) - - _ - false)) - ))) + (all _.and + (_.cover [/.reified /.reification] + (case (|> [expected_abstraction (list expected_parameter/0 expected_parameter/1)] + /.reified + /.reification) + (pattern [actual_abstraction (list actual_parameter/0 actual_parameter/1)]) + (and (same? expected_abstraction actual_abstraction) + (same? expected_parameter/0 actual_parameter/0) + (same? expected_parameter/1 actual_parameter/1)) + + _ + false)) + (_.cover [/.no_op] + (case (/.no_op expected_parameter/0) + (pattern (/.no_op actual)) + (same? expected_parameter/0 actual) + + _ + false)) + ))) (def: test|case Test (do random.monad [expected_input (..random 2) expected_match (random_match 2 (..random 2))] - ($_ _.and - (_.cover [/.case] - (case (/.case [expected_input expected_match]) - (pattern (/.case [actual_input actual_match])) - (and (same? expected_input actual_input) - (same? expected_match actual_match)) + (all _.and + (_.cover [/.case] + (case (/.case [expected_input expected_match]) + (pattern (/.case [actual_input actual_match])) + (and (same? expected_input actual_input) + (same? expected_match actual_match)) - _ - false)) - ))) + _ + false)) + ))) (with_expansions [<id> (static.random_nat) <exception> (template.symbol ["exception_" <id>])] @@ -257,73 +257,73 @@ (/.state (/.info version/0 host/0 configuration))) state/1 (has .#location location/1 (/.state (/.info version/1 host/1 configuration)))]] - ($_ _.and - (_.cover [/.set_state] - (|> (do phase.monad - [pre (extension.read function.identity) - _ (/.set_state state/1) - post (extension.read function.identity)] - (in (and (same? state/0 pre) - (same? state/1 post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (try.else false))) - (_.cover [/.failure] - (|> (/.failure expected_error) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? expected_error actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false))) - (_.cover [/.except] - (|> (/.except <exception> []) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? (exception.error <exception> []) actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false))) - (_.cover [/.with_exception] - (|> (/.failure expected_error) - (/.with_exception <exception> []) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? expected_error actual_error) - (text.contains? (exception.error <exception> []) actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false))) - (_.cover [/.assertion] - (and (|> (/.assertion <exception> [] false) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Failure actual_error} - (and (text.contains? (exception.error <exception> []) actual_error) - (text.contains? (location.format location/0) actual_error)) - - _ - false)) - (|> (/.assertion <exception> [] true) - (phase.result [extension.#bundle extension.empty - extension.#state state/0]) - (pipe.case - {try.#Success _} - true - - _ - false)))) - )))) + (all _.and + (_.cover [/.set_state] + (|> (do phase.monad + [pre (extension.read function.identity) + _ (/.set_state state/1) + post (extension.read function.identity)] + (in (and (same? state/0 pre) + (same? state/1 post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (try.else false))) + (_.cover [/.failure] + (|> (/.failure expected_error) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? expected_error actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false))) + (_.cover [/.except] + (|> (/.except <exception> []) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? (exception.error <exception> []) actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false))) + (_.cover [/.with_exception] + (|> (/.failure expected_error) + (/.with_exception <exception> []) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? expected_error actual_error) + (text.contains? (exception.error <exception> []) actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false))) + (_.cover [/.assertion] + (and (|> (/.assertion <exception> [] false) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Failure actual_error} + (and (text.contains? (exception.error <exception> []) actual_error) + (text.contains? (location.format location/0) actual_error)) + + _ + false)) + (|> (/.assertion <exception> [] true) + (phase.result [extension.#bundle extension.empty + extension.#state state/0]) + (pipe.case + {try.#Success _} + true + + _ + false)))) + )))) (def: test|state Test @@ -342,118 +342,118 @@ configuration ($configuration.random 5) .let [state (has .#location location (/.state (/.info version host configuration)))]] - ($_ _.and - (_.cover [/.info] - (let [it (/.info version host configuration)] - (and (text#= (version.format version) - (the .#version it)) - (same? host - (the .#target it)) - (..tagged? .#Build (the .#mode it)) - (same? configuration (the .#configuration it))))) - (_.cover [/.state] - (let [info (/.info version host configuration) - it (/.state info)] - (and (same? info - (the .#info it)) - (same? location.dummy - (the .#location it)) - (..tagged? .#None (the .#current_module it)) - (..tagged? .#None (the .#expected it)) - (list.empty? (the .#modules it)) - (list.empty? (the .#scopes it)) - (list.empty? (the [.#type_context .#var_bindings] it)) - (case (the .#source it) - [location 0 ""] - (same? location.dummy location) + (all _.and + (_.cover [/.info] + (let [it (/.info version host configuration)] + (and (text#= (version.format version) + (the .#version it)) + (same? host + (the .#target it)) + (..tagged? .#Build (the .#mode it)) + (same? configuration (the .#configuration it))))) + (_.cover [/.state] + (let [info (/.info version host configuration) + it (/.state info)] + (and (same? info + (the .#info it)) + (same? location.dummy + (the .#location it)) + (..tagged? .#None (the .#current_module it)) + (..tagged? .#None (the .#expected it)) + (list.empty? (the .#modules it)) + (list.empty? (the .#scopes it)) + (list.empty? (the [.#type_context .#var_bindings] it)) + (case (the .#source it) + [location 0 ""] + (same? location.dummy location) + + _ + false)))) + (_.cover [/.set_current_module] + (|> (do phase.monad + [_ (/.set_current_module expected_module)] + (extension.read (|>> (the .#current_module) (maybe.else "")))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (pipe.case + {try.#Success actual} + (same? expected_module actual) + + _ + false))) + (_.cover [/.with_current_module] + (let [current_module (extension.read (|>> (the .#current_module) (maybe.else "")))] + (|> (do phase.monad + [_ (/.set_current_module expected_module) + pre current_module + mid (/.with_current_module dummy_module + current_module) + post current_module] + (in (and (same? expected_module pre) + (same? dummy_module mid) + (same? expected_module post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (try.else false)))) + (_.cover [/.location /.set_location] + (let [expected (/.location expected_file)] + (|> (do phase.monad + [_ (/.set_location expected)] + (extension.read (the .#location))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (pipe.case + {try.#Success actual} + (same? expected actual) + + _ + false)))) + (_.cover [/.with_location] + (let [expected (/.location expected_file) + dummy (/.location expected_code) + location (extension.read (the .#location))] + (|> (do phase.monad + [_ (/.set_location expected) + pre location + mid (/.with_location dummy + location) + post location] + (in (and (same? expected pre) + (same? dummy mid) + (same? expected post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (try.else false)))) + (_.cover [/.source /.set_source_code] + (let [expected (/.source expected_file expected_code)] + (|> (do phase.monad + [_ (/.set_source_code expected)] + (extension.read (the .#source))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (pipe.case + {try.#Success actual} + (same? expected actual) _ false)))) - (_.cover [/.set_current_module] - (|> (do phase.monad - [_ (/.set_current_module expected_module)] - (extension.read (|>> (the .#current_module) (maybe.else "")))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (pipe.case - {try.#Success actual} - (same? expected_module actual) - - _ - false))) - (_.cover [/.with_current_module] - (let [current_module (extension.read (|>> (the .#current_module) (maybe.else "")))] - (|> (do phase.monad - [_ (/.set_current_module expected_module) - pre current_module - mid (/.with_current_module dummy_module - current_module) - post current_module] - (in (and (same? expected_module pre) - (same? dummy_module mid) - (same? expected_module post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (try.else false)))) - (_.cover [/.location /.set_location] - (let [expected (/.location expected_file)] - (|> (do phase.monad - [_ (/.set_location expected)] - (extension.read (the .#location))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (pipe.case - {try.#Success actual} - (same? expected actual) - - _ - false)))) - (_.cover [/.with_location] - (let [expected (/.location expected_file) - dummy (/.location expected_code) - location (extension.read (the .#location))] - (|> (do phase.monad - [_ (/.set_location expected) - pre location - mid (/.with_location dummy - location) - post location] - (in (and (same? expected pre) - (same? dummy mid) - (same? expected post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (try.else false)))) - (_.cover [/.source /.set_source_code] - (let [expected (/.source expected_file expected_code)] - (|> (do phase.monad - [_ (/.set_source_code expected)] - (extension.read (the .#source))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (pipe.case - {try.#Success actual} - (same? expected actual) - - _ - false)))) - (_.cover [/.with_source_code] - (let [expected (/.source expected_file expected_code) - dummy (/.source expected_code expected_file) - source (extension.read (the .#source))] - (|> (do phase.monad - [_ (/.set_source_code expected) - pre source - mid (/.with_source_code dummy - source) - post source] - (in (and (same? expected pre) - (same? dummy mid) - (same? expected post)))) - (phase.result [extension.#bundle extension.empty - extension.#state state]) - (try.else false)))) - ))) + (_.cover [/.with_source_code] + (let [expected (/.source expected_file expected_code) + dummy (/.source expected_code expected_file) + source (extension.read (the .#source))] + (|> (do phase.monad + [_ (/.set_source_code expected) + pre source + mid (/.with_source_code dummy + source) + post source] + (in (and (same? expected pre) + (same? dummy mid) + (same? expected post)))) + (phase.result [extension.#bundle extension.empty + extension.#state state]) + (try.else false)))) + ))) (def: .public test Test @@ -462,32 +462,32 @@ (do random.monad [left (..random 2) right (..random 2)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random 2))) - - ..test|simple - ..test|complex - ..test|reference - (_.for [/.Reification] - ..test|reification) - (_.for [/.Branch /.Branch' /.Match /.Match'] - ..test|case) - (_.for [/.Operation /.Phase /.Handler /.Bundle] - ..test|phase) - (_.for [/.State+] - ..test|state) - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - - /complex.test - /inference.test - /macro.test - /module.test - /pattern.test - /scope.test - /simple.test - /type.test - /coverage.test - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random 2))) + + ..test|simple + ..test|complex + ..test|reference + (_.for [/.Reification] + ..test|reification) + (_.for [/.Branch /.Branch' /.Match /.Match'] + ..test|case) + (_.for [/.Operation /.Phase /.Handler /.Bundle] + ..test|phase) + (_.for [/.State+] + ..test|state) + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + + /complex.test + /inference.test + /macro.test + /module.test + /pattern.test + /scope.test + /simple.test + /type.test + /coverage.test + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux index c6454b07f..5d331f85e 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/complex.lux @@ -25,52 +25,52 @@ tag (# ! each (n.% multiplicity) random.nat) lefts random.nat right? random.bit] - ($_ _.and - (_.cover [/.tag /.lefts] - (and (|> lefts - (/.tag right?) - (/.lefts right?) - (n.= lefts)) - (|> tag - (/.lefts right?) - (/.tag right?) - (n.= tag)))) - (_.cover [/.choice] - (let [[lefts right?] (/.choice multiplicity tag)] - (if right? - (n.= (-- tag) lefts) - (n.= tag lefts)))) - ))) + (all _.and + (_.cover [/.tag /.lefts] + (and (|> lefts + (/.tag right?) + (/.lefts right?) + (n.= lefts)) + (|> tag + (/.lefts right?) + (/.tag right?) + (n.= tag)))) + (_.cover [/.choice] + (let [[lefts right?] (/.choice multiplicity tag)] + (if right? + (n.= (-- tag) lefts) + (n.= tag lefts)))) + ))) (def: .public (random multiplicity it) (All (_ a) (-> Nat (Random a) (Random (/.Complex a)))) - ($_ random.or - ($_ random.and - (random#each (n.% (-- multiplicity)) random.nat) - random.bit - it) - (random.list multiplicity it) - )) + (all random.or + (all random.and + (random#each (n.% (-- multiplicity)) random.nat) + random.bit + it) + (random.list multiplicity it) + )) (def: .public test Test (let [random (..random 3 random.nat)] (<| (_.covering /._) (_.for [/.Complex /.Variant /.Tuple]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) random)) - (_.for [/.hash] - ($hash.spec (/.hash n.hash) random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) random)) + (_.for [/.hash] + ($hash.spec (/.hash n.hash) random)) - (_.for [/.Tag] - ..test|tag) - - (do random.monad - [left random - right random] - (_.cover [/.format] - (bit#= (# (/.equivalence n.equivalence) = left right) - (text#= (/.format %.nat left) (/.format %.nat right))))) - )))) + (_.for [/.Tag] + ..test|tag) + + (do random.monad + [left random + right random] + (_.cover [/.format] + (bit#= (# (/.equivalence n.equivalence) = left right) + (text#= (/.format %.nat left) (/.format %.nat right))))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux index 629ffb39f..3bfe7d2fb 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/coverage.lux @@ -46,27 +46,27 @@ (Random /.Coverage) (<| random.rec (function (_ again)) - ($_ random.or - (random#in []) - random.bit - (random.set n.hash ..spread random.nat) - (random.set i.hash ..spread random.int) - (random.set r.hash ..spread random.rev) - (random.set f.hash ..spread random.frac) - (random.set text.hash ..spread (random.unicode 1)) - ($_ random.and - (random.maybe (random#in ..spread)) - (do [! random.monad] - [cases ..random_tag - cases (random.set n.hash cases ..random_tag)] - (|> cases - set.list - (monad.each ! (function (_ case) (# ! each (|>> [case]) again))) - (# ! each (dictionary.of_list n.hash)))) - ) - (random.and again again) - (random.and again again) - ))) + (all random.or + (random#in []) + random.bit + (random.set n.hash ..spread random.nat) + (random.set i.hash ..spread random.int) + (random.set r.hash ..spread random.rev) + (random.set f.hash ..spread random.frac) + (random.set text.hash ..spread (random.unicode 1)) + (all random.and + (random.maybe (random#in ..spread)) + (do [! random.monad] + [cases ..random_tag + cases (random.set n.hash cases ..random_tag)] + (|> cases + set.list + (monad.each ! (function (_ case) (# ! each (|>> [case]) again))) + (# ! each (dictionary.of_list n.hash)))) + ) + (random.and again again) + (random.and again again) + ))) (def: (ranged min range) (-> Nat Nat (Random Nat)) @@ -77,63 +77,63 @@ (Random [/.Coverage Pattern]) (<| random.rec (function (_ again)) - (`` ($_ random.either - (random#in [{/.#Exhaustive} - {//pattern.#Simple {//simple.#Unit}}]) - (do random.monad - [it random.bit] - (in [{/.#Bit it} - {//pattern.#Simple {//simple.#Bit it}}])) - (~~ (template [<random> <hash> <coverage> <pattern>] - [(do random.monad - [it <random>] - (in [{<coverage> (set.of_list <hash> (list it))} - {//pattern.#Simple {<pattern> it}}]))] + (`` (all random.either + (random#in [{/.#Exhaustive} + {//pattern.#Simple {//simple.#Unit}}]) + (do random.monad + [it random.bit] + (in [{/.#Bit it} + {//pattern.#Simple {//simple.#Bit it}}])) + (~~ (template [<random> <hash> <coverage> <pattern>] + [(do random.monad + [it <random>] + (in [{<coverage> (set.of_list <hash> (list it))} + {//pattern.#Simple {<pattern> it}}]))] - [random.nat n.hash /.#Nat //simple.#Nat] - [random.int i.hash /.#Int //simple.#Int] - [random.rev r.hash /.#Rev //simple.#Rev] - [random.frac f.hash /.#Frac //simple.#Frac] - [(random.unicode 1) text.hash /.#Text //simple.#Text] - )) - - (do [! random.monad] - [tag (# ! each ++ ..random_tag) - right? random.bit - .let [lefts (//complex.lefts right? tag)] - [sub_coverage sub_pattern] again] - (in [{/.#Variant (if right? {.#Some tag} {.#None}) - (dictionary.of_list n.hash (list [tag sub_coverage]))} - {//pattern.#Complex - {//complex.#Variant - [//complex.#lefts lefts - //complex.#right? right? - //complex.#value sub_pattern]}}])) - - (do [! random.monad] - [arity (..ranged 2 (n.- 2 ..spread)) - it (random.list arity again) - .let [coverages (list#each product.left it) - patterns (list#each product.right it)]] - (in [(|> coverages - (list.only (|>> /.exhaustive? not)) - list.reversed - (pipe.case - {.#End} - {/.#Exhaustive} - - {.#Item last prevs} - (list#mix (function (_ left right) - {/.#Seq left right}) - last - prevs))) - {//pattern.#Complex {//complex.#Tuple patterns}}])) - - (do random.monad - [register random.nat] - (in [{/.#Exhaustive} - {//pattern.#Bind register}])) - )))) + [random.nat n.hash /.#Nat //simple.#Nat] + [random.int i.hash /.#Int //simple.#Int] + [random.rev r.hash /.#Rev //simple.#Rev] + [random.frac f.hash /.#Frac //simple.#Frac] + [(random.unicode 1) text.hash /.#Text //simple.#Text] + )) + + (do [! random.monad] + [tag (# ! each ++ ..random_tag) + right? random.bit + .let [lefts (//complex.lefts right? tag)] + [sub_coverage sub_pattern] again] + (in [{/.#Variant (if right? {.#Some tag} {.#None}) + (dictionary.of_list n.hash (list [tag sub_coverage]))} + {//pattern.#Complex + {//complex.#Variant + [//complex.#lefts lefts + //complex.#right? right? + //complex.#value sub_pattern]}}])) + + (do [! random.monad] + [arity (..ranged 2 (n.- 2 ..spread)) + it (random.list arity again) + .let [coverages (list#each product.left it) + patterns (list#each product.right it)]] + (in [(|> coverages + (list.only (|>> /.exhaustive? not)) + list.reversed + (pipe.case + {.#End} + {/.#Exhaustive} + + {.#Item last prevs} + (list#mix (function (_ left right) + {/.#Seq left right}) + last + prevs))) + {//pattern.#Complex {//complex.#Tuple patterns}}])) + + (do random.monad + [register random.nat] + (in [{/.#Exhaustive} + {//pattern.#Bind register}])) + )))) (def: (failure? exception it) (All (_ a) (-> (Exception a) (Try /.Coverage) Bit)) @@ -150,48 +150,48 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (_.cover [/.exhaustive?] - (bit#= (/#= {/.#Exhaustive} left) - (/.exhaustive? left))) - (_.cover [/.format] - (bit#= (/#= left right) - (text#= (/.format left) (/.format right)))) - )))) + (_.cover [/.exhaustive?] + (bit#= (/#= {/.#Exhaustive} left) + (/.exhaustive? left))) + (_.cover [/.format] + (bit#= (/#= left right) + (text#= (/.format left) (/.format right)))) + )))) (def: test|coverage Test (<| (let [(open "/#[0]") /.equivalence]) (do [! random.monad] [[expected pattern] ..random_pattern] - ($_ _.and - (_.cover [/.coverage] - (|> pattern - /.coverage - (try#each (/#= expected)) - (try.else false))) - (_.cover [/.invalid_tuple] - (let [invalid? (..failure? /.invalid_tuple)] - (and (|> (list) - {//complex.#Tuple} - {//pattern.#Complex} - /.coverage - invalid?) - (|> (list pattern) - {//complex.#Tuple} - {//pattern.#Complex} - /.coverage - invalid?) - (|> (list pattern pattern) - {//complex.#Tuple} - {//pattern.#Complex} - /.coverage - invalid? - not)))) - )))) + (all _.and + (_.cover [/.coverage] + (|> pattern + /.coverage + (try#each (/#= expected)) + (try.else false))) + (_.cover [/.invalid_tuple] + (let [invalid? (..failure? /.invalid_tuple)] + (and (|> (list) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid?) + (|> (list pattern) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid?) + (|> (list pattern pattern) + {//complex.#Tuple} + {//pattern.#Complex} + /.coverage + invalid? + not)))) + )))) (def: random_partial_pattern (Random [/.Coverage Pattern]) @@ -212,14 +212,14 @@ .let [cases (dictionary.of_list n.hash (list [tag/0 expected/0] [tag/1 expected/1])) expected_minimum (++ (n.max tag/0 tag/1))]] - ($_ _.and - (_.cover [/.minimum] - (and (n.= expected_minimum (/.minimum [{.#None} cases])) - (n.= expected_maximum (/.minimum [{.#Some expected_maximum} cases])))) - (_.cover [/.maximum] - (and (n.= n#top (/.maximum [{.#None} cases])) - (n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases])))) - )))) + (all _.and + (_.cover [/.minimum] + (and (n.= expected_minimum (/.minimum [{.#None} cases])) + (n.= expected_maximum (/.minimum [{.#Some expected_maximum} cases])))) + (_.cover [/.maximum] + (and (n.= n#top (/.maximum [{.#None} cases])) + (n.= expected_maximum (/.maximum [{.#Some expected_maximum} cases])))) + )))) (def: random_value_pattern (Random [/.Coverage Pattern]) @@ -239,10 +239,10 @@ [[expected/0 pattern/0] ..random_value_pattern [expected/1 pattern/1] (random.only (|>> product.left (/#= expected/0) not) ..random_value_pattern) - [expected/2 pattern/2] (random.only ($_ predicate.and - (|>> product.left (/#= expected/0) not) - (|>> product.left (/#= expected/1) not) - (|>> product.left (pipe.case {/.#Variant _} false _ true))) + [expected/2 pattern/2] (random.only (all predicate.and + (|>> product.left (/#= expected/0) not) + (|>> product.left (/#= expected/1) not) + (|>> product.left (pipe.case {/.#Variant _} false _ true))) ..random_value_pattern) bit random.bit @@ -256,211 +256,211 @@ .let [random_tag (random#each (n.% arity) random.nat)] tag/0 random_tag tag/1 (random.only (|>> (n.= tag/0) not) random_tag)] - ($_ _.and - (_.cover [/.composite] - (let [composes_simples! - (`` (and (|> (/.composite {/.#Bit bit} {/.#Bit (not bit)}) - (try#each (/#= {/.#Exhaustive})) - (try.else false)) - (|> {/.#Bit bit} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false)) - (~~ (template [<tag> <hash> <value> <next>] - [(|> (/.composite {<tag> (set.of_list <hash> (list <value>))} - {<tag> (set.of_list <hash> (list (|> <value> <next>)))}) - (try#each (/#= {<tag> (set.of_list <hash> (list <value> (|> <value> <next>)))})) - (try.else false)) - (|> {<tag> (set.of_list <hash> (list <value>))} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false))] + (all _.and + (_.cover [/.composite] + (let [composes_simples! + (`` (and (|> (/.composite {/.#Bit bit} {/.#Bit (not bit)}) + (try#each (/#= {/.#Exhaustive})) + (try.else false)) + (|> {/.#Bit bit} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false)) + (~~ (template [<tag> <hash> <value> <next>] + [(|> (/.composite {<tag> (set.of_list <hash> (list <value>))} + {<tag> (set.of_list <hash> (list (|> <value> <next>)))}) + (try#each (/#= {<tag> (set.of_list <hash> (list <value> (|> <value> <next>)))})) + (try.else false)) + (|> {<tag> (set.of_list <hash> (list <value>))} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false))] - [/.#Nat n.hash nat ++] - [/.#Int i.hash int ++] - [/.#Rev r.hash rev ++] - [/.#Frac f.hash frac (f.+ frac)] - [/.#Text text.hash text (%.format text)] - )))) + [/.#Nat n.hash nat ++] + [/.#Int i.hash int ++] + [/.#Rev r.hash rev ++] + [/.#Frac f.hash frac (f.+ frac)] + [/.#Text text.hash text (%.format text)] + )))) - composes_variants! - (let [composes_different_variants! - (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) - (function (_ left right both) - (|> (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant right (dictionary.of_list n.hash (list [tag/1 expected/1]))}) - (try#each (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected/0] - [tag/1 expected/1]))})) - (try.else false))))] - (and (composes? {.#None} {.#None} {.#None}) - (composes? {.#Some arity} {.#None} {.#Some arity}) - (composes? {.#None} {.#Some arity} {.#Some arity}) - (composes? {.#Some arity} {.#Some arity} {.#Some arity}))) + composes_variants! + (let [composes_different_variants! + (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) + (function (_ left right both) + (|> (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant right (dictionary.of_list n.hash (list [tag/1 expected/1]))}) + (try#each (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected/1]))})) + (try.else false))))] + (and (composes? {.#None} {.#None} {.#None}) + (composes? {.#Some arity} {.#None} {.#Some arity}) + (composes? {.#None} {.#Some arity} {.#Some arity}) + (composes? {.#Some arity} {.#Some arity} {.#Some arity}))) - composes_same_variants! - (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) - (function (_ left right both) - (|> (do try.monad - [variant (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant right (dictionary.of_list n.hash (list [tag/0 expected/1]))}) - expected (/.composite expected/0 expected/1)] - (in (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected]))} - variant))) - (try.else false))))] - (and (composes? {.#None} {.#None} {.#None}) - (composes? {.#Some arity} {.#None} {.#Some arity}) - (composes? {.#None} {.#Some arity} {.#Some arity}) - (composes? {.#Some arity} {.#Some arity} {.#Some arity})))] - (and composes_different_variants! composes_same_variants! - (and (|> {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false)) - (|> {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - (/.composite {/.#Exhaustive}) - (try#each (/#= {/.#Exhaustive})) - (try.else false))))) + (let [composes? (is (-> (Maybe Nat) (Maybe Nat) (Maybe Nat) Bit) + (function (_ left right both) + (|> (do try.monad + [variant (/.composite {/.#Variant left (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant right (dictionary.of_list n.hash (list [tag/0 expected/1]))}) + expected (/.composite expected/0 expected/1)] + (in (/#= {/.#Variant both (dictionary.of_list n.hash (list [tag/0 expected]))} + variant))) + (try.else false))))] + (and (composes? {.#None} {.#None} {.#None}) + (composes? {.#Some arity} {.#None} {.#Some arity}) + (composes? {.#None} {.#Some arity} {.#Some arity}) + (composes? {.#Some arity} {.#Some arity} {.#Some arity})))] + (and composes_different_variants! + composes_same_variants! + (and (|> {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false)) + (|> {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + (/.composite {/.#Exhaustive}) + (try#each (/#= {/.#Exhaustive})) + (try.else false))))) - composes_sequences! - (and (|> (/.composite {/.#Seq expected/0 expected/1} - {/.#Seq expected/1 expected/0}) - (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} - {/.#Seq expected/1 expected/0}})) - (try.else false)) - (|> (do try.monad - [seq (/.composite {/.#Seq expected/0 expected/0} - {/.#Seq expected/0 expected/1}) - expected (/.composite expected/0 expected/1)] - (in (/#= (if (/.exhaustive? expected) - expected/0 - {/.#Seq expected/0 expected}) - seq))) - (try.else false)) - (|> (do try.monad - [seq (/.composite {/.#Seq expected/0 expected/0} - {/.#Seq expected/1 expected/0}) - expected (/.composite expected/0 expected/1)] - (in (/#= {/.#Seq expected expected/0} - seq))) - (try.else false)) - (|> (/.composite {/.#Seq expected/0 expected/1} - expected/1) - (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} - expected/1})) - (try.else false)) - (|> (/.composite expected/1 - {/.#Seq expected/0 expected/1}) - (try#each (/#= {/.#Alt expected/1 - {/.#Seq expected/0 expected/1}})) - (try.else false)) - (|> (/.composite expected/0 - {/.#Seq expected/0 expected/1}) - (try#each (/#= expected/0)) - (try.else false))) - - composes_alts! - (and (|> (do try.monad - [alt (/.composite {/.#Exhaustive} - {/.#Alt expected/0 - expected/1})] - (in (/#= {/.#Exhaustive} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/1]))}})] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}})] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}] - [tag/1 expected/1]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/2]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) - expected (/.composite expected/2 expected/0)] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected] - [tag/1 expected/1]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/2]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) - expected (/.composite expected/2 expected/1)] - (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] - [tag/1 expected]))} - alt))) - (try.else false)) - (|> (do try.monad - [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))} - {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - expected/2})] - (in (/#= {/.#Alt expected/2 - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] - [tag/1 expected/1]))}} - alt))) - (try.else false)))] - (and composes_simples! - composes_variants! composes_sequences! - composes_alts!))) - (_.cover [/.redundancy] - (let [redundant? (..failure? /.redundancy)] - (`` (and (redundant? (/.composite {/.#Exhaustive} {/.#Exhaustive})) - (~~ (template [<it>] - [(redundant? (/.composite <it> <it>)) - (redundant? (/.composite <it> {/.#Exhaustive}))] - - [{/.#Bit bit}] - [{/.#Nat (set.of_list n.hash (list nat))}] - [{/.#Int (set.of_list i.hash (list int))}] - [{/.#Rev (set.of_list r.hash (list rev))}] - [{/.#Frac (set.of_list f.hash (list frac))}] - [{/.#Text (set.of_list text.hash (list text))}] - [{/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] - [{/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] - [{/.#Seq expected/0 expected/1}])) - (redundant? (/.composite {/.#Seq expected/0 expected/1} expected/0)))))) - (_.cover [/.variant_mismatch] - (let [mismatch? (..failure? /.variant_mismatch)] - (and (not (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) - - (mismatch? (/.composite {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - - (mismatch? (/.composite {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - - (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) - (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [arity expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) - (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [(-- arity) expected/0]))} - {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})))))) - )))) + (and (|> (/.composite {/.#Seq expected/0 expected/1} + {/.#Seq expected/1 expected/0}) + (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} + {/.#Seq expected/1 expected/0}})) + (try.else false)) + (|> (do try.monad + [seq (/.composite {/.#Seq expected/0 expected/0} + {/.#Seq expected/0 expected/1}) + expected (/.composite expected/0 expected/1)] + (in (/#= (if (/.exhaustive? expected) + expected/0 + {/.#Seq expected/0 expected}) + seq))) + (try.else false)) + (|> (do try.monad + [seq (/.composite {/.#Seq expected/0 expected/0} + {/.#Seq expected/1 expected/0}) + expected (/.composite expected/0 expected/1)] + (in (/#= {/.#Seq expected expected/0} + seq))) + (try.else false)) + (|> (/.composite {/.#Seq expected/0 expected/1} + expected/1) + (try#each (/#= {/.#Alt {/.#Seq expected/0 expected/1} + expected/1})) + (try.else false)) + (|> (/.composite expected/1 + {/.#Seq expected/0 expected/1}) + (try#each (/#= {/.#Alt expected/1 + {/.#Seq expected/0 expected/1}})) + (try.else false)) + (|> (/.composite expected/0 + {/.#Seq expected/0 expected/1}) + (try#each (/#= expected/0)) + (try.else false))) + + composes_alts! + (and (|> (do try.monad + [alt (/.composite {/.#Exhaustive} + {/.#Alt expected/0 + expected/1})] + (in (/#= {/.#Exhaustive} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/1]))}})] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}})] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 {/.#Exhaustive}] + [tag/1 expected/1]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/2]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) + expected (/.composite expected/2 expected/0)] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected] + [tag/1 expected/1]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/2]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}}) + expected (/.composite expected/2 expected/1)] + (in (/#= {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected]))} + alt))) + (try.else false)) + (|> (do try.monad + [alt (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))} + {/.#Alt {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + expected/2})] + (in (/#= {/.#Alt expected/2 + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0] + [tag/1 expected/1]))}} + alt))) + (try.else false)))] + (and composes_simples! + composes_variants! + composes_sequences! + composes_alts!))) + (_.cover [/.redundancy] + (let [redundant? (..failure? /.redundancy)] + (`` (and (redundant? (/.composite {/.#Exhaustive} {/.#Exhaustive})) + (~~ (template [<it>] + [(redundant? (/.composite <it> <it>)) + (redundant? (/.composite <it> {/.#Exhaustive}))] + + [{/.#Bit bit}] + [{/.#Nat (set.of_list n.hash (list nat))}] + [{/.#Int (set.of_list i.hash (list int))}] + [{/.#Rev (set.of_list r.hash (list rev))}] + [{/.#Frac (set.of_list f.hash (list frac))}] + [{/.#Text (set.of_list text.hash (list text))}] + [{/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] + [{/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))}] + [{/.#Seq expected/0 expected/1}])) + (redundant? (/.composite {/.#Seq expected/0 expected/1} expected/0)))))) + (_.cover [/.variant_mismatch] + (let [mismatch? (..failure? /.variant_mismatch)] + (and (not (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) + + (mismatch? (/.composite {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some (++ arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + + (mismatch? (/.composite {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + (mismatch? (/.composite {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some (-- arity)} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + + (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [tag/0 expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))}))) + (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [arity expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})) + (not (mismatch? (/.composite {/.#Variant {.#None} (dictionary.of_list n.hash (list [(-- arity) expected/0]))} + {/.#Variant {.#Some arity} (dictionary.of_list n.hash (list [tag/1 expected/1]))})))))) + )))) (def: .public test Test (<| (_.covering /._) (_.for [/.Coverage]) - ($_ _.and - ..test|value - ..test|coverage - (_.for [/.Variant] - ..test|variant) - ..test|composite - ))) + (all _.and + ..test|value + ..test|coverage + (_.for [/.Variant] + ..test|variant) + ..test|composite + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux index af26cf21c..2ce0c57ad 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux @@ -83,18 +83,18 @@ (def: .public simple_parameter (Random [Type Code]) - (`` ($_ random.either - (~~ (template [<type> <random> <code>] - [(random#each (|>> <code> [<type>]) <random>)] + (`` (all random.either + (~~ (template [<type> <random> <code>] + [(random#each (|>> <code> [<type>]) <random>)] - [.Bit random.bit code.bit] - [.Nat random.nat code.nat] - [.Int random.int code.int] - [.Rev random.rev code.rev] - [.Frac random.frac code.frac] - [.Text (random.ascii/lower 1) code.text] - )) - ))) + [.Bit random.bit code.bit] + [.Nat random.nat code.nat] + [.Int random.int code.int] + [.Rev random.rev code.rev] + [.Frac random.frac code.frac] + [.Text (random.ascii/lower 1) code.text] + )) + ))) (def: test|general Test @@ -107,109 +107,109 @@ [type/0 term/0] ..simple_parameter arity (# ! each (n.% 10) random.nat) nats (random.list arity random.nat)] - ($_ _.and - (_.cover [/.general] - (and (|> (/.general archive.empty ..analysis expected (list)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type.function (list.repeated arity .Nat) expected) - (list#each code.nat nats)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (function (_ [actual analysis/*]) - (and (type#= expected actual) - (# (list.equivalence //.equivalence) = - (list#each (|>> //.nat) nats) - analysis/*)))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type (-> type/0 expected)) - (list term/0)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type {.#Named name (-> type/0 expected)}) - (list term/0)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type (All (_ a) (-> a a))) - (list term/0)) - (//type.expecting type/0) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase#each (|>> product.left (check.clean (list)) //type.check)) - /phase#conjoint - (/phase.result state) - (try#each (type#= type/0)) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type ((All (_ a) (-> a a)) type/0)) - (list term/0)) - (//type.expecting type/0) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= type/0))) - (try.else false)) - (|> (do /phase.monad - [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT (type (-> type/0 expected))))] - (/.general archive.empty ..analysis varT (list term/0))) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase#each (|>> product.left (check.clean (list)) //type.check)) - /phase#conjoint - (/phase.result state) - (try#each (type#= expected)) - (try.else false)) - (|> (/.general archive.empty ..analysis - (type (Ex (_ a) (-> a a))) - (list (` ("lux io error" "")))) - //type.inferring - (//module.with 0 (product.left name)) - (/phase#each (|>> product.right product.left (check.clean (list)) //type.check)) - /phase#conjoint - (/phase.result state) - (try#each //type.existential?) - (try.else false)) - )) - (_.cover [/.cannot_infer] - (and (|> (/.general archive.empty ..analysis expected (list term/0)) - (//type.expecting expected) - (/phase.result state) - (..fails? /.cannot_infer)) - (|> (do /phase.monad - [[@var varT] (//type.check check.var)] - (/.general archive.empty ..analysis varT (list term/0))) - (//type.expecting expected) - (/phase.result state) - (..fails? /.cannot_infer)))) - (_.cover [/.cannot_infer_argument] - (|> (/.general archive.empty ..analysis - (type (-> expected expected)) - (list term/0)) - (//type.expecting expected) - (//module.with 0 (product.left name)) - (/phase.result state) - (..fails? /.cannot_infer_argument))) - ))) + (all _.and + (_.cover [/.general] + (and (|> (/.general archive.empty ..analysis expected (list)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type.function (list.repeated arity .Nat) expected) + (list#each code.nat nats)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (function (_ [actual analysis/*]) + (and (type#= expected actual) + (# (list.equivalence //.equivalence) = + (list#each (|>> //.nat) nats) + analysis/*)))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type (-> type/0 expected)) + (list term/0)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type {.#Named name (-> type/0 expected)}) + (list term/0)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type (All (_ a) (-> a a))) + (list term/0)) + (//type.expecting type/0) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each (type#= type/0)) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type ((All (_ a) (-> a a)) type/0)) + (list term/0)) + (//type.expecting type/0) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= type/0))) + (try.else false)) + (|> (do /phase.monad + [[@var varT] (//type.check check.var) + _ (//type.check (check.check varT (type (-> type/0 expected))))] + (/.general archive.empty ..analysis varT (list term/0))) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each (type#= expected)) + (try.else false)) + (|> (/.general archive.empty ..analysis + (type (Ex (_ a) (-> a a))) + (list (` ("lux io error" "")))) + //type.inferring + (//module.with 0 (product.left name)) + (/phase#each (|>> product.right product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each //type.existential?) + (try.else false)) + )) + (_.cover [/.cannot_infer] + (and (|> (/.general archive.empty ..analysis expected (list term/0)) + (//type.expecting expected) + (/phase.result state) + (..fails? /.cannot_infer)) + (|> (do /phase.monad + [[@var varT] (//type.check check.var)] + (/.general archive.empty ..analysis varT (list term/0))) + (//type.expecting expected) + (/phase.result state) + (..fails? /.cannot_infer)))) + (_.cover [/.cannot_infer_argument] + (|> (/.general archive.empty ..analysis + (type (-> expected expected)) + (list term/0)) + (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase.result state) + (..fails? /.cannot_infer_argument))) + ))) (def: test|variant Test @@ -226,99 +226,99 @@ tag (# ! each (n.% arity) random.nat) .let [[lefts right?] (//complex.choice arity tag)] arbitrary_right? random.bit] - ($_ _.and - (_.cover [/.variant] - (let [variantT (type.variant (list#each product.left types/*,terms/*)) - [tagT tagC] (|> types/*,terms/* - (list.item tag) - (maybe.else [Any (' [])])) - variant?' (is (-> Type (Maybe Type) Nat Bit Code Bit) - (function (_ variant inferred lefts right? term) - (|> (do /phase.monad - [inferT (/.variant lefts right? variant) - [_ [it _]] (|> (/.general archive.empty ..analysis inferT (list term)) - //type.inferring)] - (case inferred - {.#Some inferred} - (//type.check - (do check.monad - [_ (check.check inferred it) - _ (check.check it inferred)] - (in true))) - - {.#None} - (in true))) - (//module.with 0 (product.left name)) - (/phase#each product.right) - (/phase.result state) - (try.else false)))) - variant? (is (-> Type Nat Bit Code Bit) - (function (_ type lefts right? term) - (variant?' type {.#Some type} lefts right? term))) + (all _.and + (_.cover [/.variant] + (let [variantT (type.variant (list#each product.left types/*,terms/*)) + [tagT tagC] (|> types/*,terms/* + (list.item tag) + (maybe.else [Any (' [])])) + variant?' (is (-> Type (Maybe Type) Nat Bit Code Bit) + (function (_ variant inferred lefts right? term) + (|> (do /phase.monad + [inferT (/.variant lefts right? variant) + [_ [it _]] (|> (/.general archive.empty ..analysis inferT (list term)) + //type.inferring)] + (case inferred + {.#Some inferred} + (//type.check + (do check.monad + [_ (check.check inferred it) + _ (check.check it inferred)] + (in true))) + + {.#None} + (in true))) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase.result state) + (try.else false)))) + variant? (is (-> Type Nat Bit Code Bit) + (function (_ type lefts right? term) + (variant?' type {.#Some type} lefts right? term))) - can_match_case! - (variant? variantT lefts right? tagC) + can_match_case! + (variant? variantT lefts right? tagC) - names_do_not_matter! - (variant? {.#Named name variantT} lefts right? tagC) + names_do_not_matter! + (variant? {.#Named name variantT} lefts right? tagC) - cases_independent_of_parameters_conform_to_anything! - (variant? (type (Maybe type/0)) 0 #0 (' [])) + cases_independent_of_parameters_conform_to_anything! + (variant? (type (Maybe type/0)) 0 #0 (' [])) - cases_dependent_on_parameters_are_tettered_to_those_parameters! - (and (variant? (type (Maybe type/0)) 0 #1 term/0) - (not (variant? (type (Maybe type/0)) 0 #1 term/1))) + cases_dependent_on_parameters_are_tettered_to_those_parameters! + (and (variant? (type (Maybe type/0)) 0 #1 term/0) + (not (variant? (type (Maybe type/0)) 0 #1 term/1))) - only_bottom_conforms_to_tags_outside_of_range! - (`` (and (~~ (template [<verdict> <term>] - [(bit#= <verdict> (variant? variantT arity arbitrary_right? <term>))] + only_bottom_conforms_to_tags_outside_of_range! + (`` (and (~~ (template [<verdict> <term>] + [(bit#= <verdict> (variant? variantT arity arbitrary_right? <term>))] - [#0 term/0] - [#1 (` ("lux io error" ""))])))) + [#0 term/0] + [#1 (` ("lux io error" ""))])))) - can_handle_universal_quantification! - (and (variant?' (type (All (_ a) (Maybe a))) - {.#Some Maybe} - 0 #0 (' [])) - (variant?' (type (All (_ a) (Maybe a))) - {.#Some (type (Maybe type/0))} - 0 #1 term/0) - (not (variant?' (type (All (_ a) (Maybe a))) - {.#Some Maybe} - 0 #1 term/0))) + can_handle_universal_quantification! + (and (variant?' (type (All (_ a) (Maybe a))) + {.#Some Maybe} + 0 #0 (' [])) + (variant?' (type (All (_ a) (Maybe a))) + {.#Some (type (Maybe type/0))} + 0 #1 term/0) + (not (variant?' (type (All (_ a) (Maybe a))) + {.#Some Maybe} + 0 #1 term/0))) - existential_types_do_not_affect_independent_cases! - (variant?' (type (Ex (_ a) (Maybe a))) - {.#None} - 0 #0 (' [])) + existential_types_do_not_affect_independent_cases! + (variant?' (type (Ex (_ a) (Maybe a))) + {.#None} + 0 #0 (' [])) - existential_types_affect_dependent_cases! - (`` (and (~~ (template [<verdict> <term>] - [(bit#= <verdict> (variant?' (type (Ex (_ a) (Maybe a))) {.#None} 0 #1 <term>))] + existential_types_affect_dependent_cases! + (`` (and (~~ (template [<verdict> <term>] + [(bit#= <verdict> (variant?' (type (Ex (_ a) (Maybe a))) {.#None} 0 #1 <term>))] - [#0 term/0] - [#1 (` ("lux io error" ""))]))))] - (and can_match_case! - names_do_not_matter! + [#0 term/0] + [#1 (` ("lux io error" ""))]))))] + (and can_match_case! + names_do_not_matter! - cases_independent_of_parameters_conform_to_anything! - cases_dependent_on_parameters_are_tettered_to_those_parameters! + cases_independent_of_parameters_conform_to_anything! + cases_dependent_on_parameters_are_tettered_to_those_parameters! - only_bottom_conforms_to_tags_outside_of_range! + only_bottom_conforms_to_tags_outside_of_range! - can_handle_universal_quantification! + can_handle_universal_quantification! - existential_types_do_not_affect_independent_cases! - existential_types_affect_dependent_cases! - ))) - (_.cover [/.not_a_variant] - (let [[tagT tagC] (|> types/*,terms/* - (list.item tag) - (maybe.else [Any (' [])]))] - (|> (/.variant lefts right? tagT) - (/phase.result state) - (..fails? /.not_a_variant)))) - ))) + existential_types_do_not_affect_independent_cases! + existential_types_affect_dependent_cases! + ))) + (_.cover [/.not_a_variant] + (let [[tagT tagC] (|> types/*,terms/* + (list.item tag) + (maybe.else [Any (' [])]))] + (|> (/.variant lefts right? tagT) + (/phase.result state) + (..fails? /.not_a_variant)))) + ))) (def: test|record Test @@ -354,45 +354,45 @@ (try.else false)))) record (type.tuple (list#each product.left types/*,terms/*)) terms (list#each product.right types/*,terms/*)]] - ($_ _.and - (_.cover [/.record] - (let [can_infer_record! - (record? record {.#None} arity terms) + (all _.and + (_.cover [/.record] + (let [can_infer_record! + (record? record {.#None} arity terms) - names_do_not_matter! - (record? {.#Named name record} {.#None} arity terms) - - can_handle_universal_quantification! - (and (record? (All (_ a) (Tuple type/0 a)) - {.#Some (Tuple type/0 type/1)} - 2 (list term/0 term/1)) - (record? (All (_ a) (Tuple a type/0)) - {.#Some (Tuple type/1 type/0)} - 2 (list term/1 term/0))) - - can_handle_existential_quantification! - (and (not (record? (Ex (_ a) (Tuple type/0 a)) - {.#Some (Tuple type/0 type/1)} - 2 (list term/0 term/1))) - (record? (Ex (_ a) (Tuple type/0 a)) - {.#None} - 2 (list term/0 (` ("lux io error" "")))) - (not (record? (Ex (_ a) (Tuple a type/0)) - {.#Some (Tuple type/1 type/0)} - 2 (list term/1 term/0))) - (record? (Ex (_ a) (Tuple a type/0)) - {.#None} - 2 (list (` ("lux io error" "")) term/0)))] - (and can_infer_record! names_do_not_matter! + (record? {.#Named name record} {.#None} arity terms) + can_handle_universal_quantification! + (and (record? (All (_ a) (Tuple type/0 a)) + {.#Some (Tuple type/0 type/1)} + 2 (list term/0 term/1)) + (record? (All (_ a) (Tuple a type/0)) + {.#Some (Tuple type/1 type/0)} + 2 (list term/1 term/0))) + can_handle_existential_quantification! - ))) - (_.cover [/.not_a_record] - (|> (/.record arity type/0) - (/phase.result state) - (..fails? /.not_a_record))) - ))) + (and (not (record? (Ex (_ a) (Tuple type/0 a)) + {.#Some (Tuple type/0 type/1)} + 2 (list term/0 term/1))) + (record? (Ex (_ a) (Tuple type/0 a)) + {.#None} + 2 (list term/0 (` ("lux io error" "")))) + (not (record? (Ex (_ a) (Tuple a type/0)) + {.#Some (Tuple type/1 type/0)} + 2 (list term/1 term/0))) + (record? (Ex (_ a) (Tuple a type/0)) + {.#None} + 2 (list (` ("lux io error" "")) term/0)))] + (and can_infer_record! + names_do_not_matter! + can_handle_universal_quantification! + can_handle_existential_quantification! + ))) + (_.cover [/.not_a_record] + (|> (/.record arity type/0) + (/phase.result state) + (..fails? /.not_a_record))) + ))) (def: .public test Test @@ -406,18 +406,18 @@ ..simple_parameter) lefts (# ! each (n.% 10) random.nat) right? random.bit] - ($_ _.and - ..test|general - ..test|variant - ..test|record - (_.cover [/.invalid_type_application] - (and (|> (/.general archive.empty ..analysis (type (type/0 type/1)) (list term/0)) - (/phase.result state) - (..fails? /.invalid_type_application)) - (|> (/.variant lefts right? (type (type/0 type/1))) - (/phase.result state) - (..fails? /.invalid_type_application)) - (|> (/.record lefts (type (type/0 type/1))) - (/phase.result state) - (..fails? /.invalid_type_application)))) - )))) + (all _.and + ..test|general + ..test|variant + ..test|record + (_.cover [/.invalid_type_application] + (and (|> (/.general archive.empty ..analysis (type (type/0 type/1)) (list term/0)) + (/phase.result state) + (..fails? /.invalid_type_application)) + (|> (/.variant lefts right? (type (type/0 type/1))) + (/phase.result state) + (..fails? /.invalid_type_application)) + (|> (/.record lefts (type (type/0 type/1))) + (/phase.result state) + (..fails? /.invalid_type_application)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux index a7fe6be62..13699b82f 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/macro.lux @@ -77,35 +77,35 @@ {try.#Success [state (|> inputs (list.repeated multiplicity) list#conjoint)]}))]]) - ($_ _.and - (_.cover [/.expansion] - (|> (/.expansion ..expander name multiple (list mono)) - (meta.result lux) - (try#each (# (list.equivalence code.equivalence) = - (list.repeated multiplicity mono))) - (try.else false))) - (_.cover [/.expansion_failed] - (|> (/.expansion ..expander name singular (list)) - (meta.result lux) - (pipe.case - {try.#Failure it} - (and (text.contains? expected_error it) - (text.contains? (the exception.#label /.expansion_failed) it)) + (all _.and + (_.cover [/.expansion] + (|> (/.expansion ..expander name multiple (list mono)) + (meta.result lux) + (try#each (# (list.equivalence code.equivalence) = + (list.repeated multiplicity mono))) + (try.else false))) + (_.cover [/.expansion_failed] + (|> (/.expansion ..expander name singular (list)) + (meta.result lux) + (pipe.case + {try.#Failure it} + (and (text.contains? expected_error it) + (text.contains? (the exception.#label /.expansion_failed) it)) - _ - false))) - (_.cover [/.single_expansion] - (|> (/.single_expansion ..expander name singular poly) - (meta.result lux) - (try#each (code#= (|> poly (list.item choice) maybe.trusted))) - (try.else false))) - (_.cover [/.must_have_single_expansion] - (|> (/.single_expansion ..expander name multiple (list mono)) - (meta.result lux) - (pipe.case - {try.#Failure it} - (text.contains? (the exception.#label /.must_have_single_expansion) it) + _ + false))) + (_.cover [/.single_expansion] + (|> (/.single_expansion ..expander name singular poly) + (meta.result lux) + (try#each (code#= (|> poly (list.item choice) maybe.trusted))) + (try.else false))) + (_.cover [/.must_have_single_expansion] + (|> (/.single_expansion ..expander name multiple (list mono)) + (meta.result lux) + (pipe.case + {try.#Failure it} + (text.contains? (the exception.#label /.must_have_single_expansion) it) - _ - false))) - ))) + _ + false))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux index 538f8375a..ca3c27702 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/module.lux @@ -67,69 +67,69 @@ hash random.nat expected_import (random.ascii/lower 2) expected_alias (random.ascii/lower 3)] - ($_ _.and - (_.cover [/.empty] - (..new? hash (/.empty hash))) - (_.cover [/.create] - (|> (do /phase.monad - [_ (/.create hash name)] - (/extension.lifted (meta.module name))) - (/phase.result state) - (try#each (..new? hash)) - (try.else false))) - (_.cover [/.exists?] - (|> (do /phase.monad - [pre (/.exists? name) - _ (/.create hash name) - post (/.exists? name)] - (in (and (not pre) post))) - (/phase.result state) - (try.else false))) - (_.cover [/.with] - (|> (do /phase.monad - [[it _] (/.with hash name - (in []))] - (in it)) - (/phase.result state) - (try#each (..new? hash)) - (try.else false))) - (_.cover [/.import] - (`` (and (~~ (template [<expected>] - [(|> (do [! /phase.monad] - [_ (/.create hash expected_import) - [it ?] (/.with hash name - (do ! - [_ (if <expected> - (/.import expected_import) - (in []))] - (/extension.lifted - (meta.imported? expected_import))))] - (in ?)) - (/phase.result state) - (try#each (bit#= <expected>)) - (try.else false))] + (all _.and + (_.cover [/.empty] + (..new? hash (/.empty hash))) + (_.cover [/.create] + (|> (do /phase.monad + [_ (/.create hash name)] + (/extension.lifted (meta.module name))) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.exists?] + (|> (do /phase.monad + [pre (/.exists? name) + _ (/.create hash name) + post (/.exists? name)] + (in (and (not pre) post))) + (/phase.result state) + (try.else false))) + (_.cover [/.with] + (|> (do /phase.monad + [[it _] (/.with hash name + (in []))] + (in it)) + (/phase.result state) + (try#each (..new? hash)) + (try.else false))) + (_.cover [/.import] + (`` (and (~~ (template [<expected>] + [(|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it ?] (/.with hash name + (do ! + [_ (if <expected> + (/.import expected_import) + (in []))] + (/extension.lifted + (meta.imported? expected_import))))] + (in ?)) + (/phase.result state) + (try#each (bit#= <expected>)) + (try.else false))] - [false] - [true]))))) - (_.cover [/.alias] - (|> (do [! /phase.monad] - [_ (/.create hash expected_import) - [it _] (/.with hash name - (do ! - [_ (/.import expected_import)] - (/.alias expected_alias expected_import)))] - (in it)) - (/phase.result state) - (try#each (|>> (the .#module_aliases) - (pipe.case - (pattern (list [actual_alias actual_import])) - (and (same? expected_alias actual_alias) - (same? expected_import actual_import)) + [false] + [true]))))) + (_.cover [/.alias] + (|> (do [! /phase.monad] + [_ (/.create hash expected_import) + [it _] (/.with hash name + (do ! + [_ (/.import expected_import)] + (/.alias expected_alias expected_import)))] + (in it)) + (/phase.result state) + (try#each (|>> (the .#module_aliases) + (pipe.case + (pattern (list [actual_alias actual_import])) + (and (same? expected_alias actual_alias) + (same? expected_import actual_import)) - _ - false))) - (try.else false))) - ))) + _ + false))) + (try.else false))) + ))) (def: test|state Test @@ -139,62 +139,62 @@ /extension.#state lux]] name (random.ascii/lower 1) hash random.nat] - (`` ($_ _.and - (~~ (template [<set> <query> <not/0> <not/1>] - [(_.cover [<set> <query>] - (|> (do [! /phase.monad] - [[it ?] (/.with hash name - (do ! - [_ (<set> name) - ? (<query> name) - ~0 (<not/0> name) - ~1 (<not/1> name)] - (in (and ? (not ~0) (not ~1)))))] - (in ?)) - (/phase.result state) - (try.else false)))] + (`` (all _.and + (~~ (template [<set> <query> <not/0> <not/1>] + [(_.cover [<set> <query>] + (|> (do [! /phase.monad] + [[it ?] (/.with hash name + (do ! + [_ (<set> name) + ? (<query> name) + ~0 (<not/0> name) + ~1 (<not/1> name)] + (in (and ? (not ~0) (not ~1)))))] + (in ?)) + (/phase.result state) + (try.else false)))] - [/.set_active /.active? /.compiled? /.cached?] - [/.set_compiled /.compiled? /.cached? /.active?] - [/.set_cached /.cached? /.active? /.compiled?] - )) - (_.cover [/.can_only_change_state_of_active_module] - (and (~~ (template [<pre> <post>] - [(|> (/.with hash name - (do /phase.monad - [_ (<pre> name)] - (<post> name))) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.can_only_change_state_of_active_module) error)))] + [/.set_active /.active? /.compiled? /.cached?] + [/.set_compiled /.compiled? /.cached? /.active?] + [/.set_cached /.cached? /.active? /.compiled?] + )) + (_.cover [/.can_only_change_state_of_active_module] + (and (~~ (template [<pre> <post>] + [(|> (/.with hash name + (do /phase.monad + [_ (<pre> name)] + (<post> name))) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.can_only_change_state_of_active_module) error)))] - [/.set_compiled /.set_active] - [/.set_compiled /.set_compiled] - [/.set_compiled /.set_cached] - [/.set_cached /.set_active] - [/.set_cached /.set_compiled] - [/.set_cached /.set_cached] - )))) - (_.cover [/.unknown_module] - (and (~~ (template [<set>] - [(|> (<set> name) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.unknown_module) error)))] + [/.set_compiled /.set_active] + [/.set_compiled /.set_compiled] + [/.set_compiled /.set_cached] + [/.set_cached /.set_active] + [/.set_cached /.set_compiled] + [/.set_cached /.set_cached] + )))) + (_.cover [/.unknown_module] + (and (~~ (template [<set>] + [(|> (<set> name) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.unknown_module) error)))] - [/.set_active] - [/.set_compiled] - [/.set_cached] - )))) - )))) + [/.set_active] + [/.set_compiled] + [/.set_cached] + )))) + )))) (def: test|definition Test @@ -218,55 +218,55 @@ index (# ! each (n.% arity) random.nat) .let [definition {.#Definition [public? def_type []]} alias {.#Alias [module_name def_name]}]] - ($_ _.and - (_.cover [/.define] - (`` (and (~~ (template [<global>] - [(|> (/.with hash module_name - (/.define def_name <global>)) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false))] + (all _.and + (_.cover [/.define] + (`` (and (~~ (template [<global>] + [(|> (/.with hash module_name + (/.define def_name <global>)) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false))] - [definition] - [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] - [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] - [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] - [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) - (|> (/.with hash module_name - (do /phase.monad - [_ (/.define def_name definition)] - (/.define alias_name alias))) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false))))) - (_.cover [/.cannot_define_more_than_once] - (`` (and (~~ (template [<global>] - [(|> (/.with hash module_name - (do /phase.monad - [_ (/.define def_name <global>)] - (/.define def_name <global>))) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true))] + [definition] + [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] + [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] + [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] + [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) + (|> (/.with hash module_name + (do /phase.monad + [_ (/.define def_name definition)] + (/.define alias_name alias))) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false))))) + (_.cover [/.cannot_define_more_than_once] + (`` (and (~~ (template [<global>] + [(|> (/.with hash module_name + (do /phase.monad + [_ (/.define def_name <global>)] + (/.define def_name <global>))) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true))] - [{.#Definition [public? def_type []]}] - [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] - [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] - [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] - [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) - (|> (/.with hash module_name - (do /phase.monad - [_ (/.define def_name definition) - _ (/.define alias_name alias)] - (/.define alias_name alias))) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true))))) - ))) + [{.#Definition [public? def_type []]}] + [{.#Type [public? def_type {.#Left [labels|head labels|tail]}]}] + [{.#Type [public? def_type {.#Right [labels|head labels|tail]}]}] + [{.#Tag [public? def_type (partial_list labels|head labels|tail) index]}] + [{.#Slot [public? def_type (partial_list labels|head labels|tail) index]}])) + (|> (/.with hash module_name + (do /phase.monad + [_ (/.define def_name definition) + _ (/.define alias_name alias)] + (/.define alias_name alias))) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true))))) + ))) (def: test|label Test @@ -287,68 +287,68 @@ (random.only (|>> (text#= labels|head) not)) (random.set text.hash (-- arity)) (# ! each set.list))] - ($_ _.and - (_.cover [/.declare_labels] - (`` (and (~~ (template [<side> <record?> <query> <on_success>] - [(|> (/.with hash module_name - (do [! /phase.monad] - [.let [it {.#Named [module_name def_name] def_type}] - _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]}) - _ (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it)] - (monad.each ! (|>> [module_name] <query> /extension.lifted) - (partial_list labels|head labels|tail)))) - (/phase.result state) - (pipe.case - {try.#Success _} <on_success> - {try.#Failure _} (not <on_success>)))] + (all _.and + (_.cover [/.declare_labels] + (`` (and (~~ (template [<side> <record?> <query> <on_success>] + [(|> (/.with hash module_name + (do [! /phase.monad] + [.let [it {.#Named [module_name def_name] def_type}] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]}) + _ (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it)] + (monad.each ! (|>> [module_name] <query> /extension.lifted) + (partial_list labels|head labels|tail)))) + (/phase.result state) + (pipe.case + {try.#Success _} <on_success> + {try.#Failure _} (not <on_success>)))] - [.#Left false meta.tag true] - [.#Left false meta.slot false] - [.#Right true meta.slot true] - [.#Right true meta.tag false]))))) - (_.cover [/.cannot_declare_labels_for_anonymous_type] - (`` (and (~~ (template [<side> <record?>] - [(|> (/.with hash module_name - (do [! /phase.monad] - [.let [it def_type] - _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] - (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.cannot_declare_labels_for_anonymous_type) error)))] + [.#Left false meta.tag true] + [.#Left false meta.slot false] + [.#Right true meta.slot true] + [.#Right true meta.tag false]))))) + (_.cover [/.cannot_declare_labels_for_anonymous_type] + (`` (and (~~ (template [<side> <record?>] + [(|> (/.with hash module_name + (do [! /phase.monad] + [.let [it def_type] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] + (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.cannot_declare_labels_for_anonymous_type) error)))] - [.#Left false] - [.#Right true]))))) - (_.cover [/.cannot_declare_labels_for_foreign_type] - (`` (and (~~ (template [<side> <record?>] - [(|> (/.with hash module_name - (do [! /phase.monad] - [.let [it {.#Named [foreign_module def_name] def_type}] - _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] - (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) - (/phase.result state) - (pipe.case - {try.#Success _} - false - - {try.#Failure error} - (text.contains? (the exception.#label /.cannot_declare_labels_for_foreign_type) error)))] + [.#Left false] + [.#Right true]))))) + (_.cover [/.cannot_declare_labels_for_foreign_type] + (`` (and (~~ (template [<side> <record?>] + [(|> (/.with hash module_name + (do [! /phase.monad] + [.let [it {.#Named [foreign_module def_name] def_type}] + _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})] + (/.declare_labels <record?> (partial_list labels|head labels|tail) public? it))) + (/phase.result state) + (pipe.case + {try.#Success _} + false + + {try.#Failure error} + (text.contains? (the exception.#label /.cannot_declare_labels_for_foreign_type) error)))] - [.#Left false] - [.#Right true]))))) - ))) + [.#Left false] + [.#Right true]))))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..test|module - ..test|state - ..test|definition - (_.for [/.Label] - ..test|label) - ))) + (all _.and + ..test|module + ..test|state + ..test|definition + (_.for [/.Label] + ..test|label) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux index cd72d2b50..9151db036 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux @@ -23,11 +23,11 @@ (Random /.Pattern) (random.rec (function (_ random) - ($_ random.or - //simple.random - (//complex.random 4 random) - random.nat - )))) + (all random.or + //simple.random + (//complex.random 4 random) + random.nat + )))) (def: .public test Test @@ -47,66 +47,66 @@ left ..random right ..random]) - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - (_.cover [/.unit] - (case (/.unit) - (pattern (/.unit)) - true + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + (_.cover [/.unit] + (case (/.unit) + (pattern (/.unit)) + true - _ - false)) - (~~ (template [<tag> <value>] - [(_.cover [<tag>] - (case (<tag> <value>) - (pattern (<tag> actual)) - (same? <value> actual) + _ + false)) + (~~ (template [<tag> <value>] + [(_.cover [<tag>] + (case (<tag> <value>) + (pattern (<tag> actual)) + (same? <value> actual) - _ - false))] + _ + false))] - [/.bind expected_register] - [/.bit expected_bit] - [/.nat expected_nat] - [/.int expected_int] - [/.rev expected_rev] - [/.frac expected_frac] - [/.text expected_text] - )) - (_.cover [/.variant] - (case (/.variant [expected_lefts expected_right? (/.text expected_text)]) - (pattern (/.variant [actual_lefts actual_right? (/.text actual_text)])) - (and (same? expected_lefts actual_lefts) - (same? expected_right? actual_right?) - (same? expected_text actual_text)) + [/.bind expected_register] + [/.bit expected_bit] + [/.nat expected_nat] + [/.int expected_int] + [/.rev expected_rev] + [/.frac expected_frac] + [/.text expected_text] + )) + (_.cover [/.variant] + (case (/.variant [expected_lefts expected_right? (/.text expected_text)]) + (pattern (/.variant [actual_lefts actual_right? (/.text actual_text)])) + (and (same? expected_lefts actual_lefts) + (same? expected_right? actual_right?) + (same? expected_text actual_text)) - _ - false)) - (_.cover [/.tuple] - (case (/.tuple (list (/.bit expected_bit) - (/.nat expected_nat) - (/.int expected_int) - (/.rev expected_rev) - (/.frac expected_frac) - (/.text expected_text))) - (pattern (/.tuple (list (/.bit actual_bit) - (/.nat actual_nat) - (/.int actual_int) - (/.rev actual_rev) - (/.frac actual_frac) - (/.text actual_text)))) - (and (same? expected_bit actual_bit) - (same? expected_nat actual_nat) - (same? expected_int actual_int) - (same? expected_rev actual_rev) - (same? expected_frac actual_frac) - (same? expected_text actual_text)) + _ + false)) + (_.cover [/.tuple] + (case (/.tuple (list (/.bit expected_bit) + (/.nat expected_nat) + (/.int expected_int) + (/.rev expected_rev) + (/.frac expected_frac) + (/.text expected_text))) + (pattern (/.tuple (list (/.bit actual_bit) + (/.nat actual_nat) + (/.int actual_int) + (/.rev actual_rev) + (/.frac actual_frac) + (/.text actual_text)))) + (and (same? expected_bit actual_bit) + (same? expected_nat actual_nat) + (same? expected_int actual_int) + (same? expected_rev actual_rev) + (same? expected_frac actual_frac) + (same? expected_text actual_text)) - _ - false)) - )))) + _ + false)) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux index bd2309561..1d3895914 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/scope.lux @@ -58,147 +58,147 @@ name/1 (random.ascii/lower 2) type/0 ($type.random 0) type/1 ($type.random 0)] - ($_ _.and - (_.cover [/.variable] - (|> (/.variable name/0) - /.with - (//phase.result state) - (try#each (|>> product.right - (pipe.case - {.#None} true - {.#Some _} false))) - (try.else false))) - (_.cover [/.with_local] - (|> (/.with_local [name/0 type/0] - (/.variable name/0)) - /.with - (//phase.result state) - (try#each (|>> product.right - (maybe#each (..local? type/0 0)) - (maybe.else false))) - (try.else false))) - (_.cover [/.next] - (|> (<| (do [! //phase.monad] - [register/0 /.next]) - (/.with_local [name/0 type/0]) - (do ! - [var/0 (/.variable name/0)]) - (do ! - [register/1 /.next]) - (/.with_local [name/1 type/1]) - (do ! - [var/1 (/.variable name/1)]) - (in (do maybe.monad - [var/0 var/0 - var/1 var/1] - (in [[register/0 var/0] [register/1 var/1]])))) - /.with - (//phase.result state) - (try#each (|>> product.right - (maybe#each (function (_ [[register/0 var/0] [register/1 var/1]]) - (and (..local? type/0 register/0 var/0) - (..local? type/1 register/1 var/1)))) - (maybe.else false))) - (try.else false))) - (_.cover [/.no_scope] - (and (|> (/.with_local [name/0 type/0] - (//phase#in false)) - (//phase.result state) - (exception.otherwise (exception.match? /.no_scope))) - (|> (do //phase.monad - [_ /.next] - (in false)) - (//phase.result state) - (exception.otherwise (exception.match? /.no_scope))))) - (_.cover [/.reset] - (and (|> /.next + (all _.and + (_.cover [/.variable] + (|> (/.variable name/0) + /.with + (//phase.result state) + (try#each (|>> product.right + (pipe.case + {.#None} true + {.#Some _} false))) + (try.else false))) + (_.cover [/.with_local] + (|> (/.with_local [name/0 type/0] + (/.variable name/0)) + /.with + (//phase.result state) + (try#each (|>> product.right + (maybe#each (..local? type/0 0)) + (maybe.else false))) + (try.else false))) + (_.cover [/.next] + (|> (<| (do [! //phase.monad] + [register/0 /.next]) (/.with_local [name/0 type/0]) - /.with - (//phase.result state) - (try#each (|>> product.right - (n.= 1))) - (try.else false)) - (|> /.next - /.reset + (do ! + [var/0 (/.variable name/0)]) + (do ! + [register/1 /.next]) + (/.with_local [name/1 type/1]) + (do ! + [var/1 (/.variable name/1)]) + (in (do maybe.monad + [var/0 var/0 + var/1 var/1] + (in [[register/0 var/0] [register/1 var/1]])))) + /.with + (//phase.result state) + (try#each (|>> product.right + (maybe#each (function (_ [[register/0 var/0] [register/1 var/1]]) + (and (..local? type/0 register/0 var/0) + (..local? type/1 register/1 var/1)))) + (maybe.else false))) + (try.else false))) + (_.cover [/.no_scope] + (and (|> (/.with_local [name/0 type/0] + (//phase#in false)) + (//phase.result state) + (exception.otherwise (exception.match? /.no_scope))) + (|> (do //phase.monad + [_ /.next] + (in false)) + (//phase.result state) + (exception.otherwise (exception.match? /.no_scope))))) + (_.cover [/.reset] + (and (|> /.next + (/.with_local [name/0 type/0]) + /.with + (//phase.result state) + (try#each (|>> product.right + (n.= 1))) + (try.else false)) + (|> /.next + /.reset + (/.with_local [name/0 type/0]) + /.with + (//phase.result state) + (try#each (|>> product.right + (n.= 0))) + (try.else false)))) + (_.cover [/.drained] + (|> (function (_ [bundle state]) + {try.#Success [[bundle (has .#scopes (list) state)] + false]}) + (/.with_local [name/0 type/0]) + /.with + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (exception.match? /.drained)))) + (_.cover [/.with] + (|> (<| /.with (/.with_local [name/0 type/0]) - /.with - (//phase.result state) - (try#each (|>> product.right - (n.= 0))) - (try.else false)))) - (_.cover [/.drained] - (|> (function (_ [bundle state]) - {try.#Success [[bundle (has .#scopes (list) state)] - false]}) - (/.with_local [name/0 type/0]) - /.with - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (exception.match? /.drained)))) - (_.cover [/.with] - (|> (<| /.with - (/.with_local [name/0 type/0]) - (do //phase.monad - [var/0' (/.variable name/0) - [scope/1 var/0''] (/.with (/.variable name/0))] - (<| //phase.lifted - try.of_maybe - (do maybe.monad - [var/0' var/0' - var/0'' var/0''] - (in [var/0' scope/1 var/0'']))))) - (//phase.result state) - (try#each (function (_ [scope/0 var/0' scope/1 var/0'']) - (and (local? type/0 0 var/0') - (n.= 0 (list.size (the [.#locals .#mappings] scope/0))) - (n.= 0 (list.size (the [.#captured .#mappings] scope/0))) + (do //phase.monad + [var/0' (/.variable name/0) + [scope/1 var/0''] (/.with (/.variable name/0))] + (<| //phase.lifted + try.of_maybe + (do maybe.monad + [var/0' var/0' + var/0'' var/0''] + (in [var/0' scope/1 var/0'']))))) + (//phase.result state) + (try#each (function (_ [scope/0 var/0' scope/1 var/0'']) + (and (local? type/0 0 var/0') + (n.= 0 (list.size (the [.#locals .#mappings] scope/0))) + (n.= 0 (list.size (the [.#captured .#mappings] scope/0))) - (foreign? type/0 0 var/0'') - (n.= 0 (list.size (the [.#locals .#mappings] scope/1))) - (n.= 1 (list.size (the [.#captured .#mappings] scope/1)))))) - (try.else false))) - (_.cover [/.environment] - (let [(open "list#[0]") (list.equivalence //variable.equivalence)] - (and (|> (<| /.with - (/.with_local [name/0 type/0]) - (/.with_local [name/1 type/1]) - (do //phase.monad - [[scope/1 _] (/.with (in []))] - (in (/.environment scope/1)))) - (//phase.result state) - (try#each (|>> product.right - (list#= (list)))) - (try.else false)) - (|> (<| /.with - (do [! //phase.monad] - [register/0 /.next]) - (/.with_local [name/0 type/0]) - (/.with_local [name/1 type/1]) - (do ! - [[scope/1 _] (/.with (/.variable name/0))] - (in [register/0 (/.environment scope/1)]))) - (//phase.result state) - (try#each (function (_ [_ [register/0 environment]]) - (list#= (list {//variable.#Local register/0}) - environment))) - (try.else false)) - (|> (<| /.with - (do [! //phase.monad] - [register/0 /.next]) - (/.with_local [name/0 type/0]) - (do [! //phase.monad] - [register/1 /.next]) - (/.with_local [name/1 type/1]) - (do [! //phase.monad] - [[scope/1 _] (/.with (do ! - [_ (/.variable name/1) - _ (/.variable name/0)] - (in [])))] - (in [register/0 register/1 (/.environment scope/1)]))) - (//phase.result state) - (try#each (function (_ [_ [register/0 register/1 environment]]) - (list#= (list {//variable.#Local register/1} - {//variable.#Local register/0}) - environment))) - (try.else false))))) - )))) + (foreign? type/0 0 var/0'') + (n.= 0 (list.size (the [.#locals .#mappings] scope/1))) + (n.= 1 (list.size (the [.#captured .#mappings] scope/1)))))) + (try.else false))) + (_.cover [/.environment] + (let [(open "list#[0]") (list.equivalence //variable.equivalence)] + (and (|> (<| /.with + (/.with_local [name/0 type/0]) + (/.with_local [name/1 type/1]) + (do //phase.monad + [[scope/1 _] (/.with (in []))] + (in (/.environment scope/1)))) + (//phase.result state) + (try#each (|>> product.right + (list#= (list)))) + (try.else false)) + (|> (<| /.with + (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (/.with_local [name/1 type/1]) + (do ! + [[scope/1 _] (/.with (/.variable name/0))] + (in [register/0 (/.environment scope/1)]))) + (//phase.result state) + (try#each (function (_ [_ [register/0 environment]]) + (list#= (list {//variable.#Local register/0}) + environment))) + (try.else false)) + (|> (<| /.with + (do [! //phase.monad] + [register/0 /.next]) + (/.with_local [name/0 type/0]) + (do [! //phase.monad] + [register/1 /.next]) + (/.with_local [name/1 type/1]) + (do [! //phase.monad] + [[scope/1 _] (/.with (do ! + [_ (/.variable name/1) + _ (/.variable name/0)] + (in [])))] + (in [register/0 register/1 (/.environment scope/1)]))) + (//phase.result state) + (try#each (function (_ [_ [register/0 register/1 environment]]) + (list#= (list {//variable.#Local register/1} + {//variable.#Local register/0}) + environment))) + (try.else false))))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux index e7c22559f..3542d79c7 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/simple.lux @@ -18,28 +18,28 @@ (def: .public random (Random /.Simple) - ($_ random.or - (random#in []) - random.bit - random.nat - random.int - random.rev - (random.only (|>> f.not_a_number? not) random.frac) - (random.ascii/lower 5) - )) + (all random.or + (random#in []) + random.bit + random.nat + random.int + random.rev + (random.only (|>> f.not_a_number? not) random.frac) + (random.ascii/lower 5) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Simple]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [left ..random - right ..random] - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right))))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [left ..random + right ..random] + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right))))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux index 2a13b674c..750bade83 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux @@ -51,85 +51,85 @@ dummy (random.only (|>> (type#= expected) not) ..primitive) module (random.ascii/lower 1)] - ($_ _.and - (_.cover [/.expecting /.inference] - (and (|> (/.inference expected) - (/.expecting expected) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false)) - (|> (/.inference dummy) - (/.expecting expected) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true)) - (|> (/.inference expected) - (/.expecting dummy) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true)))) - (_.cover [/.inferring] - (|> (/.inference expected) - /.inferring - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (try#each (|>> product.left (type#= expected))) - (try.else false))) - (_.cover [/.check] - (|> (do /phase.monad - [exT (/.check (do check.monad - [[id type] check.existential] - (in type)))] - (|> (/.inference exT) - (/.expecting exT))) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false))) - (_.cover [/.existential /.existential?] - (|> (do /phase.monad - [:it: /.existential] - (in (/.existential? :it:))) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (try.else false))) - (_.cover [/.fresh] - (and (|> (do /phase.monad - [varT (/.check (do check.monad - [[id type] check.var] - (in type)))] - (|> (/.inference expected) - (/.expecting varT))) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} true - {try.#Failure _} false)) - (|> (do /phase.monad - [varT (/.check (do check.monad - [[id type] check.var] - (in type)))] - (|> (/.inference expected) - (/.expecting varT) - /.fresh)) - (/module.with 0 module) - (/phase#each product.right) - (/phase.result state) - (pipe.case - {try.#Success _} false - {try.#Failure _} true)))) - )))) + (all _.and + (_.cover [/.expecting /.inference] + (and (|> (/.inference expected) + (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false)) + (|> (/.inference dummy) + (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true)) + (|> (/.inference expected) + (/.expecting dummy) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true)))) + (_.cover [/.inferring] + (|> (/.inference expected) + /.inferring + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try#each (|>> product.left (type#= expected))) + (try.else false))) + (_.cover [/.check] + (|> (do /phase.monad + [exT (/.check (do check.monad + [[id type] check.existential] + (in type)))] + (|> (/.inference exT) + (/.expecting exT))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false))) + (_.cover [/.existential /.existential?] + (|> (do /phase.monad + [:it: /.existential] + (in (/.existential? :it:))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try.else false))) + (_.cover [/.fresh] + (and (|> (do /phase.monad + [varT (/.check (do check.monad + [[id type] check.var] + (in type)))] + (|> (/.inference expected) + (/.expecting varT))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} true + {try.#Failure _} false)) + (|> (do /phase.monad + [varT (/.check (do check.monad + [[id type] check.var] + (in type)))] + (|> (/.inference expected) + (/.expecting varT) + /.fresh)) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (pipe.case + {try.#Success _} false + {try.#Failure _} true)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux index d14a481fa..e4e903891 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis.lux @@ -921,46 +921,46 @@ $parameter/0 (# ! each code.local (random.ascii/lower 12)) $abstraction/1 (# ! each code.local (random.ascii/lower 13)) $parameter/1 (# ! each code.local (random.ascii/lower 14))]) - ($_ _.and - (_.cover [/.phase] - (and (..can_analyse_unit! lux module/0) - (..can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) - (..can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) - (..can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) - (..can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) - (..can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) - (..can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) - (..can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) - (..can_analyse_extension! lux module/0 text/0) - (..can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0) - )) - (_.cover [/.invalid] - (`` (and (~~ (template [<syntax>] - [(|> (do phase.monad - [_ (|> <syntax> - (/.phase ..expander archive.empty) - (//type.expecting .Any))] - (in false)) - //scope.with - (//module.with 0 module/0) - (phase#each (|>> product.right product.right)) - (phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.invalid))))] - - [(` ({#0} (~ (code.bit bit/0))))] - [(` ({#0 [] #1} (~ (code.bit bit/0))))] - [(` {(~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0))})] - [(` {(~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0))})] - [(` {(~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0))})] - [(` {(~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0))})] - [(` {(~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0))})] - [(` {(~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0))})] - )) - ))) - - /simple.test - /complex.test - /reference.test - /function.test - /case.test - ))) + (all _.and + (_.cover [/.phase] + (and (..can_analyse_unit! lux module/0) + (..can_analyse_simple_literal_or_singleton_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_sum! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (..can_analyse_variant! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] [@left @right]) + (..can_analyse_tuple! lux module/0 [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_record! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0]) + (..can_analyse_function! lux module/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (..can_analyse_apply! lux module/0 bit/0 nat/0 [$abstraction/0 $parameter/0 $abstraction/1 $parameter/1]) + (..can_analyse_extension! lux module/0 text/0) + (..can_analyse_pattern_matching! lux module/0 [@any @bit @nat @int @rev @frac @text] [bit/0 nat/0 int/0 rev/0 frac/0 text/0] $parameter/0) + )) + (_.cover [/.invalid] + (`` (and (~~ (template [<syntax>] + [(|> (do phase.monad + [_ (|> <syntax> + (/.phase ..expander archive.empty) + (//type.expecting .Any))] + (in false)) + //scope.with + (//module.with 0 module/0) + (phase#each (|>> product.right product.right)) + (phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.invalid))))] + + [(` ({#0} (~ (code.bit bit/0))))] + [(` ({#0 [] #1} (~ (code.bit bit/0))))] + [(` {(~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0))})] + [(` {(~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0))})] + [(` {(~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0))})] + [(` {(~ (code.rev rev/0)) (~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0))})] + [(` {(~ (code.frac frac/0)) (~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0))})] + [(` {(~ (code.text text/0)) (~ (code.bit bit/0)) (~ (code.nat nat/0)) (~ (code.int int/0)) (~ (code.rev rev/0)) (~ (code.frac frac/0))})] + )) + ))) + + /simple.test + /complex.test + /reference.test + /function.test + /case.test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux index c7272d0cc..42c064bbc 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/case.lux @@ -66,79 +66,79 @@ $binding/0 (# ! each code.local (random.ascii/lower 3)) $binding/1 (# ! each code.local (random.ascii/lower 4)) $binding/2 (# ! each code.local (random.ascii/lower 5))] - ($_ _.and - (_.cover [/.tuple] - (let [tuple? (is (-> Type Type Bit) - (function (_ :input: :expected:) - (and (|> :input: - /.tuple - (check.result check.fresh_context) - (try#each (|>> product.right (type#= :expected:))) - (try.else false)) - (|> (do check.monad - [[@var :var:] check.var - _ (check.check :var: :input:)] - (/.tuple :var:)) - (check.result check.fresh_context) - (try#each (|>> product.right (type#= :expected:))) - (try.else false)))))] - (and (tuple? input/0 - (type.anonymous input/0)) - (tuple? (Tuple input/0 input/1 input/2) - (Tuple input/0 input/1 input/2)) - (tuple? {.#Named name/0 (Tuple input/0 input/1 input/2)} - (Tuple input/0 input/1 input/2)) - (tuple? (All (_ a b c) (Tuple input/0 input/1 input/2)) - (Tuple (All (_ a b c) input/0) - (All (_ a b c) input/1) - (All (_ a b c) input/2))) - (tuple? (type ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2)) - (Tuple input/0 input/1 input/2)) - (|> (do check.monad - [[@var :var:] check.var - _ (check.bind (All (_ a b c) (Tuple a b c)) @var)] - (/.tuple (type (:var: input/0 input/1 input/2)))) - (check.result check.fresh_context) - (try#each (|>> product.right (type#= (Tuple input/0 input/1 input/2)))) - (try.else false)) - (|> (do check.monad - [[@0 :0:] check.existential - [@1 :1:] check.existential - [_ :tuple:] (/.tuple (Ex (_ a b c) (Tuple a input/1 c))) - context check.context - _ (check.with context) - _ (check.check (Tuple :0: input/1 :1:) :tuple:) - _ (check.with context) - _ (check.check :tuple: (Tuple :0: input/1 :1:))] - (in true)) - (check.result check.fresh_context) - (try.else false))))) - (_.cover [/.non_tuple] - (and (|> (do check.monad - [[@var :var:] check.var - _ (/.tuple :var:)] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) - (|> (do check.monad - [[@var :var:] check.var - _ (/.tuple (type (:var: input/0 input/1 input/2)))] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) - (|> (do check.monad - [_ (/.tuple (type (input/0 input/1 input/2)))] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) - (|> (do check.monad - [[@var :var:] check.var - _ (check.bind input/0 @var) - _ (/.tuple (type (:var: input/1 input/2)))] - (in false)) - (check.result check.fresh_context) - (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))))) - ))) + (all _.and + (_.cover [/.tuple] + (let [tuple? (is (-> Type Type Bit) + (function (_ :input: :expected:) + (and (|> :input: + /.tuple + (check.result check.fresh_context) + (try#each (|>> product.right (type#= :expected:))) + (try.else false)) + (|> (do check.monad + [[@var :var:] check.var + _ (check.check :var: :input:)] + (/.tuple :var:)) + (check.result check.fresh_context) + (try#each (|>> product.right (type#= :expected:))) + (try.else false)))))] + (and (tuple? input/0 + (type.anonymous input/0)) + (tuple? (Tuple input/0 input/1 input/2) + (Tuple input/0 input/1 input/2)) + (tuple? {.#Named name/0 (Tuple input/0 input/1 input/2)} + (Tuple input/0 input/1 input/2)) + (tuple? (All (_ a b c) (Tuple input/0 input/1 input/2)) + (Tuple (All (_ a b c) input/0) + (All (_ a b c) input/1) + (All (_ a b c) input/2))) + (tuple? (type ((All (_ a b c) (Tuple a b c)) input/0 input/1 input/2)) + (Tuple input/0 input/1 input/2)) + (|> (do check.monad + [[@var :var:] check.var + _ (check.bind (All (_ a b c) (Tuple a b c)) @var)] + (/.tuple (type (:var: input/0 input/1 input/2)))) + (check.result check.fresh_context) + (try#each (|>> product.right (type#= (Tuple input/0 input/1 input/2)))) + (try.else false)) + (|> (do check.monad + [[@0 :0:] check.existential + [@1 :1:] check.existential + [_ :tuple:] (/.tuple (Ex (_ a b c) (Tuple a input/1 c))) + context check.context + _ (check.with context) + _ (check.check (Tuple :0: input/1 :1:) :tuple:) + _ (check.with context) + _ (check.check :tuple: (Tuple :0: input/1 :1:))] + (in true)) + (check.result check.fresh_context) + (try.else false))))) + (_.cover [/.non_tuple] + (and (|> (do check.monad + [[@var :var:] check.var + _ (/.tuple :var:)] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) + (|> (do check.monad + [[@var :var:] check.var + _ (/.tuple (type (:var: input/0 input/1 input/2)))] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) + (|> (do check.monad + [_ (/.tuple (type (input/0 input/1 input/2)))] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))) + (|> (do check.monad + [[@var :var:] check.var + _ (check.bind input/0 @var) + _ (/.tuple (type (:var: input/1 input/2)))] + (in false)) + (check.result check.fresh_context) + (exception.otherwise (text.contains? (the exception.#label /.non_tuple)))))) + ))) (def: (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) (-> Lux Symbol [Type Code] [Type Code] [Type Code] [Code Code Code] [Type Code] [Type Code] [Bit Nat] Bit) @@ -514,122 +514,122 @@ extension/0 (# ! each code.text (random.ascii/lower 6)) bit/0 random.bit nat/0 random.nat] - ($_ _.and - (_.cover [/.case] - (and (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) - (test|redundancy lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/1] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [bit/0]) - (test|variant lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) - (test|record lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]))) - (_.cover [/.empty_branches] - (|> (do //phase.monad - [analysis (|> (/.case ..analysis (list) archive.empty simple/0) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.empty_branches))))) - (_.cover [/.non_exhaustive] - (let [non_exhaustive? (is (-> (List [Code Code]) Bit) - (function (_ branches) - (|> (do //phase.monad - [analysis (|> (/.case ..analysis branches archive.empty simple/0) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.non_exhaustive))))))] - (and (non_exhaustive? (list [simple/0 body/0])) - (not (non_exhaustive? (list [simple/0 body/0] - [$binding/0 body/0])))))) - (_.cover [/.invalid] - (let [invalid? (is (-> (List [Code Code]) Bit) - (function (_ branches) - (|> (do //phase.monad - [analysis (|> (/.case ..analysis branches archive.empty simple/0) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.invalid))))))] - (and (invalid? (list [(` ((~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2))) - body/0])) - (invalid? (list [(` {(~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2)}) - body/0])) - (invalid? (list [(` {[] (~ $binding/0) (~ $binding/1) (~ $binding/2)}) - body/0]))))) - (_.cover [/.sum_has_no_case] - (let [tag/0 (%.code $binding/0) - tag/1 (%.code $binding/1) - tag/2 (%.code $binding/2) - - tags/* (list tag/0 tag/1 tag/2) - :variant: {.#Named [module/0 name/0] (type.variant (list input/0 input/1 input/2))} - - tag/0 (code.symbol [module/0 tag/0]) - tag/1 (code.symbol [module/0 tag/1]) - tag/2 (code.symbol [module/0 tag/2])] - (|> (do //phase.monad - [_ (//module.declare_labels false tags/* false :variant:) - analysis (|> (` {(~ tag/0) (~ simple/0)}) - (/.case ..analysis - (list [(` {0 #0 (~ $binding/0)}) body/0] - [(` {1 #0 (~ $binding/1)}) body/0] - [(` {2 #0 (~ $binding/2)}) body/0] - [(` {2 #1 (~ $binding/2)}) body/0]) - archive.empty) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.sum_has_no_case)))))) - (_.cover [/.mismatch] - (let [slot/0 (%.code $binding/0) - slot/1 (%.code $binding/1) - slot/2 (%.code $binding/2) - - slots/* (list slot/0 slot/1 slot/2) - :record: {.#Named [module/0 name/0] (type.tuple (list input/0 input/1 input/2))} - - slot/0 (code.symbol [module/0 slot/0]) - slot/1 (code.symbol [module/0 slot/1]) - slot/2 (code.symbol [module/0 slot/2])] - (and (|> (do //phase.monad - [analysis (|> (` (~ simple/0)) - (/.case ..analysis - (list [(` {0 #0 (~ $binding/0)}) body/0] - [(` {1 #0 (~ $binding/1)}) body/0] - [(` {1 #1 (~ $binding/2)}) body/0]) - archive.empty) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.mismatch)))) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/* false :record:) - analysis (|> (` (~ simple/0)) - (/.case ..analysis - (list [(` [(~ slot/0) (~ $binding/0) - (~ slot/1) (~ $binding/1) - (~ slot/2) (~ $binding/2)]) body/0]) - archive.empty) - (//type.expecting output/0))] - (in false)) - //scope.with - (//module.with 0 module/0) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.mismatch))))))) - - ..test|tuple - )))) + (all _.and + (_.cover [/.case] + (and (test|case lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) + (test|redundancy lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/1] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [bit/0]) + (test|variant lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]) + (test|record lux [module/0 name/0] [input/0 simple/0] [input/1 simple/1] [input/2 simple/2] [$binding/0 $binding/1 $binding/2] [output/0 body/0] [output/1 body/1] [bit/0 nat/0]))) + (_.cover [/.empty_branches] + (|> (do //phase.monad + [analysis (|> (/.case ..analysis (list) archive.empty simple/0) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.empty_branches))))) + (_.cover [/.non_exhaustive] + (let [non_exhaustive? (is (-> (List [Code Code]) Bit) + (function (_ branches) + (|> (do //phase.monad + [analysis (|> (/.case ..analysis branches archive.empty simple/0) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.non_exhaustive))))))] + (and (non_exhaustive? (list [simple/0 body/0])) + (not (non_exhaustive? (list [simple/0 body/0] + [$binding/0 body/0])))))) + (_.cover [/.invalid] + (let [invalid? (is (-> (List [Code Code]) Bit) + (function (_ branches) + (|> (do //phase.monad + [analysis (|> (/.case ..analysis branches archive.empty simple/0) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.invalid))))))] + (and (invalid? (list [(` ((~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2))) + body/0])) + (invalid? (list [(` {(~ extension/0) (~ $binding/0) (~ $binding/1) (~ $binding/2)}) + body/0])) + (invalid? (list [(` {[] (~ $binding/0) (~ $binding/1) (~ $binding/2)}) + body/0]))))) + (_.cover [/.sum_has_no_case] + (let [tag/0 (%.code $binding/0) + tag/1 (%.code $binding/1) + tag/2 (%.code $binding/2) + + tags/* (list tag/0 tag/1 tag/2) + :variant: {.#Named [module/0 name/0] (type.variant (list input/0 input/1 input/2))} + + tag/0 (code.symbol [module/0 tag/0]) + tag/1 (code.symbol [module/0 tag/1]) + tag/2 (code.symbol [module/0 tag/2])] + (|> (do //phase.monad + [_ (//module.declare_labels false tags/* false :variant:) + analysis (|> (` {(~ tag/0) (~ simple/0)}) + (/.case ..analysis + (list [(` {0 #0 (~ $binding/0)}) body/0] + [(` {1 #0 (~ $binding/1)}) body/0] + [(` {2 #0 (~ $binding/2)}) body/0] + [(` {2 #1 (~ $binding/2)}) body/0]) + archive.empty) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.sum_has_no_case)))))) + (_.cover [/.mismatch] + (let [slot/0 (%.code $binding/0) + slot/1 (%.code $binding/1) + slot/2 (%.code $binding/2) + + slots/* (list slot/0 slot/1 slot/2) + :record: {.#Named [module/0 name/0] (type.tuple (list input/0 input/1 input/2))} + + slot/0 (code.symbol [module/0 slot/0]) + slot/1 (code.symbol [module/0 slot/1]) + slot/2 (code.symbol [module/0 slot/2])] + (and (|> (do //phase.monad + [analysis (|> (` (~ simple/0)) + (/.case ..analysis + (list [(` {0 #0 (~ $binding/0)}) body/0] + [(` {1 #0 (~ $binding/1)}) body/0] + [(` {1 #1 (~ $binding/2)}) body/0]) + archive.empty) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.mismatch)))) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/* false :record:) + analysis (|> (` (~ simple/0)) + (/.case ..analysis + (list [(` [(~ slot/0) (~ $binding/0) + (~ slot/1) (~ $binding/1) + (~ slot/2) (~ $binding/2)]) body/0]) + archive.empty) + (//type.expecting output/0))] + (in false)) + //scope.with + (//module.with 0 module/0) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.mismatch))))))) + + ..test|tuple + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux index 7750db2ed..44fdae7eb 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/complex.lux @@ -89,18 +89,18 @@ (def: simple_parameter (Random [Type Code]) - (`` ($_ random.either - (~~ (template [<type> <random> <code>] - [(random#each (|>> <code> [<type>]) <random>)] - - [.Bit random.bit code.bit] - [.Nat random.nat code.nat] - [.Int random.int code.int] - [.Rev random.rev code.rev] - [.Frac (random.only (|>> f.not_a_number? not) random.frac) code.frac] - [.Text (random.ascii/lower 1) code.text] - )) - ))) + (`` (all random.either + (~~ (template [<type> <random> <code>] + [(random#each (|>> <code> [<type>]) <random>)] + + [.Bit random.bit code.bit] + [.Nat random.nat code.nat] + [.Int random.int code.int] + [.Rev random.rev code.rev] + [.Frac (random.only (|>> f.not_a_number? not) random.frac) code.frac] + [.Text (random.ascii/lower 1) code.text] + )) + ))) (def: (analysed? expected actual) (-> Code Analysis Bit) @@ -141,75 +141,75 @@ [tagT tagC] (|> types/*,terms/* (list.item tag) (maybe.else [Any (' [])]))]] - ($_ _.and - (_.cover [/.sum] - (let [variantT (type.variant (list#each product.left types/*,terms/*)) - sum? (is (-> Type Nat Bit Code Bit) - (function (_ type lefts right? code) - (|> (do //phase.monad - [analysis (|> (/.sum ..analysis lefts right? archive.empty code) - (//type.expecting type))] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' analysis])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? code analysis)) - - _ - false))) - (//module.with 0 (product.left name)) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (sum? variantT lefts right? tagC) - (sum? {.#Named name variantT} lefts right? tagC) - (|> (do //phase.monad - [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT variantT)) - analysis (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting varT))] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' it])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? tagC it)) - - _ - false))) - (//module.with 0 (product.left name)) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (and (sum? (type (Maybe tagT)) 0 #0 (` [])) - (sum? (type (Maybe tagT)) 0 #1 tagC)) - (and (sum? (type (All (_ a) (Maybe a))) 0 #0 (` [])) - (not (sum? (type (All (_ a) (Maybe a))) 0 #1 tagC))) - (and (sum? (type (Ex (_ a) (Maybe a))) 0 #0 (` [])) - (sum? (type (Ex (_ a) (Maybe a))) 0 #1 tagC))))) - (_.for [/.cannot_analyse_variant] - (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) - (function (_ exception analysis) - (let [it (//phase.result state analysis)] - (and (..failure? /.cannot_analyse_variant it) - (..failure? exception it)))))] - ($_ _.and - (_.cover [/.invalid_variant_type] - (and (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting tagT) - (failure? /.invalid_variant_type)) + (all _.and + (_.cover [/.sum] + (let [variantT (type.variant (list#each product.left types/*,terms/*)) + sum? (is (-> Type Nat Bit Code Bit) + (function (_ type lefts right? code) (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting (type (varT tagT))))) - (failure? /.invalid_variant_type)))) - (_.cover [/.cannot_infer_sum] - (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> (/.sum ..analysis lefts right? archive.empty tagC) - (//type.expecting varT))) - (failure? /.cannot_infer_sum))) - ))) - ))) + [analysis (|> (/.sum ..analysis lefts right? archive.empty code) + (//type.expecting type))] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' analysis])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? code analysis)) + + _ + false))) + (//module.with 0 (product.left name)) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (sum? variantT lefts right? tagC) + (sum? {.#Named name variantT} lefts right? tagC) + (|> (do //phase.monad + [[@var varT] (//type.check check.var) + _ (//type.check (check.check varT variantT)) + analysis (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting varT))] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' it])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? tagC it)) + + _ + false))) + (//module.with 0 (product.left name)) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (and (sum? (type (Maybe tagT)) 0 #0 (` [])) + (sum? (type (Maybe tagT)) 0 #1 tagC)) + (and (sum? (type (All (_ a) (Maybe a))) 0 #0 (` [])) + (not (sum? (type (All (_ a) (Maybe a))) 0 #1 tagC))) + (and (sum? (type (Ex (_ a) (Maybe a))) 0 #0 (` [])) + (sum? (type (Ex (_ a) (Maybe a))) 0 #1 tagC))))) + (_.for [/.cannot_analyse_variant] + (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) + (function (_ exception analysis) + (let [it (//phase.result state analysis)] + (and (..failure? /.cannot_analyse_variant it) + (..failure? exception it)))))] + (all _.and + (_.cover [/.invalid_variant_type] + (and (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting tagT) + (failure? /.invalid_variant_type)) + (|> (do //phase.monad + [[@var varT] (//type.check check.var)] + (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting (type (varT tagT))))) + (failure? /.invalid_variant_type)))) + (_.cover [/.cannot_infer_sum] + (|> (do //phase.monad + [[@var varT] (//type.check check.var)] + (|> (/.sum ..analysis lefts right? archive.empty tagC) + (//type.expecting varT))) + (failure? /.cannot_infer_sum))) + ))) + ))) (def: test|variant (do [! random.monad] @@ -233,53 +233,53 @@ tag (|> tags (list.item tag) (maybe.else ""))]] - ($_ _.and - (_.cover [/.variant] - (let [expected_variant? (is (-> Symbol Bit) - (function (_ tag) - (|> (do //phase.monad - [_ (//module.declare_labels false tags false variantT) - analysis (|> (/.variant ..analysis tag archive.empty tagC) - (//type.expecting variantT))] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' analysis])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? tagC analysis)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)))) - inferred_variant? (is (-> Symbol Bit) - (function (_ tag) - (|> (do //phase.monad - [_ (//module.declare_labels false tags false variantT) - [actualT analysis] (|> (/.variant ..analysis tag archive.empty tagC) - //type.inferring)] - (in (case analysis - (pattern (//analysis.variant [lefts' right?' analysis])) - (and (n.= lefts lefts') - (bit#= right? right?') - (..analysed? tagC analysis) - (type#= variantT actualT)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (expected_variant? [module tag]) - (expected_variant? ["" tag]) - (inferred_variant? [module tag]) - (inferred_variant? ["" tag]) - - ... TODO: Test what happens when tags are shadowed by local bindings. - ))) - ))) + (all _.and + (_.cover [/.variant] + (let [expected_variant? (is (-> Symbol Bit) + (function (_ tag) + (|> (do //phase.monad + [_ (//module.declare_labels false tags false variantT) + analysis (|> (/.variant ..analysis tag archive.empty tagC) + (//type.expecting variantT))] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' analysis])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? tagC analysis)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)))) + inferred_variant? (is (-> Symbol Bit) + (function (_ tag) + (|> (do //phase.monad + [_ (//module.declare_labels false tags false variantT) + [actualT analysis] (|> (/.variant ..analysis tag archive.empty tagC) + //type.inferring)] + (in (case analysis + (pattern (//analysis.variant [lefts' right?' analysis])) + (and (n.= lefts lefts') + (bit#= right? right?') + (..analysed? tagC analysis) + (type#= variantT actualT)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (expected_variant? [module tag]) + (expected_variant? ["" tag]) + (inferred_variant? [module tag]) + (inferred_variant? ["" tag]) + + ... TODO: Test what happens when tags are shadowed by local bindings. + ))) + ))) (type: (Triple a) [a a a]) @@ -298,135 +298,135 @@ .let [module (product.left name) productT (type.tuple (list#each product.left types/*,terms/*)) expected (list#each product.right types/*,terms/*)]] - ($_ _.and - (_.cover [/.product] - (let [product? (is (-> Type (List Code) Bit) - (function (_ type expected) - (|> (do //phase.monad - [analysis (|> expected + (all _.and + (_.cover [/.product] + (let [product? (is (-> Type (List Code) Bit) + (function (_ type expected) + (|> (do //phase.monad + [analysis (|> expected + (/.product ..analysis archive.empty) + (//type.expecting type))] + (in (case analysis + (pattern (//analysis.tuple actual)) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (..analysed? expected actual)) + (list.zipped_2 expected actual))) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (product? productT expected) + (product? {.#Named name productT} expected) + (product? (type (Ex (_ a) [a a])) (list term/0 term/0)) + (not (product? (type (All (_ a) [a a])) (list term/0 term/0))) + (product? (type (Triple type/0)) (list term/0 term/0 term/0)) + (|> (do //phase.monad + [[@var varT] (//type.check check.var) + _ (//type.check (check.check varT productT)) + analysis (|> expected + (/.product ..analysis archive.empty) + (//type.expecting varT))] + (in (case analysis + (pattern (//analysis.tuple actual)) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (..analysed? expected actual)) + (list.zipped_2 expected actual))) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (|> (do //phase.monad + [[:inferred: analysis] (|> expected (/.product ..analysis archive.empty) - (//type.expecting type))] - (in (case analysis - (pattern (//analysis.tuple actual)) - (and (n.= (list.size expected) - (list.size actual)) - (list.every? (function (_ [expected actual]) - (..analysed? expected actual)) - (list.zipped_2 expected actual))) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (product? productT expected) - (product? {.#Named name productT} expected) - (product? (type (Ex (_ a) [a a])) (list term/0 term/0)) - (not (product? (type (All (_ a) [a a])) (list term/0 term/0))) - (product? (type (Triple type/0)) (list term/0 term/0 term/0)) - (|> (do //phase.monad - [[@var varT] (//type.check check.var) - _ (//type.check (check.check varT productT)) - analysis (|> expected - (/.product ..analysis archive.empty) - (//type.expecting varT))] - (in (case analysis - (pattern (//analysis.tuple actual)) - (and (n.= (list.size expected) - (list.size actual)) - (list.every? (function (_ [expected actual]) - (..analysed? expected actual)) - (list.zipped_2 expected actual))) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (|> (do //phase.monad - [[:inferred: analysis] (|> expected - (/.product ..analysis archive.empty) - //type.inferring)] - (in (case analysis - (pattern (//analysis.tuple actual)) - (and (n.= (list.size expected) - (list.size actual)) - (list.every? (function (_ [expected actual]) - (..analysed? expected actual)) - (list.zipped_2 expected actual)) - (type#= productT :inferred:)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (|> (do [! //phase.monad] - [[@var varT] (//type.check check.var) - [:inferred: analysis] (//type.inferring - (do ! - [_ (//type.inference (Tuple type/0 type/1 varT))] - (/.product ..analysis archive.empty - (list term/0 term/1 term/2 term/2 term/2)))) - :inferred: (//type.check (check.clean (list @var) :inferred:))] - (in (case analysis - (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) - (and (type#= (Tuple type/0 type/1 type/2 type/2 type/2) - :inferred:) - (..analysed? term/0 analysis/0) - (..analysed? term/1 analysis/1) - (..analysed? term/2 analysis/2) - (..analysed? term/2 analysis/3) - (..analysed? term/2 analysis/4)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - (|> (do [! //phase.monad] - [analysis (|> (list term/0 term/1 (code.tuple (list term/2 term/2 term/2))) - (/.product ..analysis archive.empty) - (//type.expecting (Tuple type/0 type/1 type/2 type/2 type/2)))] - (in (case analysis - (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) - (and (..analysed? term/0 analysis/0) - (..analysed? term/1 analysis/1) - (..analysed? term/2 analysis/2) - (..analysed? term/2 analysis/3) - (..analysed? term/2 analysis/4)) - - _ - false))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (try.else false))))) - (_.for [/.cannot_analyse_tuple] - (_.cover [/.invalid_tuple_type] - (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) - (function (_ exception operation) - (let [it (//phase.result state operation)] - (and (..failure? /.cannot_analyse_tuple it) - (..failure? exception it)))))] - (and (|> expected - (/.product ..analysis archive.empty) - (//type.expecting (|> types/*,terms/* - list.head - (maybe#each product.left) - (maybe.else .Any))) - (failure? /.invalid_tuple_type)) - (|> (do //phase.monad - [[@var varT] (//type.check check.var)] - (|> expected - (/.product ..analysis archive.empty) - (//type.expecting (type (varT type/0))))) - (failure? /.invalid_tuple_type)))))) - ))) + //type.inferring)] + (in (case analysis + (pattern (//analysis.tuple actual)) + (and (n.= (list.size expected) + (list.size actual)) + (list.every? (function (_ [expected actual]) + (..analysed? expected actual)) + (list.zipped_2 expected actual)) + (type#= productT :inferred:)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (|> (do [! //phase.monad] + [[@var varT] (//type.check check.var) + [:inferred: analysis] (//type.inferring + (do ! + [_ (//type.inference (Tuple type/0 type/1 varT))] + (/.product ..analysis archive.empty + (list term/0 term/1 term/2 term/2 term/2)))) + :inferred: (//type.check (check.clean (list @var) :inferred:))] + (in (case analysis + (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) + (and (type#= (Tuple type/0 type/1 type/2 type/2 type/2) + :inferred:) + (..analysed? term/0 analysis/0) + (..analysed? term/1 analysis/1) + (..analysed? term/2 analysis/2) + (..analysed? term/2 analysis/3) + (..analysed? term/2 analysis/4)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + (|> (do [! //phase.monad] + [analysis (|> (list term/0 term/1 (code.tuple (list term/2 term/2 term/2))) + (/.product ..analysis archive.empty) + (//type.expecting (Tuple type/0 type/1 type/2 type/2 type/2)))] + (in (case analysis + (pattern (//analysis.tuple (list analysis/0 analysis/1 (//analysis.tuple (list analysis/2 analysis/3 analysis/4))))) + (and (..analysed? term/0 analysis/0) + (..analysed? term/1 analysis/1) + (..analysed? term/2 analysis/2) + (..analysed? term/2 analysis/3) + (..analysed? term/2 analysis/4)) + + _ + false))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (try.else false))))) + (_.for [/.cannot_analyse_tuple] + (_.cover [/.invalid_tuple_type] + (let [failure? (is (All (_ a) (-> (Exception a) (//analysis.Operation Any) Bit)) + (function (_ exception operation) + (let [it (//phase.result state operation)] + (and (..failure? /.cannot_analyse_tuple it) + (..failure? exception it)))))] + (and (|> expected + (/.product ..analysis archive.empty) + (//type.expecting (|> types/*,terms/* + list.head + (maybe#each product.left) + (maybe.else .Any))) + (failure? /.invalid_tuple_type)) + (|> (do //phase.monad + [[@var varT] (//type.check check.var)] + (|> expected + (/.product ..analysis archive.empty) + (//type.expecting (type (varT type/0))))) + (failure? /.invalid_tuple_type)))))) + ))) (def: test|record (do [! random.monad] @@ -470,163 +470,163 @@ _ slots/0)]] - ($_ _.and - (_.cover [/.normal] - (let [normal? (is (-> (List [Symbol Code]) (List Code) Bit) - (function (_ expected input) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.normal false input)) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (pipe.case - {try.#Success {.#Some actual}} - (let [(open "list#[0]") (list.equivalence (product.equivalence symbol.equivalence code.equivalence))] - (list#= expected (list.reversed actual))) - - _ - false))))] - (and (normal? (list) (list)) - (normal? expected_record global_record) - (normal? expected_record local_record) - (|> (/.normal false tuple) - (//phase.result state) - (pipe.case - {try.#Success {.#None}} - true - - _ - false))))) - (_.cover [/.order] - (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) - global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) - ordered? (is (-> Bit (List [Symbol Code]) Bit) - (function (_ pattern_matching? input) + (all _.and + (_.cover [/.normal] + (let [normal? (is (-> (List [Symbol Code]) (List Code) Bit) + (function (_ expected input) (|> (do //phase.monad [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? input)) - //scope.with + (/.normal false input)) (//module.with 0 module) - (//phase#each (|>> product.right product.right)) + (//phase#each product.right) (//phase.result state) (pipe.case - {try.#Success {.#Some [actual_arity actual_tuple actual_type]}} - (and (n.= arity actual_arity) - (# code.equivalence = (code.tuple tuple) (code.tuple actual_tuple)) - (type#= :record: actual_type)) - + {try.#Success {.#Some actual}} + (let [(open "list#[0]") (list.equivalence (product.equivalence symbol.equivalence code.equivalence))] + (list#= expected (list.reversed actual))) + _ - false)))) - unit? (is (-> Bit Bit) - (function (_ pattern_matching?) - (|> (/.order false (list)) - (//phase.result state) - (pipe.case - (pattern {try.#Success {.#Some [0 (list) actual_type]}}) - (same? .Any actual_type) - - _ - false))))] - (and (ordered? false global_record) - (ordered? false (list.reversed global_record)) - (ordered? false local_record) - (ordered? false (list.reversed local_record)) - - (ordered? true global_record) - (ordered? true (list.reversed global_record)) - (not (ordered? true local_record)) - (not (ordered? true (list.reversed local_record))) - - (unit? false) - (unit? true) - - ... TODO: Test what happens when slots are shadowed by local bindings. - ))) - (_.cover [/.cannot_repeat_slot] - (let [repeated? (is (-> Bit Bit) - (function (_ pattern_matching?) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? (list.repeated arity [[module head_slot/0] head_term/0]))) - (//module.with 0 module) - (//phase#each product.right) - (//phase.result state) - (..failure? /.cannot_repeat_slot))))] - (and (repeated? false) - (repeated? true)))) - (_.cover [/.record_size_mismatch] - (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) - global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) - mismatched? (is (-> Bit (List [Symbol Code]) Bit) - (function (_ pattern_matching? input) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:)] - (/.order pattern_matching? input)) - //scope.with - (//module.with 0 module) - (//phase.result state) - (..failure? /.record_size_mismatch))))] - (and (mismatched? false (list.first slice local_record)) - (mismatched? false (list#composite local_record (list.first slice local_record))) - - (mismatched? false (list.first slice global_record)) - (mismatched? true (list.first slice global_record)) - (mismatched? false (list#composite global_record (list.first slice global_record))) - (mismatched? true (list#composite global_record (list.first slice global_record)))))) - (_.cover [/.slot_does_not_belong_to_record] - (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/01) tuple) - global_record (list.zipped_2 (list#each (|>> [module]) slots/01) tuple) - mismatched? (is (-> Bit (List [Symbol Code]) Bit) - (function (_ pattern_matching? input) - (|> (do //phase.monad - [_ (//module.declare_labels true slots/0 false :record:) - _ (//module.declare_labels true slots/1 false :record:)] - (/.order pattern_matching? input)) - //scope.with - (//module.with 0 module) - (//phase.result state) - (..failure? /.slot_does_not_belong_to_record))))] - (and (mismatched? false local_record) - - (mismatched? false global_record) - (mismatched? true global_record)))) - (_.cover [/.record] - (let [record? (is (-> Type (List Text) (List Code) Code Bit) - (function (_ type slots tuple expected) - (|> (do //phase.monad - [_ (//module.declare_labels true slots false type)] - (/.record ..analysis archive.empty tuple)) - (//type.expecting type) - //scope.with - (//module.with 0 module) - (//phase#each (|>> product.right product.right)) - (//phase.result state) - (try#each (analysed? expected)) - (try.else false)))) - inferred? (is (-> (List Code) Bit) - (function (_ record) + false))))] + (and (normal? (list) (list)) + (normal? expected_record global_record) + (normal? expected_record local_record) + (|> (/.normal false tuple) + (//phase.result state) + (pipe.case + {try.#Success {.#None}} + true + + _ + false))))) + (_.cover [/.order] + (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) + global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) + ordered? (is (-> Bit (List [Symbol Code]) Bit) + (function (_ pattern_matching? input) (|> (do //phase.monad [_ (//module.declare_labels true slots/0 false :record:)] - (//type.inferring - (/.record ..analysis archive.empty record))) + (/.order pattern_matching? input)) //scope.with (//module.with 0 module) (//phase#each (|>> product.right product.right)) (//phase.result state) - (try#each (function (_ [actual_type actual_term]) - (and (same? :record: actual_type) - (analysed? (code.tuple tuple) actual_term)))) - (try.else false))))] - (and (record? {.#Named name .Any} (list) (list) (' [])) - (record? {.#Named name type/0} (list) (list term/0) term/0) - (record? {.#Named name type/0} (list slot/0) (list term/0) term/0) - (record? :record: slots/0 tuple (code.tuple tuple)) - (record? :record: slots/0 local_record (code.tuple tuple)) - (record? :record: slots/0 global_record (code.tuple tuple)) - (inferred? local_record) - (inferred? global_record)))) - ))) + (pipe.case + {try.#Success {.#Some [actual_arity actual_tuple actual_type]}} + (and (n.= arity actual_arity) + (# code.equivalence = (code.tuple tuple) (code.tuple actual_tuple)) + (type#= :record: actual_type)) + + _ + false)))) + unit? (is (-> Bit Bit) + (function (_ pattern_matching?) + (|> (/.order false (list)) + (//phase.result state) + (pipe.case + (pattern {try.#Success {.#Some [0 (list) actual_type]}}) + (same? .Any actual_type) + + _ + false))))] + (and (ordered? false global_record) + (ordered? false (list.reversed global_record)) + (ordered? false local_record) + (ordered? false (list.reversed local_record)) + + (ordered? true global_record) + (ordered? true (list.reversed global_record)) + (not (ordered? true local_record)) + (not (ordered? true (list.reversed local_record))) + + (unit? false) + (unit? true) + + ... TODO: Test what happens when slots are shadowed by local bindings. + ))) + (_.cover [/.cannot_repeat_slot] + (let [repeated? (is (-> Bit Bit) + (function (_ pattern_matching?) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:)] + (/.order pattern_matching? (list.repeated arity [[module head_slot/0] head_term/0]))) + (//module.with 0 module) + (//phase#each product.right) + (//phase.result state) + (..failure? /.cannot_repeat_slot))))] + (and (repeated? false) + (repeated? true)))) + (_.cover [/.record_size_mismatch] + (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/0) tuple) + global_record (list.zipped_2 (list#each (|>> [module]) slots/0) tuple) + mismatched? (is (-> Bit (List [Symbol Code]) Bit) + (function (_ pattern_matching? input) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:)] + (/.order pattern_matching? input)) + //scope.with + (//module.with 0 module) + (//phase.result state) + (..failure? /.record_size_mismatch))))] + (and (mismatched? false (list.first slice local_record)) + (mismatched? false (list#composite local_record (list.first slice local_record))) + + (mismatched? false (list.first slice global_record)) + (mismatched? true (list.first slice global_record)) + (mismatched? false (list#composite global_record (list.first slice global_record))) + (mismatched? true (list#composite global_record (list.first slice global_record)))))) + (_.cover [/.slot_does_not_belong_to_record] + (let [local_record (list.zipped_2 (list#each (|>> [""]) slots/01) tuple) + global_record (list.zipped_2 (list#each (|>> [module]) slots/01) tuple) + mismatched? (is (-> Bit (List [Symbol Code]) Bit) + (function (_ pattern_matching? input) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:) + _ (//module.declare_labels true slots/1 false :record:)] + (/.order pattern_matching? input)) + //scope.with + (//module.with 0 module) + (//phase.result state) + (..failure? /.slot_does_not_belong_to_record))))] + (and (mismatched? false local_record) + + (mismatched? false global_record) + (mismatched? true global_record)))) + (_.cover [/.record] + (let [record? (is (-> Type (List Text) (List Code) Code Bit) + (function (_ type slots tuple expected) + (|> (do //phase.monad + [_ (//module.declare_labels true slots false type)] + (/.record ..analysis archive.empty tuple)) + (//type.expecting type) + //scope.with + (//module.with 0 module) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try#each (analysed? expected)) + (try.else false)))) + inferred? (is (-> (List Code) Bit) + (function (_ record) + (|> (do //phase.monad + [_ (//module.declare_labels true slots/0 false :record:)] + (//type.inferring + (/.record ..analysis archive.empty record))) + //scope.with + (//module.with 0 module) + (//phase#each (|>> product.right product.right)) + (//phase.result state) + (try#each (function (_ [actual_type actual_term]) + (and (same? :record: actual_type) + (analysed? (code.tuple tuple) actual_term)))) + (try.else false))))] + (and (record? {.#Named name .Any} (list) (list) (' [])) + (record? {.#Named name type/0} (list) (list term/0) term/0) + (record? {.#Named name type/0} (list slot/0) (list term/0) term/0) + (record? :record: slots/0 tuple (code.tuple tuple)) + (record? :record: slots/0 local_record (code.tuple tuple)) + (record? :record: slots/0 global_record (code.tuple tuple)) + (inferred? local_record) + (inferred? global_record)))) + ))) (def: .public test (<| (_.covering /._) @@ -640,20 +640,20 @@ [type/1 term/1] ..simple_parameter tag (# ! each (n.% arity) random.nat) .let [[lefts right?] (//complex.choice arity tag)]] - ($_ _.and - ..test|sum - ..test|variant - ..test|product - ..test|record - (_.cover [/.not_a_quantified_type] - (and (|> (/.sum ..analysis lefts right? archive.empty term/0) - (//type.expecting (type (type/0 type/1))) - (//phase.result state) - (..failure? /.not_a_quantified_type)) - (|> types/*,terms/* - (list#each product.right) - (/.product ..analysis archive.empty) - (//type.expecting (type (type/0 type/1))) - (//phase.result state) - (..failure? /.not_a_quantified_type)))) - )))) + (all _.and + ..test|sum + ..test|variant + ..test|product + ..test|record + (_.cover [/.not_a_quantified_type] + (and (|> (/.sum ..analysis lefts right? archive.empty term/0) + (//type.expecting (type (type/0 type/1))) + (//phase.result state) + (..failure? /.not_a_quantified_type)) + (|> types/*,terms/* + (list#each product.right) + (/.product ..analysis archive.empty) + (//type.expecting (type (type/0 type/1))) + (//phase.result state) + (..failure? /.not_a_quantified_type)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index 6cc3bce45..1e52a34bf 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -80,118 +80,118 @@ $function/1 (code.local function/1) $argument/0 (code.local argument/0) $argument/1 (code.local argument/1)]] - ($_ _.and - (_.cover [/.function] - (let [function?' (is (-> Type Code (-> [(List Analysis) Analysis] Bit) Bit) - (function (_ function_type output_term ?) - (|> (do //phase.monad - [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - output_term) - (//type.expecting function_type))] - (in (case analysis - {//analysis.#Function it} - (? it) + (all _.and + (_.cover [/.function] + (let [function?' (is (-> Type Code (-> [(List Analysis) Analysis] Bit) Bit) + (function (_ function_type output_term ?) + (|> (do //phase.monad + [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + output_term) + (//type.expecting function_type))] + (in (case analysis + {//analysis.#Function it} + (? it) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false)))) - function? (is (-> Type Code Bit) - (function (_ function_type output_term) - (function?' function_type output_term (function.constant true)))) - inferring? (is (-> Type Code Bit) - (function (_ :expected: term) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty - term) - //type.inferring)] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - (type#= :expected: :actual:) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false)))) + function? (is (-> Type Code Bit) + (function (_ function_type output_term) + (function?' function_type output_term (function.constant true)))) + inferring? (is (-> Type Code Bit) + (function (_ :expected: term) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.function ..analysis function/0 argument/0 archive.empty + term) + //type.inferring)] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + (type#= :expected: :actual:) - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (function? (-> input/0 output/0) term/0) - (function? (-> input/0 input/0) $argument/0) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (function? (-> input/0 output/0) term/0) + (function? (-> input/0 input/0) $argument/0) - (function? {.#Named name/0 (-> input/0 output/0)} term/0) - - (function? (All (_ a) (-> a a)) $argument/0) - (function? (Ex (_ a) (-> a a)) $argument/0) - (function? (Ex (_ a) (-> input/0 a)) term/0) - (function? (Ex (_ a) (-> a a)) term/0) - (function? (Rec self (-> input/0 self)) $function/0) + (function? {.#Named name/0 (-> input/0 output/0)} term/0) + + (function? (All (_ a) (-> a a)) $argument/0) + (function? (Ex (_ a) (-> a a)) $argument/0) + (function? (Ex (_ a) (-> input/0 a)) term/0) + (function? (Ex (_ a) (-> a a)) term/0) + (function? (Rec self (-> input/0 self)) $function/0) - (function? (type ((All (_ a) (-> a a)) output/0)) term/0) - (not (function? (type ((All (_ a) (-> a a)) output/1)) term/0)) + (function? (type ((All (_ a) (-> a a)) output/0)) term/0) + (not (function? (type ((All (_ a) (-> a a)) output/1)) term/0)) - (function? (type ((Ex (_ a) (-> a a)) output/0)) term/0) - (not (function? (type ((Ex (_ a) (-> a a)) output/1)) term/0)) + (function? (type ((Ex (_ a) (-> a a)) output/0)) term/0) + (not (function? (type ((Ex (_ a) (-> a a)) output/1)) term/0)) - (function?' (-> input/0 input/1 input/0) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/0))) - (function (_ [outer body]) - (and (list.empty? outer) - (case body - {//analysis.#Function [inner body]} - (n.= 1 (list.size inner)) + (function?' (-> input/0 input/1 input/0) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/0))) + (function (_ [outer body]) + (and (list.empty? outer) + (case body + {//analysis.#Function [inner body]} + (n.= 1 (list.size inner)) - _ - false)))) - (function?' (-> input/0 input/1 input/1) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/1))) - (function (_ [outer body]) - (and (list.empty? outer) - (case body - {//analysis.#Function [inner body]} - (n.= 0 (list.size inner)) + _ + false)))) + (function?' (-> input/0 input/1 input/1) (` ([(~ $function/1) (~ $argument/1)] (~ $argument/1))) + (function (_ [outer body]) + (and (list.empty? outer) + (case body + {//analysis.#Function [inner body]} + (n.= 0 (list.size inner)) - _ - false)))) + _ + false)))) - (|> (do //phase.monad - [[@var :var:] (//type.check check.var) - _ (//type.check (check.check :var: (-> input/0 output/0))) - analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - term/0) - (//type.expecting :var:))] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - true + (|> (do //phase.monad + [[@var :var:] (//type.check check.var) + _ (//type.check (check.check :var: (-> input/0 output/0))) + analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + term/0) + (//type.expecting :var:))] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + true - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false)) - - (inferring? (All (_ a) (-> a output/0)) term/0) - (inferring? (All (_ a) (-> a a)) $argument/0) - (inferring? (All (_ @0) (-> @0 @0 (And .Bit @0))) - (` ([(~ $function/1) (~ $argument/1)] - [("lux is" (~ $argument/0) (~ $argument/1)) - (~ $argument/1)])))))) - (_.cover [/.cannot_analyse] - (|> (do //phase.monad - [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty - term/1) - (//type.expecting (-> input/0 output/0)))] - (in (case analysis - {//analysis.#Function [actual_env actual_body]} - true + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false)) + + (inferring? (All (_ a) (-> a output/0)) term/0) + (inferring? (All (_ a) (-> a a)) $argument/0) + (inferring? (All (_ @0) (-> @0 @0 (And .Bit @0))) + (` ([(~ $function/1) (~ $argument/1)] + [("lux is" (~ $argument/0) (~ $argument/1)) + (~ $argument/1)])))))) + (_.cover [/.cannot_analyse] + (|> (do //phase.monad + [analysis (|> (/.function ..analysis function/0 argument/0 archive.empty + term/1) + (//type.expecting (-> input/0 output/0)))] + (in (case analysis + {//analysis.#Function [actual_env actual_body]} + true - _ - false))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.cannot_analyse))))) - ))) + _ + false))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.cannot_analyse))))) + ))) (def: test|apply Test @@ -204,55 +204,55 @@ $//inference.simple_parameter) output/0 ($type.random 0) module/0 (random.ascii/lower 1)] - ($_ _.and - (_.cover [/.apply] - (let [reification? (is (-> Type (List Code) Type Bit) - (function (_ :abstraction: terms :expected:) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.apply ..analysis terms - :abstraction: - (//analysis.unit) - archive.empty - (' [])) - //type.inferring)] - (in (and (check.subsumes? :expected: :actual:) - (case analysis - {//analysis.#Apply _} - true + (all _.and + (_.cover [/.apply] + (let [reification? (is (-> Type (List Code) Type Bit) + (function (_ :abstraction: terms :expected:) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.apply ..analysis terms + :abstraction: + (//analysis.unit) + archive.empty + (' [])) + //type.inferring)] + (in (and (check.subsumes? :expected: :actual:) + (case analysis + {//analysis.#Apply _} + true - _ - false)))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) - (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) - (reification? (All (_ a) (-> a a)) (list term/0) input/0) - (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) - (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) - (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) - (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) - (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) - (_.cover [/.cannot_apply] - (|> (do //phase.monad - [_ (|> (/.apply ..analysis (list term/1 term/0) - (-> input/0 input/1 output/0) - (//analysis.unit) - archive.empty - (' [])) - (//type.expecting output/0))] - (in false)) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.cannot_apply))))) - ))) + _ + false)))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) + (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) + (reification? (All (_ a) (-> a a)) (list term/0) input/0) + (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) + (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) + (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) + (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) + (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) + (_.cover [/.cannot_apply] + (|> (do //phase.monad + [_ (|> (/.apply ..analysis (list term/1 term/0) + (-> input/0 input/1 output/0) + (//analysis.unit) + archive.empty + (' [])) + (//type.expecting output/0))] + (in false)) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.cannot_apply))))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..test|function - ..test|apply - ))) + (all _.and + ..test|function + ..test|apply + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index 8240bcddc..f67b2431d 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -42,182 +42,182 @@ import (random.ascii/lower 3) expected_label (random.ascii/lower 4) record? random.bit] - ($_ _.and - (_.cover [/.reference] - (let [can_find_local_variable! - (|> (/.reference ["" expected_name]) - (//scope.with_local [expected_name expected_type]) - //type.inferring - //scope.with - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.local 0)]) - (type#= expected_type actual_type) + (all _.and + (_.cover [/.reference] + (let [can_find_local_variable! + (|> (/.reference ["" expected_name]) + (//scope.with_local [expected_name expected_type]) + //type.inferring + //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.local 0)]) + (type#= expected_type actual_type) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_foreign_variable! - (|> (/.reference ["" expected_name]) - //type.inferring - //scope.with - (//scope.with_local [expected_name expected_type]) - //scope.with - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (try#each (|>> product.right - product.right - (pipe.case - (pattern [actual_type (//analysis.foreign 0)]) - (type#= expected_type actual_type) + can_find_foreign_variable! + (|> (/.reference ["" expected_name]) + //type.inferring + //scope.with + (//scope.with_local [expected_name expected_type]) + //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (try#each (|>> product.right + product.right + (pipe.case + (pattern [actual_type (//analysis.foreign 0)]) + (type#= expected_type actual_type) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_local_definition! - (|> (do //phase.monad - [_ (//module.define expected_name {.#Definition [#0 expected_type []]})] - (/.reference ["" expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= expected_type actual_type) - (same? expected_module actual_module) - (same? expected_name actual_name)) + can_find_local_definition! + (|> (do //phase.monad + [_ (//module.define expected_name {.#Definition [#0 expected_type []]})] + (/.reference ["" expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= expected_type actual_type) + (same? expected_module actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_foreign_definition! - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name {.#Definition [#1 expected_type []]})) - _ (//module.import import)] - (/.reference [import expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= expected_type actual_type) - (same? import actual_module) - (same? expected_name actual_name)) + can_find_foreign_definition! + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name {.#Definition [#1 expected_type []]})) + _ (//module.import import)] + (/.reference [import expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= expected_type actual_type) + (same? import actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_alias! - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name {.#Definition [#1 expected_type []]})) - _ (//module.import import) - _ (//module.define expected_name {.#Alias [import expected_name]})] - (/.reference [expected_module expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= expected_type actual_type) - (same? import actual_module) - (same? expected_name actual_name)) + can_find_alias! + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name {.#Definition [#1 expected_type []]})) + _ (//module.import import) + _ (//module.define expected_name {.#Alias [import expected_name]})] + (/.reference [expected_module expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= expected_type actual_type) + (same? import actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false)) + _ + false))) + (try.else false)) - can_find_type! - (|> (do //phase.monad - [_ (//module.define expected_name {.#Type [#0 expected_type - (if record? - {.#Right [expected_label (list)]} - {.#Left [expected_label (list)]})]})] - (/.reference [expected_module expected_name])) - //type.inferring - (//module.with 0 expected_module) - (//phase.result state) - (try#each (|>> product.right - (pipe.case - (pattern [actual_type (//analysis.constant [actual_module actual_name])]) - (and (type#= .Type actual_type) - (same? expected_module actual_module) - (same? expected_name actual_name)) + can_find_type! + (|> (do //phase.monad + [_ (//module.define expected_name {.#Type [#0 expected_type + (if record? + {.#Right [expected_label (list)]} + {.#Left [expected_label (list)]})]})] + (/.reference [expected_module expected_name])) + //type.inferring + (//module.with 0 expected_module) + (//phase.result state) + (try#each (|>> product.right + (pipe.case + (pattern [actual_type (//analysis.constant [actual_module actual_name])]) + (and (type#= .Type actual_type) + (same? expected_module actual_module) + (same? expected_name actual_name)) - _ - false))) - (try.else false))] - (and can_find_local_variable! - can_find_foreign_variable! - - can_find_local_definition! - can_find_foreign_definition! + _ + false))) + (try.else false))] + (and can_find_local_variable! + can_find_foreign_variable! + + can_find_local_definition! + can_find_foreign_definition! - can_find_alias! - can_find_type!))) - (_.cover [/.foreign_module_has_not_been_imported] - (let [scenario (is (-> Type Global Bit) - (function (_ expected_type it) - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name it)) - _ (/.reference [import expected_name])] - (in false)) - (//type.expecting expected_type) - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.foreign_module_has_not_been_imported))) - )))] - (and (scenario expected_type {.#Definition [#1 expected_type []]}) - (scenario .Type {.#Type [#1 expected_type - (if record? - {.#Right [expected_label (list)]} - {.#Left [expected_label (list)]})]})))) - (_.cover [/.definition_has_not_been_exported] - (let [scenario (is (-> Type Global Bit) - (function (_ expected_type it) - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_name it)) - _ (/.reference [import expected_name])] - (in false)) - (//type.expecting expected_type) - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.definition_has_not_been_exported))) - )))] - (and (scenario expected_type {.#Definition [#0 expected_type []]}) - (scenario .Type {.#Type [#0 expected_type - (if record? - {.#Right [expected_label (list)]} - {.#Left [expected_label (list)]})]})))) - (_.cover [/.labels_are_not_definitions] - (let [scenario (is (-> Type Global Bit) - (function (_ expected_type it) - (|> (do //phase.monad - [_ (//module.with 0 import - (//module.define expected_label it)) - _ (/.reference [import expected_label])] - (in false)) - (//type.expecting expected_type) - (//module.with 0 expected_module) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (the exception.#label /.labels_are_not_definitions))))))] - (and (scenario expected_type {.#Tag [#1 expected_type (list) 0]}) - (scenario expected_type {.#Slot [#1 expected_type (list) 0]})))) - )))) + can_find_alias! + can_find_type!))) + (_.cover [/.foreign_module_has_not_been_imported] + (let [scenario (is (-> Type Global Bit) + (function (_ expected_type it) + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name it)) + _ (/.reference [import expected_name])] + (in false)) + (//type.expecting expected_type) + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.foreign_module_has_not_been_imported))) + )))] + (and (scenario expected_type {.#Definition [#1 expected_type []]}) + (scenario .Type {.#Type [#1 expected_type + (if record? + {.#Right [expected_label (list)]} + {.#Left [expected_label (list)]})]})))) + (_.cover [/.definition_has_not_been_exported] + (let [scenario (is (-> Type Global Bit) + (function (_ expected_type it) + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_name it)) + _ (/.reference [import expected_name])] + (in false)) + (//type.expecting expected_type) + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.definition_has_not_been_exported))) + )))] + (and (scenario expected_type {.#Definition [#0 expected_type []]}) + (scenario .Type {.#Type [#0 expected_type + (if record? + {.#Right [expected_label (list)]} + {.#Left [expected_label (list)]})]})))) + (_.cover [/.labels_are_not_definitions] + (let [scenario (is (-> Type Global Bit) + (function (_ expected_type it) + (|> (do //phase.monad + [_ (//module.with 0 import + (//module.define expected_label it)) + _ (/.reference [import expected_label])] + (in false)) + (//type.expecting expected_type) + (//module.with 0 expected_module) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (the exception.#label /.labels_are_not_definitions))))))] + (and (scenario expected_type {.#Tag [#1 expected_type (list) 0]}) + (scenario expected_type {.#Slot [#1 expected_type (list) 0]})))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux index 5827be799..4680a6e00 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -84,22 +84,22 @@ module (random.ascii/lower 2) configuration ($configuration.random 5) .let [state (/analysis.state (/analysis.info version host configuration))]] - (`` ($_ _.and - (_.cover [/.unit] - (..analysis state module .Any /.unit - (|>> (pipe.case (pattern (/analysis.unit)) true _ false)))) - (~~ (template [<analysis> <type> <random> <tag>] - [(do ! - [sample <random>] - (_.cover [<analysis>] - (..analysis state module <type> (<analysis> sample) - ((..analysis? <type> <tag>) sample))))] + (`` (all _.and + (_.cover [/.unit] + (..analysis state module .Any /.unit + (|>> (pipe.case (pattern (/analysis.unit)) true _ false)))) + (~~ (template [<analysis> <type> <random> <tag>] + [(do ! + [sample <random>] + (_.cover [<analysis>] + (..analysis state module <type> (<analysis> sample) + ((..analysis? <type> <tag>) sample))))] - [/.bit .Bit random.bit /analysis.bit] - [/.nat .Nat random.nat /analysis.nat] - [/.int .Int random.int /analysis.int] - [/.rev .Rev random.rev /analysis.rev] - [/.frac .Frac random.frac /analysis.frac] - [/.text .Text (random.unicode 1) /analysis.text] - )) - ))))) + [/.bit .Bit random.bit /analysis.bit] + [/.nat .Nat random.nat /analysis.nat] + [/.int .Int random.int /analysis.int] + [/.rev .Rev random.rev /analysis.rev] + [/.frac .Frac random.frac /analysis.frac] + [/.text .Text (random.unicode 1) /analysis.text] + )) + ))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux index 307816a02..c76f452ed 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension.lux @@ -32,10 +32,10 @@ (def: .public random (Random (/.Extension Nat)) - ($_ random.and - (random.ascii/lower 5) - (random.list 2 random.nat) - )) + (all random.and + (random.ascii/lower 5) + (random.list 2 random.nat) + )) (def: test|state Test @@ -43,55 +43,55 @@ [state random.int dummy (random.only (|>> (i.= state) not) random.int)] - ($_ _.and - (_.cover [/.read] - (|> (is (/.Operation Int Nat Nat Text) - (/.read %.int)) - (# phase.functor each (text#= (%.int state))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.update] - (|> (is (/.Operation Int Nat Nat Text) - (do phase.monad - [_ (/.update ++)] - (/.read %.int))) - (# phase.functor each (text#= (%.int (++ state)))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.temporary] - (|> (is (/.Operation Int Nat Nat Text) - (do phase.monad - [|state'| (/.temporary ++ (/.read %.int)) - |state| (/.read %.int)] - (in (format |state'| " " |state|)))) - (# phase.functor each (text#= (format (%.int (++ state)) " " (%.int state)))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.with_state] - (|> (is (/.Operation Int Nat Nat Text) - (/.with_state state - (/.read %.int))) - (# phase.functor each (text#= (%.int state))) - (phase.result [/.#bundle /.empty - /.#state dummy]) - (try.else false))) - (_.cover [/.localized] - (|> (is (/.Operation Int Nat Nat Text) - (do phase.monad - [|state| (/.localized %.int - (function (_ _ old) (++ old)) - (text.enclosed ["<" ">"]) - (/.read %.int)) - |state'| (/.read %.int)] - (in (format |state'| " " |state|)))) - (# phase.functor each (text#= (format (%.int (i.+ +2 state)) - " " (%.int (i.+ +1 state))))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false)))) + (all _.and + (_.cover [/.read] + (|> (is (/.Operation Int Nat Nat Text) + (/.read %.int)) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.update] + (|> (is (/.Operation Int Nat Nat Text) + (do phase.monad + [_ (/.update ++)] + (/.read %.int))) + (# phase.functor each (text#= (%.int (++ state)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.temporary] + (|> (is (/.Operation Int Nat Nat Text) + (do phase.monad + [|state'| (/.temporary ++ (/.read %.int)) + |state| (/.read %.int)] + (in (format |state'| " " |state|)))) + (# phase.functor each (text#= (format (%.int (++ state)) " " (%.int state)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false))) + (_.cover [/.with_state] + (|> (is (/.Operation Int Nat Nat Text) + (/.with_state state + (/.read %.int))) + (# phase.functor each (text#= (%.int state))) + (phase.result [/.#bundle /.empty + /.#state dummy]) + (try.else false))) + (_.cover [/.localized] + (|> (is (/.Operation Int Nat Nat Text) + (do phase.monad + [|state| (/.localized %.int + (function (_ _ old) (++ old)) + (text.enclosed ["<" ">"]) + (/.read %.int)) + |state'| (/.read %.int)] + (in (format |state'| " " |state|)))) + (# phase.functor each (text#= (format (%.int (i.+ +2 state)) + " " (%.int (i.+ +1 state))))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)))) )) (def: extender @@ -115,32 +115,32 @@ extension (random.ascii/lower 1) left random.nat right random.nat] - ($_ _.and - (_.cover [/.cannot_overwrite] - (|> (do phase.monad - [_ (/.install extender extension handler/0)] - (/.install extender extension handler/1)) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.cannot_overwrite error) + (all _.and + (_.cover [/.cannot_overwrite] + (|> (do phase.monad + [_ (/.install extender extension handler/0)] + (/.install extender extension handler/1)) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.cannot_overwrite error) - _ - false))) - (_.cover [/.unknown] - (|> (/.apply archive.empty (function (_ archive input) - (# phase.monad in (++ input))) - [extension (list left right)]) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.unknown error) + _ + false))) + (_.cover [/.unknown] + (|> (/.apply archive.empty (function (_ archive input) + (# phase.monad in (++ input))) + [extension (list left right)]) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.unknown error) - _ - false))) - ))) + _ + false))) + ))) (def: test|bundle Test @@ -153,77 +153,77 @@ extension (random.ascii/lower 1) left random.nat right random.nat] - ($_ _.and - (_.cover [/.empty] - (dictionary.empty? /.empty)) - (<| (_.for [/.Extender /.Handler]) - ($_ _.and - (_.cover [/.install /.apply] - (|> (do phase.monad - [_ (/.install extender extension handler/0)] - (/.apply archive.empty phase [extension (list left right)])) - (# phase.functor each (n.= (n.+ left right))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.Phase] - (let [handler (is (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (let [! phase.monad] - (|> inputs - (monad.each ! (phase archive)) - (# ! each (list#mix n.+ 0))))))] + (all _.and + (_.cover [/.empty] + (dictionary.empty? /.empty)) + (<| (_.for [/.Extender /.Handler]) + (all _.and + (_.cover [/.install /.apply] (|> (do phase.monad - [_ (/.install extender extension handler)] + [_ (/.install extender extension handler/0)] (/.apply archive.empty phase [extension (list left right)])) - (# phase.functor each (n.= (n.+ (++ left) (++ right)))) + (# phase.functor each (n.= (n.+ left right))) (phase.result [/.#bundle /.empty /.#state state]) - (try.else false)))) - (_.cover [/.with] - (|> (do phase.monad - [_ (/.with extender (dictionary.of_list text.hash (list [extension handler/1])))] - (/.apply archive.empty (function (_ archive input) - (# phase.monad in (++ input))) - [extension (list left right)])) - (# phase.functor each (n.= (n.* left right))) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false))) - (_.cover [/.incorrect_arity] - (let [handler (is (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))] + (try.else false))) + (_.cover [/.Phase] + (let [handler (is (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (let [! phase.monad] + (|> inputs + (monad.each ! (phase archive)) + (# ! each (list#mix n.+ 0))))))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list left right)])) + (# phase.functor each (n.= (n.+ (++ left) (++ right)))) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)))) + (_.cover [/.with] (|> (do phase.monad - [_ (/.install extender extension handler)] - (/.apply archive.empty phase [extension (list)])) + [_ (/.with extender (dictionary.of_list text.hash (list [extension handler/1])))] + (/.apply archive.empty (function (_ archive input) + (# phase.monad in (++ input))) + [extension (list left right)])) + (# phase.functor each (n.= (n.* left right))) (phase.result [/.#bundle /.empty /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.incorrect_arity error) + (try.else false))) + (_.cover [/.incorrect_arity] + (let [handler (is (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (phase.except /.incorrect_arity [@self 2 (list.size inputs)])))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list)])) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.incorrect_arity error) - _ - false)))) - (_.cover [/.invalid_syntax] - (let [handler (is (/.Handler Int Nat Nat) - (function (_ @self phase archive inputs) - (phase.except /.invalid_syntax [@self %.nat inputs])))] - (|> (do phase.monad - [_ (/.install extender extension handler)] - (/.apply archive.empty phase [extension (list left right)])) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure error} - (exception.match? /.invalid_syntax error) + _ + false)))) + (_.cover [/.invalid_syntax] + (let [handler (is (/.Handler Int Nat Nat) + (function (_ @self phase archive inputs) + (phase.except /.invalid_syntax [@self %.nat inputs])))] + (|> (do phase.monad + [_ (/.install extender extension handler)] + (/.apply archive.empty phase [extension (list left right)])) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure error} + (exception.match? /.invalid_syntax error) - _ - false)))) - (_.for [/.Name] - ..test|name) - )) - )))) + _ + false)))) + (_.for [/.Name] + ..test|name) + )) + )))) (def: .public test Test @@ -235,46 +235,46 @@ random.int) expected random.nat expected_error (random.ascii/lower 1)] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) ..random)) - (_.for [/.hash] - ($hash.spec (/.hash n.hash) ..random)) - - (<| (_.for [/.Operation]) - ($_ _.and - (_.cover [/.lifted] - (and (|> (is (/.Operation Int Nat Nat Nat) - (/.lifted (do phase.monad - [] - (in expected)))) - (# phase.functor each (same? expected)) - (phase.result [/.#bundle /.empty - /.#state state]) - (try.else false)) - (|> (is (/.Operation Int Nat Nat Nat) - (/.lifted (phase.lifted {try.#Failure expected_error}))) - (phase.result [/.#bundle /.empty - /.#state state]) - (pipe.case - {try.#Failure actual_error} - (same? expected_error actual_error) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) ..random)) + (_.for [/.hash] + ($hash.spec (/.hash n.hash) ..random)) + + (<| (_.for [/.Operation]) + (all _.and + (_.cover [/.lifted] + (and (|> (is (/.Operation Int Nat Nat Nat) + (/.lifted (do phase.monad + [] + (in expected)))) + (# phase.functor each (same? expected)) + (phase.result [/.#bundle /.empty + /.#state state]) + (try.else false)) + (|> (is (/.Operation Int Nat Nat Nat) + (/.lifted (phase.lifted {try.#Failure expected_error}))) + (phase.result [/.#bundle /.empty + /.#state state]) + (pipe.case + {try.#Failure actual_error} + (same? expected_error actual_error) - _ - false)))) - (_.cover [/.up] - (|> (do phase.monad - [] - (in expected)) - (is (/.Operation Int Nat Nat Nat)) - /.up - (is (phase.Operation Int Nat)) - (# phase.functor each (same? expected)) - (phase.result state) - (try.else false))) - )) - (_.for [/.State] - ..test|state) - (_.for [/.Bundle] - ..test|bundle) - )))) + _ + false)))) + (_.cover [/.up] + (|> (do phase.monad + [] + (in expected)) + (is (/.Operation Int Nat Nat Nat)) + /.up + (is (phase.Operation Int Nat)) + (# phase.functor each (same? expected)) + (phase.result state) + (try.else false))) + )) + (_.for [/.State] + ..test|state) + (_.for [/.Bundle] + ..test|bundle) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux index 24a9fb366..cbcd636f4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux @@ -61,16 +61,16 @@ [[primT primC] ..primitive [antiT antiC] (|> ..primitive (r.only (|>> product.left (type#= primT) not)))] - ($_ _.and - (_.test "Can test for reference equality." - (check_success+ "lux is" (list primC primC) Bit)) - (_.test "Reference equality must be done with elements of the same type." - (check_failure+ "lux is" (list primC antiC) Bit)) - (_.test "Can 'try' risky IO computations." - (check_success+ "lux try" - (list (` ("lux io error" "YOLO"))) - (type (Either Text primT)))) - ))) + (all _.and + (_.test "Can test for reference equality." + (check_success+ "lux is" (list primC primC) Bit)) + (_.test "Reference equality must be done with elements of the same type." + (check_failure+ "lux is" (list primC antiC) Bit)) + (_.test "Can 'try' risky IO computations." + (check_success+ "lux try" + (list (` ("lux io error" "YOLO"))) + (type (Either Text primT)))) + ))) (def: i64 Test @@ -78,46 +78,46 @@ [subjectC (|> r.nat (# ! each code.nat)) signedC (|> r.int (# ! each code.int)) paramC (|> r.nat (# ! each code.nat))] - ($_ _.and - (_.test "i64 'and'." - (check_success+ "lux i64 and" (list paramC subjectC) Nat)) - (_.test "i64 'or'." - (check_success+ "lux i64 or" (list paramC subjectC) Nat)) - (_.test "i64 'xor'." - (check_success+ "lux i64 xor" (list paramC subjectC) Nat)) - (_.test "i64 left-shift." - (check_success+ "lux i64 left-shift" (list paramC subjectC) Nat)) - (_.test "i64 logical-right-shift." - (check_success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) - (_.test "i64 arithmetic-right-shift." - (check_success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) - (_.test "i64 equivalence." - (check_success+ "lux i64 =" (list paramC subjectC) Bit)) - (_.test "i64 addition." - (check_success+ "lux i64 +" (list paramC subjectC) Int)) - (_.test "i64 subtraction." - (check_success+ "lux i64 -" (list paramC subjectC) Int)) - ))) + (all _.and + (_.test "i64 'and'." + (check_success+ "lux i64 and" (list paramC subjectC) Nat)) + (_.test "i64 'or'." + (check_success+ "lux i64 or" (list paramC subjectC) Nat)) + (_.test "i64 'xor'." + (check_success+ "lux i64 xor" (list paramC subjectC) Nat)) + (_.test "i64 left-shift." + (check_success+ "lux i64 left-shift" (list paramC subjectC) Nat)) + (_.test "i64 logical-right-shift." + (check_success+ "lux i64 logical-right-shift" (list paramC subjectC) Nat)) + (_.test "i64 arithmetic-right-shift." + (check_success+ "lux i64 arithmetic-right-shift" (list paramC signedC) Int)) + (_.test "i64 equivalence." + (check_success+ "lux i64 =" (list paramC subjectC) Bit)) + (_.test "i64 addition." + (check_success+ "lux i64 +" (list paramC subjectC) Int)) + (_.test "i64 subtraction." + (check_success+ "lux i64 -" (list paramC subjectC) Int)) + ))) (def: int Test (do [! r.monad] [subjectC (|> r.int (# ! each code.int)) paramC (|> r.int (# ! each code.int))] - ($_ _.and - (_.test "Can multiply integers." - (check_success+ "lux i64 *" (list paramC subjectC) Int)) - (_.test "Can divide integers." - (check_success+ "lux i64 /" (list paramC subjectC) Int)) - (_.test "Can calculate remainder of integers." - (check_success+ "lux i64 %" (list paramC subjectC) Int)) - (_.test "Can compare integers." - (check_success+ "lux i64 <" (list paramC subjectC) Bit)) - (_.test "Can convert integer to text." - (check_success+ "lux i64 char" (list subjectC) Text)) - (_.test "Can convert integer to fraction." - (check_success+ "lux i64 f64" (list subjectC) Frac)) - ))) + (all _.and + (_.test "Can multiply integers." + (check_success+ "lux i64 *" (list paramC subjectC) Int)) + (_.test "Can divide integers." + (check_success+ "lux i64 /" (list paramC subjectC) Int)) + (_.test "Can calculate remainder of integers." + (check_success+ "lux i64 %" (list paramC subjectC) Int)) + (_.test "Can compare integers." + (check_success+ "lux i64 <" (list paramC subjectC) Bit)) + (_.test "Can convert integer to text." + (check_success+ "lux i64 char" (list subjectC) Text)) + (_.test "Can convert integer to fraction." + (check_success+ "lux i64 f64" (list subjectC) Frac)) + ))) (def: frac Test @@ -125,34 +125,34 @@ [subjectC (|> r.safe_frac (# ! each code.frac)) paramC (|> r.safe_frac (# ! each code.frac)) encodedC (|> r.safe_frac (# ! each (|>> %.frac code.text)))] - ($_ _.and - (_.test "Can add frac numbers." - (check_success+ "lux f64 +" (list paramC subjectC) Frac)) - (_.test "Can subtract frac numbers." - (check_success+ "lux f64 -" (list paramC subjectC) Frac)) - (_.test "Can multiply frac numbers." - (check_success+ "lux f64 *" (list paramC subjectC) Frac)) - (_.test "Can divide frac numbers." - (check_success+ "lux f64 /" (list paramC subjectC) Frac)) - (_.test "Can calculate remainder of frac numbers." - (check_success+ "lux f64 %" (list paramC subjectC) Frac)) - (_.test "Can test equivalence of frac numbers." - (check_success+ "lux f64 =" (list paramC subjectC) Bit)) - (_.test "Can compare frac numbers." - (check_success+ "lux f64 <" (list paramC subjectC) Bit)) - (_.test "Can obtain minimum frac number." - (check_success+ "lux f64 min" (list) Frac)) - (_.test "Can obtain maximum frac number." - (check_success+ "lux f64 max" (list) Frac)) - (_.test "Can obtain smallest frac number." - (check_success+ "lux f64 smallest" (list) Frac)) - (_.test "Can convert frac number to integer." - (check_success+ "lux f64 i64" (list subjectC) Int)) - (_.test "Can convert frac number to text." - (check_success+ "lux f64 encode" (list subjectC) Text)) - (_.test "Can convert text to frac number." - (check_success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) - ))) + (all _.and + (_.test "Can add frac numbers." + (check_success+ "lux f64 +" (list paramC subjectC) Frac)) + (_.test "Can subtract frac numbers." + (check_success+ "lux f64 -" (list paramC subjectC) Frac)) + (_.test "Can multiply frac numbers." + (check_success+ "lux f64 *" (list paramC subjectC) Frac)) + (_.test "Can divide frac numbers." + (check_success+ "lux f64 /" (list paramC subjectC) Frac)) + (_.test "Can calculate remainder of frac numbers." + (check_success+ "lux f64 %" (list paramC subjectC) Frac)) + (_.test "Can test equivalence of frac numbers." + (check_success+ "lux f64 =" (list paramC subjectC) Bit)) + (_.test "Can compare frac numbers." + (check_success+ "lux f64 <" (list paramC subjectC) Bit)) + (_.test "Can obtain minimum frac number." + (check_success+ "lux f64 min" (list) Frac)) + (_.test "Can obtain maximum frac number." + (check_success+ "lux f64 max" (list) Frac)) + (_.test "Can obtain smallest frac number." + (check_success+ "lux f64 smallest" (list) Frac)) + (_.test "Can convert frac number to integer." + (check_success+ "lux f64 i64" (list subjectC) Int)) + (_.test "Can convert frac number to text." + (check_success+ "lux f64 encode" (list subjectC) Text)) + (_.test "Can convert text to frac number." + (check_success+ "lux f64 decode" (list encodedC) (type (Maybe Frac)))) + ))) (def: text Test @@ -162,45 +162,45 @@ replacementC (|> (r.unicode 5) (# ! each code.text)) fromC (|> r.nat (# ! each code.nat)) toC (|> r.nat (# ! each code.nat))] - ($_ _.and - (_.test "Can test text equivalence." - (check_success+ "lux text =" (list paramC subjectC) Bit)) - (_.test "Compare texts in lexicographical order." - (check_success+ "lux text <" (list paramC subjectC) Bit)) - (_.test "Can concatenate one text to another." - (check_success+ "lux text concat" (list subjectC paramC) Text)) - (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." - (check_success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) - (_.test "Can query the size/length of a text." - (check_success+ "lux text size" (list subjectC) Nat)) - (_.test "Can obtain the character code of a text at a given index." - (check_success+ "lux text char" (list fromC subjectC) Nat)) - (_.test "Can clip a piece of text between 2 indices." - (check_success+ "lux text clip" (list fromC toC subjectC) Text)) - ))) + (all _.and + (_.test "Can test text equivalence." + (check_success+ "lux text =" (list paramC subjectC) Bit)) + (_.test "Compare texts in lexicographical order." + (check_success+ "lux text <" (list paramC subjectC) Bit)) + (_.test "Can concatenate one text to another." + (check_success+ "lux text concat" (list subjectC paramC) Text)) + (_.test "Can find the index of a piece of text inside a larger one that (may) contain it." + (check_success+ "lux text index" (list fromC paramC subjectC) (type (Maybe Nat)))) + (_.test "Can query the size/length of a text." + (check_success+ "lux text size" (list subjectC) Nat)) + (_.test "Can obtain the character code of a text at a given index." + (check_success+ "lux text char" (list fromC subjectC) Nat)) + (_.test "Can clip a piece of text between 2 indices." + (check_success+ "lux text clip" (list fromC toC subjectC) Text)) + ))) (def: io Test (do [! r.monad] [logC (|> (r.unicode 5) (# ! each code.text)) exitC (|> r.int (# ! each code.int))] - ($_ _.and - (_.test "Can log messages to standard output." - (check_success+ "lux io log" (list logC) Any)) - (_.test "Can throw a run-time error." - (check_success+ "lux io error" (list logC) Nothing)) - (_.test "Can query the current time (as milliseconds since epoch)." - (check_success+ "lux io current-time" (list) Int)) - ))) + (all _.and + (_.test "Can log messages to standard output." + (check_success+ "lux io log" (list logC) Any)) + (_.test "Can throw a run-time error." + (check_success+ "lux io error" (list logC) Nothing)) + (_.test "Can query the current time (as milliseconds since epoch)." + (check_success+ "lux io current-time" (list) Int)) + ))) (def: .public test Test (<| (_.context (symbol.module (symbol /._))) - ($_ _.and - ..lux - ..i64 - ..int - ..frac - ..text - ..io - ))) + (all _.and + ..lux + ..i64 + ..int + ..frac + ..text + ..io + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux index 357172053..e64b9540a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -1,21 +1,21 @@ (.using - [lux "*" - ["_" test {"+" Test}]] - ["[0]" / "_" - ["[1][0]" primitive] - ["[1][0]" structure] - ["[1][0]" case] - ["[1][0]" function] - ["[1][0]" loop] - ["[1][0]" variable]]) + [lux "*" + ["_" test {"+" Test}]] + ["[0]" / "_" + ["[1][0]" primitive] + ["[1][0]" structure] + ["[1][0]" case] + ["[1][0]" function] + ["[1][0]" loop] + ["[1][0]" variable]]) (def: .public test Test - ($_ _.and - /primitive.test - /structure.test - /case.test - /function.test - /loop.test - /variable.test - )) + (all _.and + /primitive.test + /structure.test + /case.test + /function.test + /loop.test + /variable.test + )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index b65c3fa9d..4ea071954 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -201,12 +201,12 @@ (do [! random.monad] [[test/0 test/1 test/2 test/3 test/4] (random_five <hash> <random>) [body/0 body/1 body/2 body/3 body/4] (random_five <hash> <random>)] - (in [($_ {synthesis.#Alt} - {synthesis.#Seq (<path> test/0) {synthesis.#Then (<synthesis> body/0)}} - {synthesis.#Seq (<path> test/1) {synthesis.#Then (<synthesis> body/1)}} - {synthesis.#Seq (<path> test/2) {synthesis.#Then (<synthesis> body/2)}} - {synthesis.#Seq (<path> test/3) {synthesis.#Then (<synthesis> body/3)}} - {synthesis.#Seq (<path> test/4) {synthesis.#Then (<synthesis> body/4)}}) + (in [(all {synthesis.#Alt} + {synthesis.#Seq (<path> test/0) {synthesis.#Then (<synthesis> body/0)}} + {synthesis.#Seq (<path> test/1) {synthesis.#Then (<synthesis> body/1)}} + {synthesis.#Seq (<path> test/2) {synthesis.#Then (<synthesis> body/2)}} + {synthesis.#Seq (<path> test/3) {synthesis.#Then (<synthesis> body/3)}} + {synthesis.#Seq (<path> test/4) {synthesis.#Then (<synthesis> body/4)}}) [[analysis.#when (<pattern> test/0) analysis.#then (<analysis> body/0)] (list [analysis.#when (<pattern> test/1) analysis.#then (<analysis> body/1)] [analysis.#when (<pattern> test/2) analysis.#then (<analysis> body/2)] @@ -221,14 +221,14 @@ ) (def: random_simple - ($_ random.either - ..random_bit - ..random_nat - ..random_int - ..random_rev - ..random_frac - ..random_text - )) + (all random.either + ..random_bit + ..random_nat + ..random_int + ..random_rev + ..random_frac + ..random_text + )) (def: random_variant (Random [Path Match]) @@ -239,24 +239,24 @@ [body/0 body/1 body/2 body/3 body/4] (random_five frac.hash random.frac) .let [path (is (-> Nat Bit Text Frac Path) (function (_ lefts right? value body) - ($_ {synthesis.#Seq} - (synthesis.path/side (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Then (synthesis.f64 body)}))) + (all {synthesis.#Seq} + (synthesis.path/side (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Then (synthesis.f64 body)}))) branch (is (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) [analysis.#when (analysis.pattern/variant [analysis.#lefts lefts analysis.#right? right? analysis.#value (analysis.pattern/text value)]) analysis.#then (analysis.frac body)]))]] - (in [($_ {synthesis.#Alt} - (path lefts/0 false value/0 body/0) - (path lefts/1 false value/1 body/1) - (path lefts/2 false value/2 body/2) - (path lefts/3 false value/3 body/3) - (path lefts/4 last_is_right? value/4 body/4)) + (in [(all {synthesis.#Alt} + (path lefts/0 false value/0 body/0) + (path lefts/1 false value/1 body/1) + (path lefts/2 false value/2 body/2) + (path lefts/3 false value/3 body/3) + (path lefts/4 last_is_right? value/4 body/4)) [(branch lefts/0 false value/0 body/0) (list (branch lefts/1 false value/1 body/1) (branch lefts/2 false value/2 body/2) @@ -278,28 +278,28 @@ .let [path (is (-> Nat Bit Text Frac Path) (function (_ lefts right? value body) (if right? - ($_ {synthesis.#Seq} - (synthesis.path/member (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Then (synthesis.f64 body)}) - ($_ {synthesis.#Seq} - (synthesis.path/member (if right? - {.#Right lefts} - {.#Left lefts})) - (synthesis.path/text value) - {synthesis.#Pop} - {synthesis.#Then (synthesis.f64 body)})))) + (all {synthesis.#Seq} + (synthesis.path/member (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Then (synthesis.f64 body)}) + (all {synthesis.#Seq} + (synthesis.path/member (if right? + {.#Right lefts} + {.#Left lefts})) + (synthesis.path/text value) + {synthesis.#Pop} + {synthesis.#Then (synthesis.f64 body)})))) branch (is (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) [analysis.#when (if right? (analysis.pattern/tuple (list#composite (list.repeated (++ lefts) (analysis.pattern/unit)) (list (analysis.pattern/text value)))) - (analysis.pattern/tuple ($_ list#composite - (list.repeated lefts (analysis.pattern/unit)) - (list (analysis.pattern/text value) - (analysis.pattern/unit))))) + (analysis.pattern/tuple (all list#composite + (list.repeated lefts (analysis.pattern/unit)) + (list (analysis.pattern/text value) + (analysis.pattern/unit))))) analysis.#then (analysis.frac body)]))]] (in [(list#mix (function (_ left right) {synthesis.#Alt left right}) @@ -318,16 +318,16 @@ (list (branch (++ mid_size) true value/last body/last)))]]))) (def: random_complex - ($_ random.either - ..random_variant - ..random_tuple - )) + (all random.either + ..random_variant + ..random_tuple + )) (def: random_case - ($_ random.either - ..random_simple - ..random_complex - )) + (all random.either + ..random_simple + ..random_complex + )) (def: case_test Test @@ -349,10 +349,10 @@ Test (<| (_.covering /._) (_.for [/.synthesize]) - ($_ _.and - ..masking_test - ..let_test - ..if_test - ..get_test - ..case_test - ))) + (all _.and + ..masking_test + ..let_test + ..if_test + ..get_test + ..case_test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index 01ebdec3f..df05fcc1a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -55,10 +55,10 @@ (list#mix (function (_ arity_1 body) (case arity_1 0 {analysis.#Function (list) body} - _ {analysis.#Function ($_ list#composite - (list#each (|>> {variable.#Foreign}) - (list.indices arity_1)) - (list {variable.#Local 1})) + _ {analysis.#Function (all list#composite + (list#each (|>> {variable.#Foreign}) + (list.indices arity_1)) + (list {variable.#Local 1})) body})) body (list.reversed (list.indices arity)))) @@ -142,9 +142,9 @@ (def: (random_structure random_value output?) (-> Scenario Scenario) - ($_ random.either - (..random_variant random_value output?) - (..random_tuple random_value output?))) + (all random.either + (..random_variant random_value output?) + (..random_tuple random_value output?))) (def: (random_variable arity output?) (-> Arity Scenario) @@ -187,32 +187,32 @@ (in [(and loop?_input loop?_output) (synthesis.branch/case [expected_input - ($_ synthesis.path/alt - (synthesis.path/then expected_output) - (synthesis.path/seq (synthesis.path/bit bit_test) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/i64 (.i64 i64_test)) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/f64 f64_test) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/text text_test) - (synthesis.path/then expected_output)) - (synthesis.path/seq (synthesis.path/bind (++ arity)) - (synthesis.path/then expected_output)) - ($_ synthesis.path/seq - (synthesis.path/side side|member) - (synthesis.path/bind (++ arity)) - (synthesis.path/then expected_output)) - (if right? - ($_ synthesis.path/seq - (synthesis.path/member side|member) + (all synthesis.path/alt + (synthesis.path/then expected_output) + (synthesis.path/seq (synthesis.path/bit bit_test) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/i64 (.i64 i64_test)) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/f64 f64_test) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/text text_test) + (synthesis.path/then expected_output)) + (synthesis.path/seq (synthesis.path/bind (++ arity)) + (synthesis.path/then expected_output)) + (all synthesis.path/seq + (synthesis.path/side side|member) (synthesis.path/bind (++ arity)) - (synthesis.path/then expected_output)) - ($_ synthesis.path/seq - (synthesis.path/member side|member) - (synthesis.path/bind (++ arity)) - synthesis.path/pop - (synthesis.path/then expected_output))))]) + (synthesis.path/then expected_output)) + (if right? + (all synthesis.path/seq + (synthesis.path/member side|member) + (synthesis.path/bind (++ arity)) + (synthesis.path/then expected_output)) + (all synthesis.path/seq + (synthesis.path/member side|member) + (synthesis.path/bind (++ arity)) + synthesis.path/pop + (synthesis.path/then expected_output))))]) {analysis.#Case actual_input [[analysis.#when (analysis.pattern/unit) analysis.#then actual_output] @@ -335,10 +335,10 @@ (def: (random_loop arity random_value output?) (-> Arity Scenario Scenario) (if output? - ($_ random.either - (..random_again arity random_value output?) - (..random_scope arity output?) - ) + (all random.either + (..random_again arity random_value output?) + (..random_scope arity output?) + ) (..random_scope arity output?))) (def: (random_abstraction' output?) @@ -346,10 +346,10 @@ (do [! random.monad] [[loop?_output expected_output actual_output] (..random_nat output?) arity (|> random.nat (# ! each (|>> (n.% 5) ++))) - .let [environment ($_ list#composite - (list#each (|>> {variable.#Foreign}) - (list.indices arity)) - (list {variable.#Local 1}))]] + .let [environment (all list#composite + (list#each (|>> {variable.#Foreign}) + (list.indices arity)) + (list {variable.#Local 1}))]] (in [true (synthesis.function/abstraction [synthesis.#environment environment @@ -380,18 +380,18 @@ (-> Scenario Scenario) (if output? (..random_apply random_value output?) - ($_ random.either - (..random_abstraction' output?) - (..random_apply random_value output?) - ))) + (all random.either + (..random_abstraction' output?) + (..random_apply random_value output?) + ))) (def: (random_control arity random_value output?) (-> Arity Scenario Scenario) - ($_ random.either - (..random_branch arity random_value output?) - (..random_loop arity random_value output?) - (..random_function random_value output?) - )) + (all random.either + (..random_branch arity random_value output?) + (..random_loop arity random_value output?) + (..random_function random_value output?) + )) (def: (random_extension random_value output?) (-> Scenario Scenario) @@ -411,12 +411,12 @@ (function (random_value output?) (random.rec (function (_ _) - ($_ random.either - (..random_primitive output?) - (..random_structure random_value output?) - (..random_reference arity output?) - (..random_control arity random_value output?) - (..random_extension random_value output?)))))) + (all random.either + (..random_primitive output?) + (..random_structure random_value output?) + (..random_reference arity output?) + (..random_control arity random_value output?) + (..random_extension random_value output?)))))) (def: random_abstraction (Random [Synthesis Analysis]) @@ -460,7 +460,7 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - ..abstraction - ..application - ))) + (all _.and + ..abstraction + ..application + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux index 84c3873aa..7120348e1 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -28,20 +28,20 @@ (def: (primitive offset arity next) (Scenario Synthesis) - (`` ($_ random.either - (~~ (template [<synthesis> <random>] - [(do [! random.monad] - [example (# ! each (|>> <synthesis>) <random>)] - (in [next - [example - example]]))] + (`` (all random.either + (~~ (template [<synthesis> <random>] + [(do [! random.monad] + [example (# ! each (|>> <synthesis>) <random>)] + (in [next + [example + example]]))] - [//.bit random.bit] - [//.i64 (# ! each .i64 random.nat)] - [//.f64 random.frac] - [//.text (random.unicode 1)] - )) - ))) + [//.bit random.bit] + [//.i64 (# ! each .i64 random.nat)] + [//.f64 random.frac] + [//.text (random.unicode 1)] + )) + ))) (def: (constant offset arity next) (Scenario Constant) @@ -61,88 +61,88 @@ {variable.#Local register}]]))] (case offset 0 local - _ ($_ random.either - local - (do [! random.monad] - [foreign (# ! each (n.% offset) random.nat)] - (in [next - [{variable.#Local foreign} - {variable.#Foreign foreign}]])))))) + _ (all random.either + local + (do [! random.monad] + [foreign (# ! each (n.% offset) random.nat)] + (in [next + [{variable.#Local foreign} + {variable.#Foreign foreign}]])))))) (def: (reference offset arity next) (Scenario Synthesis) - (`` ($_ random.either - (~~ (template [<tag> <random>] - [(do [! random.monad] - [[next [exampleE exampleA]] (<random> offset arity next)] - (in [next - [(<tag> exampleE) - (<tag> exampleA)]]))] + (`` (all random.either + (~~ (template [<tag> <random>] + [(do [! random.monad] + [[next [exampleE exampleA]] (<random> offset arity next)] + (in [next + [(<tag> exampleE) + (<tag> exampleA)]]))] - [//.constant ..constant] - [//.variable ..variable] - ))))) + [//.constant ..constant] + [//.variable ..variable] + ))))) (def: (structure offset arity next) (Scenario Synthesis) - ($_ random.either - (do [! random.monad] - [lefts random.nat - right? random.bit - [next [valueE valueA]] (..reference offset arity next)] - (in [next - [(//.variant - [analysis.#lefts lefts - analysis.#right? right? - analysis.#value valueE]) - (//.variant - [analysis.#lefts lefts - analysis.#right? right? - analysis.#value valueA])]])) - (do [! random.monad] - [[next [leftE leftA]] (..reference offset arity next) - [next [rightE rightA]] (..reference offset arity next)] - (in [next - [(//.tuple (list leftE rightE)) - (//.tuple (list leftA rightA))]])) - )) + (all random.either + (do [! random.monad] + [lefts random.nat + right? random.bit + [next [valueE valueA]] (..reference offset arity next)] + (in [next + [(//.variant + [analysis.#lefts lefts + analysis.#right? right? + analysis.#value valueE]) + (//.variant + [analysis.#lefts lefts + analysis.#right? right? + analysis.#value valueA])]])) + (do [! random.monad] + [[next [leftE leftA]] (..reference offset arity next) + [next [rightE rightA]] (..reference offset arity next)] + (in [next + [(//.tuple (list leftE rightE)) + (//.tuple (list leftA rightA))]])) + )) (def: path (Scenario Path) (let [pattern (is (Scenario Path) (.function (again offset arity next) - (`` ($_ random.either - (random#in [next - [//.path/pop - //.path/pop]]) - (~~ (template [<path> <random>] - [(do [! random.monad] - [example (# ! each (|>> <path>) <random>)] - (in [next - [example - example]]))] + (`` (all random.either + (random#in [next + [//.path/pop + //.path/pop]]) + (~~ (template [<path> <random>] + [(do [! random.monad] + [example (# ! each (|>> <path>) <random>)] + (in [next + [example + example]]))] - [//.path/bit random.bit] - [//.path/i64 (# ! each .i64 random.nat)] - [//.path/f64 random.frac] - [//.path/text (random.unicode 1)] - )) - (~~ (template [<path>] - [(do [! random.monad] - [example (# ! each (|>> <path>) - (random.or random.nat - random.nat))] - (in [next - [example - example]]))] + [//.path/bit random.bit] + [//.path/i64 (# ! each .i64 random.nat)] + [//.path/f64 random.frac] + [//.path/text (random.unicode 1)] + )) + (~~ (template [<path>] + [(do [! random.monad] + [example (# ! each (|>> <path>) + (random.or random.nat + random.nat))] + (in [next + [example + example]]))] - [//.path/side] - [//.path/member] - )) - (random#in [(++ next) - [(//.path/bind (/.register_optimization offset next)) - (//.path/bind next)]]) - )))) + [//.path/side] + [//.path/member] + )) + (random#in [(++ next) + [(//.path/bind (/.register_optimization offset next)) + (//.path/bind next)]]) + )))) sequential (is (Scenario Path) (.function (again offset arity next) (do random.monad @@ -164,81 +164,81 @@ (let [random_member (is (Random Member) (random.or random.nat random.nat))] - ($_ random.either - ($_ random.either - (do [! random.monad] - [[next [inputE inputA]] (..reference offset arity next) - [next [bodyE bodyA]] (..reference offset arity next)] - (in [next - [(//.branch/let [inputE (/.register_optimization offset next) bodyE]) - (//.branch/let [inputA next bodyA])]])) - (do [! random.monad] - [[next [testE testA]] (..reference offset arity next) - [next [thenE thenA]] (..reference offset arity next) - [next [elseE elseA]] (..reference offset arity next)] - (in [next - [(//.branch/if [testE thenE elseE]) - (//.branch/if [testA thenA elseA])]]))) - ($_ random.either - (do [! random.monad] - [[next [recordE recordA]] (..reference offset arity next) - path_length (# ! each (|>> (n.% 5) ++) random.nat) - path (random.list path_length random_member)] - (in [next - [(//.branch/get [path recordE]) - (//.branch/get [path recordA])]])) - (do [! random.monad] - [[next [inputE inputA]] (..reference offset arity next) - [next [pathE pathA]] (..path offset arity next)] - (in [next - [(//.branch/case [inputE pathE]) - (//.branch/case [inputA pathA])]]))) - ))) + (all random.either + (all random.either + (do [! random.monad] + [[next [inputE inputA]] (..reference offset arity next) + [next [bodyE bodyA]] (..reference offset arity next)] + (in [next + [(//.branch/let [inputE (/.register_optimization offset next) bodyE]) + (//.branch/let [inputA next bodyA])]])) + (do [! random.monad] + [[next [testE testA]] (..reference offset arity next) + [next [thenE thenA]] (..reference offset arity next) + [next [elseE elseA]] (..reference offset arity next)] + (in [next + [(//.branch/if [testE thenE elseE]) + (//.branch/if [testA thenA elseA])]]))) + (all random.either + (do [! random.monad] + [[next [recordE recordA]] (..reference offset arity next) + path_length (# ! each (|>> (n.% 5) ++) random.nat) + path (random.list path_length random_member)] + (in [next + [(//.branch/get [path recordE]) + (//.branch/get [path recordA])]])) + (do [! random.monad] + [[next [inputE inputA]] (..reference offset arity next) + [next [pathE pathA]] (..path offset arity next)] + (in [next + [(//.branch/case [inputE pathE]) + (//.branch/case [inputA pathA])]]))) + ))) (def: (loop offset arity next) (Scenario Synthesis) - ($_ random.either - (do random.monad - [[next [firstE firstA]] (..reference offset arity next) - [next [secondE secondA]] (..reference offset arity next) - [next [iterationE iterationA]] (..reference offset arity next)] - (in [next - [(//.loop/scope - [//.#start (/.register_optimization offset next) - //.#inits (list firstE secondE) - //.#iteration iterationE]) - (//.loop/scope - [//.#start next - //.#inits (list firstA secondA) - //.#iteration iterationA])]])) - )) + (all random.either + (do random.monad + [[next [firstE firstA]] (..reference offset arity next) + [next [secondE secondA]] (..reference offset arity next) + [next [iterationE iterationA]] (..reference offset arity next)] + (in [next + [(//.loop/scope + [//.#start (/.register_optimization offset next) + //.#inits (list firstE secondE) + //.#iteration iterationE]) + (//.loop/scope + [//.#start next + //.#inits (list firstA secondA) + //.#iteration iterationA])]])) + )) (def: (function offset arity next) (Scenario Synthesis) - ($_ random.either - (do [! random.monad] - [[next [firstE firstA]] (..variable offset arity next) - [next [secondE secondA]] (..variable offset arity next) - arity (# ! each (n.max 1) random.nat) - [next [bodyE bodyA]] (..primitive 0 arity next)] - (in [next - [(//.function/abstraction - [//.#environment (list firstE secondE) - //.#arity arity - //.#body bodyE]) - (//.function/abstraction - [//.#environment (list firstA secondA) - //.#arity arity - //.#body bodyA])]])) - )) + (all random.either + (do [! random.monad] + [[next [firstE firstA]] (..variable offset arity next) + [next [secondE secondA]] (..variable offset arity next) + arity (# ! each (n.max 1) random.nat) + [next [bodyE bodyA]] (..primitive 0 arity next)] + (in [next + [(//.function/abstraction + [//.#environment (list firstE secondE) + //.#arity arity + //.#body bodyE]) + (//.function/abstraction + [//.#environment (list firstA secondA) + //.#arity arity + //.#body bodyA])]])) + )) (def: (control offset arity next) (Scenario Synthesis) - ($_ random.either - (..branch offset arity next) - (..loop offset arity next) - (..function offset arity next) - )) + (all random.either + (..branch offset arity next) + (..loop offset arity next) + (..function offset arity next) + )) (def: (extension offset arity next) (Scenario Synthesis) @@ -253,41 +253,41 @@ (def: (scenario offset arity next) (Scenario Synthesis) - ($_ random.either - (..primitive offset arity next) - (..structure offset arity next) - (..reference offset arity next) - (..control offset arity next) - (..extension offset arity next) - )) + (all random.either + (..primitive offset arity next) + (..structure offset arity next) + (..reference offset arity next) + (..control offset arity next) + (..extension offset arity next) + )) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do [! random.monad] - [expected_offset (# ! each (|>> (n.% 5) (n.+ 2)) random.nat) - arity (# ! each (|>> (n.% 5) ++) random.nat) - expected_inits (|> random.nat - (# ! each (|>> .i64 //.i64)) - (random.list arity)) - [_ [expected iteration]] (..scenario expected_offset arity 0)] - (_.cover [/.Transform /.optimization /.register_optimization] - (case (/.optimization true expected_offset expected_inits - [//.#environment (|> expected_offset - list.indices - (list#each (|>> {variable.#Local}))) - //.#arity arity - //.#body iteration]) - (pattern {.#Some (//.loop/scope [actual_offset actual_inits - actual])}) - (and (n.= expected_offset - actual_offset) - (# (list.equivalence //.equivalence) = - expected_inits - actual_inits) - (# //.equivalence = expected actual)) - - _ - false))) - ))) + (all _.and + (do [! random.monad] + [expected_offset (# ! each (|>> (n.% 5) (n.+ 2)) random.nat) + arity (# ! each (|>> (n.% 5) ++) random.nat) + expected_inits (|> random.nat + (# ! each (|>> .i64 //.i64)) + (random.list arity)) + [_ [expected iteration]] (..scenario expected_offset arity 0)] + (_.cover [/.Transform /.optimization /.register_optimization] + (case (/.optimization true expected_offset expected_inits + [//.#environment (|> expected_offset + list.indices + (list#each (|>> {variable.#Local}))) + //.#arity arity + //.#body iteration]) + (pattern {.#Some (//.loop/scope [actual_offset actual_inits + actual])}) + (and (n.= expected_offset + actual_offset) + (# (list.equivalence //.equivalence) = + expected_inits + actual_inits) + (# //.equivalence = expected actual)) + + _ + false))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux index 33f3378a1..b1b494810 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/primitive.lux @@ -32,14 +32,14 @@ (Random Analysis) (do r.monad [primitive (is (Random ////analysis.Primitive) - ($_ r.or - (in []) - r.bit - r.nat - r.int - r.rev - r.frac - (r.unicode 5)))] + (all r.or + (in []) + r.bit + r.nat + r.int + r.rev + r.frac + (r.unicode 5)))] (in {////analysis.#Primitive primitive}))) (def: .public (corresponds? analysis synthesis) @@ -74,25 +74,25 @@ (def: .public test Test (<| (_.context (%.symbol (symbol ////synthesis.#Primitive))) - (`` ($_ _.and - (~~ (template [<analysis> <synthesis> <generator>] - [(do r.monad - [expected <generator>] - (_.test (%.symbol (symbol <synthesis>)) - (|> {////analysis.#Primitive {<analysis> expected}} - (//.phase archive.empty) - (phase.result [///bundle.empty ////synthesis.init]) - (pipe.case - {try.#Success {////synthesis.#Primitive {<synthesis> actual}}} - (same? expected actual) + (`` (all _.and + (~~ (template [<analysis> <synthesis> <generator>] + [(do r.monad + [expected <generator>] + (_.test (%.symbol (symbol <synthesis>)) + (|> {////analysis.#Primitive {<analysis> expected}} + (//.phase archive.empty) + (phase.result [///bundle.empty ////synthesis.init]) + (pipe.case + {try.#Success {////synthesis.#Primitive {<synthesis> actual}}} + (same? expected actual) - _ - false))))] + _ + false))))] - [////analysis.#Unit ////synthesis.#Text (r#in ////synthesis.unit)] - [////analysis.#Bit ////synthesis.#Bit r.bit] - [////analysis.#Nat ////synthesis.#I64 (r#each .i64 r.nat)] - [////analysis.#Int ////synthesis.#I64 (r#each .i64 r.int)] - [////analysis.#Rev ////synthesis.#I64 (r#each .i64 r.rev)] - [////analysis.#Frac ////synthesis.#F64 r.frac] - [////analysis.#Text ////synthesis.#Text (r.unicode 5)])))))) + [////analysis.#Unit ////synthesis.#Text (r#in ////synthesis.unit)] + [////analysis.#Bit ////synthesis.#Bit r.bit] + [////analysis.#Nat ////synthesis.#I64 (r#each .i64 r.nat)] + [////analysis.#Int ////synthesis.#I64 (r#each .i64 r.int)] + [////analysis.#Rev ////synthesis.#I64 (r#each .i64 r.rev)] + [////analysis.#Frac ////synthesis.#F64 r.frac] + [////analysis.#Text ////synthesis.#Text (r.unicode 5)])))))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index d0383c9a7..08a90da4b 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -79,7 +79,7 @@ (def: .public test Test (<| (_.context (%.symbol (symbol ////synthesis.#Structure))) - ($_ _.and - ..variant - ..tuple - ))) + (all _.and + ..variant + ..tuple + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux index f6085d963..7e69f4420 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/variable.lux @@ -156,64 +156,64 @@ (def: (path_scenario scenario context) (-> (Scenario Synthesis) (Scenario Path)) - (`` ($_ random.either - ($_ random.either - (do [! random.monad] - [_ (in []) - [expected_then actual_then] (scenario context)] - (in [{synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then expected_then}} - {synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then actual_then}}])) - (do [! random.monad] - [_ (in []) - .let [real_register (dictionary.size (the #necessary context)) - fake_register (n.+ (the #redundants context) - (dictionary.size (the #necessary context)))] - [expected_then actual_then] (scenario (revised #necessary (dictionary.has real_register fake_register) context))] - (in [{synthesis.#Seq {synthesis.#Bind real_register} - {synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then expected_then}}} - {synthesis.#Seq {synthesis.#Bind fake_register} - {synthesis.#Seq {synthesis.#Pop} - {synthesis.#Then actual_then}}}]))) - ($_ random.either - (~~ (template [<tag> <random>] - [(do [! random.monad] - [test <random> - [expected_then actual_then] (scenario context)] - (in [{synthesis.#Seq {synthesis.#Test {<tag> test}} - {synthesis.#Then expected_then}} - {synthesis.#Seq {synthesis.#Test {<tag> test}} - {synthesis.#Then actual_then}}]))] + (`` (all random.either + (all random.either + (do [! random.monad] + [_ (in []) + [expected_then actual_then] (scenario context)] + (in [{synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then expected_then}} + {synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then actual_then}}])) + (do [! random.monad] + [_ (in []) + .let [real_register (dictionary.size (the #necessary context)) + fake_register (n.+ (the #redundants context) + (dictionary.size (the #necessary context)))] + [expected_then actual_then] (scenario (revised #necessary (dictionary.has real_register fake_register) context))] + (in [{synthesis.#Seq {synthesis.#Bind real_register} + {synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then expected_then}}} + {synthesis.#Seq {synthesis.#Bind fake_register} + {synthesis.#Seq {synthesis.#Pop} + {synthesis.#Then actual_then}}}]))) + (all random.either + (~~ (template [<tag> <random>] + [(do [! random.monad] + [test <random> + [expected_then actual_then] (scenario context)] + (in [{synthesis.#Seq {synthesis.#Test {<tag> test}} + {synthesis.#Then expected_then}} + {synthesis.#Seq {synthesis.#Test {<tag> test}} + {synthesis.#Then actual_then}}]))] - [synthesis.#Bit random.bit] - [synthesis.#I64 (# ! each .i64 random.nat)] - [synthesis.#F64 random.frac] - [synthesis.#Text (random.unicode 1)] - ))) - ($_ random.either - (do [! random.monad] - [side ..random_side - [expected_next actual_next] (path_scenario scenario context)] - (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} - expected_next} - {synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} - actual_next}])) - (do [! random.monad] - [member ..random_member - [expected_next actual_next] (path_scenario scenario context)] - (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} - expected_next} - {synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} - actual_next}]))) - (do [! random.monad] - [_ (in []) - [expected_left actual_left] (path_scenario scenario context) - [expected_right actual_right] (path_scenario scenario context)] - (in [{synthesis.#Alt expected_left expected_right} - {synthesis.#Alt actual_left actual_right}])) - ))) + [synthesis.#Bit random.bit] + [synthesis.#I64 (# ! each .i64 random.nat)] + [synthesis.#F64 random.frac] + [synthesis.#Text (random.unicode 1)] + ))) + (all random.either + (do [! random.monad] + [side ..random_side + [expected_next actual_next] (path_scenario scenario context)] + (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} + expected_next} + {synthesis.#Seq {synthesis.#Access {synthesis.#Side side}} + actual_next}])) + (do [! random.monad] + [member ..random_member + [expected_next actual_next] (path_scenario scenario context)] + (in [{synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} + expected_next} + {synthesis.#Seq {synthesis.#Access {synthesis.#Member member}} + actual_next}]))) + (do [! random.monad] + [_ (in []) + [expected_left actual_left] (path_scenario scenario context) + [expected_right actual_right] (path_scenario scenario context)] + (in [{synthesis.#Alt expected_left expected_right} + {synthesis.#Alt actual_left actual_right}])) + ))) (def: (case_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -226,12 +226,12 @@ (def: (branch_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..let_scenario scenario context) - (..if_scenario scenario context) - (..get_scenario scenario context) - (..case_scenario scenario context) - )) + (all random.either + (..let_scenario scenario context) + (..if_scenario scenario context) + (..get_scenario scenario context) + (..case_scenario scenario context) + )) (def: scope_arity 5) @@ -265,10 +265,10 @@ (def: (loop_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..scope_scenario scenario context) - (..again_scenario scenario context) - )) + (all random.either + (..scope_scenario scenario context) + (..again_scenario scenario context) + )) (def: (abstraction_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -293,30 +293,30 @@ (def: (function_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..abstraction_scenario scenario context) - (..apply_scenario scenario context) - )) + (all random.either + (..abstraction_scenario scenario context) + (..apply_scenario scenario context) + )) (def: (control_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) - ($_ random.either - (..branch_scenario scenario context) - (..loop_scenario scenario context) - (..function_scenario scenario context) - )) + (all random.either + (..branch_scenario scenario context) + (..loop_scenario scenario context) + (..function_scenario scenario context) + )) (def: (scenario context) (Scenario Synthesis) - ($_ random.either - (..primitive_scenario context) - (..structure_scenario context) - (..control_scenario (..with_redundancy - (..control_scenario - (..with_redundancy - ..structure_scenario))) - context) - )) + (all random.either + (..primitive_scenario context) + (..structure_scenario context) + (..control_scenario (..with_redundancy + (..control_scenario + (..with_redundancy + ..structure_scenario))) + context) + )) (def: default Context @@ -326,11 +326,11 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (do random.monad - [[expected input] (..scenario ..default)] - (_.cover [/.optimization] - (|> (/.optimization input) - (!expect (^.multi {try.#Success actual} - (# synthesis.equivalence = expected actual)))))) - ))) + (all _.and + (do random.monad + [[expected input] (..scenario ..default)] + (_.cover [/.optimization] + (|> (/.optimization input) + (!expect (^.multi {try.#Success actual} + (# synthesis.equivalence = expected actual)))))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux index c253f7107..132d27fb6 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -37,74 +37,74 @@ (def: code^ (Random Code) (let [numeric^ (is (Random Code) - ($_ r.either - (|> r.bit (r#each code.bit)) - (|> r.nat (r#each code.nat)) - (|> r.int (r#each code.int)) - (|> r.rev (r#each code.rev)) - (|> r.safe_frac (r#each code.frac)))) + (all r.either + (|> r.bit (r#each code.bit)) + (|> r.nat (r#each code.nat)) + (|> r.int (r#each code.int)) + (|> r.rev (r#each code.rev)) + (|> r.safe_frac (r#each code.frac)))) textual^ (is (Random Code) - ($_ r.either - (do r.monad - [size (|> r.nat (r#each (n.% 20)))] - (|> (r.ascii/upper_alpha size) (r#each code.text))) - (|> symbol^ (r#each code.symbol)) - (|> symbol^ (r#each code.tag)))) + (all r.either + (do r.monad + [size (|> r.nat (r#each (n.% 20)))] + (|> (r.ascii/upper_alpha size) (r#each code.text))) + (|> symbol^ (r#each code.symbol)) + (|> symbol^ (r#each code.tag)))) simple^ (is (Random Code) - ($_ r.either - numeric^ - textual^))] + (all r.either + numeric^ + textual^))] (r.rec (function (_ code^) (let [multi^ (do r.monad [size (|> r.nat (r#each (n.% 3)))] (r.list size code^)) composite^ (is (Random Code) - ($_ r.either - (|> multi^ (r#each code.form)) - (|> multi^ (r#each code.tuple)) - (do r.monad - [size (|> r.nat (r#each (n.% 3)))] - (|> (r.list size (r.and code^ code^)) - (r#each code.record)))))] - ($_ r.either - simple^ - composite^)))))) + (all r.either + (|> multi^ (r#each code.form)) + (|> multi^ (r#each code.tuple)) + (do r.monad + [size (|> r.nat (r#each (n.% 3)))] + (|> (r.list size (r.and code^ code^)) + (r#each code.record)))))] + (all r.either + simple^ + composite^)))))) (def: code Test (do [! r.monad] [sample code^] - ($_ _.and - (_.test "Can parse Lux code." - (case (let [source_code (%.code sample)] - (/.parse "" (dictionary.empty text.hash) (text.size source_code) - [location.dummy 0 source_code])) - {.#Left error} - false + (all _.and + (_.test "Can parse Lux code." + (case (let [source_code (%.code sample)] + (/.parse "" (dictionary.empty text.hash) (text.size source_code) + [location.dummy 0 source_code])) + {.#Left error} + false - {.#Right [_ parsed]} - (# code.equivalence = parsed sample))) - (do ! - [other code^] - (_.test "Can parse multiple Lux code nodes." - (let [source_code (format (%.code sample) " " (%.code other)) - source_code//size (text.size source_code)] - (case (/.parse "" (dictionary.empty text.hash) source_code//size - [location.dummy 0 source_code]) - {.#Left error} - false + {.#Right [_ parsed]} + (# code.equivalence = parsed sample))) + (do ! + [other code^] + (_.test "Can parse multiple Lux code nodes." + (let [source_code (format (%.code sample) " " (%.code other)) + source_code//size (text.size source_code)] + (case (/.parse "" (dictionary.empty text.hash) source_code//size + [location.dummy 0 source_code]) + {.#Left error} + false - {.#Right [remaining =sample]} - (case (/.parse "" (dictionary.empty text.hash) source_code//size - remaining) - {.#Left error} - false + {.#Right [remaining =sample]} + (case (/.parse "" (dictionary.empty text.hash) source_code//size + remaining) + {.#Left error} + false - {.#Right [_ =other]} - (and (# code.equivalence = sample =sample) - (# code.equivalence = other =other))))))) - ))) + {.#Right [_ =other]} + (and (# code.equivalence = sample =sample) + (# code.equivalence = other =other))))))) + ))) (def: comment_text^ (Random Text) @@ -124,23 +124,23 @@ (do r.monad [sample code^ comment comment^] - ($_ _.and - (_.test "Can handle comments." - (case (let [source_code (format comment (%.code sample)) - source_code//size (text.size source_code)] - (/.parse "" (dictionary.empty text.hash) source_code//size - [location.dummy 0 source_code])) - {.#Left error} - false + (all _.and + (_.test "Can handle comments." + (case (let [source_code (format comment (%.code sample)) + source_code//size (text.size source_code)] + (/.parse "" (dictionary.empty text.hash) source_code//size + [location.dummy 0 source_code])) + {.#Left error} + false - {.#Right [_ parsed]} - (# code.equivalence = parsed sample))) - ))) + {.#Right [_ parsed]} + (# code.equivalence = parsed sample))) + ))) (def: .public test Test (<| (_.context (symbol.module (symbol /._))) - ($_ _.and - ..code - ..comments - ))) + (all _.and + ..code + ..comments + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux index cb6859350..c828ed855 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access.lux @@ -8,7 +8,7 @@ (def: .public test Test - ($_ _.and - /side.test - /member.test - )) + (all _.and + /side.test + /member.test + )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux index db4f15bfa..a7c72b262 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/member.lux @@ -17,10 +17,10 @@ (def: .public random (Random /.Member) - ($_ random.and - random.nat - random.bit - )) + (all random.and + random.nat + random.bit + )) (def: .public test Test @@ -29,13 +29,13 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux index adc2b142d..c5706bc14 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/access/side.lux @@ -17,10 +17,10 @@ (def: .public random (Random /.Side) - ($_ random.and - random.nat - random.bit - )) + (all random.and + random.nat + random.bit + )) (def: .public test Test @@ -29,13 +29,13 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - (_.cover [/.format] - (bit#= (# /.equivalence = left right) - (text#= (/.format left) (/.format right)))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [/.format] + (bit#= (# /.equivalence = left right) + (text#= (/.format left) (/.format right)))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux index 568788a0e..32e833ca7 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/synthesis/simple.lux @@ -19,12 +19,12 @@ (def: .public random (Random /.Simple) - ($_ random.or - random.bit - random.i64 - random.frac - (random.ascii/lower 1) - )) + (all random.or + random.bit + random.i64 + random.frac + (random.ascii/lower 1) + )) (def: .public test Test @@ -33,13 +33,13 @@ (do [! random.monad] [left ..random right ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) - (_.cover [/.format] - (bit#= (text#= (/.format left) (/.format right)) - (# /.equivalence = left right))) - )))) + (_.cover [/.format] + (bit#= (text#= (/.format left) (/.format right)) + (# /.equivalence = left right))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux index e8b0dbb26..5dca59932 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux @@ -58,141 +58,141 @@ content/1 (random.only (|>> (n.= content/0) not) random.nat) hash random.nat .let [key (/key.key signature content/0)]] - ($_ _.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')) + (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')) - _ - 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))) + (_.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)))) + ))) (def: .public test Test @@ -206,52 +206,52 @@ content/1 (random.only (|>> (n.= content/0) not) random.nat) hash random.nat .let [key (/key.key signature content/0)]]) - ($_ _.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))) - (_.for [/.Entry] - ..test|entry) + (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))) + (_.for [/.Entry] + ..test|entry) - $/signature.test - $/key.test - $/artifact.test - $/registry.test - $/module.test - $/unit.test - ))) + $/signature.test + $/key.test + $/artifact.test + $/registry.test + $/module.test + $/unit.test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux index 7e5d789a5..e87df01d3 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact.lux @@ -14,19 +14,19 @@ (def: .public random (Random /.Artifact) - ($_ random.and - random.nat - /category.random - random.bit - )) + (all random.and + random.nat + /category.random + random.bit + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Artifact /.ID]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - /category.test - ))) + /category.test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux index 358f35350..1d45f6113 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/artifact/category.lux @@ -12,33 +12,33 @@ (def: random_definition (Random /.Definition) - ($_ random.and - (random.ascii/lower 1) - (random.maybe - ($_ random.and - random.nat - random.nat - random.nat - )) - )) + (all random.and + (random.ascii/lower 1) + (random.maybe + (all random.and + random.nat + random.nat + random.nat + )) + )) (def: .public random (Random /.Category) - ($_ random.or - (random#in []) - ..random_definition - (random.ascii/lower 2) - (random.ascii/lower 3) - (random.ascii/lower 4) - (random.ascii/lower 5) - (random.ascii/lower 6) - )) + (all random.or + (random#in []) + ..random_definition + (random.ascii/lower 2) + (random.ascii/lower 3) + (random.ascii/lower 4) + (random.ascii/lower 5) + (random.ascii/lower 6) + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Category]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + ))) 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 45d29931d..5d9457c91 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/key.lux @@ -18,10 +18,10 @@ (do random.monad [expected //signature.random document random.nat] - ($_ _.and - (_.cover [/.key /.signature] - (|> document - (/.key expected) - /.signature - (same? expected))) - )))) + (all _.and + (_.cover [/.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 2a98f38be..f86ab62d6 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -21,23 +21,23 @@ (def: .public (random it) (All (_ a) (-> (Random a) (Random (/.Module a)))) - ($_ random.and - random.nat - (/descriptor.random 0) - (do random.monad - [signature $signature.random - example it] - (in (document.document (key.key signature example) - example))))) + (all random.and + random.nat + (/descriptor.random 0) + (do random.monad + [signature $signature.random + example it] + (in (document.document (key.key signature example) + example))))) (def: .public test Test (<| (_.covering /._) (_.for [/.Module]) - ($_ _.and - (_.cover [/.ID /.runtime] - (n.= 0 /.runtime)) + (all _.and + (_.cover [/.ID /.runtime] + (n.= 0 /.runtime)) - /document.test - /descriptor.test - ))) + /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 37c1af940..6579f7b5a 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 @@ -21,21 +21,21 @@ (def: random_module_state (Random Module_State) - ($_ random.or - (random#in []) - (random#in []) - (random#in []) - )) + (all random.or + (random#in []) + (random#in []) + (random#in []) + )) (def: .public (random imports) (-> Nat (Random /.Descriptor)) - ($_ random.and - (random.ascii/lower 1) - (random.ascii/lower 1) - random.nat - ..random_module_state - (random.set text.hash imports (random.ascii/lower 2)) - )) + (all random.and + (random.ascii/lower 1) + (random.ascii/lower 1) + random.nat + ..random_module_state + (random.set text.hash imports (random.ascii/lower 2)) + )) (def: .public test Test @@ -43,17 +43,17 @@ (_.for [/.Descriptor]) (do random.monad [expected (..random 5)]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random 1))) + (all _.and + (_.for [/.equivalence] + ($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))) - ))) + (_.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))) + ))) 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 1ed849972..182b127f4 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 @@ -36,63 +36,63 @@ .let [key/0 (/key.key signature/0 0) key/1 (/key.key signature/1 0)] expected random.nat] - ($_ _.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))) - )))) + (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))) + )))) 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 595123f7f..15f5f800c 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux @@ -39,10 +39,10 @@ (def: random_dependency (Random unit.ID) - ($_ random.and - random.nat - random.nat - )) + (all random.and + random.nat + random.nat + )) (def: (random_dependencies amount) (-> Nat (Random (Set unit.ID))) @@ -61,120 +61,120 @@ expected_names (|> (random.ascii/lower 1) (random.set text.hash expected_amount) (# ! each set.list))] - (`` ($_ _.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)) + (`` (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)) - _ - 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)) - (same? <expected> actual_name) + _ + 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)) + (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)) + _ + false) + (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] - [/.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 (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)))] + [/.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 (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)))] - [/.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 |>] + )))) + (_.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 /.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 (|>>)] + )))) + (_.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 (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 85c19714c..94e9127a0 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux @@ -24,33 +24,33 @@ (def: .public random (Random /.Signature) - ($_ random.and - ($_ random.and - (random.ascii/upper 1) - (random.ascii/lower 1)) - ////version.random - )) + (all random.and + (all random.and + (random.ascii/upper 1) + (random.ascii/lower 1)) + ////version.random + )) (def: .public test Test (<| (_.covering /._) (_.for [/.Signature]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - - (do random.monad - [left ..random - right ..random] - (_.cover [/.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)))) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (do random.monad + [left ..random + right ..random] + (_.cover [/.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)))) + ))) 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 770ff473d..0bda3ebc3 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/unit.lux @@ -16,21 +16,21 @@ (def: .public random (Random /.ID) - ($_ random.and - random.nat - random.nat - )) + (all random.and + random.nat + random.nat + )) (def: .public test Test (<| (_.covering /._) (_.for [/.ID]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - - (_.cover [/.none] - (set.empty? /.none)) - ))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + + (_.cover [/.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 d48c3297e..41e6a00e9 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache.lux @@ -29,26 +29,26 @@ [.let [/ "/" fs (file.mock /)] context $//context.random] - ($_ _.and - (in (do [! async.monad] - [pre/0 (# fs directory? (/.path fs context)) - pre/1 (/.enabled? fs context) - 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)))) + (all _.and + (in (do [! async.monad] + [pre/0 (# fs directory? (/.path fs context)) + pre/1 (/.enabled? fs context) + 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)))) - /archive.test - /module.test - /artifact.test - /purge.test - )))) + /archive.test + /module.test + /artifact.test + /purge.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 34f3693f6..6b6191135 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/archive.lux @@ -65,20 +65,20 @@ archive (archive.has module/1 entry/1 archive)] (in [archive (archive.export ///.version archive)])) try.trusted)]] - ($_ _.and - (in (do [! async.monad] - [pre/0 (# fs file? (/.descriptor fs context)) - enabled? (//.enable! ! fs context) - 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)))) - )))) + (all _.and + (in (do [! async.monad] + [pre/0 (# fs file? (/.descriptor fs context)) + enabled? (//.enable! ! fs context) + 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)))) + )))) 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 34aa31b78..b27211525 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/artifact.lux @@ -34,20 +34,20 @@ @module random.nat @artifact random.nat expected ($binary.random 1)] - ($_ _.and - (in (do [! async.monad] - [pre (# fs file? (/.path fs context @module @artifact)) - _ (//module.enable! ! fs context @module) - 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))))) - )))) + (all _.and + (in (do [! async.monad] + [pre (# fs file? (/.path fs context @module @artifact)) + _ (//module.enable! ! fs context @module) + 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))))) + )))) 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 841167110..6605bf05e 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/module.lux @@ -51,44 +51,44 @@ (do [! random.monad] [context $///context.random @module random.nat] - ($_ _.and - (in (do [! async.monad] - [.let [/ "/" - fs (file.mock /)] - pre/0 (# fs directory? (/.path fs context @module)) - pre/1 (/.enabled? fs context @module) - 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)))) - (in (do [! async.monad] - [.let [/ "/" - fs (file.mock /)] - pre/0 (# fs directory? (/.path fs context @module)) - pre/1 (/.enabled? fs context @module) - 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))))) - )))) + (all _.and + (in (do [! async.monad] + [.let [/ "/" + fs (file.mock /)] + pre/0 (# fs directory? (/.path fs context @module)) + pre/1 (/.enabled? fs context @module) + 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)))) + (in (do [! async.monad] + [.let [/ "/" + fs (file.mock /)] + pre/0 (# fs directory? (/.path fs context @module)) + pre/1 (/.enabled? fs context @module) + 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))))) + )))) 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 b6f6b4f27..ae210f1a5 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cache/purge.lux @@ -64,78 +64,78 @@ / "/" fs (file.mock /)] context $context.random] - ($_ _.and - (_.for [/.Cache] - ($_ _.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))))) - )) - (_.for [/.Purge] - ($_ _.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))))))) - (in (do [! async.monad] - [_ (//module.enable! ! fs context id/0) - .let [dir (//module.path fs context id/0) - file/0 (%.format dir / name/0) - file/1 (%.format dir / name/1)] - _ (# fs write file/0 content/0) - _ (# fs write file/1 content/1) - 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) + (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))))) + )) + (_.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))))))) + (in (do [! async.monad] + [_ (//module.enable! ! fs context id/0) + .let [dir (//module.path fs context id/0) + file/0 (%.format dir / name/0) + file/1 (%.format dir / name/1)] + _ (# fs write file/0 content/0) + _ (# fs write file/1 content/1) + 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) - 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 97ee8ac28..56f8fe6af 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cli.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cli.lux @@ -43,102 +43,102 @@ module (random.ascii/lower 5) compilers (random.list amount $/compiler.random) configuration ($configuration.random 5) - .let [compilation' ($_ list#composite - (list#conjoint (list#each (|>> (list "--host_dependency")) host_dependencies)) - (list#conjoint (list#each (|>> (list "--library")) libraries)) - (list#conjoint (list#each (|>> /compiler.format (list "--compiler")) compilers)) - (list#conjoint (list#each (|>> (list "--source")) sources)) - (list "--target" target - "--module" module - "--configuration" (configuration.format configuration))) - export ($_ list#composite - (list#conjoint (list#each (|>> (list "--source")) sources)) - (list "--target" target))]] - ($_ _.and - (_.for [/.Compilation] - (`` ($_ _.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)))] + .let [compilation' (all list#composite + (list#conjoint (list#each (|>> (list "--host_dependency")) host_dependencies)) + (list#conjoint (list#each (|>> (list "--library")) libraries)) + (list#conjoint (list#each (|>> /compiler.format (list "--compiler")) compilers)) + (list#conjoint (list#each (|>> (list "--source")) sources)) + (list "--target" target + "--module" module + "--configuration" (configuration.format configuration))) + export (all list#composite + (list#conjoint (list#each (|>> (list "--source")) sources)) + (list "--target" target))]] + (all _.and + (_.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)))] - [/.Host_Dependency /.#host_dependencies (list#= host_dependencies)] - [/.Library /.#libraries (list#= libraries)] - [/compiler.Compiler /.#compilers (# (list.equivalence /compiler.equivalence) = compilers)] - [/.Source /.#sources (list#= sources)] - [/.Target /.#target (same? target)] - [/.Module /.#module (same? module)] - [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))] + [/.Host_Dependency /.#host_dependencies (list#= host_dependencies)] + [/.Library /.#libraries (list#= libraries)] + [/compiler.Compiler /.#compilers (# (list.equivalence /compiler.equivalence) = compilers)] + [/.Source /.#sources (list#= sources)] + [/.Target /.#target (same? target)] + [/.Module /.#module (same? module)] + [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))] - [/.#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)] + ))))) + (_.cover [/.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)] + ))))) + (_.cover [/.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 - )))) + $/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 69a9db048..4ad6e7f57 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/cli/compiler.lux @@ -35,14 +35,14 @@ (_.for [/.Compiler]) (do [! random.monad] [expected ..random] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) - (_.cover [/.format /.parser] - (|> expected - /.format - (<text>.result /.parser) - (try#each (# /.equivalence = expected)) - (try.else false))) - )))) + (_.cover [/.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 30e6aa280..773744465 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/context.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/context.lux @@ -19,12 +19,12 @@ (def: .public random (Random /.Context) (do [! random.monad] - [context ($_ random.either - (in /.js) - (in /.jvm) - (in /.lua) - (in /.python) - (in /.ruby))] + [context (all random.either + (in /.js) + (in /.jvm) + (in /.lua) + (in /.python) + (in /.ruby))] (# ! each context (random.ascii/lower 1)))) (def: .public test @@ -33,24 +33,24 @@ (_.for [/.Context /.Extension]) (do [! random.monad] [target (random.ascii/lower 1)] - ($_ _.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>))] + (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>))] - [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 c737eb0e3..9278a2cbf 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/export.lux @@ -57,65 +57,65 @@ (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] content/0 random_content content/1 random_content] - ($_ _.and - (in (do [! async.monad] - [it (do (try.with !) - [.let [fs (file.mock /)] - _ (# fs make_directory source/0) - _ (# fs write file/0 content/0) - - _ (# fs make_directory source/1) - _ (# fs make_directory (format source/1 / dir/0)) - _ (# fs write file/1 content/1) + (all _.and + (in (do [! async.monad] + [it (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs make_directory source/0) + _ (# fs write file/0 content/0) + + _ (# fs make_directory source/1) + _ (# fs make_directory (format source/1 / dir/0)) + _ (# fs write file/1 content/1) - _ (# fs make_directory target) - library_tar (/.library fs (list source/0 source/1)) - _ (/.export fs [(list source/0 source/1) target]) - export_tar (# fs read (format target / /.file)) - export_tar (# ! in (<binary>.result tar.parser export_tar))] - (in [library_tar export_tar]))] - ($_ _.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))) - ))) - )))) + _ (# fs make_directory target) + library_tar (/.library fs (list source/0 source/1)) + _ (/.export fs [(list source/0 source/1) target]) + export_tar (# fs read (format target / /.file)) + 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))) + ))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/import.lux b/stdlib/source/test/lux/tool/compiler/meta/import.lux index f7b90c8bf..a88cd53ad 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/import.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/import.lux @@ -108,50 +108,50 @@ (dictionary.value file/1) (maybe#each (binary#= content/1)) (maybe.else false)))))]] - ($_ _.and - (in (do [! async.monad] - [it/0 (do (try.with !) - [.let [fs (file.mock /)] - _ (# fs write library/0 library_content)] - (/.import fs (list library/0))) - it/1 (do (try.with !) - [.let [fs (file.mock /)] - _ (# 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)))))) - (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)))) - (in (do [! async.monad] - [it/0 (do (try.with !) - [.let [fs (file.mock /)] - _ (# fs write library/0 library_content/-0) - _ (/.import fs (list library/0))] - (in false)) - it/1 (do (try.with !) - [.let [fs (file.mock /)] - _ (# fs write library/0 library_content/-1) - _ (/.import fs (list library/0))] - (in false)) - it/2 (do (try.with !) - [.let [fs (file.mock /)] - _ (# 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))))) - )))) + (all _.and + (in (do [! async.monad] + [it/0 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library/0 library_content)] + (/.import fs (list library/0))) + it/1 (do (try.with !) + [.let [fs (file.mock /)] + _ (# 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)))))) + (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)))) + (in (do [! async.monad] + [it/0 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library/0 library_content/-0) + _ (/.import fs (list library/0))] + (in false)) + it/1 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library/0 library_content/-1) + _ (/.import fs (list library/0))] + (in false)) + it/2 (do (try.with !) + [.let [fs (file.mock /)] + _ (# 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))))) + )))) diff --git a/stdlib/source/test/lux/tool/compiler/phase.lux b/stdlib/source/test/lux/tool/compiler/phase.lux index ced6edd48..b758a7a01 100644 --- a/stdlib/source/test/lux/tool/compiler/phase.lux +++ b/stdlib/source/test/lux/tool/compiler/phase.lux @@ -50,51 +50,51 @@ [state random.nat expected random.int expected_error (random.ascii/lower 1)] - ($_ _.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)))) - ))) + (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)))) + ))) (def: test|state Test @@ -102,68 +102,68 @@ [state random.nat dummy random.nat expected random.int] - ($_ _.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))) - ))) + (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))) + ))) (def: test|operation Test (do [! random.monad] [state random.nat expected random.int] - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection (..comparison state) /.functor)) - (_.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))) - ..test|state - ..test|error - ))) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection (..comparison state) /.functor)) + (_.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))) + ..test|state + ..test|error + ))) (def: test|phase Test @@ -171,36 +171,36 @@ [state/0 random.nat state/1 random.rev expected random.int] - ($_ _.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)))) - ))) + (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)))) + ))) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.Operation] - ..test|operation) - (_.for [/.Phase] - ..test|phase) - ))) + (all _.and + (_.for [/.Operation] + ..test|operation) + (_.for [/.Phase] + ..test|phase) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/reference.lux b/stdlib/source/test/lux/tool/compiler/reference.lux index e938f99b9..01f967571 100644 --- a/stdlib/source/test/lux/tool/compiler/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/reference.lux @@ -24,17 +24,17 @@ (def: constant (Random /.Constant) - ($_ random.and - (random.ascii/upper 5) - (random.ascii/lower 5) - )) + (all random.and + (random.ascii/upper 5) + (random.ascii/lower 5) + )) (def: .public random (Random /.Reference) - ($_ random.or - /variable.random - ..constant - )) + (all random.or + /variable.random + ..constant + )) (def: .public test Test @@ -43,53 +43,53 @@ (do random.monad [expected_register random.nat expected_constant ..constant]) - (`` ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) - (~~ (template [<tag>] - [(_.cover [<tag>] - (case (<tag> expected_register) - (pattern (<tag> actual_register)) - (n.= expected_register actual_register) + (~~ (template [<tag>] + [(_.cover [<tag>] + (case (<tag> expected_register) + (pattern (<tag> actual_register)) + (n.= expected_register actual_register) - _ - false))] + _ + false))] - [/.local] - [/.foreign] - )) + [/.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) + (_.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) - _ - 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)))) - - /variable.test - )))) + _ + 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)))) + + /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 0c0c88936..d88aa2c56 100644 --- a/stdlib/source/test/lux/tool/compiler/reference/variable.lux +++ b/stdlib/source/test/lux/tool/compiler/reference/variable.lux @@ -16,10 +16,10 @@ (def: .public random (Random /.Variable) - ($_ random.or - random.nat - random.nat - )) + (all random.or + random.nat + random.nat + )) (def: .public test Test @@ -27,19 +27,19 @@ (_.for [/.Variable]) (do [! random.monad] [register random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.cover [/.self] - (case (/.self) - (pattern (/.self)) true - _ false)) - (_.cover [/.self?] - (/.self? (/.self))) - (_.for [/.Register] - (_.cover [/.format] - (not (text#= (/.format {/.#Local register}) - (/.format {/.#Foreign register}))))) - )))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.cover [/.self] + (case (/.self) + (pattern (/.self)) true + _ false)) + (_.cover [/.self?] + (/.self? (/.self))) + (_.for [/.Register] + (_.cover [/.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 01fc124a1..492b02fa7 100644 --- a/stdlib/source/test/lux/tool/compiler/version.lux +++ b/stdlib/source/test/lux/tool/compiler/version.lux @@ -26,16 +26,16 @@ (do [! random.monad] [this ..random that ..random] - (`` ($_ _.and - (_.cover [/.format] - (bit#= (n.= this that) - (text#= (/.format this) (/.format that)))) - (~~ (template [<level>] - [(_.cover [<level>] - (text.contains? (%.nat (<level> this)) - (/.format this)))] + (`` (all _.and + (_.cover [/.format] + (bit#= (n.= this that) + (text#= (/.format this) (/.format that)))) + (~~ (template [<level>] + [(_.cover [<level>] + (text.contains? (%.nat (<level> this)) + (/.format this)))] - [/.patch] - [/.minor] - [/.major])) - ))))) + [/.patch] + [/.minor] + [/.major])) + ))))) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 6e19e21a0..2c4eca4c4 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -52,14 +52,14 @@ (function (_ again) (let [pairG (random.and again again) un_parameterized (is (Random Type) - ($_ random.either - (random#each (|>> {.#Primitive}) (random.and ..short (random.list 0 again))) - (random#each (|>> {.#Primitive}) (random.and ..short (random.list 1 again))) - (random#each (|>> {.#Primitive}) (random.and ..short (random.list 2 again))) - (random#each (|>> {.#Sum}) pairG) - (random#each (|>> {.#Product}) pairG) - (random#each (|>> {.#Function}) pairG) - ))] + (all random.either + (random#each (|>> {.#Primitive}) (random.and ..short (random.list 0 again))) + (random#each (|>> {.#Primitive}) (random.and ..short (random.list 1 again))) + (random#each (|>> {.#Primitive}) (random.and ..short (random.list 2 again))) + (random#each (|>> {.#Sum}) pairG) + (random#each (|>> {.#Product}) pairG) + (random#each (|>> {.#Function}) pairG) + ))] (case parameters 0 un_parameterized _ (|> random.nat @@ -68,198 +68,198 @@ (def: .public (random parameters) (-> Nat (Random Type)) - ($_ random.either - (random#each (/.univ_q parameters) (random' parameters)) - (random#each (/.ex_q parameters) (random' parameters)) - )) + (all random.either + (random#each (/.univ_q parameters) (random' parameters)) + (random#each (/.ex_q parameters) (random' parameters)) + )) (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random 0))) - - (do [! random.monad] - [anonymousT (random.only (|>> (pipe.case {.#Named _ _} false - _ true)) - (..random 0)) - symbol/0 ..symbol - symbol/1 ..symbol - .let [namedT {.#Named symbol/0 anonymousT} - aliasedT {.#Named symbol/1 namedT}]] - ($_ _.and - (_.cover [/.de_aliased] - (# /.equivalence = namedT (/.de_aliased aliasedT))) - (_.cover [/.anonymous] - (# /.equivalence = anonymousT (/.anonymous aliasedT))))) - (do [! random.monad] - [size (|> random.nat (# ! each (n.% 3))) - members (|> (..random 0) - (random.only (function (_ type) - (case type - (^.or {.#Sum _} {.#Product _}) - #0 + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..random 0))) + + (do [! random.monad] + [anonymousT (random.only (|>> (pipe.case {.#Named _ _} false + _ true)) + (..random 0)) + symbol/0 ..symbol + symbol/1 ..symbol + .let [namedT {.#Named symbol/0 anonymousT} + aliasedT {.#Named symbol/1 namedT}]] + (all _.and + (_.cover [/.de_aliased] + (# /.equivalence = namedT (/.de_aliased aliasedT))) + (_.cover [/.anonymous] + (# /.equivalence = anonymousT (/.anonymous aliasedT))))) + (do [! random.monad] + [size (|> random.nat (# ! each (n.% 3))) + members (|> (..random 0) + (random.only (function (_ type) + (case type + (^.or {.#Sum _} {.#Product _}) + #0 - _ - #1))) - (list.repeated size) - (monad.all !)) - .let [(open "/#[0]") /.equivalence - (open "list#[0]") (list.equivalence /.equivalence)]] - (`` ($_ _.and - (~~ (template [<ctor> <dtor> <unit>] - [(_.cover [<ctor> <dtor>] - (let [flat (|> members <ctor> <dtor>)] - (or (list#= members flat) - (and (list#= (list) members) - (list#= (list <unit>) flat)))))] + _ + #1))) + (list.repeated size) + (monad.all !)) + .let [(open "/#[0]") /.equivalence + (open "list#[0]") (list.equivalence /.equivalence)]] + (`` (all _.and + (~~ (template [<ctor> <dtor> <unit>] + [(_.cover [<ctor> <dtor>] + (let [flat (|> members <ctor> <dtor>)] + (or (list#= members flat) + (and (list#= (list) members) + (list#= (list <unit>) flat)))))] - [/.variant /.flat_variant Nothing] - [/.tuple /.flat_tuple Any] - )) - ))) - (_.cover [/.applied] - (and (<| (maybe.else #0) - (do maybe.monad - [partial (/.applied (list Bit) Ann) - full (/.applied (list Int) partial)] - (in (# /.equivalence = full {.#Product Bit Int})))) - (|> (/.applied (list Bit) Text) - (pipe.case {.#None} #1 _ #0)))) - (do [! random.monad] - [size (|> random.nat (# ! each (n.% 3))) - members (monad.all ! (list.repeated size (..random 0))) - extra (|> (..random 0) - (random.only (function (_ type) - (case type - (^.or {.#Function _} {.#Apply _}) - #0 + [/.variant /.flat_variant Nothing] + [/.tuple /.flat_tuple Any] + )) + ))) + (_.cover [/.applied] + (and (<| (maybe.else #0) + (do maybe.monad + [partial (/.applied (list Bit) Ann) + full (/.applied (list Int) partial)] + (in (# /.equivalence = full {.#Product Bit Int})))) + (|> (/.applied (list Bit) Text) + (pipe.case {.#None} #1 _ #0)))) + (do [! random.monad] + [size (|> random.nat (# ! each (n.% 3))) + members (monad.all ! (list.repeated size (..random 0))) + extra (|> (..random 0) + (random.only (function (_ type) + (case type + (^.or {.#Function _} {.#Apply _}) + #0 - _ - #1)))) - .let [(open "/#[0]") /.equivalence - (open "list#[0]") (list.equivalence /.equivalence)]] - ($_ _.and - (_.cover [/.function /.flat_function] - (let [[inputs output] (|> (/.function members extra) /.flat_function)] - (and (list#= members inputs) - (/#= extra output)))) - (_.cover [/.application /.flat_application] - (let [[tfunc tparams] (|> extra (/.application members) /.flat_application)] - (n.= (list.size members) (list.size tparams)))) - )) - (do [! random.monad] - [size (|> random.nat (# ! each (|>> (n.% 3) ++))) - body_type (|> (..random 0) - (random.only (function (_ type) - (case type - (^.or {.#UnivQ _} {.#ExQ _}) - #0 + _ + #1)))) + .let [(open "/#[0]") /.equivalence + (open "list#[0]") (list.equivalence /.equivalence)]] + (all _.and + (_.cover [/.function /.flat_function] + (let [[inputs output] (|> (/.function members extra) /.flat_function)] + (and (list#= members inputs) + (/#= extra output)))) + (_.cover [/.application /.flat_application] + (let [[tfunc tparams] (|> extra (/.application members) /.flat_application)] + (n.= (list.size members) (list.size tparams)))) + )) + (do [! random.monad] + [size (|> random.nat (# ! each (|>> (n.% 3) ++))) + body_type (|> (..random 0) + (random.only (function (_ type) + (case type + (^.or {.#UnivQ _} {.#ExQ _}) + #0 - _ - #1)))) - .let [(open "/#[0]") /.equivalence]] - (`` ($_ _.and - (~~ (template [<ctor> <dtor>] - [(_.cover [<ctor> <dtor>] - (let [[flat_size flat_body] (|> body_type (<ctor> size) <dtor>)] - (and (n.= size flat_size) - (/#= body_type flat_body))))] + _ + #1)))) + .let [(open "/#[0]") /.equivalence]] + (`` (all _.and + (~~ (template [<ctor> <dtor>] + [(_.cover [<ctor> <dtor>] + (let [[flat_size flat_body] (|> body_type (<ctor> size) <dtor>)] + (and (n.= size flat_size) + (/#= body_type flat_body))))] - [/.univ_q /.flat_univ_q] - [/.ex_q /.flat_ex_q] - )) - (_.cover [/.quantified?] - (and (not (/.quantified? body_type)) - (|> body_type (/.univ_q size) /.quantified?) - (|> body_type (/.ex_q size) /.quantified?))) - ))) - (do [! random.monad] - [depth (|> random.nat (# ! each (|>> (n.% 3) ++))) - element_type (|> (..random 0) - (random.only (function (_ type) - (case type - (pattern {.#Primitive name (list element_type)}) - (not (text#= array.type_name name)) + [/.univ_q /.flat_univ_q] + [/.ex_q /.flat_ex_q] + )) + (_.cover [/.quantified?] + (and (not (/.quantified? body_type)) + (|> body_type (/.univ_q size) /.quantified?) + (|> body_type (/.ex_q size) /.quantified?))) + ))) + (do [! random.monad] + [depth (|> random.nat (# ! each (|>> (n.% 3) ++))) + element_type (|> (..random 0) + (random.only (function (_ type) + (case type + (pattern {.#Primitive name (list element_type)}) + (not (text#= array.type_name name)) - _ - #1)))) - .let [(open "/#[0]") /.equivalence]] - ($_ _.and - (_.cover [/.array /.flat_array] - (let [[flat_depth flat_element] (|> element_type (/.array depth) /.flat_array)] - (and (n.= depth flat_depth) - (/#= element_type flat_element)))) - (_.cover [/.array?] - (and (not (/.array? element_type)) - (/.array? (/.array depth element_type)))) - )) - (_.cover [/.by_example] - (let [example (is (Maybe Nat) - {.#None})] - (/#= (.type (List Nat)) - (/.by_example [a] - (Maybe a) - example - - (List a))))) - (do random.monad - [sample random.nat] - (_.cover [/.log!] - (exec - (/.log! sample) - true))) - (do random.monad - [left random.nat - right (random.ascii/lower 1) - .let [left,right [left right]]] - (_.cover [/.as] - (|> left,right - (/.as [l r] (And l r) (Or l r)) - (/.as [l r] (Or l r) (And l r)) - (same? left,right)))) - (do random.monad - [expected random.nat] - (_.cover [/.sharing] - (n.= expected - (/.sharing [a] - (I64 a) - expected + _ + #1)))) + .let [(open "/#[0]") /.equivalence]] + (all _.and + (_.cover [/.array /.flat_array] + (let [[flat_depth flat_element] (|> element_type (/.array depth) /.flat_array)] + (and (n.= depth flat_depth) + (/#= element_type flat_element)))) + (_.cover [/.array?] + (and (not (/.array? element_type)) + (/.array? (/.array depth element_type)))) + )) + (_.cover [/.by_example] + (let [example (is (Maybe Nat) + {.#None})] + (/#= (.type (List Nat)) + (/.by_example [a] + (Maybe a) + example + + (List a))))) + (do random.monad + [sample random.nat] + (_.cover [/.log!] + (exec + (/.log! sample) + true))) + (do random.monad + [left random.nat + right (random.ascii/lower 1) + .let [left,right [left right]]] + (_.cover [/.as] + (|> left,right + (/.as [l r] (And l r) (Or l r)) + (/.as [l r] (Or l r) (And l r)) + (same? left,right)))) + (do random.monad + [expected random.nat] + (_.cover [/.sharing] + (n.= expected + (/.sharing [a] + (I64 a) + expected - (I64 a) - (.i64 expected))))) - (do random.monad - [expected_left random.nat - expected_right random.nat] - (_.cover [/.let] - (let [[actual_left actual_right] - (is (/.let [side /.Nat] - [side side]) - [expected_left expected_right])] - (and (same? expected_left actual_left) - (same? expected_right actual_right))))) - (do random.monad - [.let [(open "/#[0]") /.equivalence] - left (..random 0) - right (..random 0)] - ($_ _.and - (_.cover [/.code] - (bit#= (/#= left right) - (code#= (/.code left) (/.code right)))) - (_.cover [/.format] - (bit#= (/#= left right) - (text#= (/.format left) (/.format right)))) - )) + (I64 a) + (.i64 expected))))) + (do random.monad + [expected_left random.nat + expected_right random.nat] + (_.cover [/.let] + (let [[actual_left actual_right] + (is (/.let [side /.Nat] + [side side]) + [expected_left expected_right])] + (and (same? expected_left actual_left) + (same? expected_right actual_right))))) + (do random.monad + [.let [(open "/#[0]") /.equivalence] + left (..random 0) + right (..random 0)] + (all _.and + (_.cover [/.code] + (bit#= (/#= left right) + (code#= (/.code left) (/.code right)))) + (_.cover [/.format] + (bit#= (/#= left right) + (text#= (/.format left) (/.format right)))) + )) - /abstract.test - /check.test - /dynamic.test - /implicit.test - /poly.test - /quotient.test - /refinement.test - /resource.test - /unit.test - /variance.test - ))) + /abstract.test + /check.test + /dynamic.test + /implicit.test + /poly.test + /quotient.test + /refinement.test + /resource.test + /unit.test + /variance.test + ))) diff --git a/stdlib/source/test/lux/type/abstract.lux b/stdlib/source/test/lux/type/abstract.lux index 27c6e97c4..7e3ce6884 100644 --- a/stdlib/source/test/lux/type/abstract.lux +++ b/stdlib/source/test/lux/type/abstract.lux @@ -59,55 +59,55 @@ (do random.monad [expected_foo (random.ascii/lower 5) expected_bar random.nat] - ($_ _.and - (_.cover [/.abstraction] - (and (exec (is (g!Foo Text) - (/.abstraction g!Foo expected_foo)) - true) - (exec (is (g!Bar Text) - (/.abstraction expected_bar)) - true))) - (_.cover [/.representation] - (and (|> expected_foo - (/.abstraction g!Foo) - (is (g!Foo Bit)) - (/.representation g!Foo) - (text#= expected_foo)) - (|> (/.abstraction expected_bar) - (is (g!Bar Bit)) - /.representation - (n.= expected_bar)))) - (_.cover [/.transmutation] - (and (exec (|> expected_foo - (/.abstraction g!Foo) - (is (g!Foo .Macro)) - (/.transmutation g!Foo) - (is (g!Foo .Lux))) - true) - (exec (|> (/.abstraction expected_bar) - (is (g!Bar .Macro)) - /.transmutation - (is (g!Bar .Lux))) - true))) - (_.cover [/.pattern] - (and (let [(/.pattern g!Foo actual_foo) - (is (g!Foo .Module) - (/.abstraction g!Foo expected_foo))] - (text#= expected_foo actual_foo)) - (let [(/.pattern actual_bar) - (is (g!Bar .Module) - (/.abstraction expected_bar))] - (n.= expected_bar actual_bar)))) - (_.for [/.Frame] - ($_ _.and - (_.cover [/.current] - (text#= (template.text [g!Bar]) - (..current))) - (_.cover [/.specific] - (text#= (template.text [g!Foo]) - (..specific))) - (_.cover [/.no_active_frames] - (and no_current! - no_specific!)) - )) - ))))))))) + (all _.and + (_.cover [/.abstraction] + (and (exec (is (g!Foo Text) + (/.abstraction g!Foo expected_foo)) + true) + (exec (is (g!Bar Text) + (/.abstraction expected_bar)) + true))) + (_.cover [/.representation] + (and (|> expected_foo + (/.abstraction g!Foo) + (is (g!Foo Bit)) + (/.representation g!Foo) + (text#= expected_foo)) + (|> (/.abstraction expected_bar) + (is (g!Bar Bit)) + /.representation + (n.= expected_bar)))) + (_.cover [/.transmutation] + (and (exec (|> expected_foo + (/.abstraction g!Foo) + (is (g!Foo .Macro)) + (/.transmutation g!Foo) + (is (g!Foo .Lux))) + true) + (exec (|> (/.abstraction expected_bar) + (is (g!Bar .Macro)) + /.transmutation + (is (g!Bar .Lux))) + true))) + (_.cover [/.pattern] + (and (let [(/.pattern g!Foo actual_foo) + (is (g!Foo .Module) + (/.abstraction g!Foo expected_foo))] + (text#= expected_foo actual_foo)) + (let [(/.pattern actual_bar) + (is (g!Bar .Module) + (/.abstraction expected_bar))] + (n.= expected_bar actual_bar)))) + (_.for [/.Frame] + (all _.and + (_.cover [/.current] + (text#= (template.text [g!Bar]) + (..current))) + (_.cover [/.specific] + (text#= (template.text [g!Foo]) + (..specific))) + (_.cover [/.no_active_frames] + (and no_current! + no_specific!)) + )) + ))))))))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index fab083c9e..07d647d77 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -58,13 +58,13 @@ random_id))) random_quantified (random.either (random#each (|>> {.#UnivQ}) quantifiedG) (random#each (|>> {.#ExQ}) quantifiedG))] - ($_ random.either - (random#each (|>> {.#Primitive}) (random.and ..short (random#in (list)))) - random_pair - random_id - random_quantified - (random#each (|>> {.#Named}) (random.and ..symbol (type' 0))) - ))))) + (all random.either + (random#each (|>> {.#Primitive}) (random.and ..short (random#in (list)))) + random_pair + random_id + random_quantified + (random#each (|>> {.#Named}) (random.and ..symbol (type' 0))) + ))))) (def: type (Random Type) @@ -107,14 +107,14 @@ (def: polymorphism Test - ($_ _.and - (_.for [/.functor] - ($functor.spec ..injection ..comparison /.functor)) - (_.for [/.apply] - ($apply.spec ..injection ..comparison /.apply)) - (_.for [/.monad] - ($monad.spec ..injection ..comparison /.monad)) - )) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + )) (def: (primitive_type parameters) (-> Nat (Random Type)) @@ -135,233 +135,233 @@ [left ..clean_type right ..clean_type ex random.nat] - ($_ _.and - (do random.monad - [expected (random.ascii/upper 10)] - (_.cover [/.failure] - (case (/.result /.fresh_context - (is (/.Check Any) - (/.failure expected))) - {try.#Success _} false - {try.#Failure actual} (same? expected actual)))) - (do random.monad - [expected (random.ascii/upper 10)] - (_.cover [/.assertion] - (and (case (/.result /.fresh_context - (is (/.Check Any) - (/.assertion expected true))) - {try.#Success _} true - {try.#Failure actual} false) - (case (/.result /.fresh_context (/.assertion expected false)) - {try.#Success _} false - {try.#Failure actual} (same? expected actual))))) - (_.cover [/.except] - (case (/.result /.fresh_context - (is (/.Check Any) - (/.except ..yolo []))) - {try.#Success _} false - {try.#Failure error} (exception.match? ..yolo error))) - (let [scenario (is (-> (-> Text Bit) Type Type Bit) - (function (_ ? <left> <right>) - (and (|> (/.check <left> <right>) - (is (/.Check Any)) - (/.result /.fresh_context) - (pipe.case {try.#Failure error} (? error) - {try.#Success _} false)) - (|> (/.check <right> <left>) - (is (/.Check Any)) - (/.result /.fresh_context) - (pipe.case {try.#Failure error} (? error) - {try.#Success _} false)))))] - ($_ _.and - (_.cover [/.type_check_failed] - (let [scenario (scenario (exception.match? /.type_check_failed))] - (and (scenario (Tuple left right) left) - (scenario (Tuple left right) (Or left right)) - (scenario (Tuple left right) (-> left right)) - (scenario (Tuple left right) {.#Ex ex}) - - (scenario (Or left right) left) - (scenario (Or left right) (-> left right)) - (scenario (Or left right) {.#Ex ex}) - - (scenario (-> left right) left) - (scenario (-> left right) {.#Ex ex}) - - (scenario {.#Ex ex} left) - ))) - (_.cover [/.invalid_type_application] - (let [scenario (scenario (text.contains? (the exception.#label /.invalid_type_application)))] - (scenario {.#Apply left right} left))))) - ))) + (all _.and + (do random.monad + [expected (random.ascii/upper 10)] + (_.cover [/.failure] + (case (/.result /.fresh_context + (is (/.Check Any) + (/.failure expected))) + {try.#Success _} false + {try.#Failure actual} (same? expected actual)))) + (do random.monad + [expected (random.ascii/upper 10)] + (_.cover [/.assertion] + (and (case (/.result /.fresh_context + (is (/.Check Any) + (/.assertion expected true))) + {try.#Success _} true + {try.#Failure actual} false) + (case (/.result /.fresh_context (/.assertion expected false)) + {try.#Success _} false + {try.#Failure actual} (same? expected actual))))) + (_.cover [/.except] + (case (/.result /.fresh_context + (is (/.Check Any) + (/.except ..yolo []))) + {try.#Success _} false + {try.#Failure error} (exception.match? ..yolo error))) + (let [scenario (is (-> (-> Text Bit) Type Type Bit) + (function (_ ? <left> <right>) + (and (|> (/.check <left> <right>) + (is (/.Check Any)) + (/.result /.fresh_context) + (pipe.case {try.#Failure error} (? error) + {try.#Success _} false)) + (|> (/.check <right> <left>) + (is (/.Check Any)) + (/.result /.fresh_context) + (pipe.case {try.#Failure error} (? error) + {try.#Success _} false)))))] + (all _.and + (_.cover [/.type_check_failed] + (let [scenario (scenario (exception.match? /.type_check_failed))] + (and (scenario (Tuple left right) left) + (scenario (Tuple left right) (Or left right)) + (scenario (Tuple left right) (-> left right)) + (scenario (Tuple left right) {.#Ex ex}) + + (scenario (Or left right) left) + (scenario (Or left right) (-> left right)) + (scenario (Or left right) {.#Ex ex}) + + (scenario (-> left right) left) + (scenario (-> left right) {.#Ex ex}) + + (scenario {.#Ex ex} left) + ))) + (_.cover [/.invalid_type_application] + (let [scenario (scenario (text.contains? (the exception.#label /.invalid_type_application)))] + (scenario {.#Apply left right} left))))) + ))) (def: var Test (<| (_.for [/.Var]) - ($_ _.and - (_.cover [/.var] - (case (/.result /.fresh_context - (do /.monad - [[var_id var_type] /.var] - (in (type#= var_type {.#Var var_id})))) - {try.#Success verdict} verdict - {try.#Failure error} false)) - (do random.monad - [nominal (random.ascii/upper 10)] - (_.cover [/.bind] - (case (/.result /.fresh_context - (do /.monad - [[var_id var_type] /.var - _ (/.bind {.#Primitive nominal (list)} - var_id)] - (in true))) - {try.#Success _} true - {try.#Failure error} false))) - (do random.monad - [nominal (random.ascii/upper 10)] - (_.cover [/.bound?] - (and (|> (do /.monad - [[var_id var_type] /.var - pre (/.bound? var_id) - _ (/.bind {.#Primitive nominal (list)} - var_id) - post (/.bound? var_id)] - (in (and (not pre) - post))) - (/.result /.fresh_context) - (try.else false)) - (|> (do /.monad - [[var_id var/0] /.var - pre (/.bound? var_id) - [_ var/1] /.var - _ (/.check var/0 var/1) - post (/.bound? var_id)] - (in (and (not pre) - (not post)))) - (/.result /.fresh_context) - (try.else false))))) - (do random.monad - [nominal (random.ascii/upper 10)] - (_.cover [/.cannot_rebind_var] - (case (/.result /.fresh_context - (do /.monad - [[var_id var_type] /.var - _ (/.bind {.#Primitive nominal (list)} - var_id)] - (/.bind {.#Primitive nominal (list)} - var_id))) - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_rebind_var error)))) - (do random.monad - [nominal (random.ascii/upper 10) - var_id random.nat] - (_.cover [/.unknown_type_var] - (case (/.result /.fresh_context - (/.bind {.#Primitive nominal (list)} - var_id)) - {try.#Success _} - false + (all _.and + (_.cover [/.var] + (case (/.result /.fresh_context + (do /.monad + [[var_id var_type] /.var] + (in (type#= var_type {.#Var var_id})))) + {try.#Success verdict} verdict + {try.#Failure error} false)) + (do random.monad + [nominal (random.ascii/upper 10)] + (_.cover [/.bind] + (case (/.result /.fresh_context + (do /.monad + [[var_id var_type] /.var + _ (/.bind {.#Primitive nominal (list)} + var_id)] + (in true))) + {try.#Success _} true + {try.#Failure error} false))) + (do random.monad + [nominal (random.ascii/upper 10)] + (_.cover [/.bound?] + (and (|> (do /.monad + [[var_id var_type] /.var + pre (/.bound? var_id) + _ (/.bind {.#Primitive nominal (list)} + var_id) + post (/.bound? var_id)] + (in (and (not pre) + post))) + (/.result /.fresh_context) + (try.else false)) + (|> (do /.monad + [[var_id var/0] /.var + pre (/.bound? var_id) + [_ var/1] /.var + _ (/.check var/0 var/1) + post (/.bound? var_id)] + (in (and (not pre) + (not post)))) + (/.result /.fresh_context) + (try.else false))))) + (do random.monad + [nominal (random.ascii/upper 10)] + (_.cover [/.cannot_rebind_var] + (case (/.result /.fresh_context + (do /.monad + [[var_id var_type] /.var + _ (/.bind {.#Primitive nominal (list)} + var_id)] + (/.bind {.#Primitive nominal (list)} + var_id))) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_rebind_var error)))) + (do random.monad + [nominal (random.ascii/upper 10) + var_id random.nat] + (_.cover [/.unknown_type_var] + (case (/.result /.fresh_context + (/.bind {.#Primitive nominal (list)} + var_id)) + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.unknown_type_var error)))) + (do random.monad + [nominal (random.ascii/upper 10) + .let [expected {.#Primitive nominal (list)}]] + (_.cover [/.peek] + (and (|> (do /.monad + [[var_id var_type] /.var] + (/.peek var_id)) + (/.result /.fresh_context) + (pipe.case {try.#Success {.#None}} true + _ false)) + (|> (do /.monad + [[var_id var/0] /.var + [_ var/1] /.var + _ (/.check var/0 var/1)] + (/.peek var_id)) + (/.result /.fresh_context) + (pipe.case {try.#Success {.#None}} true + _ false)) + (|> (do /.monad + [[var_id var_type] /.var + _ (/.bind expected var_id)] + (/.peek var_id)) + (/.result /.fresh_context) + (pipe.case {try.#Success {.#Some actual}} + (same? expected actual) + + _ + false))))) + (do random.monad + [nominal (random.ascii/upper 10) + .let [expected {.#Primitive nominal (list)}]] + (_.cover [/.read] + (case (/.result /.fresh_context + (do /.monad + [[var_id var_type] /.var + _ (/.bind expected var_id)] + (/.read var_id))) + {try.#Success actual} + (same? expected actual) + + _ + false))) + (do random.monad + [nominal (random.ascii/upper 10) + .let [expected {.#Primitive nominal (list)}]] + (_.cover [/.unbound_type_var] + (case (/.result /.fresh_context + (do /.monad + [[var_id var_type] /.var] + (/.read var_id))) + {try.#Failure error} + (exception.match? /.unbound_type_var error) + + _ + false))) + ))) + +(def: context + Test + (all _.and + (_.cover [/.fresh_context] + (and (n.= 0 (the .#var_counter /.fresh_context)) + (n.= 0 (the .#ex_counter /.fresh_context)) + (list.empty? (the .#var_bindings /.fresh_context)))) + (_.cover [/.context] + (and (case (/.result /.fresh_context /.context) + {try.#Success actual} + (same? /.fresh_context actual) {try.#Failure error} - (exception.match? /.unknown_type_var error)))) - (do random.monad - [nominal (random.ascii/upper 10) - .let [expected {.#Primitive nominal (list)}]] - (_.cover [/.peek] - (and (|> (do /.monad - [[var_id var_type] /.var] - (/.peek var_id)) - (/.result /.fresh_context) - (pipe.case {try.#Success {.#None}} true - _ false)) - (|> (do /.monad - [[var_id var/0] /.var - [_ var/1] /.var - _ (/.check var/0 var/1)] - (/.peek var_id)) - (/.result /.fresh_context) - (pipe.case {try.#Success {.#None}} true - _ false)) - (|> (do /.monad - [[var_id var_type] /.var - _ (/.bind expected var_id)] - (/.peek var_id)) - (/.result /.fresh_context) - (pipe.case {try.#Success {.#Some actual}} - (same? expected actual) - - _ - false))))) - (do random.monad - [nominal (random.ascii/upper 10) - .let [expected {.#Primitive nominal (list)}]] - (_.cover [/.read] + false) (case (/.result /.fresh_context (do /.monad - [[var_id var_type] /.var - _ (/.bind expected var_id)] - (/.read var_id))) + [_ /.var] + /.context)) {try.#Success actual} - (same? expected actual) + (and (n.= 1 (the .#var_counter actual)) + (n.= 0 (the .#ex_counter actual)) + (n.= 1 (list.size (the .#var_bindings actual)))) - _ - false))) - (do random.monad - [nominal (random.ascii/upper 10) - .let [expected {.#Primitive nominal (list)}]] - (_.cover [/.unbound_type_var] - (case (/.result /.fresh_context - (do /.monad - [[var_id var_type] /.var] - (/.read var_id))) {try.#Failure error} - (exception.match? /.unbound_type_var error) - - _ false))) - ))) - -(def: context - Test - ($_ _.and - (_.cover [/.fresh_context] - (and (n.= 0 (the .#var_counter /.fresh_context)) - (n.= 0 (the .#ex_counter /.fresh_context)) - (list.empty? (the .#var_bindings /.fresh_context)))) - (_.cover [/.context] - (and (case (/.result /.fresh_context /.context) - {try.#Success actual} - (same? /.fresh_context actual) - - {try.#Failure error} - false) - (case (/.result /.fresh_context - (do /.monad - [_ /.var] - /.context)) - {try.#Success actual} - (and (n.= 1 (the .#var_counter actual)) - (n.= 0 (the .#ex_counter actual)) - (n.= 1 (list.size (the .#var_bindings actual)))) - - {try.#Failure error} - false))) - (_.cover [/.existential] - (case (/.result /.fresh_context - (do /.monad - [_ /.existential] - /.context)) - {try.#Success actual} - (and (n.= 0 (the .#var_counter actual)) - (n.= 1 (the .#ex_counter actual)) - (n.= 0 (list.size (the .#var_bindings actual)))) - - {try.#Failure error} - false)) - )) + (_.cover [/.existential] + (case (/.result /.fresh_context + (do /.monad + [_ /.existential] + /.context)) + {try.#Success actual} + (and (n.= 0 (the .#var_counter actual)) + (n.= 1 (the .#ex_counter actual)) + (n.= 0 (list.size (the .#var_bindings actual)))) + + {try.#Failure error} + false)) + )) (def: succeeds? (All (_ a) (-> (/.Check a) Bit)) @@ -685,46 +685,46 @@ (Random (-> Type Type)) (random.rec (function (_ dirty_type) - (`` ($_ random.either - (random#each (function (_ id) - (function.constant {.#Ex id})) - random.nat) - (do random.monad - [module (random.ascii/upper 10) - short (random.ascii/upper 10) - anonymousT dirty_type] - (in (function (_ holeT) - {.#Named [module short] (anonymousT holeT)}))) - (~~ (template [<tag>] - [(do random.monad - [leftT dirty_type - rightT dirty_type] - (in (function (_ holeT) - {<tag> (leftT holeT) (rightT holeT)})))] - - [.#Sum] - [.#Product] - [.#Function] - [.#Apply] - )) - (do [! random.monad] - [name (random.ascii/upper 10) - parameterT dirty_type] - (in (function (_ holeT) - {.#Primitive name (list (parameterT holeT))}))) - (~~ (template [<tag>] - [(do [! random.monad] - [funcT dirty_type - argT dirty_type - body random.nat] - (in (function (_ holeT) - {<tag> (list (funcT holeT) (argT holeT)) - {.#Parameter body}})))] - - [.#UnivQ] - [.#ExQ] - )) - ))))) + (`` (all random.either + (random#each (function (_ id) + (function.constant {.#Ex id})) + random.nat) + (do random.monad + [module (random.ascii/upper 10) + short (random.ascii/upper 10) + anonymousT dirty_type] + (in (function (_ holeT) + {.#Named [module short] (anonymousT holeT)}))) + (~~ (template [<tag>] + [(do random.monad + [leftT dirty_type + rightT dirty_type] + (in (function (_ holeT) + {<tag> (leftT holeT) (rightT holeT)})))] + + [.#Sum] + [.#Product] + [.#Function] + [.#Apply] + )) + (do [! random.monad] + [name (random.ascii/upper 10) + parameterT dirty_type] + (in (function (_ holeT) + {.#Primitive name (list (parameterT holeT))}))) + (~~ (template [<tag>] + [(do [! random.monad] + [funcT dirty_type + argT dirty_type + body random.nat] + (in (function (_ holeT) + {<tag> (list (funcT holeT) (argT holeT)) + {.#Parameter body}})))] + + [.#UnivQ] + [.#ExQ] + )) + ))))) (def: clean Test @@ -882,19 +882,19 @@ Test (<| (_.covering /._) (_.for [/.Check]) - ($_ _.and - ..polymorphism - (do random.monad - [expected random.nat] - (_.cover [/.result] - (case (/.result /.fresh_context - (# /.monad in expected)) - {try.#Success actual} (same? expected actual) - {try.#Failure error} false))) - ..error_handling - ..var - ..context - ..check - ..clean - ..for_subsumption - ))) + (all _.and + ..polymorphism + (do random.monad + [expected random.nat] + (_.cover [/.result] + (case (/.result /.fresh_context + (# /.monad in expected)) + {try.#Success actual} (same? expected actual) + {try.#Failure error} false))) + ..error_handling + ..var + ..context + ..check + ..clean + ..for_subsumption + ))) diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index e5c31c177..d180815e5 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -23,26 +23,26 @@ (_.for [/.Dynamic]) (do random.monad [expected random.nat] - ($_ _.and - (_.cover [/.dynamic /.static] - (case (/.static Nat (/.dynamic expected)) - {try.#Success actual} - (n.= expected actual) - - {try.#Failure _} - false)) - (_.cover [/.wrong_type] - (case (/.static Text (/.dynamic expected)) - {try.#Success actual} - false - - {try.#Failure error} - (exception.match? /.wrong_type error))) - (_.cover [/.format] - (case (/.format (/.dynamic expected)) - {try.#Success actual} - (text#= (%.nat expected) actual) - - {try.#Failure _} - false)) - )))) + (all _.and + (_.cover [/.dynamic /.static] + (case (/.static Nat (/.dynamic expected)) + {try.#Success actual} + (n.= expected actual) + + {try.#Failure _} + false)) + (_.cover [/.wrong_type] + (case (/.static Text (/.dynamic expected)) + {try.#Success actual} + false + + {try.#Failure error} + (exception.match? /.wrong_type error))) + (_.cover [/.format] + (case (/.format (/.dynamic expected)) + {try.#Success actual} + (text#= (%.nat expected) actual) + + {try.#Failure _} + false)) + )))) diff --git a/stdlib/source/test/lux/type/implicit.lux b/stdlib/source/test/lux/type/implicit.lux index 38e683a02..8fa84731b 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -33,32 +33,32 @@ left random.nat right random.nat] - ($_ _.and - (_.cover [/.##] - (let [first_order! - (let [(open "list#[0]") (list.equivalence n.equivalence)] - (and (bit#= (# n.equivalence = left right) - (/.## = left right)) - (list#= (# list.functor each ++ (enum.range n.enum start end)) - (/.## each ++ (enum.range n.enum start end))))) + (all _.and + (_.cover [/.##] + (let [first_order! + (let [(open "list#[0]") (list.equivalence n.equivalence)] + (and (bit#= (# n.equivalence = left right) + (/.## = left right)) + (list#= (# list.functor each ++ (enum.range n.enum start end)) + (/.## each ++ (enum.range n.enum start end))))) - second_order! - (/.## = - (enum.range n.enum start end) - (enum.range n.enum start end)) - - third_order! - (let [lln (/.## each (enum.range n.enum start) - (enum.range n.enum start end))] - (/.## = lln lln))] - (and first_order! second_order! - third_order!))) - (_.cover [/.with] - (/.with [n.addition] - (n.= (# n.addition composite left right) - (/.## composite left right)))) - (_.cover [/.implicit:] - (n.= (# n.multiplication composite left right) - (/.## composite left right))) - )))) + (/.## = + (enum.range n.enum start end) + (enum.range n.enum start end)) + + third_order! + (let [lln (/.## each (enum.range n.enum start) + (enum.range n.enum start end))] + (/.## = lln lln))] + (and first_order! + second_order! + third_order!))) + (_.cover [/.with] + (/.with [n.addition] + (n.= (# n.addition composite left right) + (/.## composite left right)))) + (_.cover [/.implicit:] + (n.= (# n.multiplication composite left right) + (/.## composite left right))) + )))) diff --git a/stdlib/source/test/lux/type/poly.lux b/stdlib/source/test/lux/type/poly.lux index 5f0229c06..0850116fb 100644 --- a/stdlib/source/test/lux/type/poly.lux +++ b/stdlib/source/test/lux/type/poly.lux @@ -1,20 +1,20 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}]]] - [\\library - ["[0]" /]] - ["[0]" / "_" - ["[1][0]" equivalence] - ["[1][0]" functor] - ["[1][0]" json]]) + [library + [lux "*" + ["_" test {"+" Test}]]] + [\\library + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" equivalence] + ["[1][0]" functor] + ["[1][0]" json]]) (def: .public test Test (<| (_.covering /._) (_.for [/.poly: /.code]) - ($_ _.and - /equivalence.test - /functor.test - /json.test - ))) + (all _.and + /equivalence.test + /functor.test + /json.test + ))) diff --git a/stdlib/source/test/lux/type/poly/equivalence.lux b/stdlib/source/test/lux/type/poly/equivalence.lux index 02c94b58e..410627c53 100644 --- a/stdlib/source/test/lux/type/poly/equivalence.lux +++ b/stdlib/source/test/lux/type/poly/equivalence.lux @@ -59,22 +59,22 @@ (do [! random.monad] [size (# ! each (n.% 2) random.nat) .let [gen_int (|> random.int (# ! each (|>> i.abs (i.% +1,000,000))))]] - ($_ random.and - random.bit - gen_int - random.safe_frac - (random.unicode size) - (random.maybe gen_int) - (random.list size gen_int) - ($_ random.or - random.bit - gen_int - random.safe_frac) - ($_ random.and - gen_int - random.safe_frac - (random.unicode size)) - gen_recursive))) + (all random.and + random.bit + gen_int + random.safe_frac + (random.unicode size) + (random.maybe gen_int) + (random.list size gen_int) + (all random.or + random.bit + gen_int + random.safe_frac) + (all random.and + gen_int + random.safe_frac + (random.unicode size)) + gen_recursive))) (for @.old (these) (these (def: equivalence diff --git a/stdlib/source/test/lux/type/poly/json.lux b/stdlib/source/test/lux/type/poly/json.lux index 38b36eecf..00eec73fa 100644 --- a/stdlib/source/test/lux/type/poly/json.lux +++ b/stdlib/source/test/lux/type/poly/json.lux @@ -91,21 +91,21 @@ (Random Record) (do [! random.monad] [size (# ! each (n.% 2) random.nat)] - ($_ random.and - random.bit - random.safe_frac - (random.unicode size) - (random.maybe random.safe_frac) - (random.list size random.safe_frac) - (random.dictionary text.hash size (random.unicode size) random.safe_frac) - ($_ random.or random.bit (random.unicode size) random.safe_frac) - ($_ random.and random.bit (random.unicode size) random.safe_frac) - ..gen_recursive - ... _instant.instant - ... _duration.duration - random.date - ..qty - ))) + (all random.and + random.bit + random.safe_frac + (random.unicode size) + (random.maybe random.safe_frac) + (random.list size random.safe_frac) + (random.dictionary text.hash size (random.unicode size) random.safe_frac) + (all random.or random.bit (random.unicode size) random.safe_frac) + (all random.and random.bit (random.unicode size) random.safe_frac) + ..gen_recursive + ... _instant.instant + ... _duration.duration + random.date + ..qty + ))) (for @.old (these) (these (def: equivalence diff --git a/stdlib/source/test/lux/type/quotient.lux b/stdlib/source/test/lux/type/quotient.lux index cb0f8bffe..44258d4bd 100644 --- a/stdlib/source/test/lux/type/quotient.lux +++ b/stdlib/source/test/lux/type/quotient.lux @@ -34,27 +34,27 @@ .let [class (is (-> Nat Text) (|>> (n.% modulus) %.nat))] value random.nat] - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec (/.equivalence text.equivalence) - (..random (/.class class) random.nat))) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec (/.equivalence text.equivalence) + (..random (/.class class) random.nat))) - (_.for [/.Class] - (_.cover [/.class] - (same? (is Any class) - (is Any (/.class class))))) - (_.for [/.Quotient] - ($_ _.and - (_.cover [/.quotient /.value /.label] - (let [quotient (/.quotient (/.class class) value)] - (and (same? value - (/.value quotient)) - (text#= (class value) - (/.label quotient))))) - (_.cover [/.type] - (exec - (is ..Mod_10 - (/.quotient ..mod_10_class value)) - true)) - )) - )))) + (_.for [/.Class] + (_.cover [/.class] + (same? (is Any class) + (is Any (/.class class))))) + (_.for [/.Quotient] + (all _.and + (_.cover [/.quotient /.value /.label] + (let [quotient (/.quotient (/.class class) value)] + (and (same? value + (/.value quotient)) + (text#= (class value) + (/.label quotient))))) + (_.cover [/.type] + (exec + (is ..Mod_10 + (/.quotient ..mod_10_class value)) + true)) + )) + )))) diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux index 2d269d300..d6d5bf660 100644 --- a/stdlib/source/test/lux/type/refinement.lux +++ b/stdlib/source/test/lux/type/refinement.lux @@ -34,57 +34,57 @@ (|>> (n.% modulus) (n.= 0)))] total_raws (# ! each (|>> (n.% 20) ++) random.nat) raws (random.list total_raws random.nat)] - ($_ _.and - (_.for [/.Refiner] - ($_ _.and - (_.cover [/.refiner] - (case (/.refiner predicate raw) - {.#Some refined} - (predicate raw) - - {.#None} - (not (predicate raw)))) - (_.cover [/.predicate] - (|> (/.refiner predicate modulus) - (maybe#each (|>> /.predicate (same? predicate))) - (maybe.else false))) - )) - (_.cover [/.value] - (|> (/.refiner predicate modulus) - (maybe#each (|>> /.value (n.= modulus))) - (maybe.else false))) - (_.cover [/.lifted] - (and (|> (/.refiner predicate modulus) - (maybe#each (/.lifted (n.+ modulus))) - maybe#conjoint - (maybe#each (|>> /.value (n.= (n.+ modulus modulus)))) - (maybe.else false)) - (|> (/.refiner predicate modulus) - (maybe#each (/.lifted (n.+ (++ modulus)))) - maybe#conjoint - (maybe#each (|>> /.value (n.= (n.+ modulus (++ modulus))))) - (maybe.else false) - not))) - (_.cover [/.only] - (let [expected (list.only predicate raws) - actual (/.only (/.refiner predicate) raws)] - (and (n.= (list.size expected) - (list.size actual)) - (# (list.equivalence n.equivalence) = - expected - (list#each /.value actual))))) - (_.cover [/.partition] - (let [expected (list.only predicate raws) - [actual alternative] (/.partition (/.refiner predicate) raws)] - (and (n.= (list.size expected) - (list.size actual)) - (n.= (n.- (list.size expected) total_raws) - (list.size alternative)) - (# (list.equivalence n.equivalence) = - expected - (list#each /.value actual))))) - (_.cover [/.type] - (exec (is (Maybe .._type) - (.._refiner raw)) - true)) - )))) + (all _.and + (_.for [/.Refiner] + (all _.and + (_.cover [/.refiner] + (case (/.refiner predicate raw) + {.#Some refined} + (predicate raw) + + {.#None} + (not (predicate raw)))) + (_.cover [/.predicate] + (|> (/.refiner predicate modulus) + (maybe#each (|>> /.predicate (same? predicate))) + (maybe.else false))) + )) + (_.cover [/.value] + (|> (/.refiner predicate modulus) + (maybe#each (|>> /.value (n.= modulus))) + (maybe.else false))) + (_.cover [/.lifted] + (and (|> (/.refiner predicate modulus) + (maybe#each (/.lifted (n.+ modulus))) + maybe#conjoint + (maybe#each (|>> /.value (n.= (n.+ modulus modulus)))) + (maybe.else false)) + (|> (/.refiner predicate modulus) + (maybe#each (/.lifted (n.+ (++ modulus)))) + maybe#conjoint + (maybe#each (|>> /.value (n.= (n.+ modulus (++ modulus))))) + (maybe.else false) + not))) + (_.cover [/.only] + (let [expected (list.only predicate raws) + actual (/.only (/.refiner predicate) raws)] + (and (n.= (list.size expected) + (list.size actual)) + (# (list.equivalence n.equivalence) = + expected + (list#each /.value actual))))) + (_.cover [/.partition] + (let [expected (list.only predicate raws) + [actual alternative] (/.partition (/.refiner predicate) raws)] + (and (n.= (list.size expected) + (list.size actual)) + (n.= (n.- (list.size expected) total_raws) + (list.size alternative)) + (# (list.equivalence n.equivalence) = + expected + (list#each /.value actual))))) + (_.cover [/.type] + (exec (is (Maybe .._type) + (.._refiner raw)) + true)) + )))) diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 2c6b1eb29..69709555a 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -33,40 +33,40 @@ post (# ! each %.nat random.nat) .let [! identity.monad]] (_.for [/.Linear /.run! /.monad] - (`` ($_ _.and - (~~ (template [<coverage> <bindings>] - [(_.cover <coverage> - (<| (text#= (format pre post)) - (is (Identity Text)) - (/.run! !) - (do (/.monad !) - <bindings> - (in (format left right)))))] - - [[/.Affine /.Key /.Res /.Ordered /.ordered - /.Relevant /.read] - [res|left (/.ordered ! pre) - res|right (/.ordered ! post) - right (/.read ! res|right) - left (/.read ! res|left)]] - [[/.Commutative /.commutative /.exchange] - [res|left (/.commutative ! pre) - res|right (/.commutative ! post) - _ ((/.exchange [1 0]) !) - left (/.read ! res|left) - right (/.read ! res|right)]] - [[/.group /.un_group] - [res|left (/.commutative ! pre) - res|right (/.commutative ! post) - _ ((/.group 2) !) - _ ((/.un_group 2) !) - right (/.read ! res|right) - left (/.read ! res|left)]] - [[/.lifted] - [left (/.lifted ! pre) - right (/.lifted ! post)]] - )) - ))))) + (`` (all _.and + (~~ (template [<coverage> <bindings>] + [(_.cover <coverage> + (<| (text#= (format pre post)) + (is (Identity Text)) + (/.run! !) + (do (/.monad !) + <bindings> + (in (format left right)))))] + + [[/.Affine /.Key /.Res /.Ordered /.ordered + /.Relevant /.read] + [res|left (/.ordered ! pre) + res|right (/.ordered ! post) + right (/.read ! res|right) + left (/.read ! res|left)]] + [[/.Commutative /.commutative /.exchange] + [res|left (/.commutative ! pre) + res|right (/.commutative ! post) + _ ((/.exchange [1 0]) !) + left (/.read ! res|left) + right (/.read ! res|right)]] + [[/.group /.un_group] + [res|left (/.commutative ! pre) + res|right (/.commutative ! post) + _ ((/.group 2) !) + _ ((/.un_group 2) !) + right (/.read ! res|right) + left (/.read ! res|left)]] + [[/.lifted] + [left (/.lifted ! pre) + right (/.lifted ! post)]] + )) + ))))) (def: sync Test @@ -75,41 +75,41 @@ post (# ! each %.nat random.nat) .let [! io.monad]] (_.for [/.Linear /.run! /.monad] - (`` ($_ _.and - (~~ (template [<coverage> <bindings>] - [(_.cover <coverage> - (<| (text#= (format pre post)) - io.run! - (is (IO Text)) - (/.run! !) - (do (/.monad !) - <bindings> - (in (format left right)))))] + (`` (all _.and + (~~ (template [<coverage> <bindings>] + [(_.cover <coverage> + (<| (text#= (format pre post)) + io.run! + (is (IO Text)) + (/.run! !) + (do (/.monad !) + <bindings> + (in (format left right)))))] - [[/.Affine /.Key /.Res /.Ordered /.ordered - /.Relevant /.read] - [res|left (/.ordered ! pre) - res|right (/.ordered ! post) - right (/.read ! res|right) - left (/.read ! res|left)]] - [[/.Commutative /.commutative /.exchange] - [res|left (/.commutative ! pre) - res|right (/.commutative ! post) - _ ((/.exchange [1 0]) !) - left (/.read ! res|left) - right (/.read ! res|right)]] - [[/.group /.un_group] - [res|left (/.commutative ! pre) - res|right (/.commutative ! post) - _ ((/.group 2) !) - _ ((/.un_group 2) !) - right (/.read ! res|right) - left (/.read ! res|left)]] - [[/.lifted] - [left (/.lifted ! (io.io pre)) - right (/.lifted ! (io.io post))]] - )) - ))))) + [[/.Affine /.Key /.Res /.Ordered /.ordered + /.Relevant /.read] + [res|left (/.ordered ! pre) + res|right (/.ordered ! post) + right (/.read ! res|right) + left (/.read ! res|left)]] + [[/.Commutative /.commutative /.exchange] + [res|left (/.commutative ! pre) + res|right (/.commutative ! post) + _ ((/.exchange [1 0]) !) + left (/.read ! res|left) + right (/.read ! res|right)]] + [[/.group /.un_group] + [res|left (/.commutative ! pre) + res|right (/.commutative ! post) + _ ((/.group 2) !) + _ ((/.un_group 2) !) + right (/.read ! res|right) + left (/.read ! res|left)]] + [[/.lifted] + [left (/.lifted ! (io.io pre)) + right (/.lifted ! (io.io post))]] + )) + ))))) (def: async Test @@ -118,42 +118,42 @@ post (# ! each %.nat random.nat) .let [! async.monad]] (_.for [/.Linear /.run! /.monad] - (`` ($_ _.and - (~~ (template [<coverage> <bindings>] - [(in (monad.do ! - [outcome (<| (is (Async Text)) - (/.run! !) - (do (/.monad !) - <bindings> - (in (format left right))))] - (_.cover' <coverage> - (text#= (format pre post) - outcome))))] + (`` (all _.and + (~~ (template [<coverage> <bindings>] + [(in (monad.do ! + [outcome (<| (is (Async Text)) + (/.run! !) + (do (/.monad !) + <bindings> + (in (format left right))))] + (_.cover' <coverage> + (text#= (format pre post) + outcome))))] - [[/.Affine /.Key /.Res /.Ordered /.ordered - /.Relevant /.read] - [res|left (/.ordered ! pre) - res|right (/.ordered ! post) - right (/.read ! res|right) - left (/.read ! res|left)]] - [[/.Commutative /.commutative /.exchange] - [res|left (/.commutative ! pre) - res|right (/.commutative ! post) - _ ((/.exchange [1 0]) !) - left (/.read ! res|left) - right (/.read ! res|right)]] - [[/.group /.un_group] - [res|left (/.commutative ! pre) - res|right (/.commutative ! post) - _ ((/.group 2) !) - _ ((/.un_group 2) !) - right (/.read ! res|right) - left (/.read ! res|left)]] - [[/.lifted] - [left (/.lifted ! (async.resolved pre)) - right (/.lifted ! (async.resolved post))]] - )) - ))))) + [[/.Affine /.Key /.Res /.Ordered /.ordered + /.Relevant /.read] + [res|left (/.ordered ! pre) + res|right (/.ordered ! post) + right (/.read ! res|right) + left (/.read ! res|left)]] + [[/.Commutative /.commutative /.exchange] + [res|left (/.commutative ! pre) + res|right (/.commutative ! post) + _ ((/.exchange [1 0]) !) + left (/.read ! res|left) + right (/.read ! res|right)]] + [[/.group /.un_group] + [res|left (/.commutative ! pre) + res|right (/.commutative ! post) + _ ((/.group 2) !) + _ ((/.un_group 2) !) + right (/.read ! res|right) + left (/.read ! res|left)]] + [[/.lifted] + [left (/.lifted ! (async.resolved pre)) + right (/.lifted ! (async.resolved post))]] + )) + ))))) (syntax: (with_error [exception <code>.symbol to_expand <code>.any]) @@ -172,20 +172,20 @@ Test (<| (_.covering /._) (_.for [/.Procedure]) - ($_ _.and - ..pure - ..sync - ..async + (all _.and + ..pure + ..sync + ..async - (_.cover [/.amount_cannot_be_zero] - (`` (and (~~ (template [<group|un_group>] - [(with_error /.amount_cannot_be_zero - (<group|un_group> 0))] + (_.cover [/.amount_cannot_be_zero] + (`` (and (~~ (template [<group|un_group>] + [(with_error /.amount_cannot_be_zero + (<group|un_group> 0))] - [/.group] - [/.un_group] - ))))) - (_.cover [/.index_cannot_be_repeated] - (with_error /.index_cannot_be_repeated - (/.exchange [0 0]))) - ))) + [/.group] + [/.un_group] + ))))) + (_.cover [/.index_cannot_be_repeated] + (with_error /.index_cannot_be_repeated + (/.exchange [0 0]))) + ))) diff --git a/stdlib/source/test/lux/type/unit.lux b/stdlib/source/test/lux/type/unit.lux index bfcef3bc6..dac454fee 100644 --- a/stdlib/source/test/lux/type/unit.lux +++ b/stdlib/source/test/lux/type/unit.lux @@ -36,14 +36,14 @@ (def: polymorphism Test - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..meter 1,000))) - (_.for [/.order] - ($order.spec /.order (..meter 1,000))) - (_.for [/.enum] - ($enum.spec /.enum (..meter 1,000))) - )) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence (..meter 1,000))) + (_.for [/.order] + ($order.spec /.order (..meter 1,000))) + (_.for [/.enum] + ($enum.spec /.enum (..meter 1,000))) + )) (/.unit: What what) @@ -52,30 +52,30 @@ (do random.monad [expected random.int] (_.for [/.Unit] - (`` ($_ _.and - (~~ (template [<type> <unit>] - [(_.cover [<type> <unit>] - (|> expected - (# <unit> in) - (# <unit> out) - (i.= expected)))] + (`` (all _.and + (~~ (template [<type> <unit>] + [(_.cover [<type> <unit>] + (|> expected + (# <unit> in) + (# <unit> out) + (i.= expected)))] - [/.Gram /.gram] - [/.Meter /.meter] - [/.Litre /.litre] - [/.Second /.second] - )) - (_.cover [/.Pure /.pure /.number] - (|> expected - /.pure - /.number - (i.= expected))) - (_.cover [/.unit:] - (|> expected - (# ..what in) - (# ..what out) - (i.= expected))) - ))))) + [/.Gram /.gram] + [/.Meter /.meter] + [/.Litre /.litre] + [/.Second /.second] + )) + (_.cover [/.Pure /.pure /.number] + (|> expected + /.pure + /.number + (i.= expected))) + (_.cover [/.unit:] + (|> expected + (# ..what in) + (# ..what out) + (i.= expected))) + ))))) (syntax: (natural []) (# meta.monad each @@ -108,49 +108,49 @@ (# ! each (i.* (.int how::to))) (# ! each (# /.meter in)))] (_.for [/.Scale] - (`` ($_ _.and - (~~ (template [<type> <scale>] - [(_.cover [<type> <scale>] - (|> large - (# <scale> scale) - (is (/.Qty (<type> /.Meter))) - (# <scale> de_scale) - (is (/.Qty /.Meter)) - (meter#= large)))] + (`` (all _.and + (~~ (template [<type> <scale>] + [(_.cover [<type> <scale>] + (|> large + (# <scale> scale) + (is (/.Qty (<type> /.Meter))) + (# <scale> de_scale) + (is (/.Qty /.Meter)) + (meter#= large)))] - [/.Kilo /.kilo] - [/.Mega /.mega] - [/.Giga /.giga] - )) - (~~ (template [<type> <scale>] - [(_.cover [<type> <scale>] - (|> small - (# <scale> scale) - (is (/.Qty (<type> /.Meter))) - (# <scale> de_scale) - (is (/.Qty /.Meter)) - (meter#= small)))] + [/.Kilo /.kilo] + [/.Mega /.mega] + [/.Giga /.giga] + )) + (~~ (template [<type> <scale>] + [(_.cover [<type> <scale>] + (|> small + (# <scale> scale) + (is (/.Qty (<type> /.Meter))) + (# <scale> de_scale) + (is (/.Qty /.Meter)) + (meter#= small)))] - [/.Milli /.milli] - [/.Micro /.micro] - [/.Nano /.nano] - )) - (_.cover [/.re_scaled] - (|> large (is (/.Qty /.Meter)) - (# /.kilo scale) (is (/.Qty (/.Kilo /.Meter))) - (/.re_scaled /.kilo /.milli) (is (/.Qty (/.Milli /.Meter))) - (/.re_scaled /.milli /.kilo) (is (/.Qty (/.Kilo /.Meter))) - (# /.kilo de_scale) (is (/.Qty /.Meter)) - (meter#= large))) - (_.cover [/.scale:] - (and (|> unscaled - (# ..how scale) - (# ..how de_scale) - (meter#= unscaled)) - (ratio#= [..how::from - ..how::to] - (# ..how ratio)))) - ))))) + [/.Milli /.milli] + [/.Micro /.micro] + [/.Nano /.nano] + )) + (_.cover [/.re_scaled] + (|> large (is (/.Qty /.Meter)) + (# /.kilo scale) (is (/.Qty (/.Kilo /.Meter))) + (/.re_scaled /.kilo /.milli) (is (/.Qty (/.Milli /.Meter))) + (/.re_scaled /.milli /.kilo) (is (/.Qty (/.Kilo /.Meter))) + (# /.kilo de_scale) (is (/.Qty /.Meter)) + (meter#= large))) + (_.cover [/.scale:] + (and (|> unscaled + (# ..how scale) + (# ..how de_scale) + (meter#= unscaled)) + (ratio#= [..how::from + ..how::to] + (# ..how ratio)))) + ))))) (def: arithmetic Test @@ -161,34 +161,34 @@ left (random.only (|>> (meter#= zero) not) (..meter 1,000)) right (..meter 1,000) extra (..second 1,000)] - (`` ($_ _.and - (~~ (template [<q> <i>] - [(_.cover [<q>] - (i.= (<i> (# /.meter out left) (# /.meter out right)) - (# /.meter out (<q> left right))))] + (`` (all _.and + (~~ (template [<q> <i>] + [(_.cover [<q>] + (i.= (<i> (# /.meter out left) (# /.meter out right)) + (# /.meter out (<q> left right))))] - [/.+ i.+] - [/.- i.-] - )) - (_.cover [/.*] - (let [expected (i.* (# /.meter out left) (# /.meter out right)) - actual ((debug.private /.out') (is (/.Qty [/.Meter /.Meter]) - (/.* left right)))] - (i.= expected actual))) - (_.cover [/./] - (|> right - (/.* left) - (/./ left) - (meter#= right))) - )))) + [/.+ i.+] + [/.- i.-] + )) + (_.cover [/.*] + (let [expected (i.* (# /.meter out left) (# /.meter out right)) + actual ((debug.private /.out') (is (/.Qty [/.Meter /.Meter]) + (/.* left right)))] + (i.= expected actual))) + (_.cover [/./] + (|> right + (/.* left) + (/./ left) + (meter#= right))) + )))) (def: .public test Test (<| (_.covering /._) (_.for [/.Qty]) - ($_ _.and - ..polymorphism - ..unit - ..scale - ..arithmetic - ))) + (all _.and + ..polymorphism + ..unit + ..scale + ..arithmetic + ))) diff --git a/stdlib/source/test/lux/type/variance.lux b/stdlib/source/test/lux/type/variance.lux index f4442550e..5f4cbe862 100644 --- a/stdlib/source/test/lux/type/variance.lux +++ b/stdlib/source/test/lux/type/variance.lux @@ -1,15 +1,15 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [math - ["[0]" random {"+" Random}]]]] - [\\library - ["[0]" / - ["/[1]" // "_" - ["[1][0]" check]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [math + ["[0]" random {"+" Random}]]]] + [\\library + ["[0]" / + ["/[1]" // "_" + ["[1][0]" check]]]]) (type: Super (Ex (_ sub) [Text sub])) @@ -20,16 +20,16 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.cover [/.Co] - (and (//check.subsumes? (type (/.Co Super)) (type (/.Co Sub))) - (not (//check.subsumes? (type (/.Co Sub)) (type (/.Co Super)))))) - (_.cover [/.Contra] - (and (//check.subsumes? (type (/.Contra Sub)) (type (/.Contra Super))) - (not (//check.subsumes? (type (/.Contra Super)) (type (/.Contra Sub)))))) - (_.cover [/.In] - (and (//check.subsumes? (type (/.In Super)) (type (/.In Super))) - (//check.subsumes? (type (/.In Sub)) (type (/.In Sub))) - (not (//check.subsumes? (type (/.In Sub)) (type (/.In Super)))) - (not (//check.subsumes? (type (/.In Super)) (type (/.In Sub)))))) - ))) + (all _.and + (_.cover [/.Co] + (and (//check.subsumes? (type (/.Co Super)) (type (/.Co Sub))) + (not (//check.subsumes? (type (/.Co Sub)) (type (/.Co Super)))))) + (_.cover [/.Contra] + (and (//check.subsumes? (type (/.Contra Sub)) (type (/.Contra Super))) + (not (//check.subsumes? (type (/.Contra Super)) (type (/.Contra Sub)))))) + (_.cover [/.In] + (and (//check.subsumes? (type (/.In Super)) (type (/.In Super))) + (//check.subsumes? (type (/.In Sub)) (type (/.In Sub))) + (not (//check.subsumes? (type (/.In Sub)) (type (/.In Super)))) + (not (//check.subsumes? (type (/.In Super)) (type (/.In Sub)))))) + ))) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index e57811f1a..454a5a001 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -19,13 +19,13 @@ (def: .public test Test - ($_ _.and - /file.test - /shell.test - /console.test - /program.test - /input/keyboard.test - /output/video/resolution.test - /net/http/client.test - /net/http/status.test - )) + (all _.and + /file.test + /shell.test + /console.test + /program.test + /input/keyboard.test + /output/video/resolution.test + /net/http/client.test + /net/http/status.test + )) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index e1452b0a3..06963e92d 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -1,22 +1,22 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" io] - ["[0]" try {"+" Try}] - ["[0]" exception {"+" exception:}]] - [data - ["[0]" text ("[1]#[0]" equivalence) - ["%" format {"+" format}]]] - [math - ["[0]" random]]]] - [\\library - ["[0]" /]] - [\\specification - ["$[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" io] + ["[0]" try {"+" Try}] + ["[0]" exception {"+" exception:}]] + [data + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}]]] + [math + ["[0]" random]]]] + [\\library + ["[0]" /]] + [\\specification + ["$[0]" /]]) (exception: dead) @@ -51,20 +51,20 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.async /.mock /.Mock] - ($/.spec (io.io (/.async (/.mock ..mock [false ""]))))) - (do random.monad - [expected (random.ascii/alpha 10) - .let [console (/.mock ..mock [false ""])]] - (_.cover [/.write_line] - (io.run! - (do io.monad - [?_ (/.write_line expected console) - ?actual (# console read_line [])] - (in (<| (try.else false) - (do try.monad - [_ ?_ - actual ?actual] - (in (text#= expected actual))))))))) - ))) + (all _.and + (_.for [/.async /.mock /.Mock] + ($/.spec (io.io (/.async (/.mock ..mock [false ""]))))) + (do random.monad + [expected (random.ascii/alpha 10) + .let [console (/.mock ..mock [false ""])]] + (_.cover [/.write_line] + (io.run! + (do io.monad + [?_ (/.write_line expected console) + ?actual (# console read_line [])] + (in (<| (try.else false) + (do try.monad + [_ ?_ + actual ?actual] + (in (text#= expected actual))))))))) + ))) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index 5d1654269..b5d9892ad 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -244,44 +244,44 @@ (do [! random.monad] [/ (random.ascii/upper 1) file (random.ascii/lower 1)] - ($_ _.and - (_.for [/.mock] - ($/.spec (io.io (/.mock /)))) - (_.for [/.async] - ($/.spec (io.io (/.async (..fs /))))) + (all _.and + (_.for [/.mock] + ($/.spec (io.io (/.mock /)))) + (_.for [/.async] + ($/.spec (io.io (/.async (..fs /))))) - (in (do async.monad - [.let [fs (/.mock /)] - ? (# fs delete file)] - (_.cover' [/.cannot_delete] - (case ? - {try.#Failure error} - (exception.match? /.cannot_delete error) + (in (do async.monad + [.let [fs (/.mock /)] + ? (# fs delete file)] + (_.cover' [/.cannot_delete] + (case ? + {try.#Failure error} + (exception.match? /.cannot_delete error) - _ - false)))) - (in (do async.monad - [.let [fs (/.mock /)] - ? (# fs read file)] - (_.cover' [/.cannot_find_file] - (case ? - {try.#Failure error} - (exception.match? /.cannot_find_file error) + _ + false)))) + (in (do async.monad + [.let [fs (/.mock /)] + ? (# fs read file)] + (_.cover' [/.cannot_find_file] + (case ? + {try.#Failure error} + (exception.match? /.cannot_find_file error) - _ - false)))) - (in (do async.monad - [.let [fs (/.mock /)] - ?/0 (# fs directory_files file) - ?/1 (# fs sub_directories file)] - (_.cover' [/.cannot_find_directory] - (case [?/0 ?/1] - [{try.#Failure error/0} {try.#Failure error/1}] - (and (exception.match? /.cannot_find_directory error/0) - (exception.match? /.cannot_find_directory error/1)) + _ + false)))) + (in (do async.monad + [.let [fs (/.mock /)] + ?/0 (# fs directory_files file) + ?/1 (# fs sub_directories file)] + (_.cover' [/.cannot_find_directory] + (case [?/0 ?/1] + [{try.#Failure error/0} {try.#Failure error/1}] + (and (exception.match? /.cannot_find_directory error/0) + (exception.match? /.cannot_find_directory error/1)) - _ - false)))) - - /watch.test - )))) + _ + false)))) + + /watch.test + )))) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index a8bcda085..6389dec6f 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -27,66 +27,66 @@ (def: concern (Random [/.Concern (Predicate /.Concern)]) - ($_ random.either - (random#in [/.creation /.creation?]) - (random#in [/.modification /.modification?]) - (random#in [/.deletion /.deletion?]) - )) + (all random.either + (random#in [/.creation /.creation?]) + (random#in [/.modification /.modification?]) + (random#in [/.deletion /.deletion?]) + )) (def: concern##test Test - ($_ _.and - (_.cover [/.creation /.creation?] - (and (/.creation? /.creation) - (not (/.creation? /.modification)) - (not (/.creation? /.deletion)))) - (_.cover [/.modification /.modification?] - (and (not (/.modification? /.creation)) - (/.modification? /.modification) - (not (/.modification? /.deletion)))) - (_.cover [/.deletion /.deletion?] - (and (not (/.deletion? /.creation)) - (not (/.deletion? /.modification)) - (/.deletion? /.deletion))) - (do random.monad - [left ..concern - right (random.only (|>> (same? left) not) - ..concern) - .let [[left left?] left - [right right?] right]] - (_.cover [/.also] - (let [composition (/.also left right)] - (and (left? composition) - (right? composition))))) - (_.cover [/.all] - (and (/.creation? /.all) - (/.modification? /.all) - (/.deletion? /.all))) - )) + (all _.and + (_.cover [/.creation /.creation?] + (and (/.creation? /.creation) + (not (/.creation? /.modification)) + (not (/.creation? /.deletion)))) + (_.cover [/.modification /.modification?] + (and (not (/.modification? /.creation)) + (/.modification? /.modification) + (not (/.modification? /.deletion)))) + (_.cover [/.deletion /.deletion?] + (and (not (/.deletion? /.creation)) + (not (/.deletion? /.modification)) + (/.deletion? /.deletion))) + (do random.monad + [left ..concern + right (random.only (|>> (same? left) not) + ..concern) + .let [[left left?] left + [right right?] right]] + (_.cover [/.also] + (let [composition (/.also left right)] + (and (left? composition) + (right? composition))))) + (_.cover [/.all] + (and (/.creation? /.all) + (/.modification? /.all) + (/.deletion? /.all))) + )) (def: exception Test (do [! random.monad] [directory (random.ascii/alpha 5) .let [[fs watcher] (/.mock "/")]] - ($_ _.and - (in (do async.monad - [?concern (# watcher concern directory) - ?stop (# watcher stop directory)] - (_.cover' [/.not_being_watched] - (and (case ?concern - {try.#Failure error} - (exception.match? /.not_being_watched error) - - {try.#Success _} - false) - (case ?stop - {try.#Failure error} - (exception.match? /.not_being_watched error) - - {try.#Success _} - false))))) - ))) + (all _.and + (in (do async.monad + [?concern (# watcher concern directory) + ?stop (# watcher stop directory)] + (_.cover' [/.not_being_watched] + (and (case ?concern + {try.#Failure error} + (exception.match? /.not_being_watched error) + + {try.#Success _} + false) + (case ?stop + {try.#Failure error} + (exception.match? /.not_being_watched error) + + {try.#Success _} + false))))) + ))) (def: (no_events_prior_to_creation! fs watcher directory) (-> (//.System Async) (/.Watcher Async) //.Path (Async (Try Bit))) @@ -152,48 +152,48 @@ Test (<| (_.covering /._) (_.for [/.Watcher]) - ($_ _.and - (_.for [/.Concern] - ..concern##test) - ..exception - - (do [! random.monad] - [directory (random.ascii/alpha 5) - .let [/ "/" - [fs watcher] (/.mock /)] - expected_path (# ! each (|>> (format directory /)) - (random.ascii/alpha 5)) - data ($binary.random 10)] - (in (do [! async.monad] - [verdict (do (try.with !) - [no_events_prior_to_creation! - (..no_events_prior_to_creation! fs watcher directory) - - after_creation! - (..after_creation! fs watcher expected_path) - - after_modification! - (..after_modification! fs watcher data expected_path) - - after_deletion! - (..after_deletion! fs watcher expected_path)] - (in (and no_events_prior_to_creation! - after_creation! - after_modification! - after_deletion!)))] - (_.cover' [/.mock /.polling] - (try.else false verdict))))) - (do random.monad - [directory (random.ascii/alpha 5) - .let [/ "/" - [fs watcher] (/.mock /)]] - (in (do async.monad - [started? (# watcher start /.all directory)] - (_.cover' [/.cannot_poll_a_non_existent_directory] - (case started? - {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.cannot_poll_a_non_existent_directory error)))))) - ))) + (all _.and + (_.for [/.Concern] + ..concern##test) + ..exception + + (do [! random.monad] + [directory (random.ascii/alpha 5) + .let [/ "/" + [fs watcher] (/.mock /)] + expected_path (# ! each (|>> (format directory /)) + (random.ascii/alpha 5)) + data ($binary.random 10)] + (in (do [! async.monad] + [verdict (do (try.with !) + [no_events_prior_to_creation! + (..no_events_prior_to_creation! fs watcher directory) + + after_creation! + (..after_creation! fs watcher expected_path) + + after_modification! + (..after_modification! fs watcher data expected_path) + + after_deletion! + (..after_deletion! fs watcher expected_path)] + (in (and no_events_prior_to_creation! + after_creation! + after_modification! + after_deletion!)))] + (_.cover' [/.mock /.polling] + (try.else false verdict))))) + (do random.monad + [directory (random.ascii/alpha 5) + .let [/ "/" + [fs watcher] (/.mock /)]] + (in (do async.monad + [started? (# watcher start /.all directory)] + (_.cover' [/.cannot_poll_a_non_existent_directory] + (case started? + {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.cannot_poll_a_non_existent_directory error)))))) + ))) diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux index 5553373d7..0e509448c 100644 --- a/stdlib/source/test/lux/world/input/keyboard.lux +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -147,24 +147,24 @@ Test (<| (_.covering /._) (_.for [/.Key]) - (`` ($_ _.and - (~~ (template [<definition> <keys>] - [<definition>] - - <groups>)) + (`` (all _.and + (~~ (template [<definition> <keys>] + [<definition>] + + <groups>)) - (_.for [/.Press] - (`` ($_ _.and - (~~ (template [<pressed?> <function>] - [(do random.monad - [key ..random - .let [sample (<function> key)]] - (_.cover [<function>] - (and (bit#= <pressed?> (the /.#pressed? sample)) - (n.= key (the /.#input sample)))))] + (_.for [/.Press] + (`` (all _.and + (~~ (template [<pressed?> <function>] + [(do random.monad + [key ..random + .let [sample (<function> key)]] + (_.cover [<function>] + (and (bit#= <pressed?> (the /.#pressed? sample)) + (n.= key (the /.#input sample)))))] - [#0 /.release] - [#1 /.press] - )) - ))) - ))))) + [#0 /.release] + [#1 /.press] + )) + ))) + ))))) diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux index aee92d1a0..c84bc1502 100644 --- a/stdlib/source/test/lux/world/net/http/client.lux +++ b/stdlib/source/test/lux/world/net/http/client.lux @@ -97,31 +97,31 @@ [/.connect on_connect] [/.options on_options] [/.trace on_trace])] - (`` ($_ _.and - (~~ (template [<definition> <expected>] - [(_.cover [<definition>] - (|> (<definition> "" //.empty {.#None} mock) - (verification io.monad <expected>) - io.run!))] + (`` (all _.and + (~~ (template [<definition> <expected>] + [(_.cover [<definition>] + (|> (<definition> "" //.empty {.#None} mock) + (verification io.monad <expected>) + io.run!))] - <cases> - )) - (_.cover [/.headers] - (nat.= (dictionary.size headers) - (|> headers - dictionary.entries - /.headers - dictionary.size))) - (in (do [! async.monad] - [.let [mock (/.async mock)] - (~~ (template [<definition> <expected>] - [<expected> (|> (<definition> "" //.empty {.#None} mock) - (verification ! <expected>))] + <cases> + )) + (_.cover [/.headers] + (nat.= (dictionary.size headers) + (|> headers + dictionary.entries + /.headers + dictionary.size))) + (in (do [! async.monad] + [.let [mock (/.async mock)] + (~~ (template [<definition> <expected>] + [<expected> (|> (<definition> "" //.empty {.#None} mock) + (verification ! <expected>))] - <cases>))] - (_.cover' [/.async] - (and (~~ (template [<definition> <expected>] - [<expected>] + <cases>))] + (_.cover' [/.async] + (and (~~ (template [<definition> <expected>] + [<expected>] - <cases>)))))) - )))))) + <cases>)))))) + )))))) diff --git a/stdlib/source/test/lux/world/net/http/status.lux b/stdlib/source/test/lux/world/net/http/status.lux index b9018fda1..3dc8326ae 100644 --- a/stdlib/source/test/lux/world/net/http/status.lux +++ b/stdlib/source/test/lux/world/net/http/status.lux @@ -1,6 +1,6 @@ (.using [library - [lux "*" + [lux {"-" all} ["_" test {"+" Test}] [data [collection @@ -111,10 +111,10 @@ (def: .public test Test (<| (_.covering /._) - (`` ($_ _.and - (~~ (template [<category> <status+>] - [<category>] - - <categories>)) - )))) + (`` (.all _.and + (~~ (template [<category> <status+>] + [<category>] + + <categories>)) + )))) ) diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux index 9b385af95..65713e748 100644 --- a/stdlib/source/test/lux/world/output/video/resolution.lux +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -54,13 +54,13 @@ Test (<| (_.covering /._) (_.for [/.Resolution]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) + (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) - (_.cover [<resolutions>] - (n.= (list.size ..listing) - (set.size ..catalogue))) - )))) + (_.cover [<resolutions>] + (n.= (list.size ..listing) + (set.size ..catalogue))) + )))) diff --git a/stdlib/source/test/lux/world/program.lux b/stdlib/source/test/lux/world/program.lux index d1696c608..2075fd410 100644 --- a/stdlib/source/test/lux/world/program.lux +++ b/stdlib/source/test/lux/world/program.lux @@ -48,31 +48,31 @@ directory ..path unknown (random.ascii/alpha 1)] - ($_ _.and - (_.for [/.mock /.async] - ($/.spec (/.async (/.mock environment home directory)))) - (_.cover [/.environment] - (let [program (/.mock environment home directory)] - (io.run! - (do io.monad - [actual (/.environment io.monad program)] - (in (and (n.= (dictionary.size environment) - (dictionary.size actual)) - (|> actual - dictionary.entries - (list.every? (function (_ [key value]) - (|> environment - (dictionary.value key) - (maybe#each (text#= value)) - (maybe.else false))))))))))) - (_.cover [/.unknown_environment_variable] - (let [program (/.mock environment home directory)] - (|> unknown - (# program variable) - io.run! - (pipe.case {try.#Success _} - false - - {try.#Failure error} - (exception.match? /.unknown_environment_variable error))))) - )))) + (all _.and + (_.for [/.mock /.async] + ($/.spec (/.async (/.mock environment home directory)))) + (_.cover [/.environment] + (let [program (/.mock environment home directory)] + (io.run! + (do io.monad + [actual (/.environment io.monad program)] + (in (and (n.= (dictionary.size environment) + (dictionary.size actual)) + (|> actual + dictionary.entries + (list.every? (function (_ [key value]) + (|> environment + (dictionary.value key) + (maybe#each (text#= value)) + (maybe.else false))))))))))) + (_.cover [/.unknown_environment_variable] + (let [program (/.mock environment home directory)] + (|> unknown + (# program variable) + io.run! + (pipe.case {try.#Success _} + false + + {try.#Failure error} + (exception.match? /.unknown_environment_variable error))))) + )))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index 608af1381..30d19d53c 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -83,46 +83,46 @@ (def: .public test Test (<| (_.covering /._) - ($_ _.and - (_.for [/.async /.mock /.Mock] - ($/.spec (/.async (/.mock (|>> ..mock {try.#Success}) - false)))) - (_.cover [/.error] - (not (i.= /.normal /.error))) - (do random.monad - [command (random.ascii/alpha 5) - oops (random.ascii/alpha 5) - input (random.ascii/alpha 5) - destruction (random.ascii/alpha 5) - exit random.int - .let [shell (/.async (..io_shell command oops input destruction exit))]] - (in (do [! async.monad] - [verdict (do (try.with !) - [process (# shell execute [environment.empty "~" command (list)]) - read (# process read []) - failure (# process fail []) - wrote! (do ! - [write (# process write input)] - (in {try.#Success (case write - {try.#Success _} - false - - {try.#Failure write} - (text#= input write))})) - destroyed! (do ! - [destroy (# process destroy [])] - (in {try.#Success (case destroy - {try.#Success _} - false - - {try.#Failure destroy} - (text#= destruction destroy))})) - await (# process await [])] - (in (and (text#= command read) - (text#= oops failure) - wrote! - destroyed! - (i.= exit await))))] - (_.cover' [/.Shell] - (try.else false verdict))))) - ))) + (all _.and + (_.for [/.async /.mock /.Mock] + ($/.spec (/.async (/.mock (|>> ..mock {try.#Success}) + false)))) + (_.cover [/.error] + (not (i.= /.normal /.error))) + (do random.monad + [command (random.ascii/alpha 5) + oops (random.ascii/alpha 5) + input (random.ascii/alpha 5) + destruction (random.ascii/alpha 5) + exit random.int + .let [shell (/.async (..io_shell command oops input destruction exit))]] + (in (do [! async.monad] + [verdict (do (try.with !) + [process (# shell execute [environment.empty "~" command (list)]) + read (# process read []) + failure (# process fail []) + wrote! (do ! + [write (# process write input)] + (in {try.#Success (case write + {try.#Success _} + false + + {try.#Failure write} + (text#= input write))})) + destroyed! (do ! + [destroy (# process destroy [])] + (in {try.#Success (case destroy + {try.#Success _} + false + + {try.#Failure destroy} + (text#= destruction destroy))})) + await (# process await [])] + (in (and (text#= command read) + (text#= oops failure) + wrote! + destroyed! + (i.= exit await))))] + (_.cover' [/.Shell] + (try.else false verdict))))) + ))) diff --git a/stdlib/source/unsafe/lux/data/binary.lux b/stdlib/source/unsafe/lux/data/binary.lux index f6dced3cb..fe71e0fbc 100644 --- a/stdlib/source/unsafe/lux/data/binary.lux +++ b/stdlib/source/unsafe/lux/data/binary.lux @@ -156,35 +156,35 @@ it (.is ..Binary it')]) (.as .I64) (.is (.I64 .Any)) - (.$_ "lux i64 or" - ("lux i64 left-shift" 8 (..bits_8 index it)) - (..bits_8 ("lux i64 +" 1 index) it)))]) + (.all "lux i64 or" + ("lux i64 left-shift" 8 (..bits_8 index it)) + (..bits_8 ("lux i64 +" 1 index) it)))]) (template: .public (bits_32 index' it') [(.<| (.let [index (.is Nat index') it (.is ..Binary it')]) (.as .I64) (.is (.I64 .Any)) - (.$_ "lux i64 or" - ("lux i64 left-shift" 24 (..bits_8 index it)) - ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 1 index) it)) - ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 2 index) it)) - (..bits_8 ("lux i64 +" 3 index) it)))]) + (.all "lux i64 or" + ("lux i64 left-shift" 24 (..bits_8 index it)) + ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 1 index) it)) + ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 2 index) it)) + (..bits_8 ("lux i64 +" 3 index) it)))]) (template: .public (bits_64 index' it') [(.<| (.let [index (.is Nat index') it (.is ..Binary it')]) (.as .I64) (.is (.I64 .Any)) - (.$_ "lux i64 or" - ("lux i64 left-shift" 56 (..bits_8 index it)) - ("lux i64 left-shift" 48 (..bits_8 ("lux i64 +" 1 index) it)) - ("lux i64 left-shift" 40 (..bits_8 ("lux i64 +" 2 index) it)) - ("lux i64 left-shift" 32 (..bits_8 ("lux i64 +" 3 index) it)) - ("lux i64 left-shift" 24 (..bits_8 ("lux i64 +" 4 index) it)) - ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 5 index) it)) - ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 6 index) it)) - (..bits_8 ("lux i64 +" 7 index) it)))]) + (.all "lux i64 or" + ("lux i64 left-shift" 56 (..bits_8 index it)) + ("lux i64 left-shift" 48 (..bits_8 ("lux i64 +" 1 index) it)) + ("lux i64 left-shift" 40 (..bits_8 ("lux i64 +" 2 index) it)) + ("lux i64 left-shift" 32 (..bits_8 ("lux i64 +" 3 index) it)) + ("lux i64 left-shift" 24 (..bits_8 ("lux i64 +" 4 index) it)) + ("lux i64 left-shift" 16 (..bits_8 ("lux i64 +" 5 index) it)) + ("lux i64 left-shift" 8 (..bits_8 ("lux i64 +" 6 index) it)) + (..bits_8 ("lux i64 +" 7 index) it)))]) (with_expansions [<byte> (hex "FF") <it> (.is ..Binary it) |