diff options
Diffstat (limited to 'stdlib/source/test')
206 files changed, 2440 insertions, 2442 deletions
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 51281e4a8..8057a46bc 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -10,7 +10,7 @@ ["$[0]" order] ["$[0]" hash]]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}]] [world @@ -51,7 +51,7 @@ (_.cover [/.format /.identity] (and (text.ends_with? (/.identity sample) (/.format sample)) - (not (text\= (/.identity sample) (/.format sample))))) + (not (text#= (/.identity sample) (/.format sample))))) /extension.test /snapshot.test diff --git a/stdlib/source/test/aedifex/artifact/extension.lux b/stdlib/source/test/aedifex/artifact/extension.lux index e9ecafe17..f346a6c77 100644 --- a/stdlib/source/test/aedifex/artifact/extension.lux +++ b/stdlib/source/test/aedifex/artifact/extension.lux @@ -5,7 +5,7 @@ [abstract [monad {"+" [do]}]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" set] ["[0]" list]]] @@ -31,9 +31,9 @@ (set.size uniques)))) (_.cover [/.extension /.type] (`` (and (~~ (template [<type> <extension>] - [(and (text\= <extension> + [(and (text#= <extension> (/.extension <type>)) - (text\= <type> + (text#= <type> (/.type (/.extension <type>))))] [//.lux_library /.lux_library] diff --git a/stdlib/source/test/aedifex/artifact/snapshot.lux b/stdlib/source/test/aedifex/artifact/snapshot.lux index b411f425c..c89a0cede 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot.lux @@ -7,11 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" xml]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]]]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]]]] ["$[0]" / "_" ["[1][0]" build] ["[1][0]" stamp] @@ -22,7 +22,7 @@ (def: .public random (Random /.Snapshot) - (random.or (random\in []) + (random.or (random#in []) $/stamp.random)) (def: .public test @@ -40,7 +40,7 @@ /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) $/build.test diff --git a/stdlib/source/test/aedifex/artifact/snapshot/build.lux b/stdlib/source/test/aedifex/artifact/snapshot/build.lux index 24f6ee539..9bceb6737 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/build.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/build.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" xml]]] [math @@ -34,6 +34,6 @@ /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (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 0ece8e264..8c403ec24 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/stamp.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" xml]]] [math @@ -41,6 +41,6 @@ (|> expected /.format (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (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 50fbbbf49..e74d3d370 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/time.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/time.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" text]]] [math @@ -36,7 +36,7 @@ (|> expected /.format (<text>.result /.parser) - (try\each (\ /.equivalence = expected)) + (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 238a0d2a3..367ddfe93 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" xml]]] [math @@ -43,7 +43,7 @@ /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) /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 a6532c250..156c403d7 100644 --- a/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux +++ b/stdlib/source/test/aedifex/artifact/snapshot/version/value.lux @@ -7,14 +7,14 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" text]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat] ["i" int]]] @@ -32,7 +32,7 @@ (Random /.Value) ($_ random.and (random.ascii/alpha 5) - (random.or (random\in []) + (random.or (random#in []) $///stamp.random) )) @@ -50,7 +50,7 @@ (let [version (value@ /.#version sample) local! - (text\= version + (text#= version (/.format (with@ /.#snapshot {///.#Local} sample))) remote_format (/.format [/.#version (format version /.snapshot) diff --git a/stdlib/source/test/aedifex/artifact/time.lux b/stdlib/source/test/aedifex/artifact/time.lux index 9cfefe6f6..af64231ab 100644 --- a/stdlib/source/test/aedifex/artifact/time.lux +++ b/stdlib/source/test/aedifex/artifact/time.lux @@ -7,11 +7,11 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" text]]] [time - ["[0]" instant ("[1]\[0]" equivalence)]] + ["[0]" instant ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -43,7 +43,7 @@ (|> expected /.format (<text>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) (do random.monad [expected ..random] @@ -51,10 +51,10 @@ (|> expected /.instant /.of_instant - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) (_.cover [/.epoch] - (instant\= instant.epoch (/.instant /.epoch))) + (instant#= instant.epoch (/.instant /.epoch))) /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 b32787d49..85f6b69f5 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception] [parser ["<[0]>" text]]] @@ -17,7 +17,7 @@ ["n" nat] ["i" int]]] [time - ["[0]" date ("[1]\[0]" equivalence)] + ["[0]" date ("[1]#[0]" equivalence)] ["[0]" year]]]] [\\program ["[0]" /]]) @@ -49,13 +49,13 @@ (|> expected /.format (<text>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) (_.cover [/.value /.date] (|> expected /.value /.date - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) (_.cover [/.year_is_out_of_range] (case (/.date candidate) @@ -65,5 +65,5 @@ {try.#Failure error} (exception.match? /.year_is_out_of_range error))) (_.cover [/.epoch] - (date\= date.epoch (/.value /.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 c908eb69b..983e81210 100644 --- a/stdlib/source/test/aedifex/artifact/time/time.lux +++ b/stdlib/source/test/aedifex/artifact/time/time.lux @@ -6,7 +6,7 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" text]]] [math @@ -35,6 +35,6 @@ (|> expected /.format (<text>.result /.parser) - (try\each (\ time.equivalence = expected)) + (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 00b483a75..7b19d6c57 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -10,7 +10,7 @@ ["[0]" set] ["[0]" list]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\program @@ -20,12 +20,12 @@ (Random /.Type) ($_ random.either ($_ random.either - (random\in /.lux_library) - (random\in /.jvm_library)) + (random#in /.lux_library) + (random#in /.jvm_library)) ($_ random.either - (random\in /.pom) - (random\in /.md5) - (random\in /.sha-1)) + (random#in /.pom) + (random#in /.md5) + (random#in /.sha-1)) )) (def: .public test diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux index 3d489eb38..963424469 100644 --- a/stdlib/source/test/aedifex/artifact/versioning.lux +++ b/stdlib/source/test/aedifex/artifact/versioning.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" xml]]] [math @@ -42,13 +42,13 @@ /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) (_.cover [/.init] (|> /.init /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = /.init)) + (try#each (# /.equivalence = /.init)) (try.else false))) ))) diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 84b8aaa02..989b205a3 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -19,7 +19,7 @@ ["[0]" set] ["[0]" dictionary]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]] [world @@ -48,8 +48,8 @@ (def: type (Random Type) ($_ random.either - (random\in //artifact/type.lux_library) - (random\in //artifact/type.jvm_library))) + (random#in //artifact/type.lux_library) + (random#in //artifact/type.jvm_library))) (def: profile (Random [Artifact Profile XML]) @@ -64,7 +64,7 @@ (def: content (Random Binary) (do [! random.monad] - [content_size (\ ! each (n.% 100) random.nat)] + [content_size (# ! each (n.% 100) random.nat)] (_binary.random content_size))) (def: package @@ -82,7 +82,7 @@ (do [! random.monad] [[main_dependency main_package] ..package dependencies (|> (//package.dependencies main_package) - (\ try.monad each set.list) + (# try.monad each set.list) (try.else (list)) (monad.each ! (function (_ dependency) (do ! @@ -105,7 +105,7 @@ home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) .let [fs (: (file.System Async) - (file.mock (\ file.default separator))) + (file.mock (# file.default separator))) program (program.async (program.mock environment.empty home working_directory))]] (in (do async.monad [wrote! (/.write_one program fs dependency expected_package) @@ -115,7 +115,7 @@ (do try.monad [_ wrote! actual_package read!] - (in (\ //package.equivalence = + (in (# //package.equivalence = (with@ //package.#origin {//repository/origin.#Local ""} expected_package) actual_package))))))))) @@ -126,7 +126,7 @@ home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) .let [fs (: (file.System Async) - (file.mock (\ file.default separator))) + (file.mock (# file.default separator))) program (program.async (program.mock environment.empty home working_directory))]] (in (do async.monad [wrote! (/.write_all program fs expected) @@ -136,8 +136,8 @@ (do try.monad [_ wrote! actual read!] - (in (\ //dependency/resolution.equivalence = - (\ dictionary.functor each + (in (# //dependency/resolution.equivalence = + (# dictionary.functor each (with@ //package.#origin {//repository/origin.#Local ""}) expected) actual))))))))) diff --git a/stdlib/source/test/aedifex/cli.lux b/stdlib/source/test/aedifex/cli.lux index d08d5f1a1..16ae29ab4 100644 --- a/stdlib/source/test/aedifex/cli.lux +++ b/stdlib/source/test/aedifex/cli.lux @@ -16,7 +16,7 @@ [collection ["[0]" list]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]]]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]]]] [\\program ["[0]" / ["/[1]" // "_" @@ -24,22 +24,22 @@ (def: compilation (Random /.Compilation) - (random.or (random\in []) - (random\in []))) + (random.or (random#in []) + (random#in []))) (def: command (Random /.Command) ($_ random.or ... #Version - (random\in []) + (random#in []) ... #Clean - (random\in []) + (random#in []) ... #POM - (random\in []) + (random#in []) ... #Dependencies - (random\in []) + (random#in []) ... #Install - (random\in []) + (random#in []) ... #Deploy ($_ random.and (random.ascii/alpha 1) @@ -77,8 +77,8 @@ ..format (cli.result /.command) (case> {try.#Success [names actual]} - (and (\ (list.equivalence text.equivalence) = (list //.default) names) - (\ /.equivalence = expected actual)) + (and (# (list.equivalence text.equivalence) = (list //.default) names) + (# /.equivalence = expected actual)) {try.#Failure error} false))))) @@ -94,8 +94,8 @@ (list& "with" expected_profile) (cli.result /.command) (case> {try.#Success [actual_profile actual_command]} - (and (\ (list.equivalence text.equivalence) = (list expected_profile //.default) actual_profile) - (\ /.equivalence = expected_command actual_command)) + (and (# (list.equivalence text.equivalence) = (list expected_profile //.default) actual_profile) + (# /.equivalence = expected_command actual_command)) {try.#Failure error} false))))) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 307946212..eab61d51f 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -57,8 +57,8 @@ (if (n.= expected_runs actual_runs) (in {try.#Failure end_signal}) (do (try.with !) - [_ (\ fs write (\ utf8.codec encoded (%.nat actual_runs)) dummy_file) - _ (\ fs modify + [_ (# fs write (# utf8.codec encoded (%.nat actual_runs)) dummy_file) + _ (# fs modify (|> actual_runs .int instant.of_millis) dummy_file)] (in [shell.normal []])))))])) @@ -68,14 +68,14 @@ (<| (_.covering /._) (do [! random.monad] [end_signal (random.ascii/alpha 5) - .let [/ (\ file.default separator) + .let [/ (# file.default separator) [fs watcher] (watch.mock /)] program (random.ascii/alpha 5) target (random.ascii/alpha 5) source (random.ascii/alpha 5) .let [empty_profile (: Profile - (\ ///.monoid identity)) + (# ///.monoid identity)) with_target (: (-> Profile Profile) (with@ ///.#target target)) with_program (: (-> Profile Profile) @@ -89,18 +89,18 @@ home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) - expected_runs (\ ! each (|>> (n.% 10) (n.max 2)) random.nat) - dummy_path (\ ! each (|>> (format source /)) (random.ascii/alpha 5)) + 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 (binary.empty 0) dummy_path) + [_ (# fs make_directory source) + _ (# fs write (binary.empty 0) dummy_path) .let [[@runs command] (..command expected_runs end_signal fs dummy_path)] - _ (\ watcher poll [])] + _ (# watcher poll [])] (do [! async.monad] [no_dangling_process! (|> profile (with@ ///.#compiler compiler) @@ -110,7 +110,7 @@ fs (shell.async ($build.good_shell [])) resolution) - (\ ! each (|>> (case> {try.#Failure error} + (# ! each (|>> (case> {try.#Failure error} (same? end_signal error) {try.#Success _} @@ -118,7 +118,7 @@ correct_number_of_runs! (|> @runs atom.read! async.future - (\ ! each (n.= expected_runs)))] + (# ! each (n.= expected_runs)))] (in {try.#Success (and correct_number_of_runs! no_dangling_process!)})))] (_.cover' [/.do!] diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index ee69f1010..722478571 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -14,7 +14,7 @@ [parser ["[0]" environment]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" dictionary]]] [math @@ -142,14 +142,14 @@ (do [! random.monad] [last_read (random.ascii/alpha 5) last_error (random.ascii/alpha 5) - .let [fs (file.mock (\ file.default separator)) + .let [fs (file.mock (# file.default separator)) shell (shell.async (..good_shell []))] program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) .let [empty_profile (: Profile - (\ ///.monoid identity)) + (# ///.monoid identity)) with_target (: (-> Profile Profile) (with@ ///.#target target)) with_program (: (-> Profile Profile) @@ -186,10 +186,10 @@ [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs shell resolution (with@ ///.#compiler compiler profile)) - start (\ console read_line []) - end (\ console read_line [])] - (in (and (text\= /.start start) - (text\= /.success end))))] + start (# console read_line []) + end (# console read_line [])] + (in (and (text#= /.start start) + (text#= /.success end))))] (_.cover' [/.do! /.lux_group /.jvm_compiler_name @@ -208,10 +208,10 @@ [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution (with@ ///.#compiler compiler profile)) - start (\ console read_line []) - end (\ console read_line [])] - (in (and (text\= /.start start) - (text\= /.failure end))))] + start (# console read_line []) + end (# console read_line [])] + (in (and (text#= /.start start) + (text#= /.failure end))))] (_.cover' [/.failure] (try.else false verdict))))) (do ! @@ -228,19 +228,19 @@ [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 (|>> (case> {try.#Failure error} + actual/0 (# console read_line []) + actual/1 (# console read_line []) + actual/2 (# console read_line []) + end! (|> (# console read_line []) + (# ! each (|>> (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) + (in (and (text#= expected/0 actual/0) + (text#= expected/1 actual/1) + (text#= expected/2 actual/2) end!)))] (_.cover' [<log!>] (try.else false verdict)))))] diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index 7d3e57392..8a9a69e7c 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -11,10 +11,10 @@ [data [binary {"+" [Binary]}] ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor)] + ["[0]" list ("[1]#[0]" functor)] ["[0]" set]]] [math ["[0]" random {"+" [Random]}] @@ -43,15 +43,15 @@ (def: (files prefix) (-> Path (Random (List [Path Binary]))) (do [! random.monad] - [count (\ ! each (n.% 10) random.nat) + [count (# ! each (n.% 10) random.nat) names (random.set text.hash count ..node_name) contents (random.list count ($binary.random 100))] - (in (list.zipped/2 (list\each (|>> (format prefix)) (set.list names)) + (in (list.zipped/2 (list#each (|>> (format prefix)) (set.list names)) contents)))) (def: (create_file! fs [path content]) (-> (file.System Async) [Path Binary] (Async (Try Any))) - (\ fs write content path)) + (# fs write content path)) (def: (create_directory! fs path files) (-> (file.System Async) Path (List [Path Binary]) (Async (Try Any))) @@ -63,11 +63,11 @@ (def: (directory_exists? fs) (-> (file.System Async) Path (Async (Try Bit))) - (|>> (\ fs directory?) (try.lifted async.monad))) + (|>> (# fs directory?) (try.lifted async.monad))) (def: (file_exists? fs) (-> (file.System Async) Path (Async (Try Bit))) - (|>> (\ fs file?) (try.lifted async.monad))) + (|>> (# fs file?) (try.lifted async.monad))) (def: (assets_exist? fs directory_path files) (-> (file.System Async) Path (List [Path Binary]) (Async (Try Bit))) @@ -75,7 +75,7 @@ [directory_exists? (..directory_exists? fs directory_path) files_exist? (: (Action (List Bit)) (|> files - (list\each product.left) + (list#each product.left) (monad.each ///action.monad (..file_exists? fs))))] (in (and directory_exists? (list.every? (|>>) files_exist?))))) @@ -87,8 +87,8 @@ [context ..node_name target ..node_name sub ..node_name - .let [fs (file.mock (\ file.default separator)) - / (\ fs separator) + .let [fs (file.mock (# file.default separator)) + / (# fs separator) target_path (format context / target) sub_path (format target_path / sub)] direct_files (..files (format target_path /)) @@ -107,13 +107,13 @@ context_exists!/post (..directory_exists? fs context) target_exists!/post (..assets_exist? fs target_path direct_files) sub_exists!/post (..assets_exist? fs sub_path sub_files) - logging (\ console read_line [])] + logging (# console read_line [])] (in (and (and context_exists!/pre context_exists!/post) (and target_exists!/pre (not target_exists!/post)) (and sub_exists!/pre (not sub_exists!/post)) - (text\= (/.success target_path) logging))))] + (text#= (/.success target_path) logging))))] (_.cover' [/.do! /.success] (try.else false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 0b0f8558b..68e4de22c 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -12,8 +12,8 @@ [parser ["[0]" environment]]] [data - ["[0]" binary ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" binary ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}] [encoding ["[0]" utf8]]] @@ -57,7 +57,7 @@ [.let [console ($version.echo "")] _ ($install.make_sources! fs (value@ ///.#sources profile)) _ (/.do! console repository fs artifact profile)] - (\ console read_line []))) + (# console read_line []))) (def: .public test Test @@ -75,7 +75,7 @@ working_directory (random.ascii/alpha 5) .let [repository (///repository.mock $repository.mock $repository.empty) - fs (file.mock (\ file.default separator)) + fs (file.mock (# file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] (in (do [! async.monad] [verdict (do [! ///action.monad] @@ -84,39 +84,39 @@ (value@ ///.#sources) set.list (export.library fs) - (\ ! each (format.result tar.writer))) + (# ! each (format.result tar.writer))) - actual_pom (\ repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact ///artifact/extension.pom)) - actual_library (\ repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact ///artifact/extension.lux_library)) - actual_sha-1 (\ repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) - actual_sha-1 (\ async.monad in + actual_pom (# repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact ///artifact/extension.pom)) + actual_library (# repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact ///artifact/extension.lux_library)) + actual_sha-1 (# repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) + actual_sha-1 (# async.monad in (do try.monad - [actual_sha-1 (\ utf8.codec decoded actual_sha-1)] - (\ ///hash.sha-1_codec decoded actual_sha-1))) - actual_md5 (\ repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) - actual_md5 (\ async.monad in + [actual_sha-1 (# utf8.codec decoded actual_sha-1)] + (# ///hash.sha-1_codec decoded actual_sha-1))) + actual_md5 (# repository download (///repository/remote.uri (value@ ///artifact.#version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_md5 (# async.monad in (do try.monad - [actual_md5 (\ utf8.codec decoded actual_md5)] - (\ ///hash.md5_codec decoded actual_md5))) + [actual_md5 (# utf8.codec decoded actual_md5)] + (# ///hash.md5_codec decoded actual_md5))) .let [succeeded! - (text\= /.success logging) + (text#= /.success logging) deployed_library! - (binary\= expected_library + (binary#= expected_library actual_library) deployed_pom! - (binary\= (|> expected_pom (\ xml.codec encoded) (\ utf8.codec encoded)) + (binary#= (|> expected_pom (# xml.codec encoded) (# utf8.codec encoded)) actual_pom) deployed_sha-1! - (\ ///hash.equivalence = + (# ///hash.equivalence = (///hash.sha-1 expected_library) actual_sha-1) deployed_md5! - (\ ///hash.equivalence = + (# ///hash.equivalence = (///hash.md5 expected_library) actual_md5)]] (in (and succeeded! diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 037a8e119..812f4b745 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -12,7 +12,7 @@ [parser ["[0]" environment]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}] [encoding ["[0]" utf8]]] @@ -61,7 +61,7 @@ dependee_artifact $///artifact.random depender_artifact (random.only (predicate.complement - (\ ///artifact.equivalence = dependee_artifact)) + (# ///artifact.equivalence = dependee_artifact)) $///artifact.random) [_ dependee_package] $///package.random @@ -72,11 +72,11 @@ depender [///dependency.#artifact depender_artifact ///dependency.#type ///artifact/type.lux_library] - dependee_pom (|> (\ ///.monoid identity) + dependee_pom (|> (# ///.monoid identity) (with@ ///.#identity {.#Some dependee_artifact}) ///pom.write try.trusted) - depender_pom (|> (\ ///.monoid identity) + depender_pom (|> (# ///.monoid identity) (with@ ///.#identity {.#Some depender_artifact}) (with@ ///.#dependencies (set.of_list ///dependency.hash (list dependee))) ///pom.write @@ -85,15 +85,15 @@ dependee_package (|> dependee_package (with@ ///package.#origin {///repository/origin.#Remote ""}) (with@ ///package.#pom [dependee_pom - (|> dependee_pom (\ xml.codec encoded) (\ utf8.codec encoded)) + (|> dependee_pom (# xml.codec encoded) (# utf8.codec encoded)) {///dependency/status.#Unverified}])) depender_package (|> depender_package (with@ ///package.#origin {///repository/origin.#Remote ""}) (with@ ///package.#pom [depender_pom - (|> depender_pom (\ xml.codec encoded) (\ utf8.codec encoded)) + (|> depender_pom (# xml.codec encoded) (# utf8.codec encoded)) {///dependency/status.#Unverified}])) - fs (file.mock (\ file.default separator)) + fs (file.mock (# file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] (in (do async.monad [verdict (do ///action.monad @@ -102,7 +102,7 @@ pre (|> ///dependency/resolution.empty (dictionary.has dependee dependee_package) (///dependency/deployment.all local)) - post (|> (\ ///.monoid identity) + post (|> (# ///.monoid identity) (with@ ///.#dependencies (set.of_list ///dependency.hash (list dependee depender))) (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 0461029fc..ba6f599fb 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -5,7 +5,7 @@ [abstract ["[0]" monad {"+" [do]}]] [control - ["[0]" try {"+" [Try]} ("[1]\[0]" functor)] + ["[0]" try {"+" [Try]} ("[1]#[0]" functor)] ["[0]" exception] [concurrency ["[0]" async {"+" [Async]}]] @@ -13,7 +13,7 @@ ["[0]" environment]]] [data ["[0]" binary] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" set {"+" [Set]}]]] @@ -41,7 +41,7 @@ (def: .public (make_sources! fs sources) (-> (file.System Async) (Set file.Path) (Action (List Any))) - (let [/ (\ fs separator) + (let [/ (# fs separator) ! ///action.monad] (|> sources set.list @@ -58,18 +58,18 @@ [.let [console ($version.echo "")] _ (..make_sources! fs (value@ ///.#sources sample)) _ (/.do! console fs (///repository/local.repository program fs) sample)] - (\ console read_line []))) + (# console read_line []))) (def: .public test Test (<| (_.covering /._) (do [! random.monad] [identity $artifact.random - sample (\ ! each (with@ ///.#identity {.#Some identity}) + sample (# ! each (with@ ///.#identity {.#Some identity}) $profile.random) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) - .let [/ (\ file.default separator)]] + .let [/ (# file.default separator)]] ($_ _.and (in (do [! async.monad] [.let [fs (file.mock /) @@ -79,16 +79,16 @@ 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) + [succeeded! (# ! each (text#= /.success) (..execute! program fs sample)) library_exists! (|> library_path (format home /) - (\ fs file?) - (\ async.monad each (|>> {try.#Success}))) + (# fs file?) + (# async.monad each (|>> {try.#Success}))) pom_exists! (|> pom_path (format home /) - (\ fs file?) - (\ async.monad each (|>> {try.#Success})))] + (# fs file?) + (# async.monad each (|>> {try.#Success})))] (in (and succeeded! library_exists! pom_exists!)))] @@ -100,6 +100,6 @@ logging (..execute! program fs (with@ ///.#identity {.#None} sample))] (_.cover' [/.failure] (|> logging - (try\each (text\= /.failure)) + (try#each (text#= /.failure)) (try.else false))))) )))) diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index 76cdf8b02..47456bdba 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -5,12 +5,12 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [concurrency ["[0]" async]]] [data - ["[0]" binary ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" binary ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) [encoding ["[0]" utf8]]] [format @@ -35,7 +35,7 @@ (<| (_.covering /._) (do random.monad [sample @profile.random - .let [fs (file.mock (\ file.default separator))]] + .let [fs (file.mock (# file.default separator))]] (in (do [! async.monad] [.let [console (@version.echo "")] outcome (/.do! console fs sample)] @@ -44,17 +44,17 @@ (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) - (try\each (|>> (\ xml.codec encoded) - (\ utf8.codec encoded))) - (\ ! in)) - actual (\ fs read ///pom.file) + (try#each (|>> (# xml.codec encoded) + (# utf8.codec encoded))) + (# ! in)) + actual (# fs read ///pom.file) - logging! (\ ///action.monad each - (text\= /.success) - (\ console read_line [])) + logging! (# ///action.monad each + (text#= /.success) + (# console read_line [])) .let [expected_content! - (binary\= expected actual)]] + (binary#= expected actual)]] (in (and logging! expected_content!)))] (_.cover' [/.do! /.success] diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index cee27dd27..20a59f405 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -12,7 +12,7 @@ [parser ["[0]" environment]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" dictionary] ["[0]" list]]] @@ -48,7 +48,7 @@ home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) .let [empty_profile (: Profile - (\ ///.monoid identity)) + (# ///.monoid identity)) with_target (: (-> Profile Profile) (with@ ///.#target target)) with_test (: (-> Profile Profile) @@ -59,25 +59,25 @@ with_target)] [compiler resolution] @build.resolution] ($_ _.and - (let [fs (file.mock (\ file.default separator)) + (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 (with@ ///.#compiler 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)))))] + 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)) + (let [fs (file.mock (# file.default separator)) console (@version.echo "")] (in (do async.monad [verdict (do ///action.monad @@ -95,21 +95,21 @@ (def: (on_destroy state) {try.#Failure "on_destroy"}) (def: (on_await state) - {try.#Success [state (if (list.any? (text\= "build") actual_arguments) + {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 (with@ ///.#compiler 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)))))] + 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/command/version.lux b/stdlib/source/test/aedifex/command/version.lux index 583e21fcd..423c88718 100644 --- a/stdlib/source/test/aedifex/command/version.lux +++ b/stdlib/source/test/aedifex/command/version.lux @@ -11,7 +11,7 @@ [concurrency ["[0]" async {"+" [Async]}]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random]] @@ -72,8 +72,8 @@ [.let [console (..echo "")] verdict (do (try.with async.monad) [_ (/.do! console profile) - logging (\ console read_line [])] - (in (text\= (version.format language/lux.version) + logging (# console read_line [])] + (in (text#= (version.format language/lux.version) logging)))] (_.cover' [/.do!] (try.else false verdict))))))) diff --git a/stdlib/source/test/aedifex/dependency/deployment.lux b/stdlib/source/test/aedifex/dependency/deployment.lux index 625c7c9f5..f3bb6b4a3 100644 --- a/stdlib/source/test/aedifex/dependency/deployment.lux +++ b/stdlib/source/test/aedifex/dependency/deployment.lux @@ -7,20 +7,20 @@ ["[0]" hash {"+" [Hash]}]] [control ["[0]" io {"+" [IO]}] - ["[0]" maybe ("[1]\[0]" functor)] - ["[0]" try ("[1]\[0]" functor)] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [concurrency ["[0]" atom {"+" [Atom]}] ["[0]" async]]] [data ["[0]" product] - ["[0]" binary {"+" [Binary]} ("[1]\[0]" equivalence)] + ["[0]" binary {"+" [Binary]} ("[1]#[0]" equivalence)] ["[0]" text ["%" format {"+" [format]}]] [collection ["[0]" dictionary {"+" [Dictionary]}] ["[0]" set] - ["[0]" list ("[1]\[0]" mix)]]] + ["[0]" list ("[1]#[0]" mix)]]] [math ["[0]" random {"+" [Random]}] [number @@ -43,7 +43,7 @@ ["[0]" profile] ["[0]" metadata] ["[0]" package {"+" [Package]}] - ["[0]" artifact {"+" [Artifact]} ("[1]\[0]" equivalence) + ["[0]" artifact {"+" [Artifact]} ("[1]#[0]" equivalence) ["[1]/[0]" type] ["[1]/[0]" extension]] ["[0]" repository @@ -97,7 +97,7 @@ product.left) correct_artifact! - (artifact\= expected_artifact actual_artifact) + (artifact#= expected_artifact actual_artifact) expected_number_of_uploads! (n.= (n.* expected_deployments 8) @@ -106,7 +106,7 @@ correct_library_upload! (and (|> cache (dictionary.value library_url) - (maybe\each (binary\= expected_library)) + (maybe#each (binary#= expected_library)) (maybe.else false)) (dictionary.key? cache (format library_url artifact/extension.sha-1)) (dictionary.key? cache (format library_url artifact/extension.md5))) @@ -114,7 +114,7 @@ correct_pom_upload! (and (|> cache (dictionary.value pom_url) - (maybe\each (binary\= expected_pom)) + (maybe#each (binary#= expected_pom)) (maybe.else false)) (dictionary.key? cache (format pom_url artifact/extension.sha-1)) (dictionary.key? cache (format pom_url artifact/extension.md5))) @@ -147,7 +147,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [address (\ ! each (text.suffix uri.separator) + [address (# ! each (text.suffix uri.separator) (random.ascii/upper 10))] ($_ _.and (do [! random.monad] @@ -161,17 +161,17 @@ cache (async.future (atom.read! cache))] (_.cover' [/.one] (|> ?outcome - (try\each (verify_one 1 address package cache expected_artifact)) + (try#each (verify_one 1 address package cache expected_artifact)) (try.else false)))))) (do [! random.monad] [.let [hash (: (Hash [Dependency Artifact Package]) - (\ hash.functor each (|>> product.right product.left product.left) + (# hash.functor each (|>> product.right product.left product.left) text.hash))] - num_bundles (\ ! each (n.% 10) random.nat) + 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) + (# ! each set.list)) + .let [resolution (list#mix (function (_ [dependency expected_artifact package] resolution) (dictionary.has dependency package resolution)) resolution.empty bundles) @@ -184,7 +184,7 @@ cache (async.future (atom.read! cache))] (_.cover' [/.all] (|> ?outcome - (try\each (function (_ actual_artifacts) + (try#each (function (_ actual_artifacts) (let [expected_deployments! (n.= num_bundles (set.size actual_artifacts)) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index b8b50f23d..01d516480 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -39,7 +39,7 @@ ["[1]" profile] ["[1][0]" package {"+" [Package]}] ["[1][0]" hash] - ["[1][0]" dependency {"+" [Dependency]} ("[1]\[0]" equivalence) + ["[1][0]" dependency {"+" [Dependency]} ("[1]#[0]" equivalence) ["[1]/[0]" status]] ["[1][0]" pom] ["[1][0]" artifact {"+" [Artifact]} @@ -77,14 +77,14 @@ (def: sha-1 (-> Binary Binary) (|>> ///hash.sha-1 - (\ ///hash.sha-1_codec encoded) - (\ utf8.codec encoded))) + (# ///hash.sha-1_codec encoded) + (# utf8.codec encoded))) (def: md5 (-> Binary Binary) (|>> ///hash.md5 - (\ ///hash.md5_codec encoded) - (\ utf8.codec encoded))) + (# ///hash.md5_codec encoded) + (# utf8.codec encoded))) (def: .public nope (Mock Any) @@ -112,8 +112,8 @@ (|> package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded)))] + (# xml.codec encoded) + (# utf8.codec encoded)))] (cond (text.ends_with? ///artifact/extension.lux_library uri) {try.#Success [state library]} @@ -166,23 +166,23 @@ {try.#Success [state (|> expected_package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded))]} + (# xml.codec encoded) + (# utf8.codec encoded))]} (text.ends_with? ..pom_sha-1 uri) {try.#Success [state (|> dummy_package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded) + (# xml.codec encoded) + (# utf8.codec encoded) ..sha-1)]} (text.ends_with? ..pom_md5 uri) {try.#Success [state (|> expected_package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded) + (# xml.codec encoded) + (# utf8.codec encoded) ..md5)]} ... else @@ -219,23 +219,23 @@ {try.#Success [state (|> expected_package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded))]} + (# xml.codec encoded) + (# utf8.codec encoded))]} (text.ends_with? ..pom_sha-1 uri) {try.#Success [state (|> expected_package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded) + (# xml.codec encoded) + (# utf8.codec encoded) ..sha-1)]} (text.ends_with? ..pom_md5 uri) {try.#Success [state (|> dummy_package (value@ ///package.#pom) product.left - (\ xml.codec encoded) - (\ utf8.codec encoded) + (# xml.codec encoded) + (# utf8.codec encoded) ..md5)]} ... else @@ -251,7 +251,7 @@ [_ expected_package] $///package.random [_ dummy_package] (random.only (|>> product.right (with@ ///package.#pom (value@ ///package.#pom expected_package)) - (\ ///package.equivalence = expected_package) + (# ///package.equivalence = expected_package) not) $///package.random) .let [good (..single expected_artifact expected_package) @@ -265,7 +265,7 @@ (_.cover' [/.one] (case actual_package {try.#Success actual_package} - (\ ///package.equivalence = + (# ///package.equivalence = (with@ ///package.#origin {///repository/origin.#Remote ""} expected_package) actual_package) @@ -296,7 +296,7 @@ [_ expected_package] $///package.random [_ dummy_package] (random.only (|>> product.right (with@ ///package.#pom (value@ ///package.#pom expected_package)) - (\ ///package.equivalence = expected_package) + (# ///package.equivalence = expected_package) not) $///package.random) .let [good (..single expected_artifact expected_package) @@ -314,7 +314,7 @@ (_.cover' [/.any] (case actual_package {try.#Success actual_package} - (\ ///package.equivalence = + (# ///package.equivalence = (with@ ///package.#origin {///repository/origin.#Remote ""} expected_package) actual_package) @@ -341,11 +341,11 @@ (do random.monad [dependee_artifact $///artifact.random depender_artifact (random.only (predicate.complement - (\ ///artifact.equivalence = dependee_artifact)) + (# ///artifact.equivalence = dependee_artifact)) $///artifact.random) ignored_artifact (random.only (predicate.complement - (predicate.and (\ ///artifact.equivalence = dependee_artifact) - (\ ///artifact.equivalence = depender_artifact))) + (predicate.and (# ///artifact.equivalence = dependee_artifact) + (# ///artifact.equivalence = depender_artifact))) $///artifact.random)] (in [dependee_artifact depender_artifact ignored_artifact]))) @@ -365,33 +365,33 @@ ignored [///dependency.#artifact ignored_artifact ///dependency.#type ///artifact/type.lux_library] - dependee_pom (|> (\ ///.monoid identity) + dependee_pom (|> (# ///.monoid identity) (with@ ///.#identity {.#Some dependee_artifact}) ///pom.write try.trusted) - depender_pom (|> (\ ///.monoid identity) + depender_pom (|> (# ///.monoid identity) (with@ ///.#identity {.#Some depender_artifact}) (with@ ///.#dependencies (set.of_list ///dependency.hash (list dependee))) ///pom.write try.trusted) - ignored_pom (|> (\ ///.monoid identity) + ignored_pom (|> (# ///.monoid identity) (with@ ///.#identity {.#Some ignored_artifact}) ///pom.write try.trusted) dependee_package (with@ ///package.#pom [dependee_pom - (|> dependee_pom (\ xml.codec encoded) (\ utf8.codec encoded)) + (|> dependee_pom (# xml.codec encoded) (# utf8.codec encoded)) {///dependency/status.#Unverified}] dependee_package) depender_package (with@ ///package.#pom [depender_pom - (|> depender_pom (\ xml.codec encoded) (\ utf8.codec encoded)) + (|> depender_pom (# xml.codec encoded) (# utf8.codec encoded)) {///dependency/status.#Unverified}] depender_package) ignored_package (with@ ///package.#pom [ignored_pom - (|> ignored_pom (\ xml.codec encoded) (\ utf8.codec encoded)) + (|> ignored_pom (# xml.codec encoded) (# utf8.codec encoded)) {///dependency/status.#Unverified}] ignored_package)]] (in [[dependee depender ignored] @@ -418,10 +418,10 @@ /.empty)] (_.cover' [/.all] (and (dictionary.key? resolution depender) - (list.any? (///dependency\= depender) successes) + (list.any? (///dependency#= depender) successes) (dictionary.key? resolution dependee) - (list.any? (///dependency\= dependee) successes) + (list.any? (///dependency#= dependee) successes) (list.empty? failures) (not (dictionary.key? resolution ignored)))))) diff --git a/stdlib/source/test/aedifex/dependency/status.lux b/stdlib/source/test/aedifex/dependency/status.lux index ea39e0cf5..0b487873f 100644 --- a/stdlib/source/test/aedifex/dependency/status.lux +++ b/stdlib/source/test/aedifex/dependency/status.lux @@ -10,7 +10,7 @@ ["[0]" binary "_" ["[1]T" \\test]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]]]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]]]] ["$[0]" /// "_" ["[1][0]" hash]] [\\program @@ -21,7 +21,7 @@ (def: .public random (Random /.Status) ($_ random.or - (random\in []) + (random#in []) (random.or ($///hash.random ///hash.sha-1) ($///hash.random ///hash.md5)) (random.and ($///hash.random ///hash.sha-1) diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index eb3886755..67dfa6b01 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -30,8 +30,8 @@ (-> (-> Binary (/.Hash h)) (Random (/.Hash h)))) (do [! random.monad] - [size (\ ! each (n.% 100) random.nat)] - (\ ! each hash (_binary.random size)))) + [size (# ! each (n.% 100) random.nat)] + (# ! each hash (_binary.random size)))) (def: .public test Test @@ -51,11 +51,11 @@ (_.cover [<hash> <constructor> <exception>] (and (case (<constructor> (/.data expected)) {try.#Success actual} - (\ /.equivalence = expected actual) + (# /.equivalence = expected actual) {try.#Failure error} false) - (case (<constructor> (\ binary.monoid composite + (case (<constructor> (# binary.monoid composite (/.data expected) (/.data expected))) {try.#Success actual} @@ -80,8 +80,8 @@ [(do random.monad [expected (..random <hash>)] (_.cover [<codec>] - (case (\ <codec> decoded - (format (\ <codec> encoded expected) + (case (# <codec> decoded + (format (# <codec> encoded expected) "AABBCC")) {try.#Success actual} false diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index cec84de94..a2f7d77a7 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -45,20 +45,20 @@ Test (<| (_.covering /._) (do [! random.monad] - [expected (\ ! each (with@ //.#parents (list)) $profile.random) + [expected (# ! each (with@ //.#parents (list)) $profile.random) .let [fs (: (file.System Async) - (file.mock (\ file.default separator)))]] + (file.mock (# file.default separator)))]] (in (do async.monad [verdict (do //action.monad [.let [profile (|> expected (//project.project //.default) //format.project %.code - (\ utf8.codec encoded))] - _ (\ fs write profile //project.file) + (# utf8.codec encoded))] + _ (# fs write profile //project.file) actual (: (Async (Try Profile)) (/.read async.monad fs (list //.default)))] - (in (\ //.equivalence = + (in (# //.equivalence = (|> expected (revised@ //.#sources ..with_default_source) (revised@ //.#repositories ..with_default_repository)) diff --git a/stdlib/source/test/aedifex/metadata.lux b/stdlib/source/test/aedifex/metadata.lux index 79ced5b8f..093cf7937 100644 --- a/stdlib/source/test/aedifex/metadata.lux +++ b/stdlib/source/test/aedifex/metadata.lux @@ -5,7 +5,7 @@ [abstract [monad {"+" [do]}]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random]]]] ["[0]" / "_" @@ -24,26 +24,26 @@ [sample $artifact.random] ($_ _.and (_.cover [/.remote_artifact_uri /.remote_project_uri] - (not (text\= (/.remote_artifact_uri sample) + (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)))))) + (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)) + (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)) + (text#= remote_artifact_uri)) (|> remote_project_uri /.local_uri /.remote_uri - (text\= remote_project_uri))))) + (text#= remote_project_uri))))) )) /artifact.test diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 5708eb39b..29f074af9 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -8,14 +8,14 @@ ["$[0]" equivalence]]] [control ["[0]" maybe] - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["[0]" environment] ["<[0]>" xml]] [concurrency ["[0]" async]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [macro @@ -48,12 +48,12 @@ (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)] + [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) @@ -89,16 +89,16 @@ /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) (_.cover [/.uri] - (text\= (//.remote_project_uri artifact) + (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)) + fs (file.mock (# file.default separator)) repository (///repository/local.repository program fs)]] (in (do async.monad [wrote? (/.write repository artifact expected) @@ -109,7 +109,7 @@ {try.#Failure _} false) (case actual {try.#Success actual} - (\ /.equivalence = expected 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 069cefcd2..8f90a45cf 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -8,20 +8,20 @@ ["$[0]" equivalence]]] [control ["[0]" maybe] - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["[0]" environment] ["<[0]>" xml]] [concurrency ["[0]" async]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [macro ["[0]" code]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]] ["[0]" time @@ -52,12 +52,12 @@ (def: random_instant (Random Instant) (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)] + [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) @@ -73,7 +73,7 @@ (def: random_versioning (Random Versioning) ($_ random.and - (random\in {///snapshot.#Local}) + (random#in {///snapshot.#Local}) $///artifact/time.random (random.list 5 $///artifact/snapshot/version.random) )) @@ -101,16 +101,16 @@ /.format list (<xml>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) (_.cover [/.uri] - (text\= (//.remote_artifact_uri artifact) + (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)) + fs (file.mock (# file.default separator)) repository (///repository/local.repository program fs)]] (in (do async.monad [wrote? (/.write repository artifact expected) @@ -121,7 +121,7 @@ {try.#Failure _} false) (case actual {try.#Success actual} - (\ /.equivalence = expected actual) + (# /.equivalence = expected actual) {try.#Failure _} false)))))) diff --git a/stdlib/source/test/aedifex/package.lux b/stdlib/source/test/aedifex/package.lux index 8f8285c49..4d0f994d0 100644 --- a/stdlib/source/test/aedifex/package.lux +++ b/stdlib/source/test/aedifex/package.lux @@ -33,7 +33,7 @@ ["[0]" / ["/[1]" // "_" ["[1]" profile] - ["[1][0]" hash ("[1]\[0]" equivalence)] + ["[1][0]" hash ("[1]#[0]" equivalence)] ["[1][0]" pom] [dependency ["[1][0]" status]] @@ -43,7 +43,7 @@ (def: .public random (Random [//.Profile /.Package]) (do [! random.monad] - [content_size (\ ! each (n.% 100) random.nat) + [content_size (# ! each (n.% 100) random.nat) content ($binary.random content_size) [profile pom] (random.one (function (_ profile) (try.maybe @@ -61,7 +61,7 @@ [[profile package] ..random] ($_ _.and (_.for [/.equivalence] - ($equivalence.spec /.equivalence (\ ! each product.right ..random))) + ($equivalence.spec /.equivalence (# ! each product.right ..random))) (_.cover [/.local?] (/.local? (with@ /.#origin {//origin.#Local "~/yolo"} package))) @@ -83,8 +83,8 @@ (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)) + (and (//hash#= expected_sha1 actual_sha1) + (//hash#= expected_md5 expected_md5)) _ false))) @@ -92,14 +92,14 @@ 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))) + [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)) + (and (//hash#= expected_sha1 actual_sha1) + (//hash#= expected_md5 expected_md5)) _ false)))))) @@ -107,7 +107,7 @@ (let [expected (value@ //.#dependencies profile)] (case (/.dependencies package) {try.#Success actual} - (\ set.equivalence = expected actual) + (# set.equivalence = expected actual) {try.#Failure error} false))) @@ -115,7 +115,7 @@ (let [expected (value@ //.#repositories profile)] (case (/.repositories package) {try.#Success actual} - (\ set.equivalence = expected actual) + (# set.equivalence = expected actual) {try.#Failure error} false))) diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index fea31184f..183f04b27 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -15,7 +15,7 @@ [collection ["[0]" set {"+" [Set]}] ["[0]" dictionary {"+" [Dictionary]}] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random {"+" [Random]}] [number @@ -40,12 +40,12 @@ (def: (list_of random) (All (_ a) (-> (Random a) (Random (List a)))) (do [! random.monad] - [size (\ ! each (n.% 5) random.nat)] + [size (# ! each (n.% 5) random.nat)] (random.list size random))) (def: (dictionary_of key_hash key_random value_random) (All (_ k v) (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) - (\ random.functor each + (# random.functor each (dictionary.of_list key_hash) (..list_of (random.and key_random value_random)))) @@ -69,7 +69,7 @@ (def: (with_empty_profile project) (-> Project Project) (if (dictionary.empty? project) - (//project.project //.default (\ //.monoid identity)) + (//project.project //.default (# //.monoid identity)) project)) (def: .public test @@ -88,12 +88,12 @@ (|> expected ..with_empty_profile dictionary.entries - (list\each (function (_ [name profile]) + (list#each (function (_ [name profile]) [name (|> profile ..with_default_sources ..with_default_repository)])) (dictionary.of_list text.hash) - (\ //project.equivalence = actual)) + (# //project.equivalence = actual)) {try.#Failure error} false)))))) diff --git a/stdlib/source/test/aedifex/pom.lux b/stdlib/source/test/aedifex/pom.lux index dff414e66..fc9d47e00 100644 --- a/stdlib/source/test/aedifex/pom.lux +++ b/stdlib/source/test/aedifex/pom.lux @@ -10,7 +10,7 @@ ["<>" parser ["<[0]>" xml]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [format ["[0]" xml]]] [math @@ -28,7 +28,7 @@ ($_ _.and (_.cover [/.file] (|> /.file - (text\= "") + (text#= "") not)) (do random.monad [expected @profile.random] @@ -39,8 +39,8 @@ {.#Some _}] (case (<xml>.result /.parser (list pom)) {try.#Success actual} - (\ //.equivalence = - (|> (\ //.monoid identity) + (# //.equivalence = + (|> (# //.monoid identity) (with@ //.#dependencies (value@ //.#dependencies expected)) (with@ //.#repositories (value@ //.#repositories expected))) actual) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index cd5491c33..284151725 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -14,12 +14,12 @@ [parser ["[0]" cli]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" set {"+" [Set]}] ["[0]" dictionary {"+" [Dictionary]}]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [// @@ -36,8 +36,8 @@ (def: distribution (Random /.Distribution) - (random.or (random\in []) - (random\in []))) + (random.or (random#in []) + (random#in []))) (def: license (Random /.License) @@ -74,18 +74,18 @@ (def: (list_of random) (All (_ a) (-> (Random a) (Random (List a)))) (do [! random.monad] - [size (\ ! each (n.% 5) random.nat)] + [size (# ! each (n.% 5) random.nat)] (random.list size random))) (def: (set_of hash random) (All (_ a) (-> (Hash a) (Random a) (Random (Set a)))) - (\ random.functor each + (# random.functor each (set.of_list hash) (..list_of random))) (def: (dictionary_of key_hash key_random value_random) (All (_ k v) (-> (Hash k) (Random k) (Random v) (Random (Dictionary k v)))) - (\ random.functor each + (# random.functor each (dictionary.of_list key_hash) (..list_of (random.and key_random value_random)))) @@ -131,11 +131,11 @@ (random.maybe (random.ascii/alpha 1)) (random.maybe (random.ascii/alpha 1)) (..dictionary_of text.hash (random.ascii/alpha 1) ..repository) - (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) + (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 @@ -151,13 +151,13 @@ ($monoid.spec /.equivalence /.monoid ..random)) (_.cover [/.default] - (text\= "" /.default)) + (text#= "" /.default)) (_.cover [/.default_compiler] - (|> (\ /.monoid identity) + (|> (# /.monoid identity) (value@ /.#compiler) (same? /.default_compiler))) (_.cover [/.default_target] - (|> (\ /.monoid identity) + (|> (# /.monoid identity) (value@ /.#target) (same? /.default_target))) ))))) diff --git a/stdlib/source/test/aedifex/project.lux b/stdlib/source/test/aedifex/project.lux index aa3d726c3..90686e28e 100644 --- a/stdlib/source/test/aedifex/project.lux +++ b/stdlib/source/test/aedifex/project.lux @@ -8,13 +8,13 @@ ["$[0]" equivalence] ["$[0]" monoid]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception]] [data ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [// @@ -27,7 +27,7 @@ (def: profile (Random [//.Name //.Profile]) (|> @profile.random - (random\each (with@ //.#parents (list))) + (random#each (with@ //.#parents (list))) (random.and (random.ascii/alpha 1)))) (def: .public random @@ -48,39 +48,39 @@ (_.cover [/.file] (|> /.file - (text\= "") + (text#= "") not)) (do random.monad [[super_name super_profile] ..profile - [dummy_name dummy_profile] (random.only (|>> product.left (text\= super_name) not) + [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)))) + (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)))) + (and (not (text#= super_name name)) + (not (text#= dummy_name name)) + (not (text#= sub_name name)))) (random.ascii/alpha 1)) - .let [project ($_ (\ /.monoid composite) + .let [project ($_ (# /.monoid composite) (/.project super_name super_profile) (/.project dummy_name dummy_profile) (/.project sub_name (with@ //.#parents (list super_name) sub_profile))) - circular ($_ (\ /.monoid composite) + circular ($_ (# /.monoid composite) (/.project super_name (with@ //.#parents (list sub_name) super_profile)) (/.project dummy_name dummy_profile) (/.project sub_name (with@ //.#parents (list super_name) sub_profile)))]] ($_ _.and (_.cover [/.profile] (and (|> (/.profile project super_name) - (try\each (\ //.equivalence = super_profile)) + (try#each (# //.equivalence = super_profile)) (try.else false)) (|> (/.profile project dummy_name) - (try\each (\ //.equivalence = dummy_profile)) + (try#each (# //.equivalence = dummy_profile)) (try.else false)) (|> (/.profile project sub_name) - (try\each (\ //.equivalence = (\ //.monoid composite sub_profile super_profile))) + (try#each (# //.equivalence = (# //.monoid composite sub_profile super_profile))) (try.else false)))) (_.cover [/.unknown_profile] (case (/.profile project fake_name) diff --git a/stdlib/source/test/aedifex/repository/local.lux b/stdlib/source/test/aedifex/repository/local.lux index 5d3c94565..deb381511 100644 --- a/stdlib/source/test/aedifex/repository/local.lux +++ b/stdlib/source/test/aedifex/repository/local.lux @@ -5,13 +5,13 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["[0]" environment]] [concurrency ["[0]" async]]] [data - ["[0]" binary ("[1]\[0]" equivalence)] + ["[0]" binary ("[1]#[0]" equivalence)] [text [encoding ["[0]" utf8]]]] @@ -35,18 +35,18 @@ repo (/.repository program fs)] uri (random.ascii/lower 10) - expected (\ ! each (\ utf8.codec encoded) + 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)] + [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#each (binary#= expected)) (try.else false)))))) )))) diff --git a/stdlib/source/test/aedifex/repository/remote.lux b/stdlib/source/test/aedifex/repository/remote.lux index 9cea986a8..6d8811ffe 100644 --- a/stdlib/source/test/aedifex/repository/remote.lux +++ b/stdlib/source/test/aedifex/repository/remote.lux @@ -6,13 +6,13 @@ [monad {"+" [do]}]] [control ["[0]" io {"+" [IO]}] - ["[0]" maybe ("[1]\[0]" functor)] - ["[0]" try ("[1]\[0]" monad)] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" monad)] ["[0]" exception] ["[0]" function]] [data - ["[0]" binary ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" binary ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}] [encoding ["[0]" utf8]]] @@ -33,7 +33,7 @@ (def: (url_body url) (-> URL (@http.Body IO)) - (let [url (\ utf8.codec encoded url)] + (let [url (# utf8.codec encoded url)] (function (_ _) (io.io {try.#Success [(binary.size url) url]})))) @@ -48,7 +48,7 @@ {try.#Success} (if (|> headers (dictionary.value "User-Agent") - (maybe\each (same? /.user_agent)) + (maybe#each (same? /.user_agent)) (maybe.else false)) (case [method input] [#@http.Get {.#None}] @@ -59,7 +59,7 @@ [#@http.Put {.#Some input}] (if (|> headers (dictionary.value "Authorization") - (maybe\each (text\= (//identity.basic_auth user password))) + (maybe#each (text#= (//identity.basic_auth user password))) (maybe.else false)) [http/status.created [#@http.headers (http.headers (list)) @@ -90,7 +90,7 @@ user (random.ascii/lower 10) password (random.ascii/lower 10) - content (\ ! each (\ utf8.codec encoded) + content (# ! each (# utf8.codec encoded) (random.ascii/lower 10))] ($_ _.and (_.cover [/.repository /.user_agent /.Address] @@ -98,21 +98,21 @@ {.#Some [//identity.#user user //identity.#password password]} address)] - (and (|> (\ repo download uri) + (and (|> (# repo download uri) io.run! - (try\each (\ utf8.codec decoded)) - try\conjoint - (try\each (text\= (format address uri))) + (try#each (# utf8.codec decoded)) + try#conjoint + (try#each (text#= (format address uri))) (try.else false)) - (|> (\ repo upload uri content) + (|> (# repo upload uri content) io.run! - (try\each (function.constant true)) + (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)) + (case (io.run! (# repo upload uri content)) {try.#Failure error} (exception.match? /.upload_failure error) @@ -122,7 +122,7 @@ (let [repo (/.repository ..bad_http {.#None} address)] - (case (io.run! (\ repo download uri)) + (case (io.run! (# repo download uri)) {try.#Failure error} (exception.match? /.download_failure error) diff --git a/stdlib/source/test/aedifex/runtime.lux b/stdlib/source/test/aedifex/runtime.lux index 77f7bcbed..fb94da435 100644 --- a/stdlib/source/test/aedifex/runtime.lux +++ b/stdlib/source/test/aedifex/runtime.lux @@ -7,14 +7,14 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" maybe ("[1]\[0]" functor)]] + ["[0]" maybe ("[1]#[0]" functor)]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]\[0]" functor)] + ["[0]" list ("[1]#[0]" functor)] ["[0]" set]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\program @@ -23,11 +23,11 @@ (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) + (random#in /.default_java) + (random#in /.default_js) + (random#in /.default_python) + (random#in /.default_lua) + (random#in /.default_ruby) )) (def: .public test @@ -44,7 +44,7 @@ (~~ (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 (value@ /.#program))) + (list#each (value@ /.#program))) unique (set.of_list text.hash listing)] (n.= (list.size listing) (set.size unique))))] @@ -57,11 +57,11 @@ )) (_.cover [/.for] (let [runtime' (/.for runtime path)] - (and (text\= (value@ /.#program runtime) + (and (text#= (value@ /.#program runtime) (value@ /.#program runtime')) (|> runtime' (value@ /.#parameters) list.last - (maybe\each (text\= path)) + (maybe#each (text#= path)) (maybe.else false))))) ))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 46d467058..7500bb983 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -12,27 +12,27 @@ [monad {"+" [do]}]] [control ["[0]" io] - ["[0]" maybe ("[1]\[0]" functor)] + ["[0]" maybe ("[1]#[0]" functor)] [concurrency ["[0]" atom {"+" [Atom]}]] [parser ["<[0]>" code]]] [data ["[0]" product] - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor)] - ["[0]" set {"+" [Set]} ("[1]\[0]" equivalence)] + ["[0]" list ("[1]#[0]" functor)] + ["[0]" set {"+" [Set]} ("[1]#[0]" equivalence)] [dictionary ["[0]" plist]]]] ["[0]" macro [syntax {"+" [syntax:]}] - ["[0]" code ("[1]\[0]" equivalence)] + ["[0]" code ("[1]#[0]" equivalence)] ["[0]" template]] ["[0]" math - ["[0]" random ("[1]\[0]" functor)] + ["[0]" random ("[1]#[0]" functor)] [number [i8 {"+" []}] [i16 {"+" []}] @@ -42,7 +42,7 @@ ["f" frac] ["[0]" i64]]] ["[0]" meta - ["[0]" location ("[1]\[0]" equivalence)]]]] + ["[0]" location ("[1]#[0]" equivalence)]]]] ... TODO: Must have 100% coverage on tests. ["[0]" / "_" ["[1][0]" abstract] @@ -133,8 +133,8 @@ (not (/.and /.true /.false)) (/.and /.true /.true))) (_.cover [/.not] - (and (bit\= /.true (/.not /.false)) - (bit\= /.false (/.not /.true)))) + (and (bit#= /.true (/.not /.false)) + (bit#= /.false (/.not /.true)))) (_.cover [/.cond] (and (n.= expected (/.cond /.true @@ -238,7 +238,7 @@ (def: static_return 123) -(/.open: "global\[0]" (..global_returner ..static_return)) +(/.open: "global#[0]" (..global_returner ..static_return)) (def: for_interface Test @@ -251,16 +251,16 @@ (_.for [/.Interface] ($_ _.and (_.cover [/.implementation:] - (n.= expected (\ (global_returner expected) return []))) + (n.= expected (# (global_returner expected) return []))) (_.cover [/.implementation] - (n.= expected (\ local_returner return []))) + (n.= expected (# local_returner return []))) (_.cover [/.open:] - (n.= static_return (global\return []))) + (n.= static_return (global#return []))) (_.cover [/.^open] - (let [(/.^open "local\[0]") local_returner] - (n.= expected (local\return [])))) - (_.cover [/.\] - (n.= expected (/.\ local_returner return []))) + (let [(/.^open "local#[0]") local_returner] + (n.= expected (local#return [])))) + (_.cover [/.#] + (n.= expected (/.# local_returner return []))) )))) (def: for_module @@ -268,8 +268,8 @@ ($_ _.and (let [[module short] (/.name_of .example)] (_.cover [/.name_of /.prelude_module] - (and (text\= /.prelude_module module) - (text\= short "example")))) + (and (text#= /.prelude_module module) + (text#= short "example")))) (let [[module short] (/.name_of ..example)] (_.cover [/.module_separator] (and (text.contains? /.module_separator module) @@ -310,28 +310,28 @@ (do random.monad [example_nat random.nat] (_.cover [/.'] - (and (code\= (code.nat 0) (/.' 0)) - (code\= (code.int -1) (/.' -1)) - (code\= (code.rev .2) (/.' .2)) - (code\= (code.frac +3.4) (/.' +3.4)) - (code\= (code.text "5") (/.' "5")) - (code\= (code.identifier ["" "example_identifier"]) + (and (code#= (code.nat 0) (/.' 0)) + (code#= (code.int -1) (/.' -1)) + (code#= (code.rev .2) (/.' .2)) + (code#= (code.frac +3.4) (/.' +3.4)) + (code#= (code.text "5") (/.' "5")) + (code#= (code.identifier ["" "example_identifier"]) (/.' example_identifier)) - (code\= (code.identifier [/.prelude_module "example_identifier"]) + (code#= (code.identifier [/.prelude_module "example_identifier"]) (/.' .example_identifier)) - (code\= (code.identifier [..current_module "example_identifier"]) + (code#= (code.identifier [..current_module "example_identifier"]) (/.' ..example_identifier)) - (code\= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) (/.' (6 +7 .8))) - (code\= (code.variant (list (code.frac +9.0) + (code#= (code.variant (list (code.frac +9.0) (code.text "9") (code.identifier ["" "i8"]))) (/.' {+9.0 "9" i8})) - (code\= (code.tuple (list (code.frac +9.0) + (code#= (code.tuple (list (code.frac +9.0) (code.text "9") (code.identifier ["" "i8"]))) (/.' [+9.0 "9" i8])) - (not (code\= (code.nat example_nat) + (not (code#= (code.nat example_nat) (/.' (~ (code.nat example_nat))))) )))) @@ -340,28 +340,28 @@ (do random.monad [example_nat random.nat] (_.cover [/.`] - (and (code\= (code.nat 0) (/.` 0)) - (code\= (code.int -1) (/.` -1)) - (code\= (code.rev .2) (/.` .2)) - (code\= (code.frac +3.4) (/.` +3.4)) - (code\= (code.text "5") (/.` "5")) - (code\= (code.identifier [..current_module "example_identifier"]) + (and (code#= (code.nat 0) (/.` 0)) + (code#= (code.int -1) (/.` -1)) + (code#= (code.rev .2) (/.` .2)) + (code#= (code.frac +3.4) (/.` +3.4)) + (code#= (code.text "5") (/.` "5")) + (code#= (code.identifier [..current_module "example_identifier"]) (/.` example_identifier)) - (code\= (code.identifier [/.prelude_module "example_identifier"]) + (code#= (code.identifier [/.prelude_module "example_identifier"]) (/.` .example_identifier)) - (code\= (code.identifier [..current_module "example_identifier"]) + (code#= (code.identifier [..current_module "example_identifier"]) (/.` ..example_identifier)) - (code\= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) (/.` (6 +7 .8))) - (code\= (code.variant (list (code.frac +9.0) + (code#= (code.variant (list (code.frac +9.0) (code.text "9") (code.identifier [..current_module "i8"]))) (/.` {+9.0 "9" i8})) - (code\= (code.tuple (list (code.frac +9.0) + (code#= (code.tuple (list (code.frac +9.0) (code.text "9") (code.identifier [..current_module "i8"]))) (/.` [+9.0 "9" i8])) - (code\= (code.nat example_nat) + (code#= (code.nat example_nat) (/.` (~ (code.nat example_nat)))))))) (def: for_code/`' @@ -369,28 +369,28 @@ (do random.monad [example_nat random.nat] (_.cover [/.`'] - (and (code\= (code.nat 0) (/.`' 0)) - (code\= (code.int -1) (/.`' -1)) - (code\= (code.rev .2) (/.`' .2)) - (code\= (code.frac +3.4) (/.`' +3.4)) - (code\= (code.text "5") (/.`' "5")) - (code\= (code.identifier ["" "example_identifier"]) + (and (code#= (code.nat 0) (/.`' 0)) + (code#= (code.int -1) (/.`' -1)) + (code#= (code.rev .2) (/.`' .2)) + (code#= (code.frac +3.4) (/.`' +3.4)) + (code#= (code.text "5") (/.`' "5")) + (code#= (code.identifier ["" "example_identifier"]) (/.`' example_identifier)) - (code\= (code.identifier [/.prelude_module "example_identifier"]) + (code#= (code.identifier [/.prelude_module "example_identifier"]) (/.`' .example_identifier)) - (code\= (code.identifier [..current_module "example_identifier"]) + (code#= (code.identifier [..current_module "example_identifier"]) (/.`' ..example_identifier)) - (code\= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) (/.`' (6 +7 .8))) - (code\= (code.variant (list (code.frac +9.0) + (code#= (code.variant (list (code.frac +9.0) (code.text "9") (code.identifier ["" "i8"]))) (/.`' {+9.0 "9" i8})) - (code\= (code.tuple (list (code.frac +9.0) + (code#= (code.tuple (list (code.frac +9.0) (code.text "9") (code.identifier ["" "i8"]))) (/.`' [+9.0 "9" i8])) - (code\= (code.nat example_nat) + (code#= (code.nat example_nat) (/.`' (~ (code.nat example_nat)))))))) (def: for_code @@ -408,11 +408,11 @@ (_.cover [/.Ann] (|> example (value@ /.#meta) - (location\= location.dummy))) + (location#= location.dummy))) ))) (/.macro: (identity_macro tokens) - (\ meta.monad in tokens)) + (# meta.monad in tokens)) (def: crosshair "This is an arbitrary text whose only purpose is to be found, somewhere, in the source-code.") @@ -469,7 +469,7 @@ expected_left random.nat expected_right random.nat - .let [existential_type (\ ! each (|>> {.#Ex}) random.nat)] + .let [existential_type (# ! each (|>> {.#Ex}) random.nat)] expected/0 existential_type expected/1 existential_type] (<| (_.for [/.Type]) @@ -609,7 +609,7 @@ [0] [1] [2] )))] (and (n.= 3 (list.size bits)) - (list.every? (bit\= true) bits)))) + (list.every? (bit#= true) bits)))) (do random.monad [left random.nat right random.nat] @@ -617,7 +617,7 @@ (n.= (n.+ left right) (!n/+ left right)))) (do [! random.monad] - [sample (\ ! each (n.% 5) random.nat)] + [sample (# ! each (n.% 5) random.nat)] (_.cover [/.^template] (case sample (/.^template [<case>] @@ -646,7 +646,7 @@ (_.cover [/.char] (|> (`` (/.char (~~ (/.static static_char)))) text.of_char - (text\= static_char))) + (text#= static_char))) ))) (type: Small @@ -759,9 +759,9 @@ left mid right)] - (and (text\= <left_association> + (and (text#= <left_association> <right_association>) - (not (code\= (' <left_association>) + (not (code#= (' <left_association>) (' <right_association>)))))))) (def: for_expansion @@ -898,8 +898,8 @@ (def: for_case Test (do [! random.monad] - [expected_nat (\ ! each (n.% 1) random.nat) - expected_int (\ ! each (i.% +1) random.int) + [expected_nat (# ! each (n.% 1) random.nat) + expected_int (# ! each (i.% +1) random.int) expected_rev (random.either (in .5) (in .25)) expected_frac (random.either (in +0.5) @@ -1006,8 +1006,8 @@ Test ($_ _.and (do random.monad - [factor (random\each (|>> (n.% 10) (n.max 1)) random.nat) - iterations (random\each (n.% 10) random.nat) + [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 @@ -1090,8 +1090,8 @@ (_.cover [/.public /.private] (and /.public (not /.private))) (_.cover [/.global /.local] - (and (bit\= /.public /.global) - (bit\= /.private /.local))) + (and (bit#= /.public /.global) + (bit#= /.private /.local))) )) (for [@.old (as_is)] @@ -1115,12 +1115,12 @@ let/3)) actual_locals/2 (|> locals/2 (value@ .#mappings) - (list\each product.left) + (list#each product.left) (set.of_list text.hash)) correct_locals! (and (n.= 4 (value@ .#counter locals/2)) - (set\= expected_locals/2 + (set#= expected_locals/2 actual_locals/2)) captured/2 (value@ .#captured scope/2) @@ -1137,7 +1137,7 @@ (|> captured/2 (value@ .#mappings) (plist.value name) - (maybe\each (|>> product.right is?)) + (maybe#each (|>> product.right is?)) (maybe.else false)))) correct_closure! diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index 3a63d3f34..2c19ffb4e 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -25,7 +25,7 @@ ($_ _.and (_.cover [/.composite] (let [expected (n.+ left right)] - (case (\ (/.composite maybe.monad maybe.apply list.apply) on + (case (# (/.composite maybe.monad maybe.apply list.apply) on {.#Some (list right)} {.#Some (list (n.+ left))}) (^ {.#Some (list actual)}) diff --git a/stdlib/source/test/lux/abstract/codec.lux b/stdlib/source/test/lux/abstract/codec.lux index 6c4f334d3..d3338547a 100644 --- a/stdlib/source/test/lux/abstract/codec.lux +++ b/stdlib/source/test/lux/abstract/codec.lux @@ -7,7 +7,7 @@ [control ["[0]" try]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [format ["[0]" json {"+" [JSON]}]]] [math @@ -39,9 +39,9 @@ [expected random.bit] (<| (_.covering /._) (_.cover [/.composite] - (case (|> expected (\ ..codec encoded) (\ ..codec decoded)) + (case (|> expected (# ..codec encoded) (# ..codec decoded)) {try.#Success actual} - (bit\= expected actual) + (bit#= expected actual) {try.#Failure error} false))))) diff --git a/stdlib/source/test/lux/abstract/comonad/cofree.lux b/stdlib/source/test/lux/abstract/comonad/cofree.lux index d7525ca84..3db288557 100644 --- a/stdlib/source/test/lux/abstract/comonad/cofree.lux +++ b/stdlib/source/test/lux/abstract/comonad/cofree.lux @@ -13,7 +13,7 @@ [data [collection ["[0]" list] - ["[0]" sequence {"+" [Sequence]} ("[1]\[0]" comonad)]]] + ["[0]" sequence {"+" [Sequence]} ("[1]#[0]" comonad)]]] [math ["[0]" random]]]] [\\library @@ -21,19 +21,19 @@ (def: (injection value) (Injection (/.CoFree Sequence)) - [value (sequence\each injection (sequence.repeated value))]) + [value (sequence#each injection (sequence.repeated value))]) (def: (interpret [head tail]) (All (_ a) (-> (/.CoFree Sequence a) (Sequence a))) (|> tail - (sequence\each (\ (/.comonad sequence.functor) out)) + (sequence#each (# (/.comonad sequence.functor) out)) [head] //.pending)) (def: comparison (Comparison (/.CoFree Sequence)) (function (_ == left right) - (\ (list.equivalence ==) = + (# (list.equivalence ==) = (sequence.first 100 (..interpret left)) (sequence.first 100 (..interpret right))))) diff --git a/stdlib/source/test/lux/abstract/enum.lux b/stdlib/source/test/lux/abstract/enum.lux index 856c20d1a..03decb4c7 100644 --- a/stdlib/source/test/lux/abstract/enum.lux +++ b/stdlib/source/test/lux/abstract/enum.lux @@ -5,11 +5,11 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" maybe ("[1]\[0]" functor)]] + ["[0]" maybe ("[1]#[0]" functor)]] [data ["[0]" product] [collection - ["[0]" list ("[1]\[0]" mix)]]] + ["[0]" list ("[1]#[0]" mix)]]] [math ["[0]" random {"+" [Random]}] [number @@ -20,7 +20,7 @@ (def: .public test Test (let [limit (: (Random Nat) - (\ random.monad each (n.% 20) random.nat))] + (# random.monad each (n.% 20) random.nat))] (do random.monad [start limit end limit @@ -32,16 +32,16 @@ ($_ _.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) = + 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]) + (|> (list#mix (function (_ next [verdict prev]) [(and verdict - (n.= next (\ n.enum succ prev))) + (n.= next (# n.enum succ prev))) next]) [true head] tail) diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux index c0d5ad8ec..c56dacfe6 100644 --- a/stdlib/source/test/lux/abstract/equivalence.lux +++ b/stdlib/source/test/lux/abstract/equivalence.lux @@ -8,7 +8,7 @@ [functor ["$[0]" contravariant]]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -29,12 +29,12 @@ .let [equivalence (: (Equivalence (Equivalence Nat)) (implementation (def: (= left right) - (and (bit\= (\ left = leftN leftN) - (\ right = leftN leftN)) - (bit\= (\ left = rightN rightN) - (\ right = rightN rightN)) - (bit\= (\ left = leftN rightN) - (\ right = leftN rightN))))))]] + (and (bit#= (# left = leftN leftN) + (# right = leftN leftN)) + (bit#= (# left = rightN rightN) + (# right = rightN rightN)) + (bit#= (# left = leftN rightN) + (# right = leftN rightN))))))]] (<| (_.covering /._) ($_ _.and (_.for [/.functor] @@ -50,11 +50,11 @@ [{.#Item leftH lefT} {.#Item rightH rightT}] (and (n.= leftH rightH) - (\ equivalence = lefT rightT)) + (# 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)))))) + (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 7f3f078aa..00ab642c7 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -25,7 +25,7 @@ (<| (_.covering /._) ($_ _.and (_.cover [/.Or /.sum] - (and (case (\ (/.sum maybe.functor list.functor) each + (and (case (# (/.sum maybe.functor list.functor) each (n.+ shift) {.#Left {.#Some left}}) {.#Left {.#Some actual}} @@ -33,7 +33,7 @@ _ false) - (case (\ (/.sum maybe.functor list.functor) each + (case (# (/.sum maybe.functor list.functor) each (n.+ shift) {.#Right (list right)}) (^ {.#Right (list actual)}) @@ -42,7 +42,7 @@ _ false))) (_.cover [/.And /.product] - (case (\ (/.product maybe.functor list.functor) each + (case (# (/.product maybe.functor list.functor) each (n.+ shift) [{.#Some left} (list right)]) (^ [{.#Some actualL} (list actualR)]) @@ -52,7 +52,7 @@ _ false)) (_.cover [/.Then /.composite] - (case (\ (/.composite maybe.functor list.functor) each + (case (# (/.composite maybe.functor list.functor) each (n.+ shift) {.#Some (list left)}) (^ {.#Some (list actual)}) diff --git a/stdlib/source/test/lux/abstract/hash.lux b/stdlib/source/test/lux/abstract/hash.lux index 2ac3e428f..f6f090ff8 100644 --- a/stdlib/source/test/lux/abstract/hash.lux +++ b/stdlib/source/test/lux/abstract/hash.lux @@ -8,7 +8,7 @@ [functor ["$[0]" contravariant]]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random] [number @@ -25,13 +25,13 @@ rightN random.nat .let [hash (: (Equivalence (/.Hash Nat)) (implementation - (def: (= (^open "left\[0]") (^open "right\[0]")) - (and (bit\= (left\= (left\hash leftN) (left\hash leftN)) - (right\= (right\hash leftN) (right\hash leftN))) - (bit\= (left\= (left\hash rightN) (left\hash rightN)) - (right\= (right\hash rightN) (right\hash rightN))) - (bit\= (left\= (left\hash leftN) (left\hash rightN)) - (right\= (right\hash leftN) (right\hash rightN)))))))]] + (def: (= (^open "left#[0]") (^open "right#[0]")) + (and (bit#= (left#= (left#hash leftN) (left#hash leftN)) + (right#= (right#hash leftN) (right#hash leftN))) + (bit#= (left#= (left#hash rightN) (left#hash rightN)) + (right#= (right#hash rightN) (right#hash rightN))) + (bit#= (left#= (left#hash leftN) (left#hash rightN)) + (right#= (right#hash leftN) (right#hash rightN)))))))]] (<| (_.covering /._) ($_ _.and (_.for [/.functor] diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index 71e07f870..1a87c8fce 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -18,7 +18,7 @@ [number ["n" nat]]]]] [\\library - ["[0]" / {"+" [Interval]} ("\[0]" equivalence)]]) + ["[0]" / {"+" [Interval]} ("#[0]" equivalence)]]) (template [<name> <cmp>] [(def: .public <name> @@ -94,7 +94,7 @@ right_outer ..outer] ($_ _.and (_.test "The union of an interval to itself yields the same interval." - (\= some_interval (/.union some_interval some_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." @@ -115,7 +115,7 @@ right_outer ..outer] ($_ _.and (_.test "The intersection of an interval to itself yields the same interval." - (\= some_interval (/.intersection some_interval some_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)) @@ -130,7 +130,7 @@ [some_interval ..interval] ($_ _.and (_.test "The complement of a complement is the same as the original." - (\= some_interval (|> some_interval /.complement /.complement))) + (#= some_interval (|> some_interval /.complement /.complement))) (_.test "The complement of an interval does not overlap it." (not (/.overlaps? some_interval (/.complement some_interval)))) ))) @@ -139,7 +139,7 @@ Test (do [! random.monad] [[l m r] (|> (random.set n.hash 3 random.nat) - (\ ! each (|>> set.list + (# ! each (|>> set.list (list.sorted n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -161,7 +161,7 @@ Test (do [! random.monad] [[b t1 t2] (|> (random.set n.hash 3 random.nat) - (\ ! each (|>> set.list + (# ! each (|>> set.list (list.sorted n.<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -188,7 +188,7 @@ (do [! random.monad] [some_interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (\ ! each (|>> set.list + (# ! each (|>> set.list (list.sorted n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] @@ -221,7 +221,7 @@ (do [! random.monad] [some_interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) - (\ ! each (|>> set.list + (# ! each (|>> set.list (list.sorted n.<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] diff --git a/stdlib/source/test/lux/abstract/mix.lux b/stdlib/source/test/lux/abstract/mix.lux index 4d9f41ee0..279ab90d2 100644 --- a/stdlib/source/test/lux/abstract/mix.lux +++ b/stdlib/source/test/lux/abstract/mix.lux @@ -21,6 +21,6 @@ (<| (_.covering /._) ($_ _.and (_.cover [/.with_monoid] - (n.= (\ list.mix mix (\ n.addition composite) (\ n.addition identity) samples) + (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 786156f93..1abc2ff2e 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -5,7 +5,7 @@ [data ["[0]" identity {"+" [Identity]}] [collection - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [math ["[0]" random] [number @@ -30,34 +30,34 @@ (n.= (++ mono) (: (Identity Nat) (/.then identity.monad - (|>> ++ (\ identity.monad in)) - (\ identity.monad in mono))))) + (|>> ++ (# identity.monad in)) + (# identity.monad in mono))))) (_.cover [/.all] - (\ (list.equivalence n.equivalence) = - (list\each ++ poly) + (# (list.equivalence n.equivalence) = + (list#each ++ poly) (|> poly - (list\each (|>> ++ (\ identity.monad in))) + (list#each (|>> ++ (# identity.monad in))) (: (List (Identity Nat))) (/.all identity.monad) (: (Identity (List Nat)))))) (_.cover [/.each] - (\ (list.equivalence n.equivalence) = - (list\each ++ poly) + (# (list.equivalence n.equivalence) = + (list#each ++ poly) (|> poly - (/.each identity.monad (|>> ++ (\ identity.monad in))) + (/.each identity.monad (|>> ++ (# identity.monad in))) (: (Identity (List Nat)))))) (_.cover [/.only] - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list.only n.even? poly) (|> poly - (/.only identity.monad (|>> n.even? (\ identity.monad in))) + (/.only identity.monad (|>> n.even? (# identity.monad in))) (: (Identity (List Nat)))))) (_.cover [/.mix] - (n.= (list\mix n.+ 0 poly) + (n.= (list#mix n.+ 0 poly) (|> poly (/.mix identity.monad (function (_ part whole) - (\ identity.monad in + (# identity.monad in (n.+ part whole))) 0) (: (Identity Nat))))) diff --git a/stdlib/source/test/lux/abstract/monad/free.lux b/stdlib/source/test/lux/abstract/monad/free.lux index f3275ef62..14e6ee299 100644 --- a/stdlib/source/test/lux/abstract/monad/free.lux +++ b/stdlib/source/test/lux/abstract/monad/free.lux @@ -12,7 +12,7 @@ ["$[0]" monad]]] [data [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random]]]] [\\library @@ -30,13 +30,13 @@ {/.#Effect effect} (|> effect - (list\each interpret) + (list#each interpret) list.together))) (def: comparison (Comparison (/.Free List)) (function (_ == left right) - (\ (list.equivalence ==) = + (# (list.equivalence ==) = (..interpret left) (..interpret right)))) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index a366a9c91..edd4e9add 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -24,10 +24,10 @@ (<| (_.covering /._) ($_ _.and (_.cover [/.and] - (let [[natLR intLR] (\ (/.and nat.addition int.multiplication) composite + (let [[natLR intLR] (# (/.and nat.addition int.multiplication) composite [natL intL] [natR intR])] - (and (nat.= (\ nat.addition composite natL natR) + (and (nat.= (# nat.addition composite natL natR) natLR) - (int.= (\ int.multiplication composite intL intR) + (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 1457fd550..815851182 100644 --- a/stdlib/source/test/lux/abstract/order.lux +++ b/stdlib/source/test/lux/abstract/order.lux @@ -8,7 +8,7 @@ [functor ["$[0]" contravariant]]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -27,12 +27,12 @@ .let [equivalence (: (Equivalence (/.Order Nat)) (implementation (def: (= leftO rightO) - (and (bit\= (\ leftO < left left) - (\ rightO < left left)) - (bit\= (\ leftO < right right) - (\ rightO < right right)) - (bit\= (\ leftO < left right) - (\ rightO < left right))))))]]) + (and (bit#= (# leftO < left left) + (# rightO < left left)) + (bit#= (# leftO < right right) + (# rightO < right right)) + (bit#= (# leftO < left right) + (# rightO < left right))))))]]) ($_ _.and (_.for [/.functor] ($contravariant.spec equivalence n.order /.functor)) @@ -40,16 +40,16 @@ (n.< (/.max n.order left right) (/.min n.order left right))) (_.cover [/.Comparison /.>] - (not (bit\= (n.< left right) + (not (bit#= (n.< left right) (/.> n.order left right)))) (_.cover [/.<=] (and (/.<= n.order left left) (/.<= n.order right right) - (bit\= (\ n.order < left 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) + (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 d31ebfd62..c987ddc14 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -12,7 +12,7 @@ [control ["[0]" function]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math @@ -37,7 +37,7 @@ .let [equivalence (: (Equivalence (/.Predicate Nat)) (implementation (def: (= left right) - (bit\= (left sample) + (bit#= (left sample) (right sample)))))]]) (_.for [/.Predicate]) ($_ _.and @@ -46,7 +46,7 @@ (let [generator (: (Random (/.Predicate Nat)) (|> random.nat (random.only (|>> (n.= 0) not)) - (\ ! each multiple?)))] + (# ! each multiple?)))] ($_ _.and (_.for [/.union] ($monoid.spec equivalence /.union generator)) @@ -54,24 +54,24 @@ ($monoid.spec equivalence /.intersection generator)))) (_.cover [/.none] - (bit\= false (/.none sample))) + (bit#= false (/.none sample))) (_.cover [/.all] - (bit\= true (/.all sample))) + (bit#= true (/.all sample))) (_.cover [/.or] - (bit\= (/.all sample) + (bit#= (/.all sample) ((/.or /.none /.all) sample))) (_.cover [/.and] - (bit\= (/.none sample) + (bit#= (/.none sample) ((/.and /.none /.all) sample))) (_.cover [/.complement] - (and (not (bit\= (/.none sample) + (and (not (bit#= (/.none sample) ((/.complement /.none) sample))) - (not (bit\= (/.all sample) + (not (bit#= (/.all sample) ((/.complement /.all) sample))))) (_.cover [/.difference] (let [/2? (multiple? 2) /3? (multiple? 3)] - (bit\= (and (/2? sample) + (bit#= (and (/2? sample) (not (/3? sample))) ((/.difference /3? /2?) sample)))) (_.cover [/.rec] @@ -86,6 +86,6 @@ {.#Item head tail} (or (even? head) (recur tail)))))))] - (bit\= (list.any? even? samples) + (bit#= (list.any? even? samples) (any_even? samples)))) ))) diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 593e14bd8..c05e72593 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -7,7 +7,7 @@ [data ["[0]" sum] ["[0]" name] - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [macro ["[0]" template]] [math @@ -110,7 +110,7 @@ <arithmetic>')) (~~ (template [<concatenative> <functional>] [(_.cover [<concatenative>] - (bit\= (<functional> parameter subject) + (bit#= (<functional> parameter subject) (||> (/.push subject) (/.push parameter) <concatenative>)))] diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 108257528..b83431250 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -22,7 +22,7 @@ ["[0]" / {"+" [actor: message:]} [// ["[0]" atom {"+" [Atom]}] - ["[0]" async {"+" [Async Resolver]} ("[1]\[0]" monad)] + ["[0]" async {"+" [Async Resolver]} ("[1]#[0]" monad)] ["[0]" frp]]]]) (exception: got_wrecked) @@ -36,7 +36,7 @@ (message: (count! [increment Nat] state self) Nat (let [state' (n.+ increment state)] - (async\in {try.#Success [state' state']}))) + (async#in {try.#Success [state' state']}))) ) (def: (mailed? outcome) @@ -52,7 +52,7 @@ .let [as_mail (: (All (_ a) (-> (-> a a) (/.Mail a))) (function (_ transform) (function (_ state actor) - (|> state transform {try.#Success} async\in)))) + (|> state transform {try.#Success} async#in)))) ++! (: (/.Mail Nat) (as_mail ++)) --! (: (/.Mail Nat) (as_mail --))]] (<| (_.covering /._) @@ -135,7 +135,7 @@ (let [die! (: (/.Mail Nat) (function (_ state actor) - (async\in (exception.except ..got_wrecked []))))] + (async#in (exception.except ..got_wrecked []))))] (in (do async.monad [result (async.future (do io.monad [actor (/.spawn! /.default initial_state) @@ -198,9 +198,9 @@ verdict))) (do ! - [num_events (\ ! each (|>> (n.% 10) ++) random.nat) + [num_events (# ! each (|>> (n.% 10) ++) random.nat) events (random.list num_events random.nat) - num_observations (\ ! each (n.% num_events) random.nat) + num_observations (# ! each (n.% num_events) random.nat) .let [expected (list.first num_observations events) sink (: (Atom (Row Nat)) (atom.atom row.empty))]] @@ -224,5 +224,5 @@ _ (/.obituary agent) actual (async.future (atom.read! sink))] (_.cover' [/.Stop /.observe! /.obituary] - (\ (list.equivalence n.equivalence) = expected (row.list actual)))))) + (# (list.equivalence n.equivalence) = expected (row.list actual)))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/async.lux b/stdlib/source/test/lux/control/concurrency/async.lux index 57fec6c78..4954bd7a5 100644 --- a/stdlib/source/test/lux/control/concurrency/async.lux +++ b/stdlib/source/test/lux/control/concurrency/async.lux @@ -54,7 +54,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [waiting_time (|> random.nat (\ ! each (|>> (n.% ..delay) (n.+ ..delay)))) + [waiting_time (|> random.nat (# ! each (|>> (n.% ..delay) (n.+ ..delay)))) expected random.nat dummy random.nat .let [not_dummy (|> random.nat (random.only (|>> (n.= dummy) not)))] diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index fcefb15ec..202bbc73c 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -14,7 +14,7 @@ ["[0]" io {"+" [IO io]}]] [data [collection - ["[0]" list ("[1]\[0]" mix monoid)] + ["[0]" list ("[1]#[0]" mix monoid)] ["[0]" row {"+" [Row]}]]] [math ["[0]" random] @@ -23,7 +23,7 @@ [\\library ["[0]" / [// - ["[0]" async {"+" [Async]} ("[1]\[0]" monad)] + ["[0]" async {"+" [Async]} ("[1]#[0]" monad)] ["[0]" atom {"+" [Atom atom]}]]]]) (def: injection @@ -50,7 +50,7 @@ (All (_ a) (-> Nat [(/.Channel a) (/.Sink a)] (Async (List a)))) (case amount_of_polls 0 (do async.monad - [_ (async.future (\ sink close))] + [_ (async.future (# sink close))] (in {.#End})) _ (do [! async.monad] [event channel] @@ -59,13 +59,13 @@ (in {.#End}) {.#Some [head tail]} - (\ ! each (|>> {.#Item head}) + (# ! each (|>> {.#Item head}) (take_amount (-- amount_of_polls) [channel sink])))))) (def: .public test Test (<| (_.covering /._) - (let [(^open "list\[0]") (list.equivalence n.equivalence)] + (let [(^open "list#[0]") (list.equivalence n.equivalence)] (do [! random.monad] [inputs (random.list 5 random.nat) sample random.nat @@ -87,8 +87,8 @@ (case (io.run! (do (try.with io.monad) [.let [[channel sink] (/.channel [])] - _ (\ sink feed sample) - _ (\ sink close)] + _ (# sink feed sample) + _ (# sink close)] (in channel))) {try.#Success channel} (io.run! @@ -107,8 +107,8 @@ (case (io.run! (do (try.with io.monad) [.let [[channel sink] (/.channel [])] - _ (\ sink close)] - (\ sink feed sample))) + _ (# sink close)] + (# sink feed sample))) {try.#Success _} false @@ -120,14 +120,14 @@ /.of_async /.list)] (_.cover' [/.of_async /.list] - (list\= (list sample) + (list#= (list sample) output)))) (in (do async.monad [output (|> inputs (/.sequential 0) /.list)] (_.cover' [/.sequential] - (list\= inputs + (list#= inputs output)))) (in (do async.monad [output (|> inputs @@ -135,7 +135,7 @@ (/.only n.even?) /.list)] (_.cover' [/.only] - (list\= (list.only n.even? inputs) + (list#= (list.only n.even? inputs) output)))) (in (do [! async.monad] [.let [[?signal !signal] (: [(async.Async Any) (async.Resolver Any)] @@ -152,21 +152,21 @@ (do ! [_ (!signal [])] (in {.#None}))))) - (/.sequential 0 (list\composite inputs inputs)))) + (/.sequential 0 (list#composite inputs inputs)))) _ ?signal listened (|> sink atom.read! async.future - (\ ! each row.list))] + (# ! each row.list))] (_.cover' [/.Subscriber /.subscribe!] - (list\= inputs listened)))) + (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) + (n.= (list#mix n.+ 0 inputs) actual)))) (in (do async.monad [actual (|> inputs @@ -176,7 +176,7 @@ 0) /.list)] (_.cover' [/.mixes] - (list\= (list.mixes n.+ 0 inputs) + (list#= (list.mixes n.+ 0 inputs) actual)))) (in (do async.monad [actual (|> (list distint/0 distint/0 distint/0 @@ -186,11 +186,11 @@ (/.distinct n.equivalence) /.list)] (_.cover' [/.distinct] - (list\= (list distint/0 distint/1 distint/2) + (list#= (list distint/0 distint/1 distint/2) actual)))) (do ! - [polling_delay (\ ! each (|>> (n.% 10) ++) random.nat) - amount_of_polls (\ ! each (|>> (n.% 10) ++) random.nat)] + [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 (: (IO Nat) (io.io sample)))) @@ -218,6 +218,6 @@ /.list)] (_.cover' [/.iterations] (and (n.= max_iterations (list.size actual)) - (list\= (list.mixes n.+ sample (list.repeated (-- max_iterations) shift)) + (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 da3c90bae..e3f49842a 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -15,10 +15,10 @@ ["[0]" async {"+" [Async]}] ["[0]" atom {"+" [Atom]}]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -39,7 +39,7 @@ (_.for [/.Semaphore] ($_ _.and (do [! random.monad] - [initial_open_positions (|> random.nat (\ ! each (|>> (n.% 10) (n.max 1)))) + [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))] @@ -51,7 +51,7 @@ {.#None} false))))) (do [! random.monad] - [initial_open_positions (|> random.nat (\ ! each (|>> (n.% 10) (n.max 1)))) + [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)) @@ -64,7 +64,7 @@ {.#None} true))))) (do [! random.monad] - [initial_open_positions (|> random.nat (\ ! each (|>> (n.% 10) (n.max 1)))) + [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)) @@ -80,7 +80,7 @@ _ false))))) (do [! random.monad] - [initial_open_positions (|> random.nat (\ ! each (|>> (n.% 10) (n.max 1)))) + [initial_open_positions (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) .let [semaphore (/.semaphore initial_open_positions)]] (in (do async.monad [outcome (/.signal! semaphore)] @@ -98,7 +98,7 @@ (_.for [/.Mutex] ($_ _.and (do [! random.monad] - [repetitions (|> random.nat (\ ! each (|>> (n.% 100) (n.max 10)))) + [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")) @@ -124,9 +124,9 @@ _ processB .let [outcome (io.run! (atom.read! resource))]] (_.cover' [/.mutex /.synchronize!] - (or (text\= (format expected_As expected_Bs) + (or (text#= (format expected_As expected_Bs) outcome) - (text\= (format expected_Bs expected_As) + (text#= (format expected_Bs expected_As) outcome)))))) ))) @@ -155,7 +155,7 @@ _ false))) (do [! random.monad] - [limit (\ ! each (|>> (n.% 9) ++) random.nat) + [limit (# ! each (|>> (n.% 9) ++) random.nat) .let [barrier (/.barrier (maybe.trusted (/.limit limit))) resource (atom.atom "")]] (in (do [! async.monad] @@ -165,7 +165,7 @@ text.together) expected_ids (enum.range n.enum 0 (-- limit))] _ (|> expected_ids - (list\each (function (_ id) + (list#each (function (_ id) (exec (io.run! (atom.update! (|>> (format suffix)) resource)) (waiter resource barrier id)))) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 8039bf039..103476455 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -13,7 +13,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -27,7 +27,7 @@ (def: injection (Injection /.STM) - (\ /.monad in)) + (# /.monad in)) (def: comparison (Comparison /.STM) @@ -41,7 +41,7 @@ (do [! random.monad] [dummy random.nat expected random.nat - iterations_per_process (|> random.nat (\ ! each (n.% 100)))] + iterations_per_process (|> random.nat (# ! each (n.% 100)))] ($_ _.and (_.for [/.functor] ($functor.spec ..injection ..comparison /.functor)) @@ -51,7 +51,7 @@ ($monad.spec ..injection ..comparison /.monad)) (in (do async.monad - [actual (/.commit! (\ /.monad in expected))] + [actual (/.commit! (# /.monad in expected))] (_.cover' [/.commit!] (n.= expected actual)))) (in (do async.monad @@ -84,17 +84,17 @@ [follower sink] (io.run! (/.follow! box))] _ (/.commit! (/.write expected box)) _ (/.commit! (/.update (n.* 2) box)) - _ (async.future (\ sink close)) + _ (async.future (# sink close)) _ (/.commit! (/.update (n.* 3) box)) changes (frp.list follower)] (_.cover' [/.follow!] - (\ (list.equivalence n.equivalence) = + (# (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)))) + (list#each (function (_ _) (/.commit! (/.update ++ var)))) (monad.all !)) cummulative (/.commit! (/.read var))] (_.cover' [/.STM] diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index b712c2c12..51f31be4e 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -26,7 +26,7 @@ (do [! random.monad] [dummy random.nat expected random.nat - delay (\ ! each (|>> (n.% 5) (n.+ 5)) + delay (# ! each (|>> (n.% 5) (n.+ 5)) random.nat)] ($_ _.and (_.cover [/.parallelism] diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index cdabfb8d0..53425f5e2 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -32,8 +32,8 @@ (<| (_.covering /._) (do random.monad [sample random.nat - .let [(^open "_\[0]") /.apply - (^open "_\[0]") /.monad] + .let [(^open "_#[0]") /.apply + (^open "_#[0]") /.monad] elems (random.list 3 random.nat)]) (_.for [/.Cont]) ($_ _.and @@ -45,7 +45,7 @@ ($monad.spec ..injection ..comparison /.monad)) (_.cover [/.result] - (n.= sample (/.result (_\in sample)))) + (n.= sample (/.result (_#in sample)))) (_.cover [/.with_current] (n.= (n.* 2 sample) (/.result (do [! /.monad] @@ -66,14 +66,14 @@ (restart [(n.+ 10 output) (++ idx)]) (in output)))))) (_.cover [/.shift /.reset] - (let [(^open "_\[0]") /.monad - (^open "list\[0]") (list.equivalence n.equivalence) + (let [(^open "_#[0]") /.monad + (^open "list#[0]") (list.equivalence n.equivalence) visit (: (-> (List Nat) (/.Cont (List Nat) (List Nat))) (function (visit xs) (case xs {.#End} - (_\in {.#End}) + (_#in {.#End}) {.#Item x xs'} (do [! /.monad] @@ -82,7 +82,7 @@ [tail (k xs')] (in {.#Item x tail}))))] (visit output)))))] - (list\= elems + (list#= elems (/.result (/.reset (visit elems)))))) (_.cover [/.continued] (/.continued (same? sample) diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 6df9238fc..f9d5fb082 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -5,7 +5,7 @@ [abstract [monad {"+" [do]}]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random] @@ -29,7 +29,7 @@ [expected random.nat wrong (|> random.nat (random.only (|>> (n.= expected) not))) assertion_succeeded? random.bit - .let [report_element (\ ! each %.nat random.nat)] + .let [report_element (# ! each %.nat random.nat)] field0 report_element value0 report_element field1 report_element @@ -47,7 +47,7 @@ false {try.#Failure message} - (text\= message (/.error ..an_exception [])))) + (text#= message (/.error ..an_exception [])))) (_.cover [/.match?] (/.match? ..an_exception (/.error ..an_exception []))) @@ -58,7 +58,7 @@ {try.#Failure message} (and (not assertion_succeeded?) - (text\= message (/.error ..an_exception []))))) + (text#= message (/.error ..an_exception []))))) (_.cover [/.when] (and (n.= expected (|> (/.except ..an_exception []) @@ -93,7 +93,7 @@ {try.#Failure _} false) (case (/.with ..an_exception [] {try.#Failure ""}) {try.#Success _} false - {try.#Failure message} (text\= message (/.error ..an_exception []))) + {try.#Failure message} (text#= message (/.error ..an_exception []))) (case (/.with ..an_exception [] (: (Try Nat) (/.except ..another_exception []))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index 04a30d87b..f38eafb83 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -7,8 +7,6 @@ [monad {"+" [do]}] [\\specification ["$[0]" monoid]]] - [data - ["[0]" text ("[1]![0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -25,8 +23,8 @@ Test (do [! random.monad] [expected random.nat - f0 (\ ! each n.+ random.nat) - f1 (\ ! each n.* random.nat) + f0 (# ! each n.+ random.nat) + f1 (# ! each n.* random.nat) dummy random.nat extra (|> random.nat (random.only (|>> (n.= expected) not)))] (<| (_.covering /._) @@ -37,7 +35,7 @@ (n.= (left extra) (right extra))))) generator (: (Random (-> Nat Nat)) - (\ ! each n.- random.nat))] + (# ! each n.- random.nat))] (_.for [/.monoid] ($monoid.spec equivalence /.monoid generator))) diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index f975f5b97..e3188421d 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -6,12 +6,12 @@ [monad {"+" [do]}]] [control ["[0]" io {"+" [IO]}] - ["[0]" state {"+" [State]} ("[1]\[0]" monad)]] + ["[0]" state {"+" [State]} ("[1]#[0]" monad)]] [data ["[0]" product] [collection ["[0]" dictionary {"+" [Dictionary]}] - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [math ["[0]" random] [number @@ -28,8 +28,8 @@ (def: (fibonacci recur input) (/.Memo Nat Nat) (case input - 0 (state\in 0) - 1 (state\in 1) + 0 (state#in 0) + 1 (state#in 1) _ (do state.monad [output_1 (recur (n.- 1 input)) output_2 (recur (n.- 2 input))] @@ -58,7 +58,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [input (|> random.nat (\ ! each (|>> (n.% 5) (n.+ 21))))]) + [input (|> random.nat (# ! each (|>> (n.% 5) (n.+ 21))))]) (_.for [/.Memo]) ($_ _.and (_.cover [/.closed /.none] @@ -106,13 +106,13 @@ (: (//.Mixin Nat (State (Dictionary Nat Nat) Nat)) (function (factorial delegate recur input) (case input - (^or 0 1) (\ state.monad in 1) + (^or 0 1) (# state.monad in 1) _ (do state.monad [output' (recur (-- input))] (in (n.* input output'))))))) expected (|> (list.indices input) - (list\each ++) - (list\mix n.* 1)) + (list#each ++) + (list#mix n.* 1)) actual (|> (memo input) (state.result (dictionary.empty n.hash)) product.right)] diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index e56ccb3a6..45486914d 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -13,7 +13,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [math ["[0]" random {"+" [Random]}] [number @@ -25,7 +25,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [input (|> random.nat (\ ! each (|>> (n.% 6) (n.+ 20)))) + [input (|> random.nat (# ! each (|>> (n.% 6) (n.+ 20)))) dummy random.nat shift (|> random.nat (random.only (|>> (n.= dummy) not))) .let [equivalence (: (Equivalence (/.Mixin Nat Nat)) @@ -39,8 +39,8 @@ (in (function (_ delegate recur input) output)))) expected (|> (list.indices input) - (list\each ++) - (list\mix n.* 1))]]) + (list#each ++) + (list#mix n.* 1))]]) ($_ _.and (_.for [/.Mixin] ($_ _.and diff --git a/stdlib/source/test/lux/control/function/mutual.lux b/stdlib/source/test/lux/control/function/mutual.lux index 6fe925cd2..d7fb8364e 100644 --- a/stdlib/source/test/lux/control/function/mutual.lux +++ b/stdlib/source/test/lux/control/function/mutual.lux @@ -5,7 +5,7 @@ [abstract [monad {"+" [do]}]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [text ["%" format {"+" [format]}]]] [math @@ -18,7 +18,7 @@ (def: test_let Test (do [! random.monad] - [sample (\ ! each (n.% 10) random.nat) + [sample (# ! each (n.% 10) random.nat) .let [expected (n.even? sample)]] (<| (_.cover [/.let]) (/.let [(even? number) @@ -32,8 +32,8 @@ (case number 0 false _ (even? (-- number)))] - (and (bit\= expected (even? sample)) - (bit\= (not expected) (odd? sample))))))) + (and (bit#= expected (even? sample)) + (bit#= (not expected) (odd? sample))))))) (/.def: [(even? number) @@ -51,11 +51,11 @@ (def: test_def Test (do [! random.monad] - [sample (\ ! each (n.% 10) random.nat) + [sample (# ! each (n.% 10) random.nat) .let [expected (n.even? sample)]] (<| (_.cover [/.def:]) - (and (bit\= expected (..even? sample)) - (bit\= (not expected) (..odd? sample)))))) + (and (bit#= expected (..even? sample)) + (bit#= (not expected) (..odd? sample)))))) (def: .public test Test diff --git a/stdlib/source/test/lux/control/lazy.lux b/stdlib/source/test/lux/control/lazy.lux index 8455c3194..1cfb8eb05 100644 --- a/stdlib/source/test/lux/control/lazy.lux +++ b/stdlib/source/test/lux/control/lazy.lux @@ -25,11 +25,11 @@ (def: comparison (Comparison Lazy) (function (_ ==) - (\ (/.equivalence ==) =))) + (# (/.equivalence ==) =))) (def: .public lazy (All (_ a) (-> (Random a) (Random (Lazy a)))) - (\ random.functor each (|>> /.lazy))) + (# random.functor each (|>> /.lazy))) (def: .public test Test @@ -54,9 +54,9 @@ (_.cover [/.lazy] (let [lazy (/.lazy <eager>) - (^open "\=") (product.equivalence n.equivalence n.equivalence)] - (\= expected - (/.value lazy)))) + (^open "_#=") (product.equivalence n.equivalence n.equivalence)] + (_#= expected + (/.value lazy)))) (_.cover [/.value] (let [lazy (/.lazy <eager>)] diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux index 14cce16b3..b3c5f5de7 100644 --- a/stdlib/source/test/lux/control/maybe.lux +++ b/stdlib/source/test/lux/control/maybe.lux @@ -12,7 +12,7 @@ ["$[0]" apply] ["$[0]" monad]]] [control - ["[0]" io ("[1]\[0]" monad)] + ["[0]" io ("[1]#[0]" monad)] pipe] [data ["[0]" text] @@ -23,7 +23,7 @@ [number ["n" nat]]]]] [\\library - ["[0]" / ("[1]\[0]" monoid monad)]]) + ["[0]" / ("[1]#[0]" monoid monad)]]) (def: .public test Test @@ -34,16 +34,16 @@ ($equivalence.spec (/.equivalence n.equivalence) (random.maybe random.nat))) (_.for [/.hash] (|> random.nat - (\ random.monad each (|>> {.#Some})) + (# 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)) + ($functor.spec /#in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /\in /.equivalence /.apply)) + ($apply.spec /#in /.equivalence /.apply)) (_.for [/.monad] - ($monad.spec /\in /.equivalence /.monad)) + ($monad.spec /#in /.equivalence /.monad)) (do random.monad [left random.nat @@ -52,7 +52,7 @@ (let [lifted (/.lifted io.monad)] (_.cover [/.with /.lifted] (|> (io.run! (do (/.with io.monad) - [a (lifted (io\in left)) + [a (lifted (io#in left)) b (in right)] (in (n.+ a b)))) (case> {.#Some actual} @@ -76,13 +76,13 @@ (do random.monad [value random.nat] (_.cover [/.list] - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list value) (/.list {.#Some value})))) (do random.monad [expected random.nat - .let [(^open "/\[0]") (/.equivalence n.equivalence)]] + .let [(^open "/#[0]") (/.equivalence n.equivalence)]] (_.cover [/.when] - (and (/\= {.#Some expected} (/.when true {.#Some expected})) - (/\= {.#None} (/.when false {.#Some expected}))))) + (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 611459da0..f8405908d 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -14,10 +14,10 @@ [parser ["<[0]>" code]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -44,7 +44,7 @@ (All (_ a) (-> Text (Try a) Bit)) (case input {try.#Failure actual} - (text\= expected actual) + (text#= expected actual) _ #0)) @@ -90,7 +90,7 @@ Test (do [! random.monad] [expected0 random.nat - variadic (\ ! each (|>> (n.max 1) (n.min 20)) random.nat) + variadic (# ! each (|>> (n.max 1) (n.min 20)) random.nat) expected+ (random.list variadic random.nat) even0 (random.only n.even? random.nat) odd0 (random.only n.odd? random.nat) @@ -106,24 +106,24 @@ (match {.#None} #1)))) (_.cover [/.some] - (and (|> (list\each code.nat expected+) + (and (|> (list#each code.nat expected+) (/.result (/.some <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = expected+ actual))) - (|> (list\each (|>> .int code.int) expected+) + (# (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+) + (and (|> (list#each code.nat expected+) (/.result (/.many <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = expected+ 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+) + (|> (list#each (|>> .int code.int) expected+) (/.result (/.many <code>.nat)) fails?))) (_.cover [/.only] @@ -180,75 +180,75 @@ (def: combinators_1 Test (do [! random.monad] - [variadic (\ ! each (|>> (n.max 1) (n.min 20)) random.nat) - times (\ ! each (n.% variadic) random.nat) + [variadic (# ! each (|>> (n.max 1) (n.min 20)) random.nat) + times (# ! each (n.% variadic) random.nat) expected random.nat 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+) + (and (|> (list#each code.nat expected+) (/.result (/.exactly times <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list.first times expected+) actual))) - (|> (list\each code.nat expected+) + (|> (list#each code.nat expected+) (/.result (/.exactly (++ variadic) <code>.nat)) fails?))) (_.cover [/.at_least] - (and (|> (list\each code.nat expected+) + (and (|> (list#each code.nat expected+) (/.result (/.at_least times <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected+ actual))) - (|> (list\each code.nat expected+) + (|> (list#each code.nat expected+) (/.result (/.at_least (++ variadic) <code>.nat)) fails?))) (_.cover [/.at_most] - (and (|> (list\each code.nat expected+) + (and (|> (list#each code.nat expected+) (/.result (/.at_most times <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list.first times expected+) actual))) - (|> (list\each code.nat expected+) + (|> (list#each code.nat expected+) (/.result (/.at_most (++ variadic) <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected+ actual))))) (_.cover [/.between] - (and (|> (list\each code.nat expected+) + (and (|> (list#each code.nat expected+) (/.result (/.between times (n.- times variadic) <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected+ actual))) - (|> (list\each code.nat (list.first times expected+)) + (|> (list#each code.nat (list.first times expected+)) (/.result (/.between times (n.- times variadic) <code>.nat)) (match actual - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list.first times expected+) actual))))) (_.cover [/.separated_by] - (|> (list.interposed (code.text separator) (list\each code.nat expected+)) + (|> (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) = + (# (list.equivalence n.equivalence) = expected+ actual)))) (_.cover [/.remaining] - (|> (list\each code.nat expected+) + (|> (list#each code.nat expected+) (/.result /.remaining) (match actual - (\ (list.equivalence code.equivalence) = - (list\each code.nat expected+) + (# (list.equivalence code.equivalence) = + (list#each code.nat expected+) actual)))) (_.cover [/.else] - (and (|> (/.result (/.else wrong (\ /.monad in expected)) (list)) + (and (|> (/.result (/.else wrong (# /.monad in expected)) (list)) (match actual (n.= expected actual))) (|> (/.result (/.else expected (: (Parser (List Code) Nat) (/.failure "yolo"))) @@ -333,7 +333,7 @@ (def: injection (Injection (All (_ a i) (Parser i a))) - (\ /.monad in)) + (# /.monad in)) (def: comparison (Comparison (All (_ a i) (Parser i a))) @@ -362,7 +362,7 @@ ($monad.spec ..injection ..comparison /.monad)) (_.cover [/.result] - (|> (/.result (\ /.monad in expected) (list)) + (|> (/.result (# /.monad in expected) (list)) (match actual (n.= expected actual)))) (_.cover [/.failure] (|> (list) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 521bd8927..3301e044b 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -10,9 +10,9 @@ ["[0]" exception] ["<>" parser]] [data - ["[0]" name ("[1]\[0]" equivalence)] - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" name ("[1]#[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math @@ -53,12 +53,12 @@ [] (`` ($_ _.and (do [! random.monad] - [expected (\ ! each (|>> analysis.bit) random.bit)] + [expected (# ! each (|>> analysis.bit) random.bit)] (_.cover [/.result /.any] (|> (list expected) (/.result /.any) (case> {try.#Success actual} - (\ analysis.equivalence = expected actual) + (# analysis.equivalence = expected actual) {try.#Failure _} false)))) @@ -80,15 +80,15 @@ (/.result (<check> expected)) (!expect {try.#Success _}))))] - [/.bit /.bit! random.bit analysis.bit bit\=] + [/.bit /.bit! random.bit analysis.bit bit#=] [/.nat /.nat! random.nat analysis.nat n.=] [/.int /.int! random.int analysis.int i.=] [/.frac /.frac! random.safe_frac analysis.frac f.=] [/.rev /.rev! random.rev analysis.rev r.=] - [/.text /.text! (random.unicode 10) analysis.text text\=] + [/.text /.text! (random.unicode 10) analysis.text text#=] [/.local /.local! random.nat analysis.variable/local n.=] [/.foreign /.foreign! random.nat analysis.variable/foreign n.=] - [/.constant /.constant! ..constant analysis.constant name\=] + [/.constant /.constant! ..constant analysis.constant name#=] )) (do [! random.monad] [expected random.bit] @@ -96,7 +96,7 @@ (|> (list (analysis.tuple (list (analysis.bit expected)))) (/.result (/.tuple /.bit)) (case> {try.#Success actual} - (bit\= expected actual) + (bit#= expected actual) {try.#Failure _} false)))) diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux index 7b57b1547..950434ab7 100644 --- a/stdlib/source/test/lux/control/parser/binary.lux +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -18,7 +18,7 @@ ["[0]" sum] ["[0]" bit] ["[0]" name] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}] [encoding ["[0]" utf8]]] @@ -54,10 +54,10 @@ (def: (utf8_conversion_does_not_alter? value) (Predicate Text) (|> value - (\ utf8.codec encoded) - (\ utf8.codec decoded) + (# utf8.codec encoded) + (# utf8.codec decoded) (case> {try.#Success converted} - (text\= value converted) + (text#= value converted) {try.#Failure error} false))) @@ -76,7 +76,7 @@ (def: (= [expected_module expected_line expected_column] [sample_module sample_line sample_column]) - (and (text\= expected_module sample_module) + (and (text#= expected_module sample_module) (n.= expected_line sample_line) (n.= expected_column sample_column)))) @@ -92,7 +92,7 @@ (random.rec (function (_ recur) (let [random_sequence (do [! random.monad] - [size (\ ! each (n.% 2) random.nat)] + [size (# ! each (n.% 2) random.nat)] (random.list size recur))] ($_ random.and ..random_location @@ -125,7 +125,7 @@ (`` ($_ _.and (~~ (template [<size> <parser> <format>] [(do [! random.monad] - [expected (\ ! each (i64.and (i64.mask <size>)) + [expected (# ! each (i64.and (i64.mask <size>)) random.nat)] (_.cover [<size> <parser> <format>] (|> (format.result <format> expected) @@ -145,12 +145,12 @@ (`` ($_ _.and (~~ (template [<parser> <format>] [(do [! random.monad] - [expected (\ ! each (\ utf8.codec encoded) (random.ascii ..segment_size))] + [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.equivalence = expected actual))))))] [/.binary/8 format.binary/8] [/.binary/16 format.binary/16] @@ -168,7 +168,7 @@ (|> (format.result <format> expected) (/.result <parser>) (!expect (^multi {try.#Success actual} - (\ text.equivalence = expected actual))))))] + (# text.equivalence = expected actual))))))] [/.utf8/8 format.utf8/8] [/.utf8/16 format.utf8/16] @@ -188,7 +188,7 @@ (format.result (<format> format.nat)) (/.result (<parser> /.nat)) (!expect (^multi {try.#Success actual} - (\ (row.equivalence n.equivalence) = expected actual))))))] + (# (row.equivalence n.equivalence) = expected actual))))))] [/.row/8 format.row/8] [/.row/16 format.row/16] @@ -207,7 +207,7 @@ (format.result <format>) (/.result <parser>) (!expect (^multi {try.#Success actual} - (\ <equivalence> = expected actual))))))] + (# <equivalence> = expected actual))))))] [/.bit format.bit random.bit bit.equivalence] [/.nat format.nat random.nat n.equivalence] @@ -220,11 +220,11 @@ (format.result format.frac) (/.result /.frac) (!expect (^multi {try.#Success actual} - (or (\ frac.equivalence = expected 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)) + [expected (# ! each (|>> (i64.and (i64.mask /.size/8)) (n.max 2)) random.nat)] (_.cover [/.not_a_bit] @@ -246,7 +246,7 @@ (format.result <format>) (/.result <parser>) (!expect (^multi {try.#Success actual} - (\ <equivalence> = expected actual))))))] + (# <equivalence> = expected actual))))))] [/.location format.location random_location location_equivalence] [/.code format.code random_code code.equivalence] @@ -260,14 +260,14 @@ (format.result <format>) (/.result <parser>) (!expect (^multi {try.#Success actual} - (\ <equivalence> = expected 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] [/.name /.name format.name format.name ..random_name name.equivalence])) (do [! random.monad] - [expected (\ ! each (list.repeated ..segment_size) random.nat)] + [expected (# ! each (list.repeated ..segment_size) random.nat)] (_.cover [/.set_elements_are_not_unique] (|> expected (format.result (format.list format.nat)) @@ -282,11 +282,11 @@ (/.result (: (/.Parser (Either Bit Nat)) (/.or /.bit /.nat))) (!expect (^multi {try.#Success actual} - (\ (sum.equivalence bit.equivalence n.equivalence) = + (# (sum.equivalence bit.equivalence n.equivalence) = expected actual)))))) (do [! random.monad] - [tag (\ ! each (|>> (i64.and (i64.mask /.size/8)) + [tag (# ! each (|>> (i64.and (i64.mask /.size/8)) (n.max 2)) random.nat) value random.bit] @@ -310,7 +310,7 @@ (<>.and /.nat recur)))))) (!expect (^multi {try.#Success actual} - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected actual)))))) ))) @@ -326,22 +326,22 @@ (/.result /.any) (!expect {try.#Success _}))) (do [! random.monad] - [data (\ ! each (\ utf8.codec encoded) (random.ascii ..segment_size))] + [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))] + [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)))))) + (# binary.equivalence = expected actual)))))) (do [! random.monad] - [data (\ ! each (\ utf8.codec encoded) (random.ascii ..segment_size))] + [data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] (_.cover [/.end?] (|> data (/.result (do <>.monad @@ -352,8 +352,8 @@ 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))] + [to_read (# ! each (n.% (++ ..segment_size)) random.nat) + data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] (_.cover [/.Offset /.offset] (|> data (/.result (do <>.monad @@ -367,8 +367,8 @@ (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))] + [to_read (# ! each (n.% (++ ..segment_size)) random.nat) + data (# ! each (# utf8.codec encoded) (random.ascii ..segment_size))] (_.cover [/.remaining] (|> data (/.result (do <>.monad diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index d8d936cd1..30d0a4460 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -8,13 +8,13 @@ ["[0]" try] ["<>" parser]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math ["[0]" random] [number - ["n" nat ("[1]\[0]" decimal)]]]]] + ["n" nat ("[1]#[0]" decimal)]]]]] [\\library ["[0]" /]]) @@ -31,8 +31,8 @@ (<| (_.covering /._) (_.for [/.Parser]) (do [! random.monad] - [expected (\ ! each n\encoded random.nat) - .let [random_dummy (random.only (|>> (text\= expected) not) + [expected (# ! each n#encoded random.nat) + .let [random_dummy (random.only (|>> (text#= expected) not) (random.unicode 5))] dummy random_dummy short (random.unicode 1) @@ -43,12 +43,12 @@ (_.cover [/.result /.any] (|> (/.result /.any (list expected)) (!expect (^multi {try.#Success actual} - (text\= expected actual))))) + (text#= expected actual))))) (_.cover [/.parse] - (|> (/.result (/.parse n\decoded) (list expected)) + (|> (/.result (/.parse n#decoded) (list expected)) (!expect (^multi {try.#Success actual} - (text\= expected - (n\encoded actual)))))) + (text#= expected + (n#encoded actual)))))) (_.cover [/.this] (and (|> (/.result (/.this expected) (list expected)) (!expect {try.#Success _})) @@ -67,16 +67,16 @@ (_.cover [/.named] (|> (/.result (/.named dummy /.any) (list dummy expected)) (!expect (^multi {try.#Success actual} - (text\= expected actual))))) + (text#= expected actual))))) (_.cover [/.parameter] (and (|> (/.result (/.parameter [short long] /.any) (list short expected)) (!expect (^multi {try.#Success actual} - (text\= expected actual)))) + (text#= expected actual)))) (|> (/.result (/.parameter [short long] /.any) (list long expected)) (!expect (^multi {try.#Success actual} - (text\= expected 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 501e2d4ab..41f981498 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -45,7 +45,7 @@ (_.for [/.Parser]) (`` ($_ _.and (do [! random.monad] - [expected (\ ! each code.bit random.bit)] + [expected (# ! each code.bit random.bit)] (_.cover [/.result] (and (|> (/.result /.any (list expected)) (!expect {try.#Success _})) @@ -54,12 +54,12 @@ (~~ (template [<query> <check> <random> <code> <equivalence>] [(do [! random.monad] [expected <random> - dummy (|> <random> (random.only (|>> (\ <equivalence> = expected) not)))] + dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] ($_ _.and (_.cover [<query>] (|> (/.result <query> (list (<code> expected))) (!expect (^multi {try.#Success actual} - (\ <equivalence> = expected actual))))) + (# <equivalence> = expected actual))))) (_.cover [<check>] (and (|> (/.result (<check> expected) (list (<code> expected))) (!expect {try.#Success []})) @@ -67,7 +67,7 @@ (!expect {try.#Failure _})))) ))] - [/.any /.this! (\ ! each code.bit random.bit) function.identity code.equivalence] + [/.any /.this! (# ! each code.bit random.bit) function.identity code.equivalence] [/.bit /.bit! random.bit code.bit bit.equivalence] [/.nat /.nat! random.nat code.nat nat.equivalence] [/.int /.int! random.int code.int int.equivalence] @@ -86,8 +86,8 @@ (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)))))))] + (and (# nat.equivalence = expected_left actual_left) + (# int.equivalence = expected_right actual_right)))))))] [/.form code.form] [/.variant code.variant] @@ -101,10 +101,10 @@ /.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))))))) + (and (# nat.equivalence = expected_local actual_local) + (# int.equivalence = expected_global actual_global))))))) (do [! random.monad] - [dummy (\ ! each code.bit random.bit)] + [dummy (# ! each code.bit random.bit)] (_.cover [/.end?] (|> (/.result (do <>.monad [pre /.end? @@ -116,14 +116,14 @@ (!expect (^multi {try.#Success verdict} verdict))))) (do [! random.monad] - [dummy (\ ! each code.bit random.bit)] + [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)] + [expected (# ! each code.bit random.bit)] (_.cover [/.next] (|> (/.result (do <>.monad [pre /.next @@ -133,7 +133,7 @@ (list expected)) (!expect {try.#Success _})))) (do [! random.monad] - [expected (\ ! each code.bit random.bit)] + [expected (# ! each code.bit random.bit)] (_.cover [/.not] (and (|> (/.result (/.not /.nat) (list expected)) (!expect (^multi {try.#Success actual} diff --git a/stdlib/source/test/lux/control/parser/environment.lux b/stdlib/source/test/lux/control/parser/environment.lux index 06d06bc53..8f6a0b82c 100644 --- a/stdlib/source/test/lux/control/parser/environment.lux +++ b/stdlib/source/test/lux/control/parser/environment.lux @@ -8,7 +8,7 @@ ["[0]" try] ["[0]" exception]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" dictionary]]] [math @@ -17,7 +17,7 @@ ["n" nat]]]]] [\\library ["[0]" / - ["/[1]" // ("[1]\[0]" monad)]]]) + ["/[1]" // ("[1]#[0]" monad)]]]) (def: .public test Test @@ -29,8 +29,8 @@ (do random.monad [expected random.nat] (_.cover [/.result] - (|> (/.result (//\in expected) /.empty) - (\ try.functor each (n.= expected)) + (|> (/.result (//#in expected) /.empty) + (# try.functor each (n.= expected)) (try.else false)))) (do random.monad [property (random.ascii/alpha 1) @@ -39,7 +39,7 @@ (|> /.empty (dictionary.has property expected) (/.result (/.property property)) - (\ try.functor each (text\= expected)) + (# try.functor each (text#= expected)) (try.else false)))) (do random.monad [property (random.ascii/alpha 1)] diff --git a/stdlib/source/test/lux/control/parser/json.lux b/stdlib/source/test/lux/control/parser/json.lux index 6728343fb..70817caf2 100644 --- a/stdlib/source/test/lux/control/parser/json.lux +++ b/stdlib/source/test/lux/control/parser/json.lux @@ -14,10 +14,10 @@ ["[0]" bit] ["[0]" text] [collection - ["[0]" list ("[1]\[0]" functor)] + ["[0]" list ("[1]#[0]" functor)] ["[0]" set] ["[0]" dictionary] - ["[0]" row {"+" [row]} ("[1]\[0]" functor)]] + ["[0]" row {"+" [row]} ("[1]#[0]" functor)]] [format ["[0]" json]]] [math @@ -46,23 +46,23 @@ (_.for [/.Parser]) (`` ($_ _.and (do [! random.monad] - [expected (\ ! each (|>> {json.#String}) (random.unicode 1))] + [expected (# ! each (|>> {json.#String}) (random.unicode 1))] (_.cover [/.result /.any] (|> (/.result /.any expected) (!expect (^multi {try.#Success actual} - (\ json.equivalence = expected 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)))] + dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] ($_ _.and (_.cover [<query>] (|> (/.result <query> {<json> expected}) (!expect (^multi {try.#Success actual} - (\ <equivalence> = expected actual))))) + (# <equivalence> = expected actual))))) (_.cover [<test>] (and (|> (/.result (<test> expected) {<json> expected}) (!expect {try.#Success #1})) @@ -87,7 +87,7 @@ (exception.match? /.unexpected_value error)))))) (do [! random.monad] [expected (random.unicode 1) - dummy (|> (random.unicode 1) (random.only (|>> (\ text.equivalence = expected) not)))] + dummy (|> (random.unicode 1) (random.only (|>> (# text.equivalence = expected) not)))] (_.cover [/.value_mismatch] (|> (/.result (/.string! expected) {json.#String dummy}) (!expect (^multi {try.#Failure error} @@ -97,22 +97,22 @@ (_.cover [/.nullable] (and (|> (/.result (/.nullable /.string) {json.#Null}) (!expect (^multi {try.#Success actual} - (\ (maybe.equivalence text.equivalence) = {.#None} 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))))))) + (# (maybe.equivalence text.equivalence) = {.#Some expected} actual))))))) (do [! random.monad] - [size (\ ! each (n.% 10) random.nat) + [size (# ! each (n.% 10) random.nat) expected (|> (random.unicode 1) (random.list size) - (\ ! each row.of_list))] + (# ! each row.of_list))] (_.cover [/.array] (|> (/.result (/.array (<>.some /.string)) - {json.#Array (row\each (|>> {json.#String}) expected)}) + {json.#Array (row#each (|>> {json.#String}) expected)}) (!expect (^multi {try.#Success actual} - (\ (row.equivalence text.equivalence) = expected (row.of_list actual))))))) + (# (row.equivalence text.equivalence) = expected (row.of_list actual))))))) (do [! random.monad] - [expected (\ ! each (|>> {json.#String}) (random.unicode 1))] + [expected (# ! each (|>> {json.#String}) (random.unicode 1))] (_.cover [/.unconsumed_input] (|> (/.result (/.array /.any) {json.#Array (row expected expected)}) (!expect (^multi {try.#Failure error} @@ -126,7 +126,7 @@ 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 + (# ! each (|>> set.list (case> (^ (list boolean_field number_field string_field)) [boolean_field number_field string_field] @@ -143,11 +143,11 @@ [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))))))) + (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) + [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))]] @@ -155,9 +155,9 @@ (|> (/.result (/.dictionary /.string) {json.#Object (|> values - (list\each (|>> {json.#String})) + (list#each (|>> {json.#String})) (list.zipped/2 keys) (dictionary.of_list text.hash))}) (!expect (^multi {try.#Success actual} - (\ (dictionary.equivalence text.equivalence) = expected 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 161ee54bc..854206355 100644 --- a/stdlib/source/test/lux/control/parser/synthesis.lux +++ b/stdlib/source/test/lux/control/parser/synthesis.lux @@ -14,7 +14,7 @@ ["[0]" name] ["[0]" text] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random {"+" [Random]}] [number @@ -53,9 +53,9 @@ (def: random_environment (Random (Environment Synthesis)) (do [! random.monad] - [size (\ ! each (n.% 5) random.nat)] + [size (# ! each (n.% 5) random.nat)] (|> ..random_variable - (\ ! each (|>> synthesis.variable)) + (# ! each (|>> synthesis.variable)) (random.list size)))) (def: simple @@ -64,12 +64,12 @@ (~~ (template [<query> <check> <random> <synthesis> <equivalence>] [(do [! random.monad] [expected <random> - dummy (|> <random> (random.only (|>> (\ <equivalence> = expected) not)))] + dummy (|> <random> (random.only (|>> (# <equivalence> = expected) not)))] ($_ _.and (_.cover [<query>] (|> (/.result <query> (list (<synthesis> expected))) (!expect (^multi {try.#Success actual} - (\ <equivalence> = expected actual))))) + (# <equivalence> = expected actual))))) (_.cover [<check>] (and (|> (/.result (<check> expected) (list (<synthesis> expected))) (!expect {try.#Success _})) @@ -79,7 +79,7 @@ ))] [/.bit /.bit! random.bit synthesis.bit bit.equivalence] - [/.i64 /.i64! (\ ! each .i64 random.nat) synthesis.i64 i64.equivalence] + [/.i64 /.i64! (# ! each .i64 random.nat) synthesis.i64 i64.equivalence] [/.f64 /.f64! random.safe_frac synthesis.f64 frac.equivalence] [/.text /.text! (random.unicode 1) synthesis.text text.equivalence] [/.local /.local! random.nat synthesis.variable/local n.equivalence] @@ -93,7 +93,7 @@ ($_ _.and (do [! random.monad] [expected_bit random.bit - expected_i64 (\ ! each .i64 random.nat) + expected_i64 (# ! each .i64 random.nat) expected_f64 random.safe_frac expected_text (random.unicode 1)] (_.cover [/.tuple] @@ -103,10 +103,10 @@ (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))))) + (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} @@ -119,10 +119,10 @@ (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) = + (and (# (list.equivalence synthesis.equivalence) = expected_environment actual_environment) - (\ text.equivalence = expected_body actual_body))))) + (# text.equivalence = expected_body actual_body))))) (|> (/.result (/.function arity /.text) (list (synthesis.text expected_body))) (!expect (^multi {try.#Failure error} @@ -137,21 +137,21 @@ (!expect (^multi {try.#Failure error} (exception.match? /.wrong_arity error)))))) (do [! random.monad] - [arity (\ ! each (|>> (n.% 10) ++) random.nat) + [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) + (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) = + (and (# n.equivalence = expected_offset actual_offset) + (# (list.equivalence bit.equivalence) = expected_inits actual_inits) - (\ text.equivalence = expected_body actual_body))))) + (# text.equivalence = expected_body actual_body))))) (|> (/.result (/.loop (<>.many /.bit) /.text) (list (synthesis.text expected_body))) (!expect (^multi {try.#Failure error} @@ -164,23 +164,23 @@ (_.for [/.Parser]) ($_ _.and (do [! random.monad] - [expected (\ ! each (|>> synthesis.i64) random.nat)] + [expected (# ! each (|>> synthesis.i64) random.nat)] (_.cover [/.result /.any] (|> (/.result /.any (list expected)) (!expect (^multi {try.#Success actual} - (\ synthesis.equivalence = expected 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.nat)] + [expected (# ! each (|>> synthesis.i64) random.nat)] (_.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.nat)] + [dummy (# ! each (|>> synthesis.i64) random.nat)] (_.cover [/.end! /.expected_empty_input] (and (|> (/.result /.end! (list)) (!expect {try.#Success _})) @@ -188,7 +188,7 @@ (!expect (^multi {try.#Failure error} (exception.match? /.expected_empty_input error))))))) (do [! random.monad] - [dummy (\ ! each (|>> synthesis.i64) random.nat)] + [dummy (# ! each (|>> synthesis.i64) random.nat)] (_.cover [/.end?] (and (|> (/.result /.end? (list)) (!expect {try.#Success #1})) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index b340e8450..cd5b8a0ad 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -10,14 +10,14 @@ ["[0]" exception {"+" [Exception]}] ["[0]" function]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}] ["[0]" unicode "_" ["[1]" set] ["[1]/[0]" block]]] [collection ["[0]" set] - ["[0]" list ("[1]\[0]" functor)] + ["[0]" list ("[1]#[0]" functor)] [tree ["[0]" finger]]]] [math @@ -61,7 +61,7 @@ (-> Text (/.Parser Text) Bit) (|> expected (/.result parser) - (\ try.functor each (text\= expected)) + (# try.functor each (text#= expected)) (try.else false))) (def: (should_pass! expected parser) @@ -72,13 +72,13 @@ Test ($_ _.and (do [! random.monad] - [offset (\ ! each (n.% 50) random.nat) - range (\ ! each (|>> (n.% 50) (n.+ 10)) random.nat) + [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) + 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))] + 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))))) @@ -97,22 +97,22 @@ (and (..should_pass (text.of_char expected) /.lower) (..should_fail (text.of_char invalid) /.lower)))) (do [! random.monad] - [expected (\ ! each (n.% 10) random.nat) + [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) + (and (..should_pass (# n.decimal encoded expected) /.decimal) (..should_fail (text.of_char invalid) /.decimal)))) (do [! random.monad] - [expected (\ ! each (n.% 8) random.nat) + [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) + (and (..should_pass (# n.octal encoded expected) /.octal) (..should_fail (text.of_char invalid) /.octal)))) (do [! random.monad] - [expected (\ ! each (n.% 16) random.nat) + [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) + (and (..should_pass (# n.hex encoded expected) /.hexadecimal) (..should_fail (text.of_char invalid) /.hexadecimal)))) (do [! random.monad] [expected (random.char unicode.ascii/alpha) @@ -142,12 +142,12 @@ (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))))))] + (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)))) @@ -155,10 +155,10 @@ [.let [num_options 3] options (|> (random.char unicode.character) (random.set n.hash num_options) - (\ ! each (|>> set.list - (list\each text.of_char) + (# ! each (|>> set.list + (list#each text.of_char) text.together))) - expected (\ ! each (function (_ value) + expected (# ! each (function (_ value) (|> options (text.char (n.% num_options value)) maybe.trusted)) @@ -181,10 +181,10 @@ [.let [num_options 3] options (|> (random.char unicode.character) (random.set n.hash num_options) - (\ ! each (|>> set.list - (list\each text.of_char) + (# ! each (|>> set.list + (list#each text.of_char) text.together))) - invalid (\ ! each (function (_ value) + invalid (# ! each (function (_ value) (|> options (text.char (n.% num_options value)) maybe.trusted)) @@ -210,26 +210,26 @@ (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) + [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)) + (# ! each (n.% 16)) (random.only (n.>= 8)) - (\ ! each (\ n.hex encoded)))] + (# ! 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) + [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)) + (# ! each (n.% 16)) (random.only (n.>= 8)) - (\ ! each (\ n.hex encoded)))] + (# ! each (# n.hex encoded)))] (_.cover [/.some /.some!] (and (..should_pass expected (/.some /.octal)) (..should_pass "" (/.some /.octal)) @@ -238,7 +238,7 @@ (..should_pass! expected (/.some! octal!)) (..should_pass! "" (/.some! octal!))))) (do [! random.monad] - [.let [octal (\ ! each (|>> (n.% 8) (\ n.octal encoded)) random.nat)] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] first octal second octal third octal] @@ -251,7 +251,7 @@ (..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)] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] first octal second octal third octal] @@ -264,7 +264,7 @@ (..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)] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] first octal second octal third octal] @@ -277,7 +277,7 @@ (..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)] + [.let [octal (# ! each (|>> (n.% 8) (# n.octal encoded)) random.nat)] first octal second octal third octal] @@ -309,7 +309,7 @@ [.let [size 10] expected (random.unicode size) dummy (|> (random.unicode size) - (random.only (|>> (text\= expected) not)))] + (random.only (|>> (text#= expected) not)))] (_.cover [/.this /.cannot_match] (and (|> (/.result (/.this expected) expected) @@ -367,13 +367,13 @@ _ /.any post /.remaining _ /.any] - (in (and (text\= input pre) - (text\= right post))))) + (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) + expected (random.only (|>> (text#= right) not) (random.unicode 1))] (_.cover [/.enclosed] (|> (format left expected right) @@ -389,12 +389,12 @@ (/.this output))) (!expect {try.#Success _})))) (do [! random.monad] - [expected (\ ! each (|>> (n.% 8) (\ n.octal encoded)) random.nat)] + [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)))))) + (text#= expected actual)))))) (do [! random.monad] [invalid (random.ascii/upper 1) expected (random.only (|>> (unicode/block.within? unicode/block.basic_latin/upper) diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 3e26eb4ab..e7383e0fe 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -8,14 +8,14 @@ ["[0]" try] ["[0]" exception]] [data - ["[0]" name ("[1]\[0]" equivalence)] + ["[0]" name ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math ["[0]" random {"+" [Random]}] [number ["n" nat]]] - ["[0]" type ("[1]\[0]" equivalence)]]] + ["[0]" type ("[1]#[0]" equivalence)]]] [\\library ["[0]" / ["/[1]" //]]]) @@ -31,7 +31,7 @@ (def: primitive (Random Type) (|> (random.ascii/alpha_num 1) - (\ random.monad each (function (_ name) + (# random.monad each (function (_ name) {.#Primitive name (list)})))) (def: matches @@ -39,7 +39,7 @@ (<| (_.for [/.types_do_not_match]) (do [! random.monad] [expected ..primitive - dummy (random.only (|>> (type\= expected) not) + dummy (random.only (|>> (type#= expected) not) ..primitive)]) ($_ _.and (_.cover [/.exactly] @@ -82,9 +82,9 @@ (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))))) + (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} @@ -98,9 +98,9 @@ (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))))) + (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} @@ -109,9 +109,9 @@ (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))))) + (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} @@ -139,14 +139,14 @@ (/.with_extension argument) /.any) not_parameter) - (!expect (^multi {try.#Success [quantification\\binding argument\\binding actual]} + (!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 _]}))) + (!expect {try.#Success [quantification##binding argument##binding _]}))) (_.cover [/.wrong_parameter] (|> (/.result (<| (/.with_extension quantification) (/.with_extension argument) @@ -159,14 +159,14 @@ (/.with_extension argument) (/.parameter! 0)) {.#Parameter 0}) - (!expect {try.#Success [quantification\\binding argument\\binding _]}))) + (!expect {try.#Success [quantification##binding argument##binding _]}))) ))) (def: polymorphic Test (do [! random.monad] [not_polymorphic ..primitive - expected_inputs (\ ! each (|>> (n.% 10) ++) random.nat)] + expected_inputs (# ! each (|>> (n.% 10) ++) random.nat)] ($_ _.and (_.cover [/.not_polymorphic] (and (|> (/.result (/.polymorphic /.any) @@ -195,7 +195,7 @@ (_.cover [/.result /.any] (|> (/.result /.any expected) (!expect (^multi {try.#Success actual} - (type\= expected actual)))))) + (type#= expected actual)))))) (do [! random.monad] [expected ..primitive] (_.cover [/.next /.unconsumed_input] @@ -205,7 +205,7 @@ (in actual)) expected) (!expect (^multi {try.#Success actual} - (type\= expected actual)))) + (type#= expected actual)))) (|> (/.result /.next expected) (!expect (^multi {try.#Failure error} (exception.match? /.unconsumed_input error))))))) @@ -235,7 +235,7 @@ (same? /.fresh environment)))))) (do [! random.monad] [expected ..primitive - dummy (random.only (|>> (type\= expected) not) + dummy (random.only (|>> (type#= expected) not) ..primitive)] (_.cover [/.local] (|> (/.result (do //.monad @@ -244,7 +244,7 @@ /.any)) dummy) (!expect (^multi {try.#Success actual} - (type\= expected actual)))))) + (type#= expected actual)))))) (do [! random.monad] [expected random.nat] (_.cover [/.existential /.not_existential] @@ -260,8 +260,8 @@ (|> (/.result /.named {.#Named expected_name expected_type}) (!expect (^multi {try.#Success [actual_name actual_type]} - (and (name\= expected_name actual_name) - (type\= expected_type actual_type))))))) + (and (name#= expected_name actual_name) + (type#= expected_type actual_type))))))) ..aggregate ..matches ..parameter diff --git a/stdlib/source/test/lux/control/parser/xml.lux b/stdlib/source/test/lux/control/parser/xml.lux index 7b87831a8..6551d4616 100644 --- a/stdlib/source/test/lux/control/parser/xml.lux +++ b/stdlib/source/test/lux/control/parser/xml.lux @@ -2,17 +2,17 @@ [library [lux "*" ["_" test {"+" [Test]}] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] [abstract [monad {"+" [do]}]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception]] [data - ["[0]" text ("[1]\[0]" equivalence)] - ["[0]" name ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] + ["[0]" name ("[1]#[0]" equivalence)] [format - ["[0]" xml ("[1]\[0]" equivalence)]] + ["[0]" xml ("[1]#[0]" equivalence)]] [collection ["[0]" dictionary] ["[0]" list]]] @@ -24,7 +24,7 @@ ["n" nat]]]]] [\\library ["[0]" / - ["/[1]" // ("[1]\[0]" monad)]]]) + ["/[1]" // ("[1]#[0]" monad)]]]) (template: (!expect <pattern> <value>) [(case <value> @@ -64,15 +64,15 @@ (_.cover [/.result /.text] (|> (/.result /.text (list {xml.#Text expected})) (!expect (^multi {try.#Success actual} - (text\= expected actual)))))) + (text#= expected actual)))))) (!failure /.unconsumed_inputs - [[(//\in expected) + [[(//#in expected) {xml.#Text expected}]]) (do [! random.monad] - [expected (\ ! each (|>> {xml.#Text}) (random.ascii/alpha 1))] + [expected (# ! each (|>> {xml.#Text}) (random.ascii/alpha 1))] (_.cover [/.any] (|> (/.result /.any (list expected)) - (try\each (xml\= expected)) + (try#each (xml#= expected)) (try.else false)))) (do [! random.monad] [expected ..random_tag] @@ -80,17 +80,17 @@ (|> (/.result (do //.monad [actual /.tag _ /.any] - (in (name\= expected actual))) + (in (name#= expected actual))) (list {xml.#Node expected (dictionary.empty name.hash) (list)})) (!expect {try.#Success #1})))) (do [! random.monad] [expected ..random_tag] (_.cover [/.node] - (|> (/.result (/.node expected (//\in [])) + (|> (/.result (/.node expected (//#in [])) (list {xml.#Node expected (dictionary.empty name.hash) (list)})) (!expect {try.#Success []})))) (!failure /.wrong_tag - [[(/.node ["" expected] (//\in [])) + [[(/.node ["" expected] (//#in [])) {xml.#Node [expected ""] (dictionary.empty name.hash) (list)}]]) (do [! random.monad] [expected_tag ..random_tag @@ -99,7 +99,7 @@ (_.cover [/.attribute] (|> (/.result (<| (/.node expected_tag) (//.after (/.attribute expected_attribute)) - (//\in [])) + (//#in [])) (list {xml.#Node expected_tag (|> (dictionary.empty name.hash) (dictionary.has expected_attribute expected_value)) @@ -123,7 +123,7 @@ [(do //.monad [_ /.any] (/.node [expected expected] - (//\in []))) + (//#in []))) {xml.#Node [expected expected] (dictionary.empty name.hash) (list)}] @@ -139,7 +139,7 @@ [[/.text {xml.#Node [expected expected] (dictionary.empty name.hash) (list)}] [(/.node [expected expected] - (//\in [])) + (//#in [])) {xml.#Text expected}] [(/.node [expected expected] (/.attribute [expected expected])) @@ -150,16 +150,16 @@ {xml.#Node tag (dictionary.empty name.hash) children}))] parent ..random_tag right ..random_tag - wrong (random.only (|>> (name\= right) not) + wrong (random.only (|>> (name#= right) not) ..random_tag) .let [parser (<| (/.node parent) (do //.monad [_ (<| /.somewhere (/.node right) - (//\in [])) + (//#in [])) _ (//.some /.any)] (in [])))] - repetitions (\ ! each (n.% 10) random.nat)] + repetitions (# ! each (n.% 10) random.nat)] ($_ _.and (_.cover [/.somewhere] (|> (/.result parser diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index f71dae655..11f95f63c 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -7,7 +7,7 @@ [monad {"+" [do]}]] [data ["[0]" identity] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random] @@ -35,7 +35,7 @@ (|> sample (/.let> x [(n.+ x x)])))) (_.cover [/.cond>] - (text\= (cond (n.= 0 sample) "zero" + (text#= (cond (n.= 0 sample) "zero" (n.even? sample) "even" "odd") (|> sample @@ -43,7 +43,7 @@ [n.even?] [(/.new> "even" [])] [(/.new> "odd" [])])))) (_.cover [/.if>] - (text\= (if (n.even? sample) + (text#= (if (n.even? sample) "even" "odd") (|> sample @@ -81,9 +81,9 @@ [%.nat]))] (and (n.= (++ sample) left) (n.= (-- sample) middle) - (text\= (%.nat sample) right)))) + (text#= (%.nat sample) right)))) (_.cover [/.case>] - (text\= (case (n.% 10 sample) + (text#= (case (n.% 10 sample) 0 "zero" 1 "one" 2 "two" diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 2545c2834..0666930c0 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -48,11 +48,11 @@ (_.cover [/.local] (n.= (n.* factor sample) (/.result sample (/.local (n.* factor) /.read)))) - (let [(^open "io\[0]") io.monad] + (let [(^open "io#[0]") io.monad] (_.cover [/.with /.lifted] (|> (: (/.Reader Any (IO Nat)) (do (/.with io.monad) - [a (/.lifted (io\in sample)) + [a (/.lifted (io#in sample)) b (in factor)] (in (n.* b a)))) (/.result []) diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 9bdd575f7..495a120e1 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -81,7 +81,7 @@ (<| (_.covering /._) (_.for [/.Region]) (do [! random.monad] - [expected_clean_ups (|> random.nat (\ ! each (|>> (n.% 100) (n.max 1))))] + [expected_clean_ups (|> random.nat (# ! each (|>> (n.% 100) (n.max 1))))] ($_ _.and (_.for [/.functor] ($functor.spec ..injection ..comparison (: (All (_ ! r) diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 704aaed01..d8bb5fc9c 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -17,7 +17,7 @@ ["%" format {"+" [format]}]]] [math [number {"+" [hex]}] - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]] [time ["[0]" date {"+" [Date]}] ["[0]" instant] @@ -29,8 +29,8 @@ ["[0]" /]]) (def: deadline (Random Date) random.date) -(def: message (Random Text) (random\each %.bit random.bit)) -(def: focus (Random Code) (random\each code.bit random.bit)) +(def: message (Random Text) (random#each %.bit random.bit)) +(def: focus (Random Code) (random#each code.bit random.bit)) (def: (memory macro deadline message focus) (-> Name Date Text (Maybe Code) Code) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 63448cef6..875938610 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -10,7 +10,7 @@ ["$[0]" apply] ["$[0]" monad]]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random] [number @@ -55,11 +55,11 @@ (def: &equivalence (implementation (def: (= reference sample) - (text\= (%#can_downgrade reference) + (text#= (%#can_downgrade reference) (%#can_downgrade sample))))) (def: hash (|>> %#can_downgrade - (\ text.hash hash))))) + (# text.hash hash))))) (def: password %#can_upgrade) @@ -75,24 +75,24 @@ (do random.monad [.let [policy_0 (policy [])] raw_password (random.ascii 10) - .let [password (\ policy_0 password raw_password)]] + .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)) + ($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)) + ($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)))) + ($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)))) + (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))] + delegate (/.delegation (# policy_0 #can_downgrade) (# policy_1 #can_upgrade))] (_.cover [/.Delegation /.delegation] - (\ policy_1 = (delegate password) (delegate password)))) + (# 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 551ce224a..6bf554706 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -82,7 +82,7 @@ (def: loops Test (do [! random.monad] - [limit (|> random.nat (\ ! each (n.% 10))) + [limit (|> random.nat (# ! each (n.% 10))) .let [condition (do /.monad [state /.get] (in (n.< limit state)))]] @@ -107,11 +107,11 @@ [state random.nat left random.nat right random.nat] - (let [(^open "io\[0]") io.monad] + (let [(^open "io#[0]") io.monad] (_.cover [/.+State /.with /.lifted /.result'] (|> (: (/.+State io.IO Nat Nat) (do (/.with io.monad) - [a (/.lifted io.monad (io\in left)) + [a (/.lifted io.monad (io#in left)) b (in right)] (in (n.+ a b)))) (/.result' state) diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index c54b019dc..003f27eb5 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -19,7 +19,7 @@ (def: (injection value) (Injection (All (_ a !) (Thread ! a))) - (\ /.monad in value)) + (# /.monad in value)) (def: comparison (Comparison (All (_ a !) (Thread ! a))) @@ -38,12 +38,12 @@ (_.cover [/.result] (n.= sample (|> sample - (\ /.monad in) + (# /.monad in) /.result))) (_.cover [/.io] (n.= sample (|> sample - (\ /.monad in) + (# /.monad in) /.io io.run!))) diff --git a/stdlib/source/test/lux/control/try.lux b/stdlib/source/test/lux/control/try.lux index 6c05f2e53..74dfeb37f 100644 --- a/stdlib/source/test/lux/control/try.lux +++ b/stdlib/source/test/lux/control/try.lux @@ -13,7 +13,7 @@ pipe ["[0]" io]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -28,7 +28,7 @@ (def: comparison (Comparison Try) (function (_ ==) - (\ (/.equivalence ==) =))) + (# (/.equivalence ==) =))) (def: .public (attempt element) (All (_ a) (-> (Random a) (Random (Try a)))) @@ -44,7 +44,7 @@ [expected random.nat alternative (|> random.nat (random.only (|>> (n.= expected) not))) error (random.unicode 1) - .let [(^open "io\[0]") io.monad]]) + .let [(^open "io#[0]") io.monad]]) ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..attempt random.nat))) @@ -82,7 +82,7 @@ (_.cover [/.with /.lifted] (let [lifted (/.lifted io.monad)] (|> (do (/.with io.monad) - [a (lifted (io\in expected)) + [a (lifted (io#in expected)) b (in alternative)] (in (n.+ a b))) io.run! diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index d8d529e54..2f427a4a9 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -14,7 +14,7 @@ ["[0]" io]] [data ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random] [number @@ -24,7 +24,7 @@ (def: (injection monoid value) (All (_ w) (-> (Monoid w) (Injection (Writer w)))) - [(\ monoid identity) value]) + [(# monoid identity) value]) (def: comparison (All (_ w) (Comparison (Writer w))) @@ -48,13 +48,13 @@ ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid))) (_.cover [/.write] - (text\= log + (text#= log (product.left (/.write log)))) (_.cover [/.with /.lifted] (let [lifted (/.lifted text.monoid io.monad) - (^open "io\[0]") io.monad] + (^open "io#[0]") io.monad] (|> (do (/.with text.monoid io.monad) - [a (lifted (io\in left)) + [a (lifted (io#in left)) b (in right)] (in (n.+ a b))) io.run! diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index ca497af1c..70e778090 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -40,7 +40,7 @@ [byte random.nat] (exec (try.trusted (/.write/8! idx byte output)) (recur (++ idx)))) - (\ random.monad in output))))) + (# random.monad in output))))) (def: (throws? exception try) (All (_ e a) (-> (Exception e) (Try a) Bit)) @@ -79,13 +79,13 @@ Test (<| (_.covering /._) (do [! random.monad] - [.let [gen_size (|> random.nat (\ ! each (|>> (n.% 100) (n.max 8))))] + [.let [gen_size (|> random.nat (# ! each (|>> (n.% 100) (n.max 8))))] size gen_size sample (..random size) value random.nat - .let [gen_idx (|> random.nat (\ ! each (n.% size)))] + .let [gen_idx (|> random.nat (# ! each (n.% size)))] offset gen_idx - length (\ ! each (n.% (n.- offset size)) random.nat)] + length (# ! each (n.% (n.- offset size)) random.nat)] (_.for [/.Binary] ($_ _.and (_.for [/.equivalence] @@ -93,11 +93,11 @@ (_.for [/.monoid] ($monoid.spec /.equivalence /.monoid (..random size))) (_.cover [/.aggregate] - (n.= (\ list.mix mix n.+ 0 (..as_list sample)) + (n.= (# list.mix mix n.+ 0 (..as_list sample)) (/.aggregate n.+ 0 sample))) (_.cover [/.empty] - (\ /.equivalence = + (# /.equivalence = (/.empty size) (/.empty size))) (_.cover [/.size] @@ -124,7 +124,7 @@ (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) + (# (list.equivalence n.equivalence) = binary_vals slice_vals) _ #0)))) @@ -135,8 +135,8 @@ 0 (not verdict) _ verdict)))) (_.cover [/.after] - (and (\ /.equivalence = sample (/.after 0 sample)) - (\ /.equivalence = (/.empty 0) (/.after size sample)) + (and (# /.equivalence = sample (/.after 0 sample)) + (# /.equivalence = (/.empty 0) (/.after size sample)) (case (list.reversed (..as_list sample)) {.#End} false @@ -148,7 +148,7 @@ (and (case (/.copy size 0 sample 0 (/.empty size)) {try.#Success output} (and (not (same? sample output)) - (\ /.equivalence = sample output)) + (# /.equivalence = sample output)) {try.#Failure _} false) diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index f54892910..4bd7e6956 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -34,12 +34,12 @@ ($codec.spec /.equivalence /.codec random.bit)) (_.cover [/.no /.yes] - (and (\ /.equivalence = false /.no) - (\ /.equivalence = true /.yes))) + (and (# /.equivalence = false /.no) + (# /.equivalence = true /.yes))) (_.cover [/.off /.on] - (and (\ /.equivalence = false /.off) - (\ /.equivalence = true /.on))) + (and (# /.equivalence = false /.off) + (# /.equivalence = true /.on))) (_.cover [/.complement] - (and (not (\ /.equivalence = value ((/.complement function.identity) value))) - (\ /.equivalence = value ((/.complement not) value)))) + (and (not (# /.equivalence = value ((/.complement function.identity) value))) + (# /.equivalence = value ((/.complement not) value)))) )))) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 0337bd12a..3d875ac3d 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -29,7 +29,7 @@ (def: bounded_size (Random Nat) - (\ random.monad each (|>> (n.% 100) (n.+ 1)) + (# random.monad each (|>> (n.% 100) (n.+ 1)) random.nat)) (def: structures @@ -57,7 +57,7 @@ the_array (random.array size random.nat)] ($_ _.and (_.cover [/.example] - (\ (maybe.equivalence n.equivalence) = + (# (maybe.equivalence n.equivalence) = (/.example n.even? the_array) (list.example n.even? (/.list {.#None} the_array)))) (_.cover [/.example+] @@ -80,11 +80,11 @@ _ false)) (_.cover [/.every?] - (\ bit.equivalence = + (# bit.equivalence = (list.every? n.even? (/.list {.#None} the_array)) (/.every? n.even? the_array))) (_.cover [/.any?] - (\ bit.equivalence = + (# bit.equivalence = (list.any? n.even? (/.list {.#None} the_array)) (/.any? n.even? the_array))) ))) @@ -169,7 +169,7 @@ _ false))) (do ! - [occupancy (\ ! each (n.% (++ size)) random.nat)] + [occupancy (# ! each (n.% (++ size)) random.nat)] (_.cover [/.occupancy /.vacancy] (let [the_array (loop [output (: (Array Nat) (/.empty size)) @@ -191,9 +191,9 @@ random.nat)] (_.cover [/.of_list /.list] (and (|> the_list /.of_list (/.list {.#None}) - (\ (list.equivalence n.equivalence) = the_list)) + (# (list.equivalence n.equivalence) = the_list)) (|> the_array (/.list {.#None}) /.of_list - (\ (/.equivalence n.equivalence) = the_array)) + (# (/.equivalence n.equivalence) = the_array)) (exec (/.filter! n.even? the_array) (list.every? (function (_ value) @@ -201,18 +201,18 @@ (same? default value))) (/.list {.#Some default} the_array)))))) (do ! - [amount (\ ! each (n.% (++ size)) random.nat)] + [amount (# ! each (n.% (++ size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.empty size))] (exec (/.copy! amount 0 the_array 0 copy) - (\ (list.equivalence n.equivalence) = + (# (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)))) + (# (/.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?))] @@ -220,5 +220,5 @@ (exec (/.filter! 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)))))) + (|> the_array (/.list {.#None}) (# (list.equivalence n.equivalence) = evens)))))) )))) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index ea93acfcb..8c7d69241 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -17,16 +17,16 @@ (def: (size min max) (-> Nat Nat (Random Nat)) (|> random.nat - (\ random.monad each (|>> (n.% (++ max)) (n.max min))))) + (# random.monad each (|>> (n.% (++ max)) (n.max min))))) (def: .public random (Random Bits) (do [! random.monad] - [size (\ ! each (n.% 1,000) random.nat)] + [size (# ! each (n.% 1,000) random.nat)] (case size 0 (in /.empty) _ (do [! random.monad] - [idx (|> random.nat (\ ! each (n.% size)))] + [idx (|> random.nat (# ! each (n.% size)))] (in (/.one idx /.empty)))))) (def: .public test @@ -47,8 +47,8 @@ (/.empty? /.empty)) (do [! random.monad] - [size (\ ! each (|>> (n.% 1,000) ++) random.nat) - idx (\ ! each (n.% size) random.nat) + [size (# ! each (|>> (n.% 1,000) ++) random.nat) + idx (# ! each (n.% size) random.nat) sample ..random] ($_ _.and (_.cover [/.bit /.one] @@ -79,17 +79,17 @@ (_.cover [/.not] (and (same? /.empty (/.not /.empty)) (or (same? /.empty sample) - (and (not (\ /.equivalence = sample (/.not sample))) - (\ /.equivalence = sample (/.not (/.not 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)) + (and (# /.equivalence = sample (/.or sample sample)) (n.= (/.size (/.or sample (/.not sample))) (/.capacity sample)))) (_.cover [/.and] - (and (\ /.equivalence = sample (/.and sample sample)) + (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 264f80fb9..562b20c0e 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -9,13 +9,13 @@ ["$[0]" equivalence] ["$[0]" functor {"+" [Injection]}]]] [control - ["[0]" maybe ("[1]\[0]" functor)] + ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try] ["[0]" exception]] [data ["[0]" product] [collection - ["[0]" list ("[1]\[0]" functor)] + ["[0]" list ("[1]#[0]" functor)] ["[0]" set]]] [math ["[0]" random] @@ -31,7 +31,7 @@ (def: for_dictionaries Test (do [! random.monad] - [.let [capped_nat (\ random.monad each (n.% 100) random.nat)] + [.let [capped_nat (# random.monad each (n.% 100) random.nat)] size capped_nat dict (random.dictionary n.hash size random.nat capped_nat) non_key (random.only (|>> (/.key? dict) not) @@ -71,7 +71,7 @@ unique_keys! (|> entries - (list\each product.left) + (list#each product.left) (set.of_list n.hash) set.size (n.= (/.size dict))) @@ -80,7 +80,7 @@ (list.every? (function (_ [key value]) (|> dict (/.value key) - (maybe\each (n.= value)) + (maybe#each (n.= value)) (maybe.else false))) entries)] (and correct_size! @@ -112,7 +112,7 @@ (let [merging_with_oneself (let [(^open "[0]") (/.equivalence n.equivalence)] (= dict (/.merged dict dict))) overwritting_keys (let [dict' (|> dict /.entries - (list\each (function (_ [k v]) [k (++ v)])) + (list#each (function (_ [k v]) [k (++ v)])) (/.of_list n.hash)) (^open "[0]") (/.equivalence n.equivalence)] (= dict' (/.merged dict' dict)))] @@ -133,7 +133,7 @@ (def: for_entries Test (do random.monad - [.let [capped_nat (\ random.monad each (n.% 100) random.nat)] + [.let [capped_nat (# random.monad each (n.% 100) random.nat)] size capped_nat dict (random.dictionary n.hash size random.nat capped_nat) non_key (random.only (|>> (/.key? dict) not) @@ -253,7 +253,7 @@ (<| (_.covering /._) (_.for [/.Dictionary]) (do random.monad - [.let [capped_nat (\ random.monad each (n.% 100) random.nat)] + [.let [capped_nat (# random.monad each (n.% 100) random.nat)] size capped_nat dict (random.dictionary n.hash size random.nat capped_nat) non_key (random.only (|>> (/.key? dict) not) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 75749c61d..3ade2fc0b 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -9,15 +9,15 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" maybe ("[1]\[0]" monad)]] + ["[0]" maybe ("[1]#[0]" monad)]] [data ["[0]" product] - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" set] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\library @@ -28,7 +28,7 @@ (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size 0 - (random\in (/.empty order)) + (random#in (/.empty order)) _ (do random.monad @@ -43,7 +43,7 @@ (<| (_.covering /._) (_.for [/.Dictionary]) (do [! random.monad] - [size (\ ! each (n.% 100) random.nat) + [size (# ! each (n.% 100) random.nat) keys (random.set n.hash size random.nat) values (random.set n.hash size random.nat) extra_key (random.only (|>> (set.member? keys) not) @@ -56,12 +56,12 @@ sorted_pairs (list.sorted (function (_ [left _] [right _]) (n.< left right)) pairs) - sorted_values (list\each product.right sorted_pairs) - (^open "list\[0]") (list.equivalence (: (Equivalence [Nat Nat]) + sorted_values (list#each product.right sorted_pairs) + (^open "list#[0]") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) (and (n.= kr ks) (n.= vr vs))))) - (^open "/\[0]") (/.equivalence n.equivalence)]] + (^open "/#[0]") (/.equivalence n.equivalence)]] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) @@ -69,7 +69,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit\= (n.= 0 (/.size sample)) + (bit#= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? (/.empty n.order))) @@ -94,15 +94,15 @@ _ #0)) (_.cover [/.entries] - (list\= (/.entries sample) + (list#= (/.entries sample) sorted_pairs)) (_.cover [/.keys /.values] - (list\= (/.entries sample) + (list#= (/.entries sample) (list.zipped/2 (/.keys sample) (/.values sample)))) (_.cover [/.of_list] (|> sample /.entries (/.of_list n.order) - (/\= sample))) + (/#= sample))) (_.cover [/.key?] (and (list.every? (/.key? sample) (/.keys sample)) @@ -126,12 +126,12 @@ (|> sample (/.has extra_key extra_value) (/.lacks extra_key) - (/\= sample))) + (/#= 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#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 572f06c31..f7079325e 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -7,9 +7,9 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" maybe ("[1]\[0]" monad)]] + ["[0]" maybe ("[1]#[0]" monad)]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" text] [collection ["[0]" set] @@ -35,7 +35,7 @@ (_.for [/.PList]) (do [! random.monad] [.let [gen_key (random.ascii/alpha 10)] - size (\ ! each (n.% 100) random.nat) + size (# ! each (n.% 100) random.nat) sample (..random size gen_key random.nat) .let [keys (|> sample /.keys (set.of_list text.hash))] @@ -51,12 +51,12 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit\= (n.= 0 (/.size sample)) + (bit#= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? /.empty)) (_.cover [/.keys /.values] - (\ (/.equivalence n.equivalence) = + (# (/.equivalence n.equivalence) = sample (list.zipped/2 (/.keys sample) (/.values sample)))) @@ -75,18 +75,18 @@ (|> sample (/.has extra_key extra_value) (/.value extra_key) - (maybe\each (n.= extra_value)) + (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#each (n.= (n.+ shift extra_value))) (maybe.else false))) (_.cover [/.lacks] (|> sample (/.has extra_key extra_value) (/.lacks extra_key) - (\ (/.equivalence n.equivalence) = sample))) + (# (/.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 d924cb788..44316d6a5 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -21,7 +21,7 @@ [data ["[0]" bit] ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" set]]] [math @@ -30,11 +30,11 @@ ["n" nat] ["[0]" int]]]]] [\\library - ["[0]" / ("[1]\[0]" monad)]]) + ["[0]" / ("[1]#[0]" monad)]]) (def: bounded_size (Random Nat) - (\ random.monad each (n.% 100) + (# random.monad each (n.% 100) random.nat)) (def: random @@ -43,7 +43,7 @@ [size ..bounded_size] (|> random.nat (random.set n.hash size) - (\ ! each set.list)))) + (# ! each set.list)))) (def: signatures Test @@ -52,28 +52,28 @@ ($equivalence.spec (/.equivalence n.equivalence) ..random)) (_.for [/.hash] (|> random.nat - (\ random.monad each (|>> list)) + (# 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)) + ($mix.spec /#in /.equivalence /.mix)) (_.for [/.functor] - ($functor.spec /\in /.equivalence /.functor)) + ($functor.spec /#in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /\in /.equivalence /.apply)) + ($apply.spec /#in /.equivalence /.apply)) (_.for [/.monad] - ($monad.spec /\in /.equivalence /.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 + (^open "io#[0]") io.monad expected (n.+ parameter subject)] (_.cover [/.with /.lifted] (|> (io.run! (do (/.with io.monad) - [a (lifted (io\in parameter)) + [a (lifted (io#in parameter)) b (in subject)] (in (n.+ a b)))) (case> (^ (list actual)) @@ -87,13 +87,13 @@ Test (do [! random.monad] [size ..bounded_size - .let [(^open "/\[0]") (/.equivalence n.equivalence)] - sample (\ ! each set.list (random.set n.hash size random.nat))] + .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 = + (# bit.equivalence = (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.repeated] @@ -101,11 +101,11 @@ (_.cover [/.reversed] (or (n.< 2 (/.size sample)) (let [not_same! - (not (/\= sample + (not (/#= sample (/.reversed sample))) self_symmetry! - (/\= sample + (/#= sample (/.reversed (/.reversed sample)))] (and not_same! self_symmetry!)))) @@ -121,7 +121,7 @@ (/.size (/.sorted <<< sample))) symmetry! - (/\= (/.sorted <<< sample) + (/#= (/.sorted <<< sample) (/.reversed (/.sorted (function.flipped <<<) sample)))] (and size_preservation! symmetry!))) @@ -129,8 +129,8 @@ (def: indices Test - (let [(^open "/\[0]") (/.equivalence n.equivalence) - (^open "/\[0]") /.functor] + (let [(^open "/#[0]") (/.equivalence n.equivalence) + (^open "/#[0]") /.functor] (do [! random.monad] [sample ..random .let [size (/.size sample)]] @@ -142,7 +142,7 @@ (n.= size (/.size indices)) already_sorted! - (/\= indices + (/#= indices (/.sorted n.< indices)) expected_numbers! @@ -157,12 +157,12 @@ (let [enumeration (/.enumeration sample) has_correct_indices! - (/\= (/.indices (/.size enumeration)) - (/\each product.left enumeration)) + (/#= (/.indices (/.size enumeration)) + (/#each product.left enumeration)) has_correct_values! - (/\= sample - (/\each product.right enumeration))] + (/#= sample + (/#each product.right enumeration))] (and has_correct_indices! has_correct_values!))) (_.cover [/.item] @@ -178,14 +178,14 @@ (def: slice Test - (let [(^open "/\[0]") (/.equivalence n.equivalence) - (^open "/\[0]") /.monoid] + (let [(^open "/#[0]") (/.equivalence n.equivalence) + (^open "/#[0]") /.monoid] (do [! random.monad] [sample (random.only (|>> /.size (n.> 0)) ..random) .let [size (/.size sample)] - idx (\ ! each (n.% size) random.nat) - sub_size (\ ! each (|>> (n.% size) ++) random.nat)] + idx (# ! each (n.% size) random.nat) + sub_size (# ! each (|>> (n.% size) ++) random.nat)] ($_ _.and (_.cover [/.only] (let [positives (/.only n.even? sample) @@ -198,36 +198,36 @@ (/.size negatives)))))) (_.cover [/.partition] (let [[positives negatives] (/.partition n.even? sample)] - (and (/\= (/.only n.even? sample) + (and (/#= (/.only n.even? sample) positives) - (/\= (/.only (bit.complement n.even?) sample) + (/#= (/.only (bit.complement n.even?) sample) negatives)))) (_.cover [/.split_at] (let [[left right] (/.split_at idx sample)] - (/\= sample - (/\composite left right)))) + (/#= sample + (/#composite left right)))) (_.cover [/.split_when] (let [[left right] (/.split_when n.even? sample)] - (/\= sample - (/\composite left right)))) + (/#= sample + (/#composite left right)))) (_.cover [/.first /.after] - (/\= sample - (/\composite (/.first idx sample) + (/#= sample + (/#composite (/.first idx sample) (/.after idx sample)))) (_.cover [/.while /.until] - (/\= sample - (/\composite (/.while n.even? sample) + (/#= 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 + (/#= sample (/.together subs))))) )))) (def: member Test - (let [(^open "/\[0]") (/.equivalence n.equivalence)] + (let [(^open "/#[0]") (/.equivalence n.equivalence)] (do [! random.monad] [sample ..random] (`` ($_ _.and @@ -249,7 +249,7 @@ (_.cover [<tail>] (case [(<pre> sample) (<tail> sample)] [{.#Item _ expected} {.#Some actual}] - (/\= (<pre> expected) actual) + (/#= (<pre> expected) actual) [{.#End} {.#None}] true @@ -265,9 +265,9 @@ (def: grouping Test - (let [(^open "/\[0]") (/.equivalence n.equivalence) - (^open "/\[0]") /.functor - (^open "/\[0]") /.monoid + (let [(^open "/#[0]") (/.equivalence n.equivalence) + (^open "/#[0]") /.functor + (^open "/#[0]") /.monoid +/2 (: (-> Nat Nat Nat) (function (_ left right) @@ -292,10 +292,10 @@ (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 (/#= (/.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] @@ -310,52 +310,52 @@ (/.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 (/#= (/.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)) = + (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)) = + (# (/.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)))) (_.cover [/.zipped_with/2] - (/\= (/\each (function (_ [left right]) + (/#= (/#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]) + (/#= (/#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) + (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) ((/.zipped_with 3) +/3 sample/0 sample/1 sample/2)))) (_.cover [/.together] - (and (/\= (/\composite sample/0 sample/1) + (and (/#= (/#composite sample/0 sample/1) (/.together (list sample/0 sample/1))) - (/\= ($_ /\composite sample/0 sample/1 sample/2) + (/#= ($_ /#composite sample/0 sample/1 sample/2) (/.together (list sample/0 sample/1 sample/2))))) )))) (def: search Test - (let [(^open "/\[0]") /.functor + (let [(^open "/#[0]") /.functor choose (: (-> Nat (Maybe Text)) (function (_ value) (if (n.even? value) - {.#Some (\ n.decimal encoded value)} + {.#Some (# n.decimal encoded value)} {.#None})))] (do [! random.monad] [sample ..random] @@ -363,11 +363,11 @@ (_.cover [/.one] (case [(|> sample (/.only n.even?) - (/\each (\ n.decimal encoded)) + (/#each (# n.decimal encoded)) /.head) (/.one choose sample)] [{.#Some expected} {.#Some actual}] - (text\= expected actual) + (text#= expected actual) [{.#None} {.#None}] true @@ -375,10 +375,10 @@ _ false)) (_.cover [/.all] - (\ (/.equivalence text.equivalence) = + (# (/.equivalence text.equivalence) = (|> sample (/.only n.even?) - (/\each (\ n.decimal encoded))) + (/#each (# n.decimal encoded))) (/.all choose sample))) (_.cover [/.example] (case (/.example n.even? sample) @@ -393,8 +393,8 @@ Test (<| (_.covering /._) (_.for [.List]) - (let [(^open "/\[0]") (/.equivalence n.equivalence) - (^open "/\[0]") /.functor] + (let [(^open "/#[0]") (/.equivalence n.equivalence) + (^open "/#[0]") /.functor] (do [! random.monad] [sample ..random separator random.nat] @@ -416,21 +416,21 @@ (_.cover [/.iterations] (or (/.empty? sample) (let [size (/.size sample)] - (/\= (/.indices size) + (/#= (/.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))) + (/#= (/#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)]] + .let [(^open "/#[0]") (/.equivalence n.equivalence)]] (_.cover [/.when] - (and (/\= (list expected) (/.when true (list expected))) - (/\= (list) (/.when false (list expected)))))) + (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 45053e52b..7d5cf2f01 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -8,10 +8,10 @@ ["$[0]" equivalence] ["$[0]" functor {"+" [Injection]}]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" set] - ["[0]" list ("[1]\[0]" monoid)]]] + ["[0]" list ("[1]#[0]" monoid)]]] [math ["[0]" random] [number @@ -28,7 +28,7 @@ (<| (_.covering /._) (_.for [/.Queue]) (do [! random.monad] - [size (\ ! each (n.% 100) random.nat) + [size (# ! each (n.% 100) random.nat) members (random.set n.hash size random.nat) non_member (random.only (|>> (set.member? members) not) random.nat) @@ -42,18 +42,18 @@ (_.cover [/.of_list /.list] (|> members /.of_list /.list - (\ (list.equivalence n.equivalence) = members))) + (# (list.equivalence n.equivalence) = members))) (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit\= (n.= 0 size) (/.empty? sample))) + (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) = + (bit#= (/.empty? sample) + (# (/.equivalence n.equivalence) = sample /.empty))] (and empty_is_empty! @@ -87,8 +87,8 @@ (/.member? n.equivalence pushed non_member) has_expected_order! - (\ (list.equivalence n.equivalence) = - (list\composite (/.list sample) (list non_member)) + (# (list.equivalence n.equivalence) = + (list#composite (/.list sample) (list non_member)) (/.list pushed))] (and size_increases! new_member_is_identified! @@ -106,7 +106,7 @@ (not (/.member? n.equivalence popped target)) has_expected_order! - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected (/.list popped))] (and size_decreases! diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 807ee4fd5..06f2edef4 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -5,9 +5,9 @@ [abstract ["[0]" monad {"+" [do]}]] [control - ["[0]" maybe ("[1]\[0]" functor)]] + ["[0]" maybe ("[1]#[0]" functor)]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -31,7 +31,7 @@ (<| (_.covering /._) (_.for [/.Queue]) (do [! random.monad] - [size (\ ! each (n.% 100) random.nat) + [size (# ! each (n.% 100) random.nat) sample (..random size) non_member_priority random.nat non_member (random.only (|>> (/.member? n.equivalence sample) not) @@ -43,7 +43,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit\= (n.= 0 (/.size sample)) + (bit#= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? /.empty)) @@ -80,7 +80,7 @@ (/.end /.min min_member) (/.end /.max max_member) /.front - (maybe\each (n.= max_member)) + (maybe#each (n.= max_member)) (maybe.else false))) (_.cover [/.min] (|> /.empty @@ -88,7 +88,7 @@ (/.end /.min min_member) /.next /.front - (maybe\each (n.= min_member)) + (maybe#each (n.= min_member)) (maybe.else false))) )) )))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 17e1d8192..1e2180361 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -15,60 +15,60 @@ ["[0]" try {"+" [Try]}] ["[0]" exception]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]\[0]" mix)] + ["[0]" list ("[1]#[0]" mix)] ["[0]" set]]] [math ["[0]" random] [number ["n" nat]]]]] [\\library - ["[0]" / ("[1]\[0]" monad)]]) + ["[0]" / ("[1]#[0]" monad)]]) (def: signatures Test (do [! random.monad] - [size (\ ! each (n.% 100) random.nat)] + [size (# ! each (n.% 100) random.nat)] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.row size random.nat))) (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.row size random.nat))) (_.for [/.mix] - ($mix.spec /\in /.equivalence /.mix)) + ($mix.spec /#in /.equivalence /.mix)) (_.for [/.functor] - ($functor.spec /\in /.equivalence /.functor)) + ($functor.spec /#in /.equivalence /.functor)) (_.for [/.apply] - ($apply.spec /\in /.equivalence /.apply)) + ($apply.spec /#in /.equivalence /.apply)) (_.for [/.monad] - ($monad.spec /\in /.equivalence /.monad)) + ($monad.spec /#in /.equivalence /.monad)) ))) (def: whole Test (do [! random.monad] - [size (\ ! each (n.% 100) random.nat) + [size (# ! each (n.% 100) random.nat) sample (random.set n.hash size random.nat) .let [sample (|> sample set.list /.of_list)] - .let [(^open "/\[0]") (/.equivalence n.equivalence)]] + .let [(^open "/#[0]") (/.equivalence n.equivalence)]] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit\= (/.empty? sample) (n.= 0 (/.size sample)))) + (bit#= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.empty] (/.empty? /.empty)) (_.cover [/.list /.of_list] - (|> sample /.list /.of_list (/\= sample))) + (|> sample /.list /.of_list (/#= sample))) (_.cover [/.reversed] (or (n.< 2 (/.size sample)) (let [not_same! - (not (/\= sample + (not (/#= sample (/.reversed sample))) self_symmetry! - (/\= sample + (/#= sample (/.reversed (/.reversed sample)))] (and not_same! self_symmetry!)))) @@ -81,10 +81,10 @@ (def: index_based Test (do [! random.monad] - [size (\ ! each (|>> (n.% 100) ++) random.nat)] + [size (# ! each (|>> (n.% 100) ++) random.nat)] ($_ _.and (do ! - [good_index (|> random.nat (\ ! each (n.% size))) + [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) @@ -134,7 +134,7 @@ (<| (_.covering /._) (_.for [/.Row]) (do [! random.monad] - [size (\ ! each (|>> (n.% 100) ++) random.nat)] + [size (# ! each (|>> (n.% 100) ++) random.nat)] ($_ _.and ..signatures ..whole @@ -145,14 +145,14 @@ non_member (random.only (|>> (set.member? sample) not) random.nat) .let [sample (|> sample set.list /.of_list)] - .let [(^open "/\[0]") (/.equivalence n.equivalence)]] + .let [(^open "/#[0]") (/.equivalence n.equivalence)]] ($_ _.and (do ! [value/0 random.nat value/1 random.nat value/2 random.nat] (_.cover [/.row] - (/\= (/.of_list (list value/0 value/1 value/2)) + (/#= (/.of_list (list value/0 value/1 value/2)) (/.row value/0 value/1 value/2)))) (_.cover [/.member?] (and (list.every? (/.member? n.equivalence sample) @@ -180,7 +180,7 @@ (|> sample (/.suffix non_member) /.prefix - (/\= sample))] + (/#= sample))] (and expected_size! symmetry!)))) )) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 0d772e7dd..2c9a8aca5 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -13,7 +13,7 @@ ["[0]" text ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -25,7 +25,7 @@ (All (_ a) (-> (Equivalence a) (Equivalence (/.Sequence a)))) (def: (= reference subject) - (\ (list.equivalence super) = + (# (list.equivalence super) = (/.first 100 reference) (/.first 100 subject)))) @@ -42,12 +42,12 @@ Test (<| (_.covering /._) (_.for [/.Sequence]) - (let [(^open "list\[0]") (list.equivalence n.equivalence)]) + (let [(^open "list#[0]") (list.equivalence n.equivalence)]) (do [! random.monad] [repeated random.nat - index (\ ! each (n.% 100) random.nat) - size (\ ! each (|>> (n.% 10) ++) random.nat) - offset (\ ! each (n.% 100) random.nat) + index (# ! each (n.% 100) random.nat) + size (# ! each (|>> (n.% 10) ++) random.nat) + offset (# ! each (n.% 100) random.nat) cycle_start random.nat cycle_next (random.list size random.nat)] ($_ _.and @@ -63,38 +63,38 @@ (n.= repeated (/.item index (/.repeated repeated)))) (_.cover [/.first] - (list\= (enum.range n.enum offset (-- (n.+ size offset))) + (list#= (enum.range n.enum offset (-- (n.+ size offset))) (/.first size (..iterations ++ offset)))) (_.cover [/.after] - (list\= (enum.range n.enum offset (-- (n.+ size offset))) + (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)) + (and (list#= (enum.range n.enum 0 (-- size)) drops) - (list\= (enum.range n.enum size (-- (n.* 2 size))) + (list#= (enum.range n.enum size (-- (n.* 2 size))) (/.first size takes))))) (_.cover [/.while] - (list\= (enum.range n.enum 0 (-- size)) + (list#= (enum.range n.enum 0 (-- size)) (/.while (n.< size) (..iterations ++ 0)))) (_.cover [/.until] - (list\= (enum.range n.enum offset (-- (n.+ size offset))) + (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)) + (and (list#= (enum.range n.enum 0 (-- size)) drops) - (list\= (enum.range n.enum size (-- (n.* 2 size))) + (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)) + (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))) + (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))] @@ -103,16 +103,16 @@ (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))) + (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 (list& cycle_start cycle_next)] - (list\= (list.together (list.repeated size cycle)) + (list#= (list.together (list.repeated size cycle)) (/.first (n.* size (list.size cycle)) (/.cycle [cycle_start cycle_next]))))) (_.cover [/.^sequence&] diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 3745cf845..7cf9debe0 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -10,7 +10,7 @@ ["$[0]" hash] ["$[0]" monoid]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math @@ -18,11 +18,11 @@ [number ["n" nat]]]]] [\\library - ["[0]" / ("\[0]" equivalence)]]) + ["[0]" / ("#[0]" equivalence)]]) (def: gen_nat (Random Nat) - (\ random.monad each (n.% 100) + (# random.monad each (n.% 100) random.nat)) (def: .public test @@ -36,7 +36,7 @@ ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) (_.for [/.hash] (|> random.nat - (\ random.monad each (|>> list (/.of_list n.hash))) + (# 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))) @@ -52,7 +52,7 @@ (_.cover [/.empty] (/.empty? (/.empty n.hash))) (do ! - [hash (\ ! each (function (_ constant) + [hash (# ! each (function (_ constant) (: (Hash Nat) (implementation (def: &equivalence n.equivalence) @@ -65,10 +65,10 @@ (_.cover [/.size] (n.= sizeL (/.size setL))) (_.cover [/.empty?] - (bit\= (/.empty? setL) + (bit#= (/.empty? setL) (n.= 0 (/.size setL)))) (_.cover [/.list /.of_list] - (|> setL /.list (/.of_list n.hash) (\= setL))) + (|> setL /.list (/.of_list n.hash) (#= setL))) (_.cover [/.member?] (and (list.every? (/.member? setL) (/.list setL)) (not (/.member? setL non_memberL)))) @@ -89,12 +89,12 @@ (|> setL (/.has non_memberL) (/.lacks non_memberL) - (\= setL)) + (#= setL)) idempotency! (|> setL (/.lacks non_memberL) - (\= setL))] + (#= setL))] (and symmetry! idempotency!))) (_.cover [/.union /.sub?] @@ -107,7 +107,7 @@ union_with_empty_set! (|> setL (/.union (/.empty n.hash)) - (\= setL))] + (#= setL))] (and sets_are_subs_of_their_unions! union_with_empty_set!))) (_.cover [/.intersection /.super?] diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 2b614a1a4..b281e85bd 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -10,10 +10,10 @@ ["$[0]" equivalence] ["$[0]" hash]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" set] - ["[0]" list ("[1]\[0]" mix)]]] + ["[0]" list ("[1]#[0]" mix)]]] [math ["[0]" random {"+" [Random]}] [number @@ -23,14 +23,14 @@ (def: count (Random Nat) - (\ random.monad each (|>> (n.% 10) ++) random.nat)) + (# random.monad each (|>> (n.% 10) ++) random.nat)) (def: .public (random size hash count element) (All (_ a) (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a)))) (do [! random.monad] [elements (random.set hash size element) element_counts (random.list size ..count)] - (in (list\mix (function (_ [count element] set) + (in (list#mix (function (_ [count element] set) (/.has count element set)) (/.empty hash) (list.zipped/2 element_counts @@ -39,13 +39,13 @@ (def: signature Test (do [! random.monad] - [diversity (\ ! each (n.% 10) random.nat)] + [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) + (# random.monad each (function (_ single) (/.has 1 single (/.empty n.hash)))) ($hash.spec /.hash))) ))) @@ -53,7 +53,7 @@ (def: composition Test (do [! random.monad] - [diversity (\ ! each (n.% 10) random.nat) + [diversity (# ! each (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) another (..random diversity n.hash ..count random.nat)] (`` ($_ _.and @@ -113,24 +113,24 @@ (<| (_.covering /._) (_.for [/.Set]) (do [! random.monad] - [diversity (\ ! each (n.% 10) random.nat) + [diversity (# ! each (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) non_member (random.only (predicate.complement (set.member? (/.support sample))) random.nat) addition_count ..count - partial_removal_count (\ ! each (n.% addition_count) random.nat) + 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))) + (# /.equivalence = sample))) (_.cover [/.size] (n.= (list.size (/.list sample)) (/.size sample))) (_.cover [/.empty?] - (bit\= (/.empty? sample) + (bit#= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.empty] (/.empty? (/.empty n.hash))) @@ -159,7 +159,7 @@ (let [null_scenario! (|> sample (/.has 0 non_member) - (\ /.equivalence = sample)) + (# /.equivalence = sample)) normal_scenario! (let [sample+ (/.has addition_count non_member sample)] @@ -170,7 +170,7 @@ normal_scenario!))) (_.cover [/.lacks] (let [null_scenario! - (\ /.equivalence = + (# /.equivalence = (|> sample (/.has addition_count non_member)) (|> sample @@ -190,7 +190,7 @@ (|> sample (/.has addition_count non_member) (/.lacks addition_count non_member) - (\ /.equivalence = sample))] + (# /.equivalence = sample))] (and null_scenario! partial_scenario! total_scenario!))) @@ -202,12 +202,12 @@ (let [unary (|> sample /.support /.of_set)] (and (/.sub? sample unary) (or (not (/.sub? unary sample)) - (\ /.equivalence = sample unary))))) + (# /.equivalence = sample unary))))) (_.cover [/.super?] (let [unary (|> sample /.support /.of_set)] (and (/.super? unary sample) (or (not (/.super? sample unary)) - (\ /.equivalence = sample unary))))) + (# /.equivalence = sample unary))))) (_.cover [/.difference] (let [|sample| (/.support sample) |another| (/.support another) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 383c5c747..33ddfc89d 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -8,11 +8,11 @@ [\\specification ["$[0]" equivalence]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\library @@ -21,13 +21,13 @@ (def: size (random.Random Nat) - (\ random.monad each (n.% 100) random.nat)) + (# random.monad each (n.% 100) random.nat)) (def: .public (random size &order gen_value) (All (_ a) (-> Nat (Order a) (Random a) (Random (Set a)))) (case size 0 - (random\in (/.empty &order)) + (random#in (/.empty &order)) _ (do random.monad @@ -47,8 +47,8 @@ non_memberL (random.only (|>> (//.member? usetL) not) random.nat) .let [listL (//.list usetL)] - listR (|> (random.set n.hash sizeR random.nat) (\ ! each //.list)) - .let [(^open "/\[0]") /.equivalence + listR (|> (random.set n.hash sizeR random.nat) (# ! each //.list)) + .let [(^open "/#[0]") /.equivalence setL (/.of_list n.order listL) setR (/.of_list n.order listR) empty (/.empty n.order)]] @@ -59,18 +59,18 @@ (_.cover [/.size] (n.= sizeL (/.size setL))) (_.cover [/.empty?] - (bit\= (n.= 0 (/.size setL)) + (bit#= (n.= 0 (/.size setL)) (/.empty? setL))) (_.cover [/.empty] (/.empty? (/.empty n.order))) (_.cover [/.list] - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (/.list (/.of_list n.order listL)) - (list.sorted (\ n.order <) listL))) + (list.sorted (# n.order <) listL))) (_.cover [/.of_list] (|> setL /.list (/.of_list n.order) - (/\= setL))) + (/#= setL))) (~~ (template [<coverage> <comparison>] [(_.cover [<coverage>] (case (<coverage> setL) @@ -101,7 +101,7 @@ (|> setL (/.has non_memberL) (/.lacks non_memberL) - (\ /.equivalence = setL))) + (# /.equivalence = setL))) (_.cover [/.sub?] (let [self! (/.sub? setL setL) @@ -118,7 +118,7 @@ (/.super? empty setL) symmetry! - (bit\= (/.super? setL setR) + (bit#= (/.super? setL setR) (/.sub? setR setL))] (and self! empty! @@ -126,7 +126,7 @@ (~~ (template [<coverage> <relation> <empty?>] [(_.cover [<coverage>] (let [self! - (\ /.equivalence = + (# /.equivalence = setL (<coverage> setL setL)) @@ -135,12 +135,12 @@ (<relation> (<coverage> setL setR) setR)) empty! - (\ /.equivalence = + (# /.equivalence = (if <empty?> empty setL) (<coverage> setL empty)) idempotence! - (\ /.equivalence = + (# /.equivalence = (<coverage> setL (<coverage> setL setR)) (<coverage> setR (<coverage> setL setR)))] (and self! @@ -155,19 +155,19 @@ (let [self! (|> setL (/.difference setL) - (\ /.equivalence = empty)) + (# /.equivalence = empty)) empty! (|> setL (/.difference empty) - (\ /.equivalence = setL)) + (# /.equivalence = setL)) difference! (not (list.any? (/.member? (/.difference setL setR)) (/.list setL))) idempotence! - (\ /.equivalence = + (# /.equivalence = (/.difference setL setR) (/.difference setL (/.difference setL setR)))] (and self! diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 97e69923f..3ca1e508a 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -10,7 +10,7 @@ [control ["[0]" maybe]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random] [number @@ -27,7 +27,7 @@ (<| (_.covering /._) (_.for [/.Stack]) (do random.monad - [size (\ random.monad each (n.% 100) random.nat) + [size (# random.monad each (n.% 100) random.nat) sample (random.stack size random.nat) expected_top random.nat] ($_ _.and @@ -39,7 +39,7 @@ (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (bit\= (n.= 0 (/.size sample)) + (bit#= (n.= 0 (/.size sample)) (/.empty? sample))) (_.cover [/.empty] (/.empty? /.empty)) @@ -56,7 +56,7 @@ (/.empty? sample) {.#Some [top remaining]} - (\ (/.equivalence n.equivalence) = + (# (/.equivalence n.equivalence) = sample (/.top top remaining)))) (_.cover [/.top] diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index fef8c14f6..9cba03540 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -11,7 +11,7 @@ [data ["[0]" product] [collection - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [math ["[0]" random {"+" [Random]}] [number @@ -23,13 +23,13 @@ (All (_ a) (-> (Random a) (Random [Nat (Tree a)]))) (do [! random.monad] [value gen_value - num_children (\ ! each (n.% 2) random.nat) + num_children (# ! each (n.% 2) random.nat) children (random.list num_children (tree gen_value))] (in [(|> children - (list\each product.left) - (list\mix n.+ 1)) + (list#each product.left) + (list#mix n.+ 1)) [/.#value value - /.#children (list\each product.right children)]]))) + /.#children (list#each product.right children)]]))) (def: .public test Test @@ -38,7 +38,7 @@ ($_ _.and (_.for [/.equivalence] (|> (..tree random.nat) - (\ random.monad each product.right) + (# random.monad each product.right) ($equivalence.spec (/.equivalence n.equivalence)))) (_.for [/.mix] ($mix.spec /.leaf /.equivalence /.mix)) @@ -53,17 +53,17 @@ (do random.monad [expected random.nat] (_.cover [/.leaf] - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list expected) (/.flat (/.leaf expected))))) (do [! random.monad] [value random.nat - num_children (\ ! each (n.% 3) random.nat) + num_children (# ! each (n.% 3) random.nat) children (random.list num_children random.nat)] (_.cover [/.branch] - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list& value children) - (/.flat (/.branch value (list\each /.leaf children)))))) + (/.flat (/.branch value (list#each /.leaf children)))))) (do random.monad [expected/0 random.nat expected/1 random.nat @@ -72,15 +72,15 @@ expected/4 random.nat expected/5 random.nat] (_.cover [/.tree] - (and (\ (list.equivalence n.equivalence) = + (and (# (list.equivalence n.equivalence) = (list expected/0) (/.flat (/.tree expected/0))) - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list expected/0 expected/1 expected/2) (/.flat (/.tree expected/0 {expected/1 {} expected/2 {}}))) - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list expected/0 expected/1 expected/2 expected/3 expected/4 expected/5) (/.flat (/.tree expected/0 diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index e00a0773b..5285a8eca 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -5,11 +5,11 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" maybe ("[1]\[0]" functor)]] + ["[0]" maybe ("[1]#[0]" functor)]] [data - ["[0]" text ("[1]\[0]" equivalence monoid)] + ["[0]" text ("[1]#[0]" equivalence monoid)] [collection - ["[0]" list ("[1]\[0]" mix)]]] + ["[0]" list ("[1]#[0]" mix)]]] [math ["[0]" random] [number @@ -34,7 +34,7 @@ (_.for [/.Tree]) (do [! random.monad] [tag_left (random.ascii/alpha_num 1) - tag_right (random.only (|>> (text\= tag_left) not) + tag_right (random.only (|>> (text#= tag_left) not) (random.ascii/alpha_num 1)) expected_left random.nat expected_right random.nat] @@ -43,22 +43,22 @@ (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)))))) + (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)) + (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))) + (case (/.root (# ..builder branch + (# ..builder leaf tag_left expected_left) + (# ..builder leaf tag_right expected_right))) {.#Left _} false @@ -73,11 +73,11 @@ false)))) (_.cover [/.value] (and (n.= expected_left - (/.value (\ ..builder leaf tag_left 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)))))) + (/.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)] @@ -86,40 +86,40 @@ 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) + (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 = (list& tags/H tags/T) (/.tags tree)) - (\ values_equivalence = (list& values/H values/T) (/.values tree)))))) + (and (# tags_equivalence = (list& tags/H tags/T) (/.tags tree)) + (# values_equivalence = (list& values/H values/T) (/.values tree)))))) (_.cover [/.one] (let [can_find_correct_one! - (|> (\ ..builder leaf tag_left expected_left) + (|> (# ..builder leaf tag_left expected_left) (/.one (text.contains? tag_left)) - (maybe\each (n.= expected_left)) + (maybe#each (n.= expected_left)) (maybe.else false)) cannot_find_incorrect_one! - (|> (\ ..builder leaf tag_right expected_right) + (|> (# ..builder leaf tag_right expected_right) (/.one (text.contains? tag_left)) - (maybe\each (n.= expected_left)) + (maybe#each (n.= expected_left)) (maybe.else false) not) can_find_left! - (|> (\ ..builder branch - (\ ..builder leaf tag_left expected_left) - (\ ..builder leaf tag_right expected_right)) + (|> (# ..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#each (n.= expected_left)) (maybe.else false)) can_find_right! - (|> (\ ..builder branch - (\ ..builder leaf tag_left expected_left) - (\ ..builder leaf tag_right expected_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#each (n.= expected_right)) (maybe.else false))] (and can_find_correct_one! cannot_find_incorrect_one! @@ -128,23 +128,23 @@ (_.cover [/.exists?] (let [can_find_correct_one! (/.exists? (text.contains? tag_left) - (\ ..builder leaf tag_left expected_left)) + (# ..builder leaf tag_left expected_left)) cannot_find_incorrect_one! (not (/.exists? (text.contains? tag_left) - (\ ..builder leaf tag_right expected_right))) + (# ..builder leaf tag_right expected_right))) can_find_left! (/.exists? (text.contains? tag_left) - (\ ..builder branch - (\ ..builder leaf tag_left expected_left) - (\ ..builder leaf tag_right expected_right))) + (# ..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)))] + (# ..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! diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index f9308d080..bda2162f9 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -10,7 +10,7 @@ ["$[0]" comonad]]] [control pipe - ["[0]" maybe ("[1]\[0]" functor)]] + ["[0]" maybe ("[1]#[0]" functor)]] [data ["[0]" product] ["[0]" text] @@ -159,18 +159,18 @@ [[size sample] (//.tree random.nat) expected random.nat dummy (random.only (|>> (n.= expected) not) random.nat) - .let [(^open "tree\[0]") (tree.equivalence n.equivalence) - (^open "list\[0]") (list.equivalence n.equivalence)]] + .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)))) + ($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))) + (|> sample /.zipper /.tree (tree#= sample))) (_.cover [/.start?] (|> sample /.zipper /.start?)) (_.cover [/.leaf?] @@ -197,7 +197,7 @@ (|> sample /.zipper /.end - (maybe\each /.end?) + (maybe#each /.end?) (maybe.else false)))) (_.cover [/.interpose] (let [cursor (|> (tree.branch dummy (list (tree.leaf dummy))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 5069ab31f..cf2f1053c 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -26,7 +26,7 @@ (def: .public random (Random /.Color) (|> ($_ random.and random.nat random.nat random.nat) - (\ random.monad each /.of_rgb))) + (# random.monad each /.of_rgb))) (def: scale (-> Nat Frac) @@ -73,7 +73,7 @@ ($_ _.and (_.cover [/.RGB /.rgb /.of_rgb] (|> expected /.rgb /.of_rgb - (\ /.equivalence = expected))) + (# /.equivalence = expected))) (_.cover [/.HSL /.hsl /.of_hsl] (|> expected /.hsl /.of_hsl (distance/3 expected) @@ -131,15 +131,15 @@ Test (_.for [/.Spread /.Palette] (do [! random.monad] - [eH (\ ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) + [eH (# ! each (|>> f.abs (f.% +0.9) (f.+ +0.05)) random.safe_frac) .let [eS +0.5] - variations (\ ! each (|>> (n.% 3) (n.+ 2)) random.nat) + variations (# ! each (|>> (n.% 3) (n.+ 2)) random.nat) .let [max_spread (f./ (|> variations ++ .int int.frac) +1.0) min_spread (f./ +2.0 max_spread) spread_space (f.- min_spread max_spread)] - spread (\ ! each (|>> f.abs (f.% spread_space) (f.+ min_spread)) + spread (# ! each (|>> f.abs (f.% spread_space) (f.+ min_spread)) random.safe_frac)] (`` ($_ _.and (~~ (template [<brightness> <palette>] @@ -148,7 +148,7 @@ expected (/.of_hsb [eH eS eB]) palette (<palette> spread variations expected)] (and (n.= variations (list.size palette)) - (not (list.any? (\ /.equivalence = expected) palette)))))] + (not (list.any? (# /.equivalence = expected) palette)))))] [+1.0 /.analogous] [+0.5 /.monochromatic] )) @@ -156,9 +156,9 @@ [(_.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)))))] + (and (# /.equivalence = expected c0) + (not (# /.equivalence = expected c1)) + (not (# /.equivalence = expected c2)))))] [/.triad] [/.clash] @@ -167,10 +167,10 @@ [(_.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)))))] + (and (# /.equivalence = expected c0) + (not (# /.equivalence = expected c1)) + (not (# /.equivalence = expected c2)) + (not (# /.equivalence = expected c3)))))] [/.square] [/.tetradic])) @@ -195,12 +195,12 @@ (..encoding expected) (_.cover [/.complement] (let [~expected (/.complement expected) - (^open "/\[0]") /.equivalence] - (and (not (/\= expected ~expected)) - (/\= 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)))) + (and (# /.equivalence = /.white (/.complement /.black)) + (# /.equivalence = /.black (/.complement /.white)))) ..transformation ..palette (_.for [/.Alpha /.Pigment] diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 38b2b730f..939a95ffe 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -233,8 +233,8 @@ <colors>)) (_.cover [/.aqua] - (\ //.equivalence = /.cyan /.aqua)) + (# //.equivalence = /.cyan /.aqua)) (_.cover [/.fuchsia] - (\ //.equivalence = /.magenta /.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 f2ace808f..bb09a2f77 100644 --- a/stdlib/source/test/lux/data/format/binary.lux +++ b/stdlib/source/test/lux/data/format/binary.lux @@ -8,7 +8,7 @@ [\\specification ["$[0]" monoid]]] [data - ["[0]" binary ("[1]\[0]" equivalence)]] + ["[0]" binary ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}]]]] [\\library @@ -18,12 +18,12 @@ (Equivalence /.Specification) (def: (= reference subject) - (binary\= (/.instance reference) + (binary#= (/.instance reference) (/.instance subject)))) (def: random (Random /.Specification) - (\ random.monad each /.nat random.nat)) + (# random.monad each /.nat random.nat)) (def: .public test Test diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index f71def6fe..35381fc7a 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -9,7 +9,7 @@ ["$[0]" equivalence] ["$[0]" codec]]] [control - ["[0]" try ("[1]\[0]" functor)]] + ["[0]" try ("[1]#[0]" functor)]] [data ["[0]" product] ["[0]" bit] @@ -19,7 +19,7 @@ ["[0]" row] ["[0]" dictionary] ["[0]" set] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random {"+" [Random]}] [number @@ -29,16 +29,16 @@ ["[0]" syntax {"+" [syntax:]}] ["[0]" code]]]] [\\library - ["[0]" / {"+" [JSON]} ("\[0]" equivalence)]]) + ["[0]" / {"+" [JSON]} ("#[0]" equivalence)]]) (def: .public random (Random /.JSON) (random.rec (function (_ recur) (do [! random.monad] - [size (\ ! each (n.% 2) random.nat)] + [size (# ! each (n.% 2) random.nat)] ($_ random.or - (\ ! in []) + (# ! in []) random.bit random.safe_frac (random.unicode size) @@ -74,7 +74,7 @@ (do random.monad [sample ..random] (_.cover [/.Null /.null?] - (\ bit.equivalence = + (# bit.equivalence = (/.null? sample) (case sample {/.#Null} true @@ -84,21 +84,21 @@ (_.cover [/.format] (|> expected /.format - (\ /.codec decoded) - (try\each (\= expected)) + (# /.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))) + (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) + (# (list.equivalence text.equivalence) = + (list#each product.left expected) actual) {try.#Failure error} @@ -106,13 +106,13 @@ (_.cover [/.field] (list.every? (function (_ [key expected]) (|> (/.field key object) - (try\each (\= expected)) + (try#each (#= expected)) (try.else false))) expected)) )) (do random.monad [key (random.ascii/alpha 1) - unknown (random.only (|>> (\ text.equivalence = key) not) + unknown (random.only (|>> (# text.equivalence = key) not) (random.ascii/alpha 1)) expected random.safe_frac] (_.cover [/.has] @@ -122,7 +122,7 @@ .let [can_find_known_key! (|> object (/.field key) - (try\each (\= {/.#Number expected})) + (try#each (#= {/.#Number expected})) (try.else false)) cannot_find_unknown_key! @@ -141,7 +141,7 @@ (_.cover [<type> <field>] (|> (/.object (list [key {<tag> value}])) (<field> key) - (try\each (\ <equivalence> = value)) + (try#each (# <equivalence> = value)) (try.else false))))] [/.Boolean /.boolean_field /.#Boolean random.bit bit.equivalence] @@ -165,15 +165,15 @@ <key5> (string) <key6> (string)] (_.cover [/.json] - (and (\= {/.#Null} (/.json ())) + (and (#= {/.#Null} (/.json ())) (~~ (template [<tag> <value>] - [(\= {<tag> <value>} (/.json <value>))] + [(#= {<tag> <value>} (/.json <value>))] [/.#Boolean <boolean>] [/.#Number <number>] [/.#String <string>] )) - (\= {/.#Array <array_row>} (/.json [() <boolean> <number> <string>])) + (#= {/.#Array <array_row>} (/.json [() <boolean> <number> <string>])) (let [object (/.json {<key0> () <key1> <boolean> <key2> <number> @@ -189,11 +189,11 @@ 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_row>} value4) - (\= {/.#Number <number>} value6)))))) + (in (and (#= {/.#Null} value0) + (#= {/.#Boolean <boolean>} value1) + (#= {/.#Number <number>} value2) + (#= {/.#String <string>} value3) + (#= {/.#Array <array_row>} 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 1ed6821f6..4ada18f50 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -12,8 +12,8 @@ ["<b>" binary]]] [data ["[0]" product] - ["[0]" binary ("[1]\[0]" equivalence monoid)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" binary ("[1]#[0]" equivalence monoid)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}] [encoding ["[0]" utf8]] @@ -22,7 +22,7 @@ ["[1]/[0]" block]]] [collection ["[0]" row] - ["[0]" list ("[1]\[0]" mix)]] + ["[0]" list ("[1]#[0]" mix)]] ["[0]" format "_" ["[1]" binary]]] [time @@ -48,13 +48,13 @@ (_.cover [/.path /.from_path] (case (/.path expected) {try.#Success actual} - (text\= expected + (text#= expected (/.from_path actual)) {try.#Failure error} false)) (_.cover [/.no_path] - (text\= "" (/.from_path /.no_path))) + (text#= "" (/.from_path /.no_path))) (_.cover [/.path_size /.path_is_too_long] (case (/.path invalid) {try.#Success _} @@ -83,7 +83,7 @@ (_.cover [/.name /.from_name] (case (/.name expected) {try.#Success actual} - (text\= expected + (text#= expected (/.from_name actual)) {try.#Failure error} @@ -108,8 +108,8 @@ Test (_.for [/.Small] (do [! random.monad] - [expected (|> random.nat (\ ! each (n.% /.small_limit))) - invalid (|> random.nat (\ ! each (n.max /.small_limit)))] + [expected (|> random.nat (# ! each (n.% /.small_limit))) + invalid (|> random.nat (# ! each (n.max /.small_limit)))] (`` ($_ _.and (_.cover [/.small /.from_small] (case (/.small expected) @@ -132,8 +132,8 @@ Test (_.for [/.Big] (do [! random.monad] - [expected (|> random.nat (\ ! each (n.% /.big_limit))) - invalid (|> random.nat (\ ! each (n.max /.big_limit)))] + [expected (|> random.nat (# ! each (n.% /.big_limit))) + invalid (|> random.nat (# ! each (n.max /.big_limit)))] (`` ($_ _.and (_.cover [/.big /.from_big] (case (/.big expected) @@ -158,14 +158,14 @@ Test (do [! random.monad] [expected_path (random.ascii/lower (-- /.path_size)) - expected_moment (\ ! each (|>> (n.% 1,0,00,00,00,00,000) .int instant.of_millis) + expected_moment (# ! each (|>> (n.% 1,0,00,00,00,00,000) .int instant.of_millis) random.nat) chunk (random.ascii/lower chunk_size) - chunks (\ ! each (n.% 100) random.nat) + chunks (# ! each (n.% 100) random.nat) .let [content (|> chunk (list.repeated chunks) text.together - (\ utf8.codec encoded))]] + (# utf8.codec encoded))]] (`` ($_ _.and (~~ (template [<type> <tag>] [(_.cover [<type>] @@ -176,7 +176,7 @@ (<b>.result /.parser))] (in (case (row.list tar) (^ (list {<tag> actual_path})) - (text\= (/.from_path expected_path) + (text#= (/.from_path expected_path) (/.from_path actual_path)) _ @@ -207,11 +207,11 @@ (^ (list {<tag> [actual_path actual_moment actual_mode actual_ownership actual_content]})) (let [seconds (: (-> Instant Int) (|>> instant.relative (duration.ticks duration.second)))] - (and (text\= (/.from_path expected_path) + (and (text#= (/.from_path expected_path) (/.from_path actual_path)) (i.= (seconds expected_moment) (seconds actual_moment)) - (binary\= (/.data expected_content) + (binary#= (/.data expected_content) (/.data actual_content)))) _ @@ -245,7 +245,7 @@ (do [! random.monad] [path (random.ascii/lower 10) modes (random.list 4 ..random_mode) - .let [expected_mode (list\mix /.and /.none modes)]] + .let [expected_mode (list#mix /.and /.none modes)]] (`` ($_ _.and (_.cover [/.and] (|> (do try.monad @@ -353,9 +353,9 @@ (<b>.result /.parser))] (in (case (row.list tar) (^ (list {/.#Normal [_ _ _ actual_ownership _]})) - (and (text\= (/.from_name expected) + (and (text#= (/.from_name expected) (/.from_name (value@ [/.#user /.#name] actual_ownership))) - (text\= (/.from_name /.anonymous) + (text#= (/.from_name /.anonymous) (/.from_name (value@ [/.#group /.#name] actual_ownership)))) _ @@ -377,11 +377,11 @@ (<b>.result /.parser))] (in (case (row.list tar) (^ (list {/.#Normal [_ _ _ actual_ownership _]})) - (and (text\= (/.from_name /.anonymous) + (and (text#= (/.from_name /.anonymous) (/.from_name (value@ [/.#user /.#name] actual_ownership))) (n.= (/.from_small /.no_id) (/.from_small (value@ [/.#user /.#id] actual_ownership))) - (text\= (/.from_name /.anonymous) + (text#= (/.from_name /.anonymous) (/.from_name (value@ [/.#group /.#name] actual_ownership))) (n.= (/.from_small /.no_id) (/.from_small (value@ [/.#group /.#id] actual_ownership)))) @@ -402,11 +402,11 @@ (|> row.empty (format.result /.writer) (<b>.result /.parser) - (\ try.monad each row.empty?) + (# try.monad each row.empty?) (try.else false))) (_.cover [/.invalid_end_of_archive] (let [dump (format.result /.writer row.empty)] - (case (<b>.result /.parser (binary\composite dump dump)) + (case (<b>.result /.parser (binary#composite dump dump)) {try.#Success _} false diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 27f2e76a5..e6772262f 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -15,13 +15,13 @@ ["</>" xml]]] [data ["[0]" name] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" dictionary] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\library @@ -36,13 +36,13 @@ (def: char (Random Nat) (do [! random.monad] - [idx (|> random.nat (\ ! each (n.% (text.size char_range))))] + [idx (|> random.nat (# ! each (n.% (text.size char_range))))] (in (maybe.trusted (text.char idx char_range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) (let [constraint (|>> (n.% top) (n.max bottom))] - (random\each constraint random.nat))) + (random#each constraint random.nat))) (def: (text bottom top) (-> Nat Nat (Random Text)) @@ -81,7 +81,7 @@ (`` ($_ _.and (~~ (template [<type> <format>] [(_.cover [<type> <format>] - (and (text\= name (<format> ["" name])) + (and (text#= name (<format> ["" name])) (let [identifier (<format> identifier)] (and (text.starts_with? namespace identifier) (text.ends_with? name identifier)))))] diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index dd9171e99..76761b0ae 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -12,7 +12,7 @@ [control pipe] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -30,12 +30,12 @@ (<| (_.covering /._) (do [! random.monad] [... First Name - sizeM1 (|> random.nat (\ ! each (n.% 100))) - sizeS1 (|> random.nat (\ ! each (|>> (n.% 100) (n.max 1)))) + sizeM1 (|> random.nat (# ! each (n.% 100))) + sizeS1 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..random sizeM1 sizeS1) ... Second Name - sizeM2 (|> random.nat (\ ! each (n.% 100))) - sizeS2 (|> random.nat (\ ! each (|>> (n.% 100) (n.max 1)))) + sizeM2 (|> random.nat (# ! each (n.% 100))) + sizeS2 (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) (^@ name2 [module2 short2]) (..random sizeM2 sizeS2)] (_.for [.Name] ($_ _.and @@ -43,27 +43,27 @@ ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) (_.for [/.hash] (|> (random.ascii 1) - (\ ! each (|>> [""])) + (# ! each (|>> [""])) ($hash.spec /.hash))) (_.for [/.order] ($order.spec /.order (..random sizeM1 sizeS1))) (_.for [/.codec] (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) - (let [(^open "/\[0]") /.codec] + (let [(^open "/#[0]") /.codec] (_.test "Encoding an name without a module component results in text equal to the short of the name." (if (text.empty? module1) - (text\= short1 (/\encoded name1)) + (text#= short1 (/#encoded name1)) #1))))) (_.cover [/.module /.short] (and (same? module1 (/.module name1)) (same? short1 (/.short name1)))) (_.for [.name_of] - (let [(^open "/\[0]") /.equivalence] + (let [(^open "/#[0]") /.equivalence] ($_ _.and (_.test "Can obtain Name from identifier." - (and (/\= [.prelude_module "yolo"] (.name_of .yolo)) - (/\= ["test/lux/data/name" "yolo"] (.name_of ..yolo)) - (/\= ["" "yolo"] (.name_of yolo)) - (/\= ["library/lux/test" "yolo"] (.name_of library/lux/test.yolo))))))) + (and (/#= [.prelude_module "yolo"] (.name_of .yolo)) + (/#= ["test/lux/data/name" "yolo"] (.name_of ..yolo)) + (/#= ["" "yolo"] (.name_of yolo)) + (/#= ["library/lux/test" "yolo"] (.name_of library/lux/test.yolo))))))) ))))) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 38b0dad48..c4e666117 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -32,9 +32,9 @@ 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]))))) + (n.= (n.+ (# i.hash hash left) + (# n.hash hash right)) + (# hash hash [left right]))))) (<| (_.cover [/.left]) (n.= expected (/.left [expected dummy]))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 353c6f6c2..761bda10c 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -11,7 +11,7 @@ [data ["[0]" text] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -36,10 +36,10 @@ right random.nat] (_.cover [/.hash] (let [hash (/.hash i.hash n.hash)] - (and (n.= (\ i.hash hash left) - (\ hash hash {.#Left left})) - (n.= (\ n.hash hash right) - (\ hash hash {.#Right right})))))) + (and (n.= (# i.hash hash left) + (# hash hash {.#Left left})) + (n.= (# n.hash hash right) + (# hash hash {.#Right right})))))) (_.cover [/.left] (|> (/.left expected) @@ -70,39 +70,39 @@ (/.then (n.+ shift) (n.- shift)) (case> {0 #1 actual} (n.= (n.- shift expected) actual) _ false)))) (do ! - [size (\ ! each (n.% 5) random.nat) + [size (# ! each (n.% 5) random.nat) expected (random.list size random.nat)] ($_ _.and (_.cover [/.lefts] (let [actual (: (List (Or Nat Nat)) - (list\each /.left expected))] - (and (\ (list.equivalence n.equivalence) = + (list#each /.left expected))] + (and (# (list.equivalence n.equivalence) = expected (/.lefts actual)) - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list) (/.rights actual))))) (_.cover [/.rights] (let [actual (: (List (Or Nat Nat)) - (list\each /.right expected))] - (and (\ (list.equivalence n.equivalence) = + (list#each /.right expected))] + (and (# (list.equivalence n.equivalence) = expected (/.rights actual)) - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = (list) (/.lefts actual))))) (_.cover [/.partition] (let [[lefts rights] (|> expected - (list\each (function (_ value) + (list#each (function (_ value) (if (n.even? value) (/.left value) (/.right value)))) (: (List (Or Nat Nat))) /.partition)] - (and (\ (list.equivalence n.equivalence) = + (and (# (list.equivalence n.equivalence) = (list.only n.even? expected) lefts) - (\ (list.equivalence n.equivalence) = + (# (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 b53d4b83b..ff8ed74dd 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -34,12 +34,12 @@ (def: bounded_size (random.Random Nat) (|> random.nat - (\ random.monad each (|>> (n.% 20) (n.+ 1))))) + (# random.monad each (|>> (n.% 20) (n.+ 1))))) (def: size Test (do [! random.monad] - [size (\ ! each (n.% 10) random.nat) + [size (# ! each (n.% 10) random.nat) sample (random.unicode size)] ($_ _.and (_.cover [/.size] @@ -52,11 +52,11 @@ Test (do [! random.monad] [inner (random.unicode 1) - outer (random.only (|>> (\ /.equivalence = inner) not) + outer (random.only (|>> (# /.equivalence = inner) not) (random.unicode 1)) left (random.unicode 1) right (random.unicode 1) - .let [full (\ /.monoid composite inner outer) + .let [full (# /.monoid composite inner outer) fake_index (-- 0)]] (`` ($_ _.and (~~ (template [<affix> <predicate>] @@ -81,23 +81,23 @@ Test (do [! random.monad] [inner (random.unicode 1) - outer (random.only (|>> (\ /.equivalence = inner) not) + outer (random.only (|>> (# /.equivalence = inner) not) (random.unicode 1)) .let [fake_index (-- 0)]] ($_ _.and (_.cover [/.contains?] - (let [full (\ /.monoid composite inner outer)] + (let [full (# /.monoid composite inner outer)] (and (/.contains? inner full) (/.contains? outer full)))) (_.cover [/.index] - (and (|> (/.index inner (\ /.monoid composite inner outer)) + (and (|> (/.index inner (# /.monoid composite inner outer)) (maybe.else fake_index) (n.= 0)) - (|> (/.index outer (\ /.monoid composite inner outer)) + (|> (/.index outer (# /.monoid composite inner outer)) (maybe.else fake_index) (n.= 1)))) (_.cover [/.index_since] - (let [full (\ /.monoid composite inner outer)] + (let [full (# /.monoid composite inner outer)] (and (|> (/.index_since 0 inner full) (maybe.else fake_index) (n.= 0)) @@ -115,7 +115,7 @@ (maybe.else fake_index) (n.= fake_index))))) (_.cover [/.last_index] - (let [full ($_ (\ /.monoid composite) outer inner outer)] + (let [full ($_ (# /.monoid composite) outer inner outer)] (and (|> (/.last_index inner full) (maybe.else fake_index) (n.= 1)) @@ -131,7 +131,7 @@ (`` ($_ _.and (~~ (template [<short> <long>] [(_.cover [<short> <long>] - (\ /.equivalence = <short> <long>))] + (# /.equivalence = <short> <long>))] [/.\0 /.null] [/.\a /.alarm] @@ -143,13 +143,13 @@ [/.\r /.carriage_return] [/.\'' /.double_quote])) (_.cover [/.line_feed] - (\ /.equivalence = /.new_line /.line_feed)) + (# /.equivalence = /.new_line /.line_feed)) ))) (do [! random.monad] - [size (\ ! each (|>> (n.% 10) ++) random.nat) + [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)] + expected (# ! each (n.% size) random.nat)] (_.cover [/.char] (case (/.char expected sample) {.#Some char} @@ -178,13 +178,13 @@ (def: manipulation Test (do [! random.monad] - [size (\ ! each (|>> (n.% 10) (n.+ 2)) random.nat) + [size (# ! each (|>> (n.% 10) (n.+ 2)) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) separator (random.only (|>> (set.member? characters) not) (random.ascii/alpha 1)) .let [with_no_separator (|> characters set.list /.together)] static (random.ascii/alpha 1) - .let [dynamic (random.only (|>> (\ /.equivalence = static) not) + .let [dynamic (random.only (|>> (# /.equivalence = static) not) (random.ascii/alpha 1))] pre dynamic post dynamic @@ -200,19 +200,19 @@ (/.interposed separator) (/.all_split_by separator) (set.of_list /.hash) - (\ set.equivalence = characters)) - (\ /.equivalence = + (# set.equivalence = characters)) + (# /.equivalence = (/.together (set.list characters)) (/.interposed "" (set.list characters))))) (_.cover [/.replaced/1] - (\ /.equivalence = - (\ /.monoid composite post static) - (/.replaced/1 pre post (\ /.monoid composite pre static)))) + (# /.equivalence = + (# /.monoid composite post static) + (/.replaced/1 pre post (# /.monoid composite pre static)))) (_.cover [/.split_by] - (case (/.split_by static ($_ (\ /.monoid composite) pre static post)) + (case (/.split_by static ($_ (# /.monoid composite) pre static post)) {.#Some [left right]} - (and (\ /.equivalence = pre left) - (\ /.equivalence = post right)) + (and (# /.equivalence = pre left) + (# /.equivalence = post right)) {.#None} false)) @@ -220,19 +220,19 @@ (let [effectiveness! (|> upper /.lower_cased - (\ /.equivalence = upper) + (# /.equivalence = upper) not) idempotence! (|> lower /.lower_cased - (\ /.equivalence = lower)) + (# /.equivalence = lower)) inverse! (|> lower /.upper_cased /.lower_cased - (\ /.equivalence = lower))] + (# /.equivalence = lower))] (and effectiveness! idempotence! inverse!))) @@ -240,19 +240,19 @@ (let [effectiveness! (|> lower /.upper_cased - (\ /.equivalence = lower) + (# /.equivalence = lower) not) idempotence! (|> upper /.upper_cased - (\ /.equivalence = upper)) + (# /.equivalence = upper)) inverse! (|> upper /.lower_cased /.upper_cased - (\ /.equivalence = upper))] + (# /.equivalence = upper))] (and effectiveness! idempotence! inverse!))) @@ -286,14 +286,14 @@ sampleR (random.unicode sizeR) middle (random.unicode 1) .let [sample (/.together (list sampleL sampleR)) - (^open "/\[0]") /.equivalence]] + (^open "/#[0]") /.equivalence]] ($_ _.and (_.cover [/.split_at] (|> (/.split_at sizeL sample) (case> {.#Right [_l _r]} - (and (/\= sampleL _l) - (/\= sampleR _r) - (/\= sample (/.together (list _l _r)))) + (and (/#= sampleL _l) + (/#= sampleR _r) + (/#= sample (/.together (list _l _r)))) _ #0))) @@ -303,10 +303,10 @@ (/.clip_since sizeL sample) (/.clip_since 0 sample)] (case> [{.#Right _l} {.#Right _r} {.#Right _r'} {.#Right _f}] - (and (/\= sampleL _l) - (/\= sampleR _r) - (/\= _r _r') - (/\= sample _f)) + (and (/#= sampleL _l) + (/#= sampleR _r) + (/#= _r _r') + (/#= sample _f)) _ #0))) @@ -317,7 +317,7 @@ .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))))] + 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) @@ -325,9 +325,9 @@ parts (random.list sizeL part_gen) .let [sample1 (/.together (list.interposed sep1 parts)) sample2 (/.together (list.interposed sep2 parts)) - (^open "/\[0]") /.equivalence]] + (^open "/#[0]") /.equivalence]] (_.cover [/.replaced] - (/\= sample2 + (/#= sample2 (/.replaced sep1 sep2 sample1)))) /buffer.test diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux index 72a9c7912..018ce9a22 100644 --- a/stdlib/source/test/lux/data/text/buffer.lux +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -5,7 +5,7 @@ [abstract [monad {"+" [do]}]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random {"+" [Random]}] @@ -17,7 +17,7 @@ (def: part (Random Text) (do [! random.monad] - [size (\ ! each (|>> (n.% 10) ++) random.nat)] + [size (# ! each (|>> (n.% 10) ++) random.nat)] (random.ascii/alpha size))) (def: .public test @@ -35,7 +35,7 @@ (n.= (text.size left) (/.size (/.then left /.empty)))) (_.cover [/.text] - (text\= (format left mid right) + (text#= (format left mid right) (|> /.empty (/.then left) (/.then mid) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index fab8f3c06..2644c2e43 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -10,9 +10,9 @@ ["[0]" maybe] ["[0]" try]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection - ["[0]" list ("[1]\[0]" mix)] + ["[0]" list ("[1]#[0]" mix)] ["[0]" set]]] [macro ["[0]" template]] @@ -193,7 +193,7 @@ (list.together (list <named>))) (def: unique_encodings - (list\mix (function (_ encoding set) + (list#mix (function (_ encoding set) (set.has (/.name encoding) set)) (set.empty text.hash) ..all_encodings)) @@ -214,7 +214,7 @@ (Random /.Encoding) (let [options (list.size ..all_encodings)] (do [! random.monad] - [choice (\ ! each (n.% options) random.nat)] + [choice (# ! each (n.% options) random.nat)] (in (maybe.trusted (list.item choice ..all_encodings)))))) (def: .public test diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index edce881aa..43dde1c22 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -12,8 +12,8 @@ [parser ["<[0]>" code]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text {"+" [Char]} ("[1]\[0]" equivalence) + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text {"+" [Char]} ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" set {"+" [Set]}]]] @@ -34,7 +34,7 @@ (def: (range max min) (-> Char Char (Random Char)) (let [range (n.- min max)] - (\ random.monad each + (# random.monad each (|>> (n.% range) (n.+ min)) random.nat))) @@ -93,7 +93,7 @@ [/.\n] [/.\v] [/.\f] [/.\r] [/.\''] [/.\\]))) (/.escapable? ascii) - (bit\= (/.escapable? ascii) + (bit#= (/.escapable? ascii) (or (n.< (debug.private /.ascii_bottom) ascii) (n.> (debug.private /.ascii_top) ascii))))))) (do random.monad @@ -106,15 +106,15 @@ (let [escaped (/.escaped expected)] (case (/.un_escaped escaped) {try.#Success un_escaped} - (and (not (text\= escaped expected)) - (text\= un_escaped expected)) + (and (not (text#= escaped expected)) + (text#= un_escaped expected)) {try.#Failure error} false)) - (text\= expected (/.escaped expected)))))) + (text#= expected (/.escaped expected)))))) (do [! random.monad] [dummy (|> (random.char unicode.character) - (\ ! each text.of_char))] + (# ! each text.of_char))] (_.cover [/.dangling_escape] (case (/.un_escaped (format (/.escaped dummy) "\")) {try.#Success _} @@ -125,7 +125,7 @@ (do [! random.monad] [dummy (|> (random.char unicode.character) (random.only (|>> (set.member? ..valid_sigils) not)) - (\ ! each text.of_char))] + (# ! each text.of_char))] (_.cover [/.invalid_escape] (case (/.un_escaped (format "\" dummy)) {try.#Success _} @@ -135,10 +135,10 @@ (exception.match? /.invalid_escape error)))) (do [! random.monad] [too_short (|> (random.char unicode.character) - (\ ! each (n.% (hex "1000")))) + (# ! each (n.% (hex "1000")))) code (|> (random.unicode 4) (random.only (function (_ code) - (case (\ n.hex decoded code) + (case (# n.hex decoded code) {try.#Failure error} true {try.#Success _} false))))] (_.cover [/.invalid_unicode_escape] @@ -149,9 +149,9 @@ {try.#Failure error} (exception.match? /.invalid_unicode_escape error))]] - (and (!invalid (\ n.hex encoded too_short)) + (and (!invalid (# n.hex encoded too_short)) (!invalid code))))) (_.cover [/.literal] (with_expansions [<example> (..static_sample)] - (text\= <example> (`` (/.literal (~~ (..static_escaped <example>))))))) + (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 14883a7ff..2bfc7a74e 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -11,14 +11,14 @@ [control ["[0]" try]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] ["[0]" bit] ["[0]" name] [format ["[0]" xml] ["[0]" json]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] ["[0]" time ["[0]" day] ["[0]" month] @@ -26,7 +26,7 @@ ["[0]" duration] ["[0]" date]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] ["[0]" modulus] ["[0]" modular] [number @@ -56,17 +56,17 @@ (All (_ a) (-> a (Equivalence (/.Format a)))) (def: (= reference subject) - (text\= (reference example) (subject example)))) + (text#= (reference example) (subject example)))) (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]) + (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 @@ -76,7 +76,7 @@ [(do random.monad [sample <random>] (_.cover [<format>] - (text\= (\ <codec> encoded sample) + (text#= (# <codec> encoded sample) (<format> sample))))] [/.bit bit.codec random.bit] @@ -135,14 +135,14 @@ mid (random.unicode 5) right (random.unicode 5)] (_.cover [/.format] - (text\= (/.format left mid right) + (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) + (text#= (<alias> sample) (<format> sample))))] [/.text text.format (random.unicode 5)] @@ -157,9 +157,9 @@ (do random.monad [members (random.list 5 random.nat)] (_.cover [/.list] - (text\= (/.list /.nat members) + (text#= (/.list /.nat members) (|> members - (list\each /.nat) + (list#each /.nat) (text.interposed " ") list (/.list (|>>)))))) @@ -177,9 +177,9 @@ [modulus (random.one (|>> modulus.modulus try.maybe) random.int) - sample (\ ! each (modular.modular modulus) + sample (# ! each (modular.modular modulus) random.int)] (_.cover [/.mod] - (text\= (\ (modular.codec modulus) encoded sample) + (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 cb766f27b..cfc58a897 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -11,7 +11,7 @@ ["<[0]>" text {"+" [Parser]}] ["<[0]>" code]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] ["[0]" macro [syntax {"+" [syntax:]}] @@ -27,7 +27,7 @@ (|> input (<text>.result regex) (case> {try.#Success parsed} - (text\= parsed input) + (text#= parsed input) _ #0))) @@ -37,7 +37,7 @@ (|> input (<text>.result regex) (case> {try.#Success parsed} - (text\= test parsed) + (text#= test parsed) _ false))) @@ -305,9 +305,9 @@ (case (format sample1 "-" sample2 "-" sample3) (/.^regex "(.{3})-(.{3})-(.{4})" [_ match1 match2 match3]) - (and (text\= sample1 match1) - (text\= sample2 match2) - (text\= sample3 match3)) + (and (text#= sample1 match1) + (text#= sample2 match2) + (text#= sample3 match3)) _ false))) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index e0325be7b..e01250a30 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -25,8 +25,8 @@ (def: .public random (Random /.Block) (do [! random.monad] - [start (\ ! each (n.% 1,000,000) random.nat) - additional (\ ! each (n.% 1,000,000) random.nat)] + [start (# ! each (n.% 1,000,000) random.nat) + additional (# ! each (n.% 1,000,000) random.nat)] (in (/.block start additional)))) (with_expansions [<blocks> (as_is [blocks/0 @@ -173,12 +173,12 @@ [.let [top_start (hex "AC00") top_end (hex "D7AF") end_range (n.- top_start top_end)] - start (\ ! each (|>> (n.% top_start) ++) random.nat) - end (\ ! each (|>> (n.% end_range) (n.+ top_start)) random.nat) + start (# ! each (|>> (n.% top_start) ++) random.nat) + end (# ! each (|>> (n.% end_range) (n.+ top_start)) random.nat) .let [additional (n.- start end) sample (/.block start additional) size (/.size sample)] - inside (\ ! each + inside (# ! each (|>> (n.% size) (n.+ (/.start sample))) random.nat)] diff --git a/stdlib/source/test/lux/data/text/unicode/set.lux b/stdlib/source/test/lux/data/text/unicode/set.lux index ae3fbed65..fe145fd50 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -8,9 +8,9 @@ ["$[0]" equivalence]]] [data ["[0]" product] - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection - ["[0]" set ("[1]\[0]" equivalence)]]] + ["[0]" set ("[1]#[0]" equivalence)]]] [math ["[0]" random {"+" [Random]}] [number @@ -36,7 +36,7 @@ (_.for [/.Set]) (do [! random.monad] [block //block.random - inside (\ ! each + inside (# ! each (|>> (n.% (block.size block)) (n.+ (block.start block))) random.nat) @@ -62,7 +62,7 @@ (block.end right)) (/.end (/.set [left (list right)])))) (_.cover [/.member?] - (bit\= (block.within? block inside) + (bit#= (block.within? block inside) (/.member? (/.set [block (list)]) inside))) (_.cover [/.composite] (let [composed (/.composite (/.set [left (list)]) diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux index d912904ec..4a229b335 100644 --- a/stdlib/source/test/lux/debug.lux +++ b/stdlib/source/test/lux/debug.lux @@ -6,15 +6,15 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception] [parser ["<[0]>" code]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor)]] + ["[0]" list ("[1]#[0]" functor)]] [format [json {"+" [JSON]}] [xml {"+" [XML]}]]] @@ -59,7 +59,7 @@ sample_rev random.rev] (in (`` (and (~~ (template [<type> <format> <sample>] [(|> (/.representation <type> <sample>) - (try\each (text\= (<format> <sample>))) + (try#each (text#= (<format> <sample>))) (try.else false))] [Bit %.bit sample_bit] @@ -79,7 +79,7 @@ (in (`` (and (case (/.representation (type [Bit Int Frac]) [sample_bit sample_int sample_frac]) {try.#Success actual} - (text\= (format "[" (%.bit sample_bit) + (text#= (format "[" (%.bit sample_bit) " " (%.int sample_int) " " (%.frac sample_frac) "]") @@ -92,7 +92,7 @@ ... [(|> (/.representation (type (Or Bit Int Frac)) ... (: (Or Bit Int Frac) ... (<lefts> <right?> <value>))) - ... (try\each (text\= (format "(" (%.nat <lefts>) + ... (try#each (text#= (format "(" (%.nat <lefts>) ... " " (%.bit <right?>) ... " " (<format> <value>) ")"))) ... (try.else false))] @@ -115,7 +115,7 @@ sample_json $//json.random] (in (`` (and (~~ (template [<type> <format> <sample>] [(|> (/.representation <type> <sample>) - (try\each (text\= (<format> <sample>))) + (try#each (text#= (<format> <sample>))) (try.else false))] [Ratio %.ratio sample_ratio] @@ -138,7 +138,7 @@ sample_day random.day] (in (`` (and (~~ (template [<type> <format> <sample>] [(|> (/.representation <type> <sample>) - (try\each (text\= (<format> <sample>))) + (try#each (text#= (<format> <sample>))) (try.else false))] [Instant %.instant sample_instant] @@ -169,14 +169,14 @@ can_represent_time_types! (|> (/.representation .Any sample_frac) - (try\each (text\= "[]")) + (try#each (text#= "[]")) (try.else false)) (|> (/.representation (type (List Nat)) (: (List Nat) (list sample_nat))) - (try\each (text\= (%.list %.nat (list sample_nat)))) + (try#each (text#= (%.list %.nat (list sample_nat)))) (try.else false)) (~~ (template [<sample>] [(|> (/.representation (type (Maybe Nat)) (: (Maybe Nat) <sample>)) - (try\each (text\= (%.maybe %.nat <sample>))) + (try#each (text#= (%.maybe %.nat <sample>))) (try.else false))] [{.#Some sample_nat}] @@ -201,16 +201,16 @@ sample_text (random.ascii/upper 10)] (_.cover [/.inspection] (`` (and (~~ (template [<format> <sample>] - [(text\= (<format> <sample>) (/.inspection <sample>))] + [(text#= (<format> <sample>) (/.inspection <sample>))] [%.bit sample_bit] [%.int sample_int] [%.frac sample_frac] [%.text sample_text] )) - (text\= (|> (list sample_bit sample_int sample_frac sample_text) + (text#= (|> (list sample_bit sample_int sample_frac sample_text) (: (List Any)) - (list\each /.inspection) + (list#each /.inspection) (text.interposed " ") (text.enclosed ["[" "]"])) (/.inspection [sample_bit sample_int sample_frac sample_text])) diff --git a/stdlib/source/test/lux/documentation.lux b/stdlib/source/test/lux/documentation.lux index 2d651be8e..f46fb8abc 100644 --- a/stdlib/source/test/lux/documentation.lux +++ b/stdlib/source/test/lux/documentation.lux @@ -9,7 +9,7 @@ [parser ["<[0]>" code]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format]] [format ["md" markdown]]] @@ -30,7 +30,7 @@ false)))]})) (syntax: (description []) - (\ meta.monad each + (# meta.monad each (|>> %.nat code.text list) meta.seed)) @@ -56,11 +56,11 @@ (^ (list definition)) (and (|> definition (value@ /.#definition) - (text\= (template.text [g!default]))) + (text#= (template.text [g!default]))) (|> definition (value@ /.#documentation) md.markdown - (text\= "") + (text#= "") not)) _ @@ -70,7 +70,7 @@ (^ (list documentation:)) (and (|> documentation: (value@ /.#definition) - (text\= (template.text [/.documentation:]))) + (text#= (template.text [/.documentation:]))) (|> documentation: (value@ /.#documentation) md.markdown diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 20b1a5357..80134f010 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -20,11 +20,11 @@ ["<[0]>" synthesis]]] [data ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" row] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -64,7 +64,7 @@ (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) - (\ ! each (|>> {analysis.#Extension self}))))) + (# ! each (|>> {analysis.#Extension self}))))) (synthesis: (..my_synthesis self phase archive [pass_through <analysis>.any]) (phase archive pass_through)) @@ -74,28 +74,28 @@ (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) - (\ ! each (|>> {analysis.#Extension self}))))) + (# ! each (|>> {analysis.#Extension self}))))) (synthesis: (..my_generation self phase archive [parameters (<>.some <analysis>.any)]) (let [! phase.monad] (|> parameters (monad.each ! (phase archive)) - (\ ! each (|>> {synthesis.#Extension self}))))) + (# ! each (|>> {synthesis.#Extension self}))))) (generation: (..my_generation self phase archive [pass_through <synthesis>.any]) (for [@.jvm - (\ phase.monad each (|>> {jvm.#Embedded} row.row) + (# phase.monad each (|>> {jvm.#Embedded} row.row) (phase archive pass_through))] (phase archive pass_through))) (analysis: (..dummy_generation self phase archive []) - (\ phase.monad in {analysis.#Extension self (list)})) + (# phase.monad in {analysis.#Extension self (list)})) (synthesis: (..dummy_generation self phase archive []) - (\ phase.monad in {synthesis.#Extension self (list)})) + (# phase.monad in {synthesis.#Extension self (list)})) (generation: (..dummy_generation self phase archive []) - (\ phase.monad in + (# phase.monad in (for [@.jvm (row.row {jvm.#Constant {jvm.#LDC {jvm.#String self}}}) @@ -135,7 +135,7 @@ false] (and (n.= expected (`` ((~~ (static ..my_generation)) expected))) - (text\= ..dummy_generation + (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 15b278176..d51c3c1c7 100644 --- a/stdlib/source/test/lux/ffi.js.lux +++ b/stdlib/source/test/lux/ffi.js.lux @@ -7,8 +7,8 @@ [control ["[0]" try]] [data - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -46,9 +46,9 @@ Test (do [! random.monad] [boolean random.bit - number (\ ! each (|>> (nat.% 100) nat.frac) random.nat) + number (# ! each (|>> (nat.% 100) nat.frac) random.nat) string (random.ascii 5) - function (\ ! each (function (_ shift) + function (# ! each (function (_ shift) (: (-> Nat Nat) (nat.+ shift))) random.nat) @@ -105,24 +105,24 @@ (and (or /.on_nashorn? /.on_node_js? /.on_browser?) - (bit\= /.on_nashorn? + (bit#= /.on_nashorn? (not (or /.on_node_js? /.on_browser?))) - (bit\= /.on_node_js? + (bit#= /.on_node_js? (not (or /.on_nashorn? /.on_browser?))) - (bit\= /.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)))) + (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 + (text#= string (cond /.on_nashorn? (let [binary (java/lang/String::getBytes [encoding] (:as java/lang/String string))] (|> (java/lang/String::new [binary encoding]) diff --git a/stdlib/source/test/lux/ffi.jvm.lux b/stdlib/source/test/lux/ffi.jvm.lux index e94c61b39..f3feb2b75 100644 --- a/stdlib/source/test/lux/ffi.jvm.lux +++ b/stdlib/source/test/lux/ffi.jvm.lux @@ -2,7 +2,7 @@ [library [lux "*" ["_" test {"+" [Test]}] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] ["[0]" meta] [abstract [monad {"+" [do]}]] @@ -13,8 +13,8 @@ [parser ["<[0]>" code]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" array {"+" [Array]}]]] @@ -26,8 +26,8 @@ ["[0]" random {"+" [Random]}] [number ["n" nat] - ["i" int ("[1]\[0]" equivalence)] - ["f" frac ("[1]\[0]" equivalence)]]]]] + ["i" int ("[1]#[0]" equivalence)] + ["f" frac ("[1]#[0]" equivalence)]]]]] [\\library ["[0]" /]]) @@ -48,14 +48,14 @@ (<=> (:as <lux> (<conversion> left)) (:as <lux> (<conversion> right))))] - [boolean\= /.Boolean <| Bit bit\=] - [byte\= /.Byte /.byte_to_long Int i\=] - [short\= /.Short /.short_to_long Int i\=] - [integer\= /.Integer /.int_to_long Int i\=] - [long\= /.Long <| Int i\=] - [float\= /.Float /.float_to_double Frac f\=] - [double\= /.Double <| Frac f\=] - [character\= /.Character /.char_to_long Int i\=] + [boolean#= /.Boolean <| Bit bit#=] + [byte#= /.Byte /.byte_to_long Int i#=] + [short#= /.Short /.short_to_long Int i#=] + [integer#= /.Integer /.int_to_long Int i#=] + [long#= /.Long <| Int i#=] + [float#= /.Float /.float_to_double Frac f#=] + [double#= /.Double <| Frac f#=] + [character#= /.Character /.char_to_long Int i#=] ) (syntax: (macro_error [expression <code>.any]) @@ -71,13 +71,13 @@ (def: for_conversions Test (do [! random.monad] - [long (\ ! each (|>> (:as /.Long)) random.int) - integer (\ ! each (|>> (:as /.Long) /.long_to_int) random.int) - byte (\ ! each (|>> (:as /.Long) /.long_to_byte) random.int) - short (\ ! each (|>> (:as /.Long) /.long_to_short) random.int) + [long (# ! each (|>> (:as /.Long)) random.int) + integer (# ! each (|>> (:as /.Long) /.long_to_int) random.int) + byte (# ! each (|>> (:as /.Long) /.long_to_byte) random.int) + short (# ! each (|>> (:as /.Long) /.long_to_short) random.int) float (|> random.frac (random.only (|>> f.not_a_number? not)) - (\ ! each (|>> (:as /.Double) /.double_to_float)))] + (# ! each (|>> (:as /.Double) /.double_to_float)))] (`` ($_ _.and (~~ (template [<sample> <=> <to> <from>] [(_.cover [<to> <from>] @@ -85,30 +85,30 @@ (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] + [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 (do [! random.monad] - [size (|> random.nat (\ ! each (|>> (n.% 100) (n.max 1)))) - idx (|> random.nat (\ ! each (n.% size))) - value (\ ! each (|>> (:as java/lang/Long)) random.int)] + [size (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) + idx (|> random.nat (# ! each (n.% size))) + value (# ! each (|>> (:as java/lang/Long)) random.int)] ($_ _.and (_.cover [/.array /.length] (|> size @@ -132,21 +132,21 @@ (def: for_miscellaneous Test (`` (do [! random.monad] - [sample (\ ! each (|>> (:as java/lang/Object)) + [sample (# ! each (|>> (:as java/lang/Object)) (random.ascii 1)) - boolean (\ ! each (|>> (:as /.Boolean)) random.bit) - byte (\ ! each (|>> (:as /.Long) /.long_to_byte) random.int) - short (\ ! each (|>> (:as /.Long) /.long_to_short) random.int) - integer (\ ! each (|>> (:as /.Long) /.long_to_int) random.int) - long (\ ! each (|>> (:as /.Long)) random.int) + boolean (# ! each (|>> (:as /.Boolean)) random.bit) + byte (# ! each (|>> (:as /.Long) /.long_to_byte) random.int) + short (# ! each (|>> (:as /.Long) /.long_to_short) random.int) + integer (# ! each (|>> (:as /.Long) /.long_to_int) random.int) + long (# ! each (|>> (:as /.Long)) random.int) float (|> random.frac (random.only (|>> f.not_a_number? not)) - (\ ! each (|>> (:as /.Double) /.double_to_float))) + (# ! each (|>> (:as /.Double) /.double_to_float))) double (|> random.frac (random.only (|>> f.not_a_number? not)) - (\ ! each (|>> (:as /.Double)))) - character (\ ! each (|>> (:as /.Long) /.long_to_int /.int_to_char) random.int) - string (\ ! each (|>> (:as java/lang/String)) + (# ! each (|>> (:as /.Double)))) + character (# ! each (|>> (:as /.Long) /.long_to_int /.int_to_char) random.int) + string (# ! each (|>> (:as java/lang/String)) (random.ascii 1))] ($_ _.and (_.cover [/.check] @@ -157,7 +157,7 @@ (_.cover [/.synchronized] (/.synchronized sample #1)) (_.cover [/.class_for] - (text\= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class)))) + (text#= "java.lang.Class" (java/lang/Class::getName (/.class_for java/lang/Class)))) (_.cover [/.null /.null?] (and (/.null? (/.null)) (not (/.null? sample)))) @@ -188,14 +188,14 @@ (<=> <value>) (_.cover [<object> <primitive>]))] - [/.Boolean /.boolean boolean boolean\=] - [/.Byte /.byte byte byte\=] - [/.Short /.short short short\=] - [/.Integer /.int integer integer\=] - [/.Long /.long long long\=] - [/.Float /.float float float\=] - [/.Double /.double double double\=] - [/.Character /.char character character\=] + [/.Boolean /.boolean boolean boolean#=] + [/.Byte /.byte byte byte#=] + [/.Short /.short short short#=] + [/.Integer /.int integer integer#=] + [/.Long /.long long long#=] + [/.Float /.float float float#=] + [/.Double /.double double double#=] + [/.Character /.char character character#=] )) (_.cover [/.cannot_cast_to_non_object] (text.contains? (value@ exception.#label /.cannot_cast_to_non_object) @@ -205,22 +205,22 @@ (/.:as 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))))) + (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 @@ -553,7 +553,7 @@ (test/TestInterface4::actual4 left right right object/8)))] .let [random_long (: (Random java/lang/Long) - (\ ! each (|>> (:as java/lang/Long)) + (# ! each (|>> (:as java/lang/Long)) random.int))] dummy/0 random_long dummy/1 random_long diff --git a/stdlib/source/test/lux/ffi.old.lux b/stdlib/source/test/lux/ffi.old.lux index 9a1e0de54..294106143 100644 --- a/stdlib/source/test/lux/ffi.old.lux +++ b/stdlib/source/test/lux/ffi.old.lux @@ -8,7 +8,7 @@ [control [pipe {"+" [case>]}]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [macro ["[0]" template]] @@ -18,7 +18,7 @@ ["n" nat] ["i" int] ["f" frac]]] - ["[0]" type ("[1]\[0]" equivalence)]]] + ["[0]" type ("[1]#[0]" equivalence)]]] [\\library ["[0]" /]]) @@ -89,13 +89,13 @@ Test (do [! random.monad] [long random.int - int (\ ! each (|>> /.long_to_int) random.int) - char (\ ! each (|>> /.long_to_int /.int_to_char) random.int) + int (# ! each (|>> /.long_to_int) random.int) + char (# ! each (|>> /.long_to_int /.int_to_char) random.int) double (|> random.frac (random.only (|>> f.not_a_number? not))) float (|> random.frac (random.only (|>> f.not_a_number? not)) - (\ ! each (|>> /.double_to_float)))] + (# ! each (|>> /.double_to_float)))] (`` ($_ _.and (~~ (template [<=> <sample> <to> <from>] [(_.cover [<to> <from>] @@ -156,8 +156,8 @@ (def: arrays Test (do [! random.monad] - [size (|> random.nat (\ ! each (|>> (n.% 100) (n.max 1)))) - idx (|> random.nat (\ ! each (n.% size))) + [size (|> random.nat (# ! each (|>> (n.% 100) (n.max 1)))) + idx (|> random.nat (# ! each (n.% size))) value random.int] ($_ _.and (_.cover [/.array /.length] @@ -206,7 +206,7 @@ (_.cover [/.class_for /.import:] (|> (/.class_for java/lang/Class) java/lang/Class::getName - (text\= "java.lang.Class"))) + (text#= "java.lang.Class"))) (_.cover [/.class: /.do_to] (|> (/.do_to (test/lux/ffi/TestClass::new increase counter) (test/lux/ffi/TestClass::upC) @@ -222,9 +222,9 @@ test/lux/ffi/TestInterface::current (i.= (i.+ increase counter)))) (_.cover [/.type] - (and (type\= (primitive "java.lang.Char") + (and (type#= (primitive "java.lang.Char") (/.type java/lang/Char)) - (type\= (primitive "java.util.List" [(primitive "java.lang.Byte")]) + (type#= (primitive "java.util.List" [(primitive "java.lang.Byte")]) (/.type (java/util/List java/lang/Byte))))) ))) diff --git a/stdlib/source/test/lux/ffi.php.lux b/stdlib/source/test/lux/ffi.php.lux index a63bdcfea..23af523ba 100644 --- a/stdlib/source/test/lux/ffi.php.lux +++ b/stdlib/source/test/lux/ffi.php.lux @@ -7,7 +7,7 @@ [control ["[0]" try]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number diff --git a/stdlib/source/test/lux/ffi.scm.lux b/stdlib/source/test/lux/ffi.scm.lux index a63bdcfea..23af523ba 100644 --- a/stdlib/source/test/lux/ffi.scm.lux +++ b/stdlib/source/test/lux/ffi.scm.lux @@ -7,7 +7,7 @@ [control ["[0]" try]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux index e2214512c..02e482b41 100644 --- a/stdlib/source/test/lux/locale.lux +++ b/stdlib/source/test/lux/locale.lux @@ -8,9 +8,9 @@ ["$[0]" equivalence] ["$[0]" hash]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["[0]" encoding {"+" [Encoding]}]] [collection ["[0]" list]]]]] @@ -24,18 +24,18 @@ (def: random_language (Random Language) - (random.either (random\in language.afar) - (random\in language.zaza))) + (random.either (random#in language.afar) + (random#in language.zaza))) (def: random_territory (Random Territory) - (random.either (random\in territory.afghanistan) - (random\in territory.zimbabwe))) + (random.either (random#in territory.afghanistan) + (random#in territory.zimbabwe))) (def: random_encoding (Random Encoding) - (random.either (random\in encoding.ascii) - (random\in encoding.koi8_u))) + (random.either (random#in encoding.ascii) + (random#in encoding.koi8_u))) (def: random_locale (Random /.Locale) @@ -59,15 +59,15 @@ fixed_encoding ..random_encoding] ($_ _.and (|> ..random_language - (\ ! each (function (_ language) + (# ! each (function (_ language) (/.locale language {.#Some fixed_territory} {.#Some fixed_encoding}))) ($hash.spec /.hash)) (|> ..random_territory - (\ ! each (function (_ territory) + (# ! each (function (_ territory) (/.locale fixed_language {.#Some territory} {.#Some fixed_encoding}))) ($hash.spec /.hash)) (|> ..random_encoding - (\ ! each (function (_ encoding) + (# ! each (function (_ encoding) (/.locale fixed_language {.#Some fixed_territory} {.#Some encoding}))) ($hash.spec /.hash)) ))) @@ -80,7 +80,7 @@ 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) + .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))) diff --git a/stdlib/source/test/lux/locale/language.lux b/stdlib/source/test/lux/locale/language.lux index ba19738dc..fd6d93b90 100644 --- a/stdlib/source/test/lux/locale/language.lux +++ b/stdlib/source/test/lux/locale/language.lux @@ -13,7 +13,7 @@ ["[0]" text] [collection ["[0]" set {"+" [Set]}] - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [macro ["[0]" template]] [math @@ -38,8 +38,8 @@ languages (: (List /.Language) (`` (list (~~ (template.spliced <languages>)))))] [#amount amount - #names (|> languages (list\each /.name) (set.of_list text.hash)) - #codes (|> languages (list\each /.code) (set.of_list text.hash)) + #names (|> languages (list#each /.name) (set.of_list text.hash)) + #codes (|> languages (list#each /.code) (set.of_list text.hash)) #languages (set.of_list /.hash languages) #test (_.cover <languages> true)]))] @@ -189,7 +189,7 @@ (Hash a) (List Bundle) [Nat (Set a)])) - (list\mix (function (_ bundle [amount set]) + (list#mix (function (_ bundle [amount set]) [(n.+ amount (value@ #amount bundle)) (set.union set (lens bundle))]) [0 (set.empty hash)] @@ -199,8 +199,8 @@ Test (|> ..languages list.reversed - (list\each (value@ #test)) - (list\mix _.and + (list#each (value@ #test)) + (list#mix _.and (`` ($_ _.and (~~ (template [<lens> <tag> <hash>] [(let [[amount set] (..aggregate (value@ <tag>) <hash> ..languages)] @@ -215,7 +215,7 @@ (template: (!aliases <reference> <aliases>) [(_.cover <aliases> - (list.every? (\ /.equivalence = <reference>) + (list.every? (# /.equivalence = <reference>) (`` (list (~~ (template.spliced <aliases>))))))]) (def: aliases_test/0 @@ -279,10 +279,10 @@ (def: .public random (Random /.Language) (let [options (|> ..languages - (list\each (|>> (value@ #languages) set.list)) + (list#each (|>> (value@ #languages) set.list)) list.together)] (do [! random.monad] - [choice (\ ! each (n.% (list.size options)) + [choice (# ! each (n.% (list.size options)) random.nat)] (in (maybe.trusted (list.item choice options)))))) diff --git a/stdlib/source/test/lux/locale/territory.lux b/stdlib/source/test/lux/locale/territory.lux index 825d54f7e..724f43388 100644 --- a/stdlib/source/test/lux/locale/territory.lux +++ b/stdlib/source/test/lux/locale/territory.lux @@ -13,7 +13,7 @@ ["[0]" text] [collection ["[0]" set {"+" [Set]}] - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [macro ["[0]" template]] [math @@ -39,10 +39,10 @@ (let [amount (template.amount <territories>) territories (`` (list (~~ (template.spliced <territories>))))] [#amount amount - #names (|> territories (list\each /.name) (set.of_list text.hash)) - #shorts (|> territories (list\each /.short_code) (set.of_list text.hash)) - #longs (|> territories (list\each /.long_code) (set.of_list text.hash)) - #numbers (|> territories (list\each /.numeric_code) (set.of_list n.hash)) + #names (|> territories (list#each /.name) (set.of_list text.hash)) + #shorts (|> territories (list#each /.short_code) (set.of_list text.hash)) + #longs (|> territories (list#each /.long_code) (set.of_list text.hash)) + #numbers (|> territories (list#each /.numeric_code) (set.of_list n.hash)) #territories (|> territories (set.of_list /.hash)) #test (_.cover <territories> true)]))] @@ -144,7 +144,7 @@ (Hash a) (List Bundle) [Nat (Set a)])) - (list\mix (function (_ bundle [amount set]) + (list#mix (function (_ bundle [amount set]) [(n.+ amount (value@ #amount bundle)) (set.union set (lens bundle))]) [0 (set.empty hash)] @@ -154,8 +154,8 @@ Test (|> ..territories list.reversed - (list\each (value@ #test)) - (list\mix _.and + (list#each (value@ #test)) + (list#mix _.and (`` ($_ _.and (~~ (template [<lens> <tag> <hash>] [(let [[amount set] (..aggregate (value@ <tag>) <hash> ..territories)] @@ -172,7 +172,7 @@ (template: (!aliases <reference> <aliases>) [(_.cover <aliases> - (list.every? (\ /.equivalence = <reference>) + (list.every? (# /.equivalence = <reference>) (`` (list (~~ (template.spliced <aliases>))))))]) (def: aliases_test @@ -205,10 +205,10 @@ (def: .public random (Random /.Territory) (let [options (|> ..territories - (list\each (|>> (value@ #territories) set.list)) + (list#each (|>> (value@ #territories) set.list)) list.together)] (do [! random.monad] - [choice (\ ! each (n.% (list.size options)) + [choice (# ! each (n.% (list.size options)) random.nat)] (in (maybe.trusted (list.item choice options)))))) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index db57938a1..d4bc81738 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -5,11 +5,11 @@ [abstract [monad {"+" [do]}]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" code]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" name] ["[0]" text ["%" format {"+" [format]}]] @@ -24,7 +24,7 @@ [\\library ["[0]" / [syntax {"+" [syntax:]}] - ["[0]" code ("[1]\[0]" equivalence)] + ["[0]" code ("[1]#[0]" equivalence)] ["[0]" template]]] ["[0]" / "_" ["[1][0]" code] @@ -105,9 +105,9 @@ (do [! random.monad] [[seed identifier_prefix lux] ..random_lux - pow/1 (\ ! each code.nat random.nat) + pow/1 (# ! each code.nat random.nat) - repetitions (\ ! each (nat.% 10) random.nat) + repetitions (# ! each (nat.% 10) random.nat) .let [single_expansion (` (..pow/2 (..pow/2 (~ pow/1)))) expansion (` (nat.* (..pow/2 (~ pow/1)) (..pow/2 (~ pow/1)))) @@ -118,18 +118,18 @@ [(_.cover [<expander>] (|> (<expander> (` (..pow/4 (~ pow/1)))) (meta.result lux) - (try\each (\ (list.equivalence code.equivalence) = + (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#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#each (# (list.equivalence code.equivalence) = (list <expansion>))) (try.else false))))] [/.single_expansion /.log_single_expansion! single_expansion] @@ -137,7 +137,7 @@ [/.full_expansion /.log_full_expansion! full_expansion] )) (_.cover [/.one_expansion] - (bit\= (not (nat.= 1 repetitions)) + (bit#= (not (nat.= 1 repetitions)) (|> (/.one_expansion (` (..repeated (~ (code.nat repetitions)) (~ pow/1)))) (meta.result lux) (!expect {try.#Failure _})))) @@ -152,7 +152,7 @@ ($_ _.and (_.cover [/.identifier] (|> (/.identifier identifier_prefix) - (\ meta.monad each %.code) + (# meta.monad each %.code) (meta.result lux) (!expect (^multi {try.#Success actual_identifier} (and (text.contains? identifier_prefix actual_identifier) @@ -166,7 +166,7 @@ (_.cover [/.with_identifiers] (with_expansions [<expected> (fresh_identifier)] (|> (/.with_identifiers [<expected>] - (\ meta.monad in <expected>)) + (# meta.monad in <expected>)) (meta.result lux) (!expect (^multi {try.#Success [_ {.#Identifier ["" actual]}]} (text.contains? (template.text [<expected>]) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 96657f706..20d6741c3 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -12,9 +12,9 @@ ["[0]" product] ["[0]" text] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]] [meta @@ -38,7 +38,7 @@ (def: (random_sequence random) (All (_ a) (-> (Random a) (Random (List a)))) (do [! random.monad] - [size (|> random.nat (\ ! each (n.% 3)))] + [size (|> random.nat (# ! each (n.% 3)))] (random.list size random))) (def: .public random @@ -46,16 +46,16 @@ (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 /.identifier ..random_name) - (random\each /.form (..random_sequence random)) - (random\each /.variant (..random_sequence random)) - (random\each /.tuple (..random_sequence random)) + (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 /.identifier ..random_name) + (random#each /.form (..random_sequence random)) + (random#each /.variant (..random_sequence random)) + (random#each /.tuple (..random_sequence random)) )))) (def: (read source_code) @@ -80,20 +80,20 @@ (function (_ to_code) (do [! random.monad] [parts (..random_sequence replacement_simulation)] - (in [(to_code (list\each product.left parts)) - (to_code (list\each product.right parts))]))))] + (in [(to_code (list#each product.left parts)) + (to_code (list#each product.right parts))]))))] ($_ random.either - (random\in [original substitute]) + (random#in [original substitute]) (do [! random.monad] - [sample (random.only (|>> (\ /.equivalence = original) not) + [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 /.identifier ..random_name)))] + (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 /.identifier ..random_name)))] (in [sample sample])) (for_sequence /.form) (for_sequence /.variant) @@ -109,13 +109,13 @@ (_.cover [<coverage>] (and (case (..read (/.format (<coverage> expected))) {try.#Success actual} - (\ /.equivalence = + (# /.equivalence = actual (<coverage> expected)) {try.#Failure error} false) - (\ /.equivalence = + (# /.equivalence = [location.dummy {<tag> expected}] (<coverage> expected)))))] @@ -135,13 +135,13 @@ (_.cover [<coverage>] (and (case (..read (/.format (<coverage> expected))) {try.#Success actual} - (\ /.equivalence = + (# /.equivalence = actual (<coverage> expected)) {try.#Failure error} false) - (\ /.equivalence = + (# /.equivalence = [location.dummy {<tag> ["" expected]}] (<coverage> expected))) ))] @@ -161,13 +161,13 @@ (do [! random.monad] [[original substitute] (random.only (function (_ [original substitute]) - (not (\ /.equivalence = original substitute))) + (not (# /.equivalence = original substitute))) (random.and ..random ..random)) [sample expected] (random.only (function (_ [sample expected]) - (not (\ /.equivalence = sample expected))) + (not (# /.equivalence = sample expected))) (..replacement_simulation [original substitute]))] (_.cover [/.replaced] - (\ /.equivalence = + (# /.equivalence = expected (/.replaced original substitute sample)))) ))) diff --git a/stdlib/source/test/lux/macro/syntax/check.lux b/stdlib/source/test/lux/macro/syntax/check.lux index 0b315092e..baf86ac5b 100644 --- a/stdlib/source/test/lux/macro/syntax/check.lux +++ b/stdlib/source/test/lux/macro/syntax/check.lux @@ -13,7 +13,7 @@ [math ["[0]" random {"+" [Random]}]] [macro - ["[0]" code ("[1]\[0]" equivalence)]]]] + ["[0]" code ("[1]#[0]" equivalence)]]]] [\\library ["[0]" /]] ["$[0]" /// "_" @@ -44,5 +44,5 @@ false {try.#Success check} - (and (code\= type (value@ /.#type check)) - (code\= value (value@ /.#value check))))))))) + (and (code#= type (value@ /.#type check)) + (code#= value (value@ /.#value check))))))))) diff --git a/stdlib/source/test/lux/macro/syntax/declaration.lux b/stdlib/source/test/lux/macro/syntax/declaration.lux index f4dbee84b..9102faed6 100644 --- a/stdlib/source/test/lux/macro/syntax/declaration.lux +++ b/stdlib/source/test/lux/macro/syntax/declaration.lux @@ -23,7 +23,7 @@ ($_ random.and word (do [! random.monad] - [size (\ ! each (n.% 10) random.nat)] + [size (# ! each (n.% 10) random.nat)] (random.list size word)) ))) @@ -44,4 +44,4 @@ false {try.#Success actual} - (\ /.equivalence = expected 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 d6881c287..4b1057c64 100644 --- a/stdlib/source/test/lux/macro/syntax/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/definition.lux @@ -12,7 +12,7 @@ ["<>" parser ["<[0]>" code]]] [macro - ["[0]" code ("[1]\[0]" equivalence)]] + ["[0]" code ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}]] [meta @@ -73,7 +73,7 @@ false {try.#Success actual} - (\ /.equivalence = expected actual))) + (# /.equivalence = expected actual))) (_.cover [/.typed] (let [expected (with@ /.#value {.#Left [type untyped_value]} expected)] (case (<code>.result (/.typed compiler) @@ -82,7 +82,7 @@ false {try.#Success actual} - (\ /.equivalence = expected actual)))) + (# /.equivalence = expected actual)))) (_.cover [/.lacks_type] (let [expected (with@ /.#value {.#Right untyped_value} expected)] (case (<code>.result (/.typed compiler) diff --git a/stdlib/source/test/lux/macro/syntax/export.lux b/stdlib/source/test/lux/macro/syntax/export.lux index 0dcc94f69..91707f1ab 100644 --- a/stdlib/source/test/lux/macro/syntax/export.lux +++ b/stdlib/source/test/lux/macro/syntax/export.lux @@ -6,11 +6,11 @@ [monad {"+" [do]}]] [control ["[0]" maybe] - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" code]]] [macro - ["[0]" code ("[1]\[0]" equivalence)]] + ["[0]" code ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -22,7 +22,7 @@ (Random [(Maybe Code) Nat]) ($_ random.and (|> random.bit - (\ random.monad each code.bit) + (# random.monad each code.bit) random.maybe) random.nat)) @@ -39,9 +39,9 @@ {.#None} (list (code.nat expected_un_exported))) (<code>.result (/.parser <code>.nat)) - (try\each (function (_ [actual_export_policy actual_un_exported]) + (try#each (function (_ [actual_export_policy actual_un_exported]) (|> expected_export_policy (maybe.else /.default_policy) - (code\= actual_export_policy) + (code#= actual_export_policy) (and (n.= expected_un_exported actual_un_exported))))) (try.else false)))))) diff --git a/stdlib/source/test/lux/macro/syntax/input.lux b/stdlib/source/test/lux/macro/syntax/input.lux index 9ac7d311b..26e721986 100644 --- a/stdlib/source/test/lux/macro/syntax/input.lux +++ b/stdlib/source/test/lux/macro/syntax/input.lux @@ -45,4 +45,4 @@ false {try.#Success actual} - (\ (list.equivalence /.equivalence) = (list expected) 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 f08398725..329ed3557 100644 --- a/stdlib/source/test/lux/macro/syntax/type/variable.lux +++ b/stdlib/source/test/lux/macro/syntax/type/variable.lux @@ -7,7 +7,7 @@ [\\specification ["$[0]" equivalence]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] [parser ["<[0]>" code]]] [math @@ -32,6 +32,6 @@ (_.cover [/.format /.parser] (|> (list (/.format expected)) (<code>.result /.parser) - (try\each (\ /.equivalence = expected)) + (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 dd0a8ef06..655b70602 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -50,7 +50,7 @@ <short>' "abc#0#12+3-4.5"] ($_ _.and (_.cover [/.spliced] - (\ (list.equivalence nat.equivalence) = + (# (list.equivalence nat.equivalence) = (list left mid right) (`` (list (~~ (/.spliced [left mid right])))))) (_.cover [/.amount] diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 02eac6b3e..17f53064b 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -37,7 +37,7 @@ ($_ _.and (do [! random.monad] [.let [~= (f.approximately? ..margin_of_error)] - angle (|> random.safe_frac (\ ! each (f.* /.tau)))] + angle (|> random.safe_frac (# ! each (f.* /.tau)))] ($_ _.and (_.cover [/.sin /.asin] (trigonometric_symmetry /.sin /.asin angle)) @@ -61,7 +61,7 @@ (~= (f./ +2.0 /.tau) /.pi)) )) (do [! random.monad] - [sample (|> random.safe_frac (\ ! each (f.* +1000.0)))] + [sample (|> random.safe_frac (# ! each (f.* +1000.0)))] ($_ _.and (_.cover [/.ceil] (let [ceil'd (/.ceil sample)] @@ -91,8 +91,8 @@ )) (do [! random.monad] [.let [~= (f.approximately? ..margin_of_error)] - sample (\ ! each (f.* +10.0) random.safe_frac) - power (\ ! each (|>> (n.% 10) ++ n.frac) random.nat)] + sample (# ! each (f.* +10.0) random.safe_frac) + power (# ! each (|>> (n.% 10) ++ n.frac) random.nat)] ($_ _.and (_.cover [/.exp /.log] (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample))) @@ -107,9 +107,9 @@ )) (do [! random.monad] [.let [~= (f.approximately? ..margin_of_error)] - angle (\ ! each (f.* /.tau) random.safe_frac) - sample (\ ! each f.abs random.safe_frac) - big (\ ! each (f.* +1,000,000,000.00) random.safe_frac)] + angle (# ! each (f.* /.tau) random.safe_frac) + sample (# ! each f.abs random.safe_frac) + big (# ! each (f.* +1,000,000,000.00) random.safe_frac)] (template.let [(odd! <function>) [(_.cover [<function>] (~= (f.opposite (<function> angle)) @@ -137,8 +137,8 @@ (inverse! /.atanh /.acoth big) ))) (do [! random.monad] - [x (\ ! each (|>> (f.* +10.0) f.abs) random.safe_frac) - y (\ ! each (|>> (f.* +10.0) f.abs) random.safe_frac)] + [x (# ! each (|>> (f.* +10.0) f.abs) random.safe_frac) + y (# ! each (|>> (f.* +10.0) f.abs) random.safe_frac)] (_.cover [/.hypotenuse] (let [h (/.hypotenuse x y)] (and (f.>= x h) @@ -146,8 +146,8 @@ (do [! random.monad] [.let [~= (f.approximately? ..margin_of_error) tau/4 (f./ +4.0 /.tau)] - x (\ ! each (f.* tau/4) random.safe_frac) - y (\ ! each (f.* tau/4) random.safe_frac)] + x (# ! each (f.* tau/4) random.safe_frac) + y (# ! each (f.* tau/4) random.safe_frac)] (_.cover [/.atan/2] (let [expected (/.atan/2 x y) actual (if (f.> +0.0 x) @@ -160,7 +160,7 @@ (~= (f.opposite tau/4) (/.atan/2 +0.0 (f.opposite (f.abs y)))) (f.not_a_number? (/.atan/2 +0.0 +0.0)))))) (do [! random.monad] - [of (\ ! each (|>> (n.% 10) ++) random.nat)] + [of (# ! each (|>> (n.% 10) ++) random.nat)] (_.cover [/.factorial] (and (n.= 1 (/.factorial 0)) (|> (/.factorial of) (n.% of) (n.= 0))))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index 158135874..3b1532d75 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -5,7 +5,7 @@ [abstract [monad {"+" [do]}]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random] [number @@ -46,7 +46,7 @@ (/.infix [(n.* parameter subject) n.gcd extra])) non_numeric! - (bit\= (and (n.< parameter subject) (n.< extra parameter)) + (bit#= (and (n.< parameter subject) (n.< extra parameter)) (/.infix [[subject n.< parameter] and [parameter n.< extra]]))] (and constant_values! unary_functions! diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index 65474ff58..55a79cda9 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -9,7 +9,7 @@ [functor ["$[0]" contravariant]]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" list] ["[0]" set]]] @@ -39,9 +39,9 @@ (do [! random.monad] [sample random.rev - threshold_0 (\ ! each (r.% .5) + threshold_0 (# ! each (r.% .5) random.rev) - threshold_1 (\ ! each (|>> (r.% .5) (r.+ .5)) + threshold_1 (# ! each (|>> (r.% .5) (r.+ .5)) random.rev) .let [bottom (r.min threshold_0 threshold_1) @@ -89,7 +89,7 @@ [bottom middle_bottom middle_top top] (|> random.rev (random.set r.hash 4) - (\ ! each (|>> set.list (list.sorted r.<))) + (# ! each (|>> set.list (list.sorted r.<))) (random.one (function (_ thresholds) (case thresholds (^ (list threshold_0 threshold_1 threshold_2 threshold_3)) @@ -173,7 +173,7 @@ [bottom middle_bottom middle_top top] (|> random.rev (random.set r.hash 4) - (\ ! each (|>> set.list (list.sorted r.<))) + (# ! each (|>> set.list (list.sorted r.<))) (random.one (function (_ thresholds) (case thresholds (^ (list threshold_0 threshold_1 threshold_2 threshold_3)) @@ -203,12 +203,12 @@ (r.= //.false (/.membership reference top))) inside_range! - (bit\= (r.> //.false (/.membership reference sample)) + (bit#= (r.> //.false (/.membership reference sample)) (and (r.> bottom sample) (r.< top sample))) outside_range! - (bit\= (r.= //.false (/.membership reference sample)) + (bit#= (r.= //.false (/.membership reference sample)) (or (r.<= bottom sample) (r.>= top sample)))] (and irrelevant_order! @@ -265,18 +265,18 @@ (r.= //.false (/.membership reference top))) inside_range! - (bit\= (r.> //.false (/.membership reference sample)) + (bit#= (r.> //.false (/.membership reference sample)) (and (r.> bottom sample) (r.< top sample))) outside_range! - (bit\= (r.= //.false (/.membership reference sample)) + (bit#= (r.= //.false (/.membership reference sample)) (or (r.<= bottom sample) (r.>= top sample))) inside_inner_range! - (bit\= (r.= //.true (/.membership reference sample)) + (bit#= (r.= //.true (/.membership reference sample)) (and (r.<= middle_top sample) (r.>= middle_bottom sample)))] (and irrelevant_order! @@ -296,11 +296,11 @@ sample random.nat] ($_ _.and (_.cover [/.of_predicate] - (bit\= (r.= //.true (/.membership (/.of_predicate under?) sample)) + (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)) + (bit#= (r.= //.true (/.membership (/.of_set set) sample)) (set.member? set sample)))) ))) @@ -325,10 +325,10 @@ sample random.rev] ($_ _.and (_.cover [/.predicate] - (bit\= (not ((/.predicate threshold set) sample)) + (bit#= (not ((/.predicate threshold set) sample)) (r.< threshold (/.membership set sample)))) (_.cover [/.cut] - (bit\= (r.= //.false (/.membership (/.cut threshold set) sample)) + (bit#= (r.= //.false (/.membership (/.cut threshold set) sample)) (r.< threshold (/.membership set sample)))) ))) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index f9d17a318..b3d4ebd2f 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -2,7 +2,7 @@ [library [lux "*" ["_" test {"+" [Test]}] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] [abstract [monad {"+" [do]}] ["[0]" predicate] @@ -16,7 +16,7 @@ ["[0]" exception]] [data ["[0]" product] - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -30,7 +30,7 @@ (def: .public (random modulus) (All (_ %) (-> (//.Modulus %) (Random (/.Mod %)))) - (\ random.monad each + (# random.monad each (/.modular modulus) random.int)) @@ -39,51 +39,51 @@ (<| (_.covering /._) (_.for [/.Mod]) (do random.monad - [param\\% ($//.random +1,000,000) - param (..random param\\%) + [param##% ($//.random +1,000,000) + param (..random param##%) - subject\\% (random.only (predicate.and (|>> //.divisor (i.> +2)) - (|>> (//.= param\\%) not)) + subject##% (random.only (predicate.and (|>> //.divisor (i.> +2)) + (|>> (//.= param##%) not)) ($//.random +1,000,000)) - subject (..random subject\\%) - another (..random subject\\%)] + subject (..random subject##%) + another (..random subject##%)] (`` ($_ _.and (_.for [/.equivalence /.=] - ($equivalence.spec /.equivalence (..random subject\\%))) + ($equivalence.spec /.equivalence (..random subject##%))) (_.for [/.order /.<] - ($order.spec /.order (..random subject\\%))) + ($order.spec /.order (..random subject##%))) (~~ (template [<composite> <monoid>] [(_.for [<monoid> <composite>] - ($monoid.spec /.equivalence (<monoid> subject\\%) (..random subject\\%)))] + ($monoid.spec /.equivalence (<monoid> subject##%) (..random subject##%)))] [/.+ /.addition] [/.* /.multiplication] )) (_.for [/.codec] - ($codec.spec /.equivalence (/.codec subject\\%) (..random subject\\%))) + ($codec.spec /.equivalence (/.codec subject##%) (..random subject##%))) (_.cover [/.incorrect_modulus] (case (|> param - (\ (/.codec param\\%) encoded) - (\ (/.codec subject\\%) decoded)) + (# (/.codec param##%) encoded) + (# (/.codec subject##%) decoded)) {try.#Failure error} (exception.match? /.incorrect_modulus error) {try.#Success _} false)) (_.cover [/.modulus] - (and (type\= (:of (/.modulus subject)) + (and (type#= (:of (/.modulus subject)) (:of (/.modulus subject))) - (not (type\= (:of (/.modulus subject)) + (not (type#= (:of (/.modulus subject)) (:of (/.modulus param)))))) (_.cover [/.modular /.value] (/.= subject (/.modular (/.modulus subject) (/.value subject)))) (_.cover [/.>] - (bit\= (/.> another subject) + (bit#= (/.> another subject) (/.< subject another))) (_.cover [/.<= /.>=] - (bit\= (/.<= another subject) + (bit#= (/.<= another subject) (/.>= subject another))) (_.cover [/.-] (let [zero (/.modular (/.modulus subject) +0)] @@ -107,15 +107,15 @@ (_.cover [/.adapter] (<| (try.else false) (do try.monad - [copy\\% (//.modulus (//.divisor subject\\%)) - adapt (/.adapter subject\\% copy\\%)] + [copy##% (//.modulus (//.divisor subject##%)) + adapt (/.adapter subject##% copy##%)] (in (|> subject /.value - (/.modular copy\\%) + (/.modular copy##%) adapt (/.= subject)))))) (_.cover [/.moduli_are_not_equal] - (case (/.adapter subject\\% param\\%) + (case (/.adapter subject##% param##%) {try.#Failure error} (exception.match? /.moduli_are_not_equal error) diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 8d79b95b1..6f43194e6 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -28,7 +28,7 @@ (def: .public (random range) (Ex (_ %) (-> Int (Random (/.Modulus %)))) (|> random.int - (\ random.monad each (i.% range)) + (# random.monad each (i.% range)) (random.one (|>> /.modulus try.maybe)))) (def: .public test diff --git a/stdlib/source/test/lux/math/number.lux b/stdlib/source/test/lux/math/number.lux index be315bbcc..e93816a7a 100644 --- a/stdlib/source/test/lux/math/number.lux +++ b/stdlib/source/test/lux/math/number.lux @@ -34,7 +34,7 @@ ($_ _.and (_.cover [/.bin] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decoded (..clean_commas <number>)) + [(case (# <codec> decoded (..clean_commas <number>)) {try.#Success actual} (<=> (/.bin <number>) actual) @@ -55,7 +55,7 @@ ))))) (_.cover [/.oct] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decoded (..clean_commas <number>)) + [(case (# <codec> decoded (..clean_commas <number>)) {try.#Success actual} (<=> (/.oct <number>) actual) @@ -76,7 +76,7 @@ ))))) (_.cover [/.hex] (`` (and (~~ (template [<=> <codec> <number>] - [(case (\ <codec> decoded (..clean_commas <number>)) + [(case (# <codec> decoded (..clean_commas <number>)) {try.#Success actual} (<=> (/.hex <number>) actual) diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index d8097380a..18448f514 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -11,7 +11,7 @@ ["$[0]" codec]]] [data [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] ["[0]" math ["[0]" random {"+" [Random]}]]]] [\\library @@ -28,7 +28,7 @@ (def: dimension (Random Frac) (do [! random.monad] - [factor (|> random.nat (\ ! each (|>> (n.% 1000) (n.max 1)))) + [factor (|> random.nat (# ! each (|>> (n.% 1000) (n.max 1)))) measure (|> random.safe_frac (random.only (f.> +0.0)))] (in (f.* (|> factor .int int.frac) measure)))) @@ -42,7 +42,7 @@ (def: angle (Random /.Complex) - (\ random.monad each + (# random.monad each (|>> (revised@ /.#real (f.% +1.0)) (revised@ /.#imaginary (f.% +1.0))) ..random)) @@ -260,11 +260,11 @@ Test (do [! random.monad] [sample ..random - degree (|> random.nat (\ ! each (|>> (n.max 1) (n.% 5))))] + degree (|> random.nat (# ! each (|>> (n.max 1) (n.% 5))))] (_.cover [/.roots] (|> sample (/.roots degree) - (list\each (/.pow' (|> degree .int int.frac))) + (list#each (/.pow' (|> degree .int int.frac))) (list.every? (/.approximately? ..margin_of_error sample)))))) (def: .public test diff --git a/stdlib/source/test/lux/math/number/frac.lux b/stdlib/source/test/lux/math/number/frac.lux index 459edd275..f3dd864ad 100644 --- a/stdlib/source/test/lux/math/number/frac.lux +++ b/stdlib/source/test/lux/math/number/frac.lux @@ -13,7 +13,7 @@ ["$[0]" monoid] ["$[0]" codec]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}]]]] [\\library @@ -26,7 +26,7 @@ (def: random (Random Frac) - (\ random.monad each (|>> (i.% +1,000,000) i.frac) random.int)) + (# random.monad each (|>> (i.% +1,000,000) i.frac) random.int)) (def: constant Test @@ -38,7 +38,7 @@ (_.cover [/.positive_infinity] (/.< /.positive_infinity sample)) (_.cover [/.smallest] - (bit\= (/.positive? sample) + (bit#= (/.positive? sample) (/.>= /.smallest sample))) (_.cover [/.negative_infinity] (/.> /.negative_infinity sample)) @@ -52,16 +52,16 @@ Test (do [! random.monad] [sample ..random - shift (\ ! each /.abs ..random)] + shift (# ! each /.abs ..random)] ($_ _.and (_.cover [/.negative?] - (bit\= (/.negative? sample) + (bit#= (/.negative? sample) (/.< +0.0 sample))) (_.cover [/.positive?] - (bit\= (/.positive? sample) + (bit#= (/.positive? sample) (/.> +0.0 sample))) (_.cover [/.zero?] - (bit\= (/.zero? sample) + (bit#= (/.zero? sample) (/.= +0.0 sample))) (_.cover [/.approximately?] (and (/.approximately? /.smallest sample sample) @@ -77,15 +77,15 @@ Test ($_ _.and (do [! random.monad] - [expected (\ ! each (n.% 1,000,000) random.nat)] + [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)] + [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) + [expected (# ! each (|>> (i64.left_shifted 52) .rev) random.nat)] (_.cover [/.rev] (|> expected r.frac /.rev (r.= expected)))) @@ -136,10 +136,10 @@ right random.safe_frac] ($_ _.and (_.cover [/.>] - (bit\= (/.> left right) + (bit#= (/.> left right) (/.< right left))) (_.cover [/.<= /.>=] - (bit\= (/.<= left right) + (bit#= (/.<= left right) (/.>= right left))) )) (do random.monad @@ -154,7 +154,7 @@ (and (/.= +1.0 (/./ sample sample)) (/.= sample (/./ +1.0 sample)))) (_.cover [/.abs] - (bit\= (/.> sample (/.abs sample)) + (bit#= (/.> sample (/.abs sample)) (/.negative? sample))) (_.cover [/.signum] (/.= (/.abs sample) diff --git a/stdlib/source/test/lux/math/number/i16.lux b/stdlib/source/test/lux/math/number/i16.lux index bd767dcc5..ab692a934 100644 --- a/stdlib/source/test/lux/math/number/i16.lux +++ b/stdlib/source/test/lux/math/number/i16.lux @@ -16,7 +16,7 @@ (def: .public random (Random /.I16) - (\ random.functor each /.i16 random.i64)) + (# random.functor each /.i16 random.i64)) (def: .public test Test @@ -27,12 +27,12 @@ //i64.mask .int ++)] - expected (\ ! each (i.% limit) random.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))) + (# //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 b9af4c673..d7985b92e 100644 --- a/stdlib/source/test/lux/math/number/i32.lux +++ b/stdlib/source/test/lux/math/number/i32.lux @@ -16,7 +16,7 @@ (def: .public random (Random /.I32) - (\ random.functor each /.i32 random.i64)) + (# random.functor each /.i32 random.i64)) (def: .public test Test @@ -27,12 +27,12 @@ //i64.mask .int ++)] - expected (\ ! each (i.% limit) random.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))) + (# //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 d935d0d9e..9c40721a9 100644 --- a/stdlib/source/test/lux/math/number/i64.lux +++ b/stdlib/source/test/lux/math/number/i64.lux @@ -3,7 +3,7 @@ [lux "*" ["_" test {"+" [Test]}] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [abstract [monad {"+" [do]}] [\\specification @@ -13,7 +13,7 @@ [math ["[0]" random {"+" [Random]}]]]] [\\library - ["[0]" / ("\[0]" equivalence) + ["[0]" / ("#[0]" equivalence) [// {"+" [hex]} ["n" nat] ["i" int]]]]) @@ -22,24 +22,24 @@ Test (do [! random.monad] [pattern random.nat - idx (\ ! each (n.% /.width) 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))))) + (#= 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))))) + (#= pattern (/.zero idx pattern)) + (not (#= pattern (/.zero idx pattern))))) (_.cover [/.flipped] - (\= (/.flipped idx pattern) + (#= (/.flipped idx pattern) (if (/.one? idx pattern) (/.zero idx pattern) (/.one idx pattern)))) (_.cover [/.bit] - (bit\= (/.zero? idx pattern) - (\= /.false (/.and (/.bit idx) pattern)))) + (bit#= (/.zero? idx pattern) + (#= /.false (/.and (/.bit idx) pattern)))) ))) (def: shift @@ -48,19 +48,19 @@ [pattern random.nat] ($_ _.and (do ! - [idx (\ ! each (|>> (n.% (-- /.width)) ++) random.nat)] + [idx (# ! each (|>> (n.% (-- /.width)) ++) random.nat)] (_.cover [/.left_shifted /.right_shifted] (let [nullity! - (and (\= pattern (/.left_shifted 0 pattern)) - (\= pattern (/.right_shifted 0 pattern))) + (and (#= pattern (/.left_shifted 0 pattern)) + (#= pattern (/.right_shifted 0 pattern))) idempotency! - (and (\= pattern (/.left_shifted /.width pattern)) - (\= pattern (/.right_shifted /.width pattern))) + (and (#= pattern (/.left_shifted /.width pattern)) + (#= pattern (/.right_shifted /.width pattern))) movement! (let [shift (n.- idx /.width)] - (\= (/.and (/.mask idx) pattern) + (#= (/.and (/.mask idx) pattern) (|> pattern (/.left_shifted shift) (/.right_shifted shift))))] @@ -74,37 +74,37 @@ (<| (_.for [/.Mask]) (do [! random.monad] [pattern random.nat - idx (\ ! each (n.% /.width) random.nat) + idx (# ! each (n.% /.width) random.nat) signed random.int] ($_ _.and (_.cover [/.sign] - (bit\= (\= (.i64 0) (/.and /.sign signed)) + (bit#= (#= (.i64 0) (/.and /.sign signed)) (i.positive? signed))) (_.cover [/.mask] (let [mask (/.mask idx) - idempotency! (\= (/.and mask pattern) + idempotency! (#= (/.and mask pattern) (/.and mask (/.and mask pattern))) limit (++ (.nat mask)) limit! (if (n.< limit pattern) - (\= pattern (/.and mask pattern)) + (#= pattern (/.and mask pattern)) (n.< limit (/.and mask pattern))) - empty! (\= /.false (/.mask 0)) - full! (\= /.true (/.mask /.width))] + empty! (#= /.false (/.mask 0)) + full! (#= /.true (/.mask /.width))] (and idempotency! limit! empty! full!))) (do ! - [size (\ ! each (n.% /.width) random.nat) + [size (# ! each (n.% /.width) random.nat) .let [spare (n.- size /.width)] - offset (\ ! each (n.% spare) random.nat)] + offset (# ! each (n.% spare) random.nat)] (_.cover [/.region] (case size - 0 (\= /.false (/.region offset size)) - _ (\= (|> pattern + 0 (#= /.false (/.region offset size)) + _ (#= (|> pattern ... NNNNYYYYNNNN (/.right_shifted offset) ... ____NNNNYYYY @@ -122,7 +122,7 @@ Test (_.for [/.Sub] (do [! random.monad] - [size (\ ! each (n.% /.width) random.nat)] + [size (# ! each (n.% /.width) random.nat)] (case (/.sub size) {.#None} (_.cover [/.sub] @@ -130,20 +130,20 @@ {.#Some sub} (do [! random.monad] - [.let [limit (|> (-- (\ sub bits)) + [.let [limit (|> (-- (# sub bits)) /.mask .int ++)] - expected (\ ! each (i.% limit) random.int) + expected (# ! each (i.% limit) random.int) .let [random (: (All (_ size) (-> (-> I64 (I64 size)) (Random (I64 size)))) (function (_ narrow) - (\ random.functor each narrow random.i64)))]] + (# random.functor each narrow random.i64)))]] ($_ _.and - ($equivalence.spec (\ sub &equivalence) (random (\ sub narrow))) + ($equivalence.spec (# sub &equivalence) (random (# sub narrow))) (_.cover [/.sub] - (let [actual (|> expected .i64 (\ sub narrow) (\ sub wide))] - (\= expected actual))) + (let [actual (|> expected .i64 (# sub narrow) (# sub wide))] + (#= expected actual))) )))))) (def: signature @@ -165,7 +165,7 @@ (_.for [.I64]) (do [! random.monad] [pattern random.nat - idx (\ ! each (n.% /.width) random.nat)] + idx (# ! each (n.% /.width) random.nat)] ($_ _.and (_.cover [/.width /.bits_per_byte /.bytes_per_i64] (and (n.= /.bytes_per_i64 @@ -175,25 +175,25 @@ (_.cover [/.false] (n.= 0 (/.ones /.false))) (_.cover [/.or] - (and (\= /.true (/.or /.true pattern)) - (\= pattern (/.or /.false pattern)))) + (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)))) + (and (#= pattern (/.and /.true pattern)) + (#= /.false (/.and /.false pattern)))) (_.cover [/.not] - (and (\= /.false + (and (#= /.false (/.and pattern (/.not pattern))) - (\= /.true + (#= /.true (/.or pattern (/.not pattern))))) (_.cover [/.xor] - (and (\= /.true + (and (#= /.true (/.xor pattern (/.not pattern))) - (\= /.false + (#= /.false (/.xor pattern pattern)))) (_.cover [/.ones] @@ -210,51 +210,51 @@ complementarity!))) (_.cover [/.left_rotated /.right_rotated] (let [false! - (and (\= /.false (/.left_rotated idx /.false)) - (\= /.false (/.right_rotated idx /.false))) + (and (#= /.false (/.left_rotated idx /.false)) + (#= /.false (/.right_rotated idx /.false))) true! - (and (\= /.true (/.left_rotated idx /.true)) - (\= /.true (/.right_rotated idx /.true))) + (and (#= /.true (/.left_rotated idx /.true)) + (#= /.true (/.right_rotated idx /.true))) inverse! (and (|> pattern (/.left_rotated idx) (/.right_rotated idx) - (\= pattern)) + (#= pattern)) (|> pattern (/.right_rotated idx) (/.left_rotated idx) - (\= pattern))) + (#= pattern))) nullity! (and (|> pattern (/.left_rotated 0) - (\= pattern)) + (#= pattern)) (|> pattern (/.right_rotated 0) - (\= pattern))) + (#= pattern))) futility! (and (|> pattern (/.left_rotated /.width) - (\= pattern)) + (#= pattern)) (|> pattern (/.right_rotated /.width) - (\= pattern)))] + (#= pattern)))] (and false! true! inverse! nullity! futility!))) (_.cover [/.reversed] - (and (|> pattern /.reversed /.reversed (\= pattern)) - (or (|> pattern /.reversed (\= pattern) not) + (and (|> pattern /.reversed /.reversed (#= pattern)) + (or (|> pattern /.reversed (#= pattern) not) (let [high (/.and (hex "FFFFFFFF00000000") pattern) low (/.and (hex "00000000FFFFFFFF") pattern)] - (\= (/.reversed high) + (#= (/.reversed high) low))))) ..bit diff --git a/stdlib/source/test/lux/math/number/i8.lux b/stdlib/source/test/lux/math/number/i8.lux index f56137631..564080d7e 100644 --- a/stdlib/source/test/lux/math/number/i8.lux +++ b/stdlib/source/test/lux/math/number/i8.lux @@ -16,7 +16,7 @@ (def: .public random (Random /.I8) - (\ random.functor each /.i8 random.i64)) + (# random.functor each /.i8 random.i64)) (def: .public test Test @@ -27,12 +27,12 @@ //i64.mask .int ++)] - expected (\ ! each (i.% limit) random.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))) + (# //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 6cb8f0bfc..9ba73e445 100644 --- a/stdlib/source/test/lux/math/number/int.lux +++ b/stdlib/source/test/lux/math/number/int.lux @@ -13,7 +13,7 @@ ["$[0]" monoid] ["$[0]" codec]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}]]]] [\\library @@ -60,16 +60,16 @@ [sample random.int] ($_ _.and (_.cover [/.negative?] - (bit\= (/.negative? sample) + (bit#= (/.negative? sample) (/.< +0 sample))) (_.cover [/.positive?] - (bit\= (/.positive? sample) + (bit#= (/.positive? sample) (/.> +0 sample))) (_.cover [/.zero?] - (bit\= (/.zero? sample) + (bit#= (/.zero? sample) (/.= +0 sample))) (_.cover [/.even? /.odd?] - (bit\= (/.even? sample) + (bit#= (/.even? sample) (not (/.odd? sample)))) ))) @@ -90,7 +90,7 @@ (and (/.= +1 (/./ sample sample)) (/.= sample (/./ +1 sample)))) (_.cover [/.abs] - (bit\= (/.> sample (/.abs sample)) + (bit#= (/.> sample (/.abs sample)) (/.negative? sample))) (_.cover [/.signum] (/.= (/.abs sample) @@ -101,10 +101,10 @@ right random.int] ($_ _.and (_.cover [/.>] - (bit\= (/.> left right) + (bit#= (/.> left right) (/.< right left))) (_.cover [/.<= /.>=] - (bit\= (/.<= left right) + (bit#= (/.<= left right) (/.>= right left))) )) (do random.monad @@ -136,7 +136,7 @@ )) (do [! random.monad] [.let [random (|> random.int - (\ ! each (/.% +1,000)) + (# ! each (/.% +1,000)) (random.only (|>> (/.= +0) not)))] left random right random] @@ -159,7 +159,7 @@ (and same_gcd! bezout_identity!))) (_.cover [/.co_prime?] - (bit\= (/.= +1 (/.gcd left right)) + (bit#= (/.= +1 (/.gcd left right)) (/.co_prime? left right))) (_.cover [/.lcm] (let [lcm (/.lcm left right)] @@ -177,14 +177,14 @@ (and subtraction! inverse!)))) (do [! random.monad] - [expected (\ ! each (/.% +1,000,000) random.int) + [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)] + idx (# ! each (n.% i64.width) random.nat)] (_.cover [/.right_shifted] (let [nullity! (/.= pattern (/.right_shifted 0 pattern)) diff --git a/stdlib/source/test/lux/math/number/nat.lux b/stdlib/source/test/lux/math/number/nat.lux index 2acfa18f1..9a5da5d6d 100644 --- a/stdlib/source/test/lux/math/number/nat.lux +++ b/stdlib/source/test/lux/math/number/nat.lux @@ -13,7 +13,7 @@ ["$[0]" monoid] ["$[0]" codec]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random]]]] [\\library @@ -58,7 +58,7 @@ [sample random.nat] ($_ _.and (_.cover [/.even? /.odd?] - (bit\= (/.even? sample) + (bit#= (/.even? sample) (not (/.odd? sample)))) ))) @@ -82,10 +82,10 @@ right random.nat] ($_ _.and (_.cover [/.>] - (bit\= (/.> left right) + (bit#= (/.> left right) (/.< right left))) (_.cover [/.<= /.>=] - (bit\= (/.<= left right) + (bit#= (/.<= left right) (/.>= right left))) )) (do random.monad @@ -104,7 +104,7 @@ (/.= rem (/.% left right))))) )) (do [! random.monad] - [.let [random (\ ! each (|>> (/.% 1,000) ++) random.nat)] + [.let [random (# ! each (|>> (/.% 1,000) ++) random.nat)] left random right random] ($_ _.and @@ -113,7 +113,7 @@ (and (/.= 0 (/.% gcd left)) (/.= 0 (/.% gcd right))))) (_.cover [/.co_prime?] - (bit\= (/.= 1 (/.gcd left right)) + (bit#= (/.= 1 (/.gcd left right)) (/.co_prime? left right))) (_.cover [/.lcm] (let [lcm (/.lcm left right)] @@ -121,7 +121,7 @@ (/.= 0 (/.% right lcm))))) )) (do [! random.monad] - [expected (\ ! each (/.% 1,000,000) random.nat) + [expected (# ! each (/.% 1,000,000) random.nat) sample random.nat] (_.cover [/.frac] (and (|> expected /.frac f.nat (/.= expected)) diff --git a/stdlib/source/test/lux/math/number/ratio.lux b/stdlib/source/test/lux/math/number/ratio.lux index a9b18cdf8..2d3ba322d 100644 --- a/stdlib/source/test/lux/math/number/ratio.lux +++ b/stdlib/source/test/lux/math/number/ratio.lux @@ -10,19 +10,19 @@ ["$[0]" monoid] ["$[0]" codec]]] [control - ["[0]" maybe ("[1]\[0]" functor)]] + ["[0]" maybe ("[1]#[0]" functor)]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}]]]] [\\library ["[0]" / [// - ["n" nat ("[1]\[0]" equivalence)]]]]) + ["n" nat ("[1]#[0]" equivalence)]]]]) (def: part (Random Nat) - (\ random.monad each + (# random.monad each (|>> (n.% 1,000,000) (n.max 1)) random.nat)) @@ -54,27 +54,27 @@ ($codec.spec /.equivalence /.codec ..random)) (do random.monad - [.let [(^open "\[0]") /.equivalence] + [.let [(^open "#[0]") /.equivalence] denom/0 ..part denom/1 ..part] (_.cover [/.ratio] - (\= (/.ratio 0 denom/0) + (#= (/.ratio 0 denom/0) (/.ratio 0 denom/1)))) (do random.monad [numerator ..part - denominator (random.only (|>> (n\= 1) not) + denominator (random.only (|>> (n#= 1) not) ..part)] (_.cover [/.nat] (let [only_numerator! (|> (/.ratio numerator) /.nat - (maybe\each (n\= numerator)) + (maybe#each (n#= numerator)) (maybe.else false)) denominator_1! (|> (/.ratio numerator 1) /.nat - (maybe\each (n\= numerator)) + (maybe#each (n#= numerator)) (maybe.else false)) with_denominator! @@ -118,10 +118,10 @@ right ..random] ($_ _.and (_.cover [/.>] - (bit\= (/.> left right) + (bit#= (/.> left right) (/.< right left))) (_.cover [/.<= /.>=] - (bit\= (/.<= left right) + (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 a15b3f3f5..90ef03c5f 100644 --- a/stdlib/source/test/lux/math/number/rev.lux +++ b/stdlib/source/test/lux/math/number/rev.lux @@ -13,7 +13,7 @@ ["$[0]" monoid] ["$[0]" codec]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random]]]] [\\library @@ -21,7 +21,7 @@ [// {"+" [hex]} ["n" nat] ["f" frac] - ["[0]" i64 ("[1]\[0]" hash)]]]]) + ["[0]" i64 ("[1]#[0]" hash)]]]]) (def: signature Test @@ -89,9 +89,9 @@ (and (/.< left (/.* left right)) (/.< right (/.* left right))))) (do [! random.monad] - [.let [dividend (\ ! each (i64.and (hex "FFFF")) + [.let [dividend (# ! each (i64.and (hex "FFFF")) random.rev) - divisor (\ ! each (|>> (i64.and (hex "F")) + divisor (# ! each (|>> (i64.and (hex "F")) (i64.or (hex "1")) (i64.right_rotated 8) .rev) @@ -100,14 +100,14 @@ divisor/0 divisor divisor/1 (random.only (|>> (/.= divisor/0) not) divisor) - scale (\ ! each (|>> (n.% 10) ++) + scale (# ! each (|>> (n.% 10) ++) random.nat)] ($_ _.and (_.cover [/./] - (bit\= (/.< divisor/0 divisor/1) + (bit#= (/.< divisor/0 divisor/1) (/.> (/./ divisor/0 dividend) (/./ divisor/1 dividend)))) (_.cover [/.%] - (\ i64.equivalence = + (# i64.equivalence = (.i64 (n.% (.nat divisor/0) (.nat dividend))) (.i64 (/.% divisor/0 dividend)))) (_.cover [/.up /.down] @@ -144,10 +144,10 @@ right random.rev] ($_ _.and (_.cover [/.>] - (bit\= (/.> left right) + (bit#= (/.> left right) (/.< right left))) (_.cover [/.<= /.>=] - (bit\= (/.<= left right) + (bit#= (/.<= left right) (/.>= right left))) )) (do random.monad @@ -156,7 +156,7 @@ (/.= (/.reciprocal sample) (|> sample /.reciprocal .nat /.reciprocal .nat /.reciprocal)))) (do [! random.monad] - [expected (\ ! each (|>> f.abs (f.% +1.0)) + [expected (# ! each (|>> f.abs (f.% +1.0)) random.safe_frac) sample random.rev] (_.cover [/.frac] diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index d20c3d22c..2c92a430b 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -2,7 +2,7 @@ [library [lux "*" ["_" test {"+" [Test]}] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] [abstract [equivalence {"+" [Equivalence]}] [monad {"+" [do]}] @@ -12,15 +12,15 @@ ["$[0]" monad]]] [control ["[0]" maybe] - ["[0]" try {"+" [Try]} ("[1]\[0]" functor)]] + ["[0]" try {"+" [Try]} ("[1]#[0]" functor)]] [data ["[0]" product] - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" name ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" name ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor monoid)] + ["[0]" list ("[1]#[0]" functor monoid)] ["[0]" set]]] [meta ["[0]" location]] @@ -68,12 +68,12 @@ .#host []]]] ($_ _.and (_.cover [/.result] - (|> (\ /.monad in expected) + (|> (# /.monad in expected) (/.result expected_lux) (!expect (^multi {try.#Success actual} (n.= expected actual))))) (_.cover [/.result'] - (|> (\ /.monad in expected) + (|> (# /.monad in expected) (/.result' expected_lux) (!expect (^multi {try.#Success [actual_lux actual]} (and (same? expected_lux actual_lux) @@ -120,7 +120,7 @@ (: (Meta Any)) (/.result expected_lux) (!expect (^multi {try.#Failure actual_error} - (text\= (location.with location.dummy expected_error) + (text#= (location.with location.dummy expected_error) actual_error))))) (_.cover [/.assertion] (and (|> (/.assertion expected_error true) @@ -130,9 +130,9 @@ (|> (/.assertion expected_error false) (/.result expected_lux) (!expect (^multi {try.#Failure actual_error} - (text\= expected_error actual_error)))))) + (text#= expected_error actual_error)))))) (_.cover [/.either] - (and (|> (/.either (\ /.monad in expected) + (and (|> (/.either (# /.monad in expected) (: (Meta Nat) (/.failure expected_error))) (/.result expected_lux) @@ -140,7 +140,7 @@ (n.= expected actual)))) (|> (/.either (: (Meta Nat) (/.failure expected_error)) - (\ /.monad in expected)) + (# /.monad in expected)) (/.result expected_lux) (!expect (^multi {try.#Success actual} (n.= expected actual)))) @@ -150,10 +150,10 @@ (/.failure expected_error))) (/.result expected_lux) (!expect (^multi {try.#Failure actual_error} - (text\= (location.with location.dummy expected_error) + (text#= (location.with location.dummy expected_error) actual_error)))) - (|> (/.either (\ /.monad in expected) - (\ /.monad in dummy)) + (|> (/.either (# /.monad in expected) + (# /.monad in dummy)) (/.result expected_lux) (!expect (^multi {try.#Success actual} (n.= expected actual)))) @@ -167,7 +167,7 @@ version (random.ascii/upper 1) source_code (random.ascii/upper 1) expected_current_module (random.ascii/upper 1) - imported_module_name (random.only (|>> (text\= expected_current_module) not) + imported_module_name (random.only (|>> (text#= expected_current_module) not) (random.ascii/upper 1)) primitive_type (random.ascii/upper 1) expected_seed random.nat @@ -175,8 +175,8 @@ dummy (random.only (|>> (n.= expected) not) random.nat) expected_short (random.ascii/upper 1) dummy_module (random.only (function (_ module) - (not (or (text\= expected_current_module module) - (text\= imported_module_name module)))) + (not (or (text#= expected_current_module module) + (text#= imported_module_name module)))) (random.ascii/upper 1)) .let [imported_module [.#module_hash 0 .#module_aliases (list) @@ -215,7 +215,7 @@ (|> /.current_module_name (/.result expected_lux) (!expect (^multi {try.#Success actual_current_module} - (text\= expected_current_module actual_current_module))))) + (text#= expected_current_module actual_current_module))))) (_.cover [/.current_module] (|> /.current_module (/.result expected_lux) @@ -241,12 +241,12 @@ (_.cover [/.imported_modules] (and (|> (/.imported_modules expected_current_module) (/.result expected_lux) - (try\each (\ (list.equivalence text.equivalence) = + (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) = + (try#each (# (list.equivalence text.equivalence) = (list))) (try.else false)))) (_.cover [/.imported_by?] @@ -261,12 +261,12 @@ (and (|> (/.normal ["" expected_short]) (/.result expected_lux) (!expect (^multi {try.#Success [actual_module actual_short]} - (and (text\= expected_current_module actual_module) + (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) + (and (text#= dummy_module actual_module) (same? expected_short actual_short))))))) )))) @@ -283,7 +283,7 @@ version (random.ascii/upper 1) source_code (random.ascii/upper 1) expected_current_module (random.ascii/upper 1) - expected_type (\ ! each (function (_ name) + expected_type (# ! each (function (_ name) {.#Primitive name (list)}) (random.ascii/upper 1)) expected_seed random.nat @@ -331,7 +331,7 @@ (_.cover [.Type_Context /.type_context] (|> /.type_context (/.result expected_lux) - (try\each (same? type_context)) + (try#each (same? type_context)) (try.else false))) ))) @@ -339,10 +339,10 @@ Test (do [! random.monad] [expected_current_module (random.ascii/upper 1) - expected_macro_module (random.only (|>> (text\= expected_current_module) not) + expected_macro_module (random.only (|>> (text#= expected_current_module) not) (random.ascii/upper 1)) expected_short (random.ascii/upper 1) - expected_type (\ ! each (function (_ name) + expected_type (# ! each (function (_ name) {.#Primitive name (list)}) (random.ascii/upper 1)) expected_value (random.either (in .def:) @@ -454,10 +454,10 @@ (do [! random.monad] [expected_exported? random.bit expected_current_module (random.ascii/upper 1) - expected_macro_module (random.only (|>> (text\= expected_current_module) not) + expected_macro_module (random.only (|>> (text#= expected_current_module) not) (random.ascii/upper 1)) expected_short (random.ascii/upper 1) - expected_type (\ ! each (function (_ name) + expected_type (# ! each (function (_ name) {.#Primitive name (list)}) (random.ascii/upper 1)) expected_value (random.either (in .def:) @@ -560,11 +560,11 @@ (expected_lux true {.#Some .Macro})] (and (|> (/.de_aliased [expected_macro_module expected_short]) (/.result expected_lux) - (try\each (name\= [expected_macro_module expected_short])) + (try#each (name#= [expected_macro_module expected_short])) (try.else false)) (|> (/.de_aliased [expected_current_module expected_short]) (/.result expected_lux) - (try\each (name\= [expected_macro_module expected_short])) + (try#each (name#= [expected_macro_module expected_short])) (try.else false))))) (_.cover [/.definition] (let [[current_globals macro_globals expected_lux] @@ -574,7 +574,7 @@ (|> (/.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?) + (and (bit#= expected_exported? actual_exported?) (same? expected_type actual_type) (same? (:as Any expected_value) actual_value))))) @@ -626,22 +626,22 @@ Test (do [! random.monad] [current_module (random.ascii/upper 1) - tag_module (random.only (|>> (text\= current_module) not) + tag_module (random.only (|>> (text#= current_module) not) (random.ascii/upper 1)) name_0 (random.ascii/upper 1) - name_1 (random.only (|>> (text\= name_0) not) + name_1 (random.only (|>> (text#= name_0) not) (random.ascii/upper 1)) - .let [random_tag (\ ! each (|>> [tag_module]) + .let [random_tag (# ! each (|>> [tag_module]) (random.ascii/upper 1)) random_labels (: (Random [Text (List Text)]) (do ! [head (random.ascii/lower 5)] (|> (random.ascii/lower 5) - (random.only (|>> (text\= head) not)) + (random.only (|>> (text#= head) not)) (random.set text.hash 3) - (\ ! each set.list) + (# ! each set.list) (random.and (in head)))))] tags_0 random_labels tags_1 (let [set/0 (set.of_list text.hash {.#Item tags_0})] @@ -671,14 +671,14 @@ .#module_aliases (list) .#definitions (list& [name_0 {.#Type [false type_0 {.#Left tags_0}]}] [name_1 {.#Type [true type_1 {.#Right tags_1}]}] - ($_ list\composite + ($_ list#composite (|> {.#Item tags_0} list.enumeration - (list\each (function (_ [index short]) + (list#each (function (_ [index short]) [short {.#Label [false type_0 {.#Item tags_0} index]}]))) (|> {.#Item tags_1} list.enumeration - (list\each (function (_ [index short]) + (list#each (function (_ [index short]) [short {.#Slot [true type_1 {.#Item tags_1} index]}]))))) .#imports (list) .#module_state {.#Active}]]) @@ -700,13 +700,13 @@ type.equivalence))] (|> (/.tag_lists tag_module) (/.result expected_lux) - (try\each (\ equivalence = (list [(list\each (|>> [tag_module]) {.#Item tags_1}) + (try#each (# equivalence = (list [(list#each (|>> [tag_module]) {.#Item tags_1}) type_1]))) (try.else false)))) (_.cover [/.tags_of] (|> (/.tags_of [tag_module name_1]) (/.result expected_lux) - (try\each (\ (maybe.equivalence (list.equivalence name.equivalence)) = {.#Some (list\each (|>> [tag_module]) {.#Item tags_1})})) + (try#each (# (maybe.equivalence (list.equivalence name.equivalence)) = {.#Some (list#each (|>> [tag_module]) {.#Item tags_1})})) (try.else false))) (_.cover [/.slot] (|> {.#Item tags_1} @@ -721,12 +721,12 @@ actual_index) correct_tags! - (\ (list.equivalence name.equivalence) = - (list\each (|>> [tag_module]) {.#Item tags_1}) + (# (list.equivalence name.equivalence) = + (list#each (|>> [tag_module]) {.#Item tags_1}) actual_tags) correct_type! - (type\= type_1 + (type#= type_1 actual_type)] (and correct_index! correct_tags! @@ -740,7 +740,7 @@ [current_module (random.ascii/upper 1) [name_0 name_1 name_2 name_3 name_4] (|> (random.ascii/upper 1) (random.set text.hash 5) - (\ ! each set.list) + (# ! each set.list) (random.one (function (_ values) (case values (^ (list name_0 name_1 name_2 name_3 name_4)) @@ -811,57 +811,57 @@ type.equivalence))))] (|> /.locals (/.result expected_lux) - (try\each (\ equivalence = (list (list [name_3 type_3]) + (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#each (# type.equivalence = type_0)) (try.else false)) (|> (/.var_type name_1) (/.result expected_lux) - (try\each (\ type.equivalence = type_1)) + (try#each (# type.equivalence = type_1)) (try.else false)) (|> (/.var_type name_2) (/.result expected_lux) - (try\each (\ type.equivalence = type_2)) + (try#each (# type.equivalence = type_2)) (try.else false)) (|> (/.var_type name_3) (/.result expected_lux) - (try\each (\ type.equivalence = type_3)) + (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#each (# type.equivalence = type_0)) (try.else false)) (|> (/.type ["" name_1]) (/.result expected_lux) - (try\each (\ type.equivalence = type_1)) + (try#each (# type.equivalence = type_1)) (try.else false)) (|> (/.type ["" name_2]) (/.result expected_lux) - (try\each (\ type.equivalence = type_2)) + (try#each (# type.equivalence = type_2)) (try.else false)) (|> (/.type ["" name_3]) (/.result expected_lux) - (try\each (\ type.equivalence = type_3)) + (try#each (# type.equivalence = type_3)) (try.else false)) (|> (/.type [current_module name_4]) (/.result expected_lux) - (try\each (\ type.equivalence = type_4)) + (try#each (# type.equivalence = type_4)) (try.else false)) (|> (/.type ["" name_4]) (/.result expected_lux) - (try\each (\ type.equivalence = type_4)) + (try#each (# type.equivalence = type_4)) (try.else false)))) ))) (def: injection (Injection Meta) - (\ /.monad in)) + (# /.monad in)) (def: (comparison init) (-> Lux (Comparison Meta)) @@ -884,7 +884,7 @@ version (random.ascii/upper 1) source_code (random.ascii/upper 1) expected_current_module (random.ascii/upper 1) - expected_type (\ ! each (function (_ name) + expected_type (# ! each (function (_ name) {.#Primitive name (list)}) (random.ascii/upper 1)) expected_seed random.nat @@ -926,7 +926,7 @@ /.lifted (/.result expected_lux) (!expect (^multi {try.#Failure actual} - (text\= (location.with expected_location expected_error) + (text#= (location.with expected_location expected_error) actual)))) (|> expected_value {try.#Success} diff --git a/stdlib/source/test/lux/meta/location.lux b/stdlib/source/test/lux/meta/location.lux index a01518d3b..c1dc2fbe4 100644 --- a/stdlib/source/test/lux/meta/location.lux +++ b/stdlib/source/test/lux/meta/location.lux @@ -33,7 +33,7 @@ ($equivalence.spec /.equivalence ..random)) (_.cover [/.here] - (not (\ /.equivalence = (/.here) (/.here)))) + (not (# /.equivalence = (/.here) (/.here)))) (do random.monad [location ..random error (random.ascii/alpha 10)] @@ -46,5 +46,5 @@ (do random.monad [[location _] $///code.random] (_.cover [/.dummy] - (\ /.equivalence = /.dummy location))) + (# /.equivalence = /.dummy location))) ))) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index b80b2aa90..f652e4ebf 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -32,7 +32,7 @@ (do random.monad [inputs (random.list 5 (random.ascii/upper 5))] (_.cover [/.program:] - (let [(^open "list\[0]") (list.equivalence text.equivalence)] + (let [(^open "list#[0]") (list.equivalence text.equivalence)] (and (with_expansions [<program> (/.program: all_arguments (io.io all_arguments))] (let [outcome ((: (-> (List Text) (io.IO Any)) @@ -49,14 +49,14 @@ (let [outcome ((: (-> (List Text) (io.IO Any)) (..actual_program <program>)) inputs)] - (list\= (list.reversed inputs) + (list#= (list.reversed inputs) (:as (List Text) (io.run! outcome))))) (with_expansions [<program> (/.program: [all_arguments (<>.many <cli>.any)] (io.io all_arguments))] (let [outcome ((: (-> (List Text) (io.IO Any)) (..actual_program <program>)) inputs)] - (list\= inputs + (list#= inputs (:as (List Text) (io.run! outcome))))) (with_expansions [<program> (/.program: [arg/0 <cli>.any arg/1 <cli>.any diff --git a/stdlib/source/test/lux/static.lux b/stdlib/source/test/lux/static.lux index e048503ba..98b8c32eb 100644 --- a/stdlib/source/test/lux/static.lux +++ b/stdlib/source/test/lux/static.lux @@ -5,7 +5,7 @@ ["@" target] ["[0]" meta] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [macro ["[0]" code]] @@ -61,7 +61,7 @@ <l+r> (/.text (format <left> <right>))] (case (' <l+r>) [_ {.#Text l+r}] - (text\= l+r (format <left> <right>)) + (text#= l+r (format <left> <right>)) _ false))) @@ -71,7 +71,7 @@ <l+r> (/.literal code.text (format <left> <right>))] (case (' <l+r>) [_ {.#Text l+r}] - (text\= l+r (format <left> <right>)) + (text#= l+r (format <left> <right>)) _ false))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 9c834c5dc..d4d1aa460 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -13,8 +13,8 @@ [concurrency ["[0]" atom]]] [data - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] ["[0]" format "_" ["[1]" binary]] @@ -23,9 +23,9 @@ ["[0]" dictionary] ["[0]" row] ["[0]" set] - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat] ["i" int] @@ -37,7 +37,7 @@ ["[0]" / "_" ["[1][0]" loader {"+" [Library]}] ["[1][0]" version] - ["[1][0]" modifier ("[1]\[0]" monoid)] + ["[1][0]" modifier ("[1]#[0]" monoid)] ["[1][0]" field] ["[1][0]" method {"+" [Method]}] ["[1][0]" class] @@ -55,7 +55,7 @@ ["[0]" category {"+" [Value Object Class]}]]]]) (def: method_modifier - ($_ /modifier\composite + ($_ /modifier#composite /method.public /method.static)) @@ -167,7 +167,7 @@ (/.invokestatic ..$Byte "valueOf" (/type.method [(list) (list /type.byte) ..$Byte (list)]))) (def: $Byte::random (Random java/lang/Byte) - (\ random.monad each (|>> (:as java/lang/Long) ffi.long_to_byte) random.int)) + (# random.monad each (|>> (:as java/lang/Long) ffi.long_to_byte) random.int)) (def: $Byte::literal (-> java/lang/Byte (Bytecode Any)) (|>> ffi.byte_to_long (:as I64) i32.i32 /.int)) @@ -185,7 +185,7 @@ (/.invokestatic ..$Short "valueOf" (/type.method [(list) (list /type.short) ..$Short (list)]))) (def: $Short::random (Random java/lang/Short) - (\ random.monad each (|>> (:as java/lang/Long) ffi.long_to_short) random.int)) + (# random.monad each (|>> (:as java/lang/Long) ffi.long_to_short) random.int)) (def: $Short::literal (-> java/lang/Short (Bytecode Any)) (|>> ffi.short_to_long (:as I64) i32.i32 /.int)) @@ -203,7 +203,7 @@ (/.invokestatic ..$Integer "valueOf" (/type.method [(list) (list /type.int) ..$Integer (list)]))) (def: $Integer::random (Random java/lang/Integer) - (\ random.monad each (|>> (:as java/lang/Long) ffi.long_to_int) random.int)) + (# random.monad each (|>> (:as java/lang/Long) ffi.long_to_int) random.int)) (def: $Integer::literal (-> java/lang/Integer (Bytecode Any)) (|>> ffi.int_to_long (:as I64) i32.i32 /.int)) @@ -231,7 +231,7 @@ (def: $Float::wrap (/.invokestatic ..$Float "valueOf" (/type.method [(list) (list /type.float) ..$Float (list)]))) (def: $Float::random (Random java/lang/Float) - (\ random.monad each + (# random.monad each (|>> (:as java/lang/Double) ffi.double_to_float) random.frac)) (def: $Float::literal /.float) @@ -271,7 +271,7 @@ (/.invokestatic ..$Character "valueOf" (/type.method [(list) (list /type.char) ..$Character (list)]))) (def: $Character::random (Random java/lang/Character) - (\ random.monad each (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) + (# random.monad each (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_char) random.int)) (def: $Character::literal (-> java/lang/Character (Bytecode Any)) (|>> ffi.char_to_long (:as I64) i32.i32 /.int)) @@ -306,7 +306,7 @@ [(def: <name> Test (do [! random.monad] - [expected (\ ! each (i64.and (i64.mask <bits>)) random.nat)] + [expected (# ! each (i64.and (i64.mask <bits>)) random.nat)] (<| (_.lifted <message>) (..bytecode (for [@.old (|>> (:as <type>) <to_long> ("jvm leq" expected)) @@ -384,7 +384,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do [! random.monad] - [parameter (\ ! each (|>> (n.% 32) .int (:as java/lang/Long) ffi.long_to_int) random.nat) + [parameter (# ! each (|>> (n.% 32) .int (:as java/lang/Long) ffi.long_to_int) random.nat) subject ..$Integer::random] (int (reference parameter subject) (do /.monad @@ -463,7 +463,7 @@ shift (: (-> (-> java/lang/Integer java/lang/Long java/lang/Long) (Bytecode Any) (Random Bit)) (function (_ reference instruction) (do [! random.monad] - [parameter (\ ! each (|>> (n.% 64) (:as java/lang/Long)) random.nat) + [parameter (# ! each (|>> (n.% 64) (:as java/lang/Long)) random.nat) subject ..$Long::random] (long (reference (ffi.long_to_int parameter) subject) (do /.monad @@ -801,7 +801,7 @@ (<| (_.lifted "INVOKEVIRTUAL") (do random.monad [expected ..$Double::random]) - (..bytecode (|>> (:as Bit) (bit\= (f.not_a_number? (:as Frac expected))))) + (..bytecode (|>> (:as Bit) (bit#= (f.not_a_number? (:as Frac expected))))) (do /.monad [_ (/.double expected) _ ..$Double::wrap @@ -870,7 +870,7 @@ _ /.lload_1 _ (/.putfield $Self object_field /type.long)] /.return)}) - (/method.method ($_ /modifier\composite + (/method.method ($_ /modifier#composite /method.public /method.static) static_method @@ -944,7 +944,7 @@ Test)) (function (_ constructor random literal [*store *load *wrap] test) (do [! random.monad] - [size (\ ! each (|>> (n.% 1024) (n.max 1)) random.nat) + [size (# ! each (|>> (n.% 1024) (n.max 1)) random.nat) value random] ($_ _.and (<| (_.lifted "length") @@ -954,7 +954,7 @@ ($_ _.and (_.context "boolean" (array (/.newarray /instruction.t_boolean) $Boolean::random $Boolean::literal [/.bastore /.baload $Boolean::wrap] - (function (_ expected) (|>> (:as Bit) (bit\= (:as Bit expected)))))) + (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) @@ -1013,10 +1013,10 @@ (|>> (: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)))))) + (function (_ expected) (|>> (:as Text) (text#= (:as Text expected)))))) (<| (_.context "multi") (do [! random.monad] - [.let [size (\ ! each (|>> (n.% 5) (n.+ 1)) + [.let [size (# ! each (|>> (n.% 5) (n.+ 1)) random.nat)] dimensions size sizesH size @@ -1129,7 +1129,7 @@ (function (_ random_value literal *wrap [store load] test) (do [! random.monad] [expected random_value - register (\ ! each (n.% 128) random.nat)] + register (# ! each (n.% 128) random.nat)] (<| (..bytecode (test expected)) (do /.monad [_ (literal expected) @@ -1153,7 +1153,7 @@ (_.lifted "IINC" (do [! random.monad] [base ..$Byte::random - increment (\ ! each (|>> (n.% 100) /unsigned.u1 try.trusted) + increment (# ! each (|>> (n.% 100) /unsigned.u1 try.trusted) random.nat) .let [expected (: java/lang/Long (for [@.old @@ -1216,7 +1216,7 @@ (<| (_.context "object") (let [test (: (-> java/lang/String Any Bit) (function (_ expected actual) - (|> actual (:as Text) (text\= (:as Text expected)))))] + (|> 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)) @@ -1235,7 +1235,7 @@ (do random.monad [expected/1 $String::random .let [object_test (: (-> Any Bit) - (|>> (:as Text) (text\= (:as Text expected/1))))] + (|>> (:as Text) (text#= (:as Text expected/1))))] dummy/1 $String::random .let [single ($_ _.and (<| (_.lifted "DUP & POP") @@ -1324,7 +1324,7 @@ primitive_method_name (random.ascii/upper 10) .let [primitive_method_type (/type.method [(list) (list) (value@ #unboxed primitive) (list)])] object_method_name (|> (random.ascii/upper 10) - (random.only (|>> (text\= primitive_method_name) not))) + (random.only (|>> (text#= primitive_method_name) not))) expected (value@ #random primitive) .let [$Self (/type.class class_name (list))]] (in (case (do try.monad @@ -1372,7 +1372,7 @@ (_.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 "ARETURN" (primitive_return ..$String::primitive /.areturn {.#None} (function (_ expected actual) (text#= (:as Text expected) (:as Text actual))))) (_.lifted "RETURN" (primitive_return (: (Primitive java/lang/String) [#unboxed /type.void #boxed ..$String @@ -1381,7 +1381,7 @@ #literal (function.constant /.nop)]) /.return {.#Some ..$String::literal} - (function (_ expected actual) (text\= (:as Text expected) (:as Text actual))))) + (function (_ expected actual) (text#= (:as Text expected) (:as Text actual))))) ))) (def: branching @@ -1477,9 +1477,9 @@ (do [! random.monad] [expected ..$Long::random dummy ..$Long::random - minimum (\ ! each (|>> (n.% 100) .int /signed.s4 try.trusted) + minimum (# ! each (|>> (n.% 100) .int /signed.s4 try.trusted) random.nat) - afterwards (\ ! each (n.% 10) random.nat)]) + afterwards (# ! each (n.% 10) random.nat)]) (..bytecode ((!::= java/lang/Long "jvm leq" "jvm long =") expected)) (do /.monad [@right /.new_label @@ -1496,13 +1496,13 @@ ..$Long::wrap)) (<| (_.lifted "LOOKUPSWITCH") (do [! random.monad] - [options (\ ! each (|>> (n.% 10) (n.+ 1)) + [options (# ! each (|>> (n.% 10) (n.+ 1)) random.nat) - choice (\ ! each (n.% options) 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))) + (# ! each (|>> (:as java/lang/Long) ffi.long_to_int ffi.int_to_long (:as Int))) (random.set i.hash options) - (\ ! each set.list)) + (# ! each set.list)) .let [choice (maybe.trusted (list.item choice options))] expected ..$Long::random dummy ..$Long::random]) @@ -1512,7 +1512,7 @@ @wrong /.new_label @return /.new_label _ (..$Integer::literal (ffi.long_to_int (:as java/lang/Long choice))) - _ (/.lookupswitch @wrong (list\each (function (_ option) + _ (/.lookupswitch @wrong (list#each (function (_ option) [(|> option /signed.s4 try.trusted) (if (i.= choice option) @right @wrong)]) options)) @@ -1586,11 +1586,11 @@ (do random.monad [abstract_class ..class_name interface_class (|> ..class_name - (random.only (|>> (text\= abstract_class) not))) + (random.only (|>> (text#= abstract_class) not))) concrete_class (|> ..class_name (random.only (function (_ class) - (not (or (text\= abstract_class class) - (text\= interface_class class)))))) + (not (or (text#= abstract_class class) + (text#= interface_class class)))))) part0 ..$Long::random part1 ..$Long::random part2 ..$Long::random @@ -1627,17 +1627,17 @@ [_ (..$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 ($_ /modifier#composite /class.public /class.abstract /class.interface) (/name.internal interface_class) (/name.internal "java.lang.Object") (list) (list) - (list (/method.method ($_ /modifier\composite /method.public /method.abstract) + (list (/method.method ($_ /modifier#composite /method.public /method.abstract) interface_method method::type (list) {.#None})) (row.row)) 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 ($_ /modifier#composite /class.public /class.abstract) (/name.internal abstract_class) (/name.internal "java.lang.Object") (list) @@ -1652,7 +1652,7 @@ /.return)}) (method inherited_method part0) (method overriden_method fake_part2) - (/method.method ($_ /modifier\composite /method.public /method.abstract) + (/method.method ($_ /modifier#composite /method.public /method.abstract) abstract_method method::type (list) {.#None})) (row.row)) try.trusted @@ -1679,7 +1679,7 @@ (method overriden_method part2) (method abstract_method part3) (method interface_method part4) - (/method.method ($_ /modifier\composite + (/method.method ($_ /modifier#composite /method.public /method.static) static_method diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index d8dfd6e88..98556c778 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -10,7 +10,7 @@ ["[0]" async] ["[0]" atom {"+" [Atom]}]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list] ["[0]" set]]] @@ -32,7 +32,7 @@ /.Test (do [! random.monad] [expected_message/0 (random.ascii/lower 5) - expected_message/1 (random.only (|>> (text\= expected_message/0) not) + expected_message/1 (random.only (|>> (text#= expected_message/0) not) (random.ascii/lower 5))] ($_ /.and (in (do async.monad @@ -99,7 +99,7 @@ (n.= 0 (value@ /.#successes tally)) (n.= 1 (value@ /.#failures tally))))))) (do [! random.monad] - [expected (\ ! each (|>> (n.% 10) ++) random.nat) + [expected (# ! each (|>> (n.% 10) ++) random.nat) .let [counter (: (Atom Nat) (atom.atom 0))] times_assertion (<| (/.times expected) @@ -120,7 +120,7 @@ /.Test ($_ /.and (do [! random.monad] - [expected (\ ! each (|>> (n.% 10) ++) random.nat) + [expected (# ! each (|>> (n.% 10) ++) random.nat) .let [counter (: (Atom Nat) (atom.atom 0))] assertion (<| /.in_parallel @@ -138,7 +138,7 @@ (n.= expected (value@ /.#successes tally)) (n.= 0 (value@ /.#failures tally))))))) (do [! random.monad] - [expected (\ ! each (|>> (n.% 10) ++) random.nat) + [expected (# ! each (|>> (n.% 10) ++) random.nat) .let [counter (: (Atom Nat) (atom.atom 0))] assertion (<| /.in_parallel @@ -221,9 +221,9 @@ (/.for [/.Test]) (do [! random.monad] [expected_context (random.ascii/lower 5) - expected_message/0 (random.only (|>> (text\= expected_context) not) + expected_message/0 (random.only (|>> (text#= expected_context) not) (random.ascii/lower 5)) - expected_message/1 (random.only (|>> (text\= expected_message/0) not) + expected_message/1 (random.only (|>> (text#= expected_message/0) not) (random.ascii/lower 5))] ($_ /.and (/.for [/.Assertion] diff --git a/stdlib/source/test/lux/time.lux b/stdlib/source/test/lux/time.lux index 2e2ce39c5..e1d0ffce5 100644 --- a/stdlib/source/test/lux/time.lux +++ b/stdlib/source/test/lux/time.lux @@ -11,7 +11,7 @@ ["$[0]" codec]]] [control [pipe {"+" [case>]}] - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception] [parser ["<[0]>" text]]] @@ -53,16 +53,16 @@ (|> expected /.clock /.time - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))))) (def: for_ranges Test (do [! random.monad] - [valid_hour (\ ! each (|>> (n.% /.hours) (n.max 10)) random.nat) - valid_minute (\ ! each (|>> (n.% /.minutes) (n.max 10)) random.nat) - valid_second (\ ! each (|>> (n.% /.seconds) (n.max 10)) random.nat) - valid_milli_second (\ ! each (n.% /.milli_seconds) random.nat) + [valid_hour (# ! each (|>> (n.% /.hours) (n.max 10)) random.nat) + valid_minute (# ! each (|>> (n.% /.minutes) (n.max 10)) random.nat) + valid_second (# ! each (|>> (n.% /.seconds) (n.max 10)) random.nat) + valid_milli_second (# ! each (n.% /.milli_seconds) random.nat) .let [invalid_hour (|> valid_hour (n.+ /.hours)) invalid_minute (|> valid_minute (n.+ /.minutes) (n.min 99)) @@ -75,7 +75,7 @@ %.nat (text.prefix <prefix>) (text.suffix <suffix>) - (\ /.codec decoded) + (# /.codec decoded) (case> {try.#Success _} true {try.#Failure error} false)) @@ -84,7 +84,7 @@ %.nat (text.prefix <prefix>) (text.suffix <suffix>) - (\ /.codec decoded) + (# /.codec decoded) (case> {try.#Success _} false @@ -101,7 +101,7 @@ (|> valid_milli_second %.nat (format "00:00:00.") - (\ /.codec decoded) + (# /.codec decoded) (case> {try.#Success _} true {try.#Failure error} false))) )))) @@ -114,7 +114,7 @@ [.let [day (.nat (duration.millis duration.day))] expected random.time - out_of_bounds (\ ! each (|>> /.millis (n.+ day)) + out_of_bounds (# ! each (|>> /.millis (n.+ day)) random.time)] (`` ($_ _.and ..for_implementation @@ -123,7 +123,7 @@ (|> expected /.millis /.of_millis - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) (_.cover [/.time_exceeds_a_day] (case (/.of_millis out_of_bounds) @@ -138,9 +138,9 @@ (n.= 0))) (_.cover [/.parser] (|> expected - (\ /.codec encoded) + (# /.codec encoded) (<text>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) ..for_ranges (_.for [/.Clock] diff --git a/stdlib/source/test/lux/time/date.lux b/stdlib/source/test/lux/time/date.lux index 975131f1c..1c4365552 100644 --- a/stdlib/source/test/lux/time/date.lux +++ b/stdlib/source/test/lux/time/date.lux @@ -10,7 +10,7 @@ ["$[0]" enum] ["$[0]" codec]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception] [parser ["<[0]>" text]]] @@ -45,7 +45,7 @@ (|> (/.date (/.year expected) (/.month expected) (/.day_of_month expected)) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) (do random.monad [expected random.date] @@ -64,7 +64,7 @@ (|> expected /.days /.of_days - (\ /.equivalence = expected)))) + (# /.equivalence = expected)))) (_.cover [/.epoch] (|> /.epoch /.days @@ -72,16 +72,16 @@ (do random.monad [expected random.date] (_.cover [/.parser] - (|> (\ /.codec encoded expected) + (|> (# /.codec encoded expected) (<text>.result /.parser) - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false)))) (do [! random.monad] - [year (\ ! each (|>> (n.% 10,000) ++) + [year (# ! each (|>> (n.% 10,000) ++) random.nat) - month (\ ! each (|>> (n.% 10) (n.+ 13)) + month (# ! each (|>> (n.% 10) (n.+ 13)) random.nat) - day (\ ! each (|>> (n.% 10) (n.+ 10)) + day (# ! each (|>> (n.% 10) (n.+ 10)) random.nat) .let [input (format (%.nat year) "-" (%.nat month) diff --git a/stdlib/source/test/lux/time/day.lux b/stdlib/source/test/lux/time/day.lux index c6f953334..0f8f50821 100644 --- a/stdlib/source/test/lux/time/day.lux +++ b/stdlib/source/test/lux/time/day.lux @@ -12,14 +12,14 @@ ["$[0]" enum] ["$[0]" codec]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception]] [data [collection ["[0]" list] ["[0]" set]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\library @@ -27,13 +27,13 @@ (def: .public random (Random /.Day) - (random.either (random.either (random.either (random\in {/.#Sunday}) - (random\in {/.#Monday})) - (random.either (random\in {/.#Tuesday}) - (random\in {/.#Wednesday}))) - (random.either (random.either (random\in {/.#Thursday}) - (random\in {/.#Friday})) - (random\in {/.#Saturday})))) + (random.either (random.either (random.either (random#in {/.#Sunday}) + (random#in {/.#Monday})) + (random.either (random#in {/.#Tuesday}) + (random#in {/.#Wednesday}))) + (random.either (random.either (random#in {/.#Thursday}) + (random#in {/.#Friday})) + (random#in {/.#Saturday})))) (def: .public test Test @@ -59,7 +59,7 @@ (do random.monad [not_a_day (random.ascii/upper 1)] (_.cover [/.not_a_day_of_the_week] - (case (\ /.codec decoded not_a_day) + (case (# /.codec decoded not_a_day) {try.#Failure error} (exception.match? /.not_a_day_of_the_week error) @@ -69,7 +69,7 @@ (|> expected /.number /.by_number - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) (_.cover [/.invalid_day] (case (/.by_number invalid) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index da6d73296..58a2ad1f1 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -11,7 +11,7 @@ ["$[0]" monoid] ["$[0]" codec]]] [data - ["[0]" bit ("[1]\[0]" equivalence)]] + ["[0]" bit ("[1]#[0]" equivalence)]] [math ["[0]" random {"+" [Random]}] [number @@ -39,35 +39,35 @@ (do random.monad [duration random.duration] (_.cover [/.of_millis /.millis] - (|> duration /.millis /.of_millis (\ /.equivalence = duration)))) + (|> duration /.millis /.of_millis (# /.equivalence = duration)))) (do random.monad - [.let [(^open "\[0]") /.equivalence] + [.let [(^open "#[0]") /.equivalence] expected random.duration parameter random.duration] ($_ _.and (_.cover [/.merged /.difference] - (|> expected (/.merged parameter) (/.difference parameter) (\= expected))) + (|> expected (/.merged parameter) (/.difference parameter) (#= expected))) (_.cover [/.empty] - (|> expected (/.merged /.empty) (\= expected))) + (|> expected (/.merged /.empty) (#= expected))) (_.cover [/.inverse] - (and (|> expected /.inverse /.inverse (\= expected)) - (|> expected (/.merged (/.inverse expected)) (\= /.empty)))) + (and (|> expected /.inverse /.inverse (#= expected)) + (|> expected (/.merged (/.inverse expected)) (#= /.empty)))) (_.cover [/.positive? /.negative? /.neutral?] - (or (bit\= (/.positive? expected) + (or (bit#= (/.positive? expected) (/.negative? (/.inverse expected))) - (bit\= (/.neutral? expected) + (bit#= (/.neutral? expected) (/.neutral? (/.inverse expected))))) )) (do random.monad - [.let [(^open "\[0]") /.equivalence] + [.let [(^open "#[0]") /.equivalence] factor random.nat] (_.cover [/.up /.down] - (|> /.milli_second (/.up factor) (/.down factor) (\= /.milli_second)))) + (|> /.milli_second (/.up factor) (/.down factor) (#= /.milli_second)))) (do [! random.monad] - [.let [(^open "\[0]") /.order + [.let [(^open "#[0]") /.order positive (|> random.duration - (random.only (|>> (\= /.empty) not)) - (\ ! each (function (_ duration) + (random.only (|>> (#= /.empty) not)) + (# ! each (function (_ duration) (if (/.positive? duration) duration (/.inverse duration)))))] @@ -76,13 +76,13 @@ (`` ($_ _.and (_.cover [/.framed] (let [sample' (/.framed frame sample)] - (and (\< frame sample') - (bit\= (\< frame sample) - (\= sample sample'))))) + (and (#< frame sample') + (bit#= (#< frame sample) + (#= sample sample'))))) (_.cover [/.ticks] (i.= +1 (/.ticks sample sample))) (_.cover [/.milli_second] - (\= /.empty (\ /.enum pred /.milli_second))) + (#= /.empty (# /.enum pred /.milli_second))) (~~ (template [<factor> <big> <small>] [(_.cover [<big>] (|> <big> (/.ticks <small>) (i.= <factor>)))] diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux index aba4914bf..8c5d5f8d7 100644 --- a/stdlib/source/test/lux/time/instant.lux +++ b/stdlib/source/test/lux/time/instant.lux @@ -15,12 +15,12 @@ ["[0]" io]] [data [collection - ["[0]" list ("[1]\[0]" mix)]]] + ["[0]" list ("[1]#[0]" mix)]]] [math ["[0]" random]] [time ["[0]" duration {"+" [Duration]}] - ["[0]" day {"+" [Day]} ("[1]\[0]" enum)]]]] + ["[0]" day {"+" [Day]} ("[1]#[0]" enum)]]]] [\\library ["[0]" /]]) @@ -39,30 +39,30 @@ ($codec.spec /.equivalence /.codec random.instant)) (do random.monad - [.let [(^open "\[0]") /.equivalence] + [.let [(^open "#[0]") /.equivalence] expected random.instant] ($_ _.and (_.cover [/.millis /.of_millis] - (|> expected /.millis /.of_millis (\= expected))) + (|> expected /.millis /.of_millis (#= expected))) (_.cover [/.relative /.absolute] - (|> expected /.relative /.absolute (\= expected))) + (|> expected /.relative /.absolute (#= expected))) (_.cover [/.date /.time /.of_date_time] - (\= expected + (#= expected (/.of_date_time (/.date expected) (/.time expected)))) )) (do random.monad - [.let [(^open "\[0]") /.equivalence - (^open "duration\[0]") duration.equivalence] + [.let [(^open "#[0]") /.equivalence + (^open "duration#[0]") duration.equivalence] from random.instant to random.instant] ($_ _.and (_.cover [/.span] - (|> from (/.span from) (duration\= duration.empty))) + (|> from (/.span from) (duration#= duration.empty))) (_.cover [/.after] - (|> from (/.after (/.span from to)) (\= to))) + (|> from (/.after (/.span from to)) (#= to))) (_.cover [/.epoch] - (duration\= (/.relative to) + (duration#= (/.relative to) (/.span /.epoch to))) )) (do random.monad @@ -71,31 +71,31 @@ (_.cover [/.day_of_week] (let [apply (: (-> (-> Duration Duration) (-> Day Day) Nat Bit) (function (_ polarity move steps) - (let [day_shift (list\mix (function.constant move) + (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 + (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) + (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))))) + (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 _} diff --git a/stdlib/source/test/lux/time/month.lux b/stdlib/source/test/lux/time/month.lux index 354441828..b724ea855 100644 --- a/stdlib/source/test/lux/time/month.lux +++ b/stdlib/source/test/lux/time/month.lux @@ -12,12 +12,12 @@ ["$[0]" enum] ["$[0]" codec]]] [control - ["[0]" try ("[1]\[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] ["[0]" exception]] [data [collection ["[0]" set] - ["[0]" list ("[1]\[0]" functor mix)]]] + ["[0]" list ("[1]#[0]" functor mix)]]] [math ["[0]" random {"+" [Random]}] [number @@ -31,7 +31,7 @@ (Random /.Month) (let [december (/.number {/.#December})] (|> random.nat - (\ random.monad each (|>> (n.% december) ++)) + (# random.monad each (|>> (n.% december) ++)) (random.one (|>> /.by_number try.maybe))))) (def: .public test @@ -60,7 +60,7 @@ (|> expected /.number /.by_number - (try\each (\ /.equivalence = expected)) + (try#each (# /.equivalence = expected)) (try.else false))) (_.cover [/.invalid_month] (case (/.by_number invalid) @@ -79,19 +79,19 @@ (_.cover [/.days] (let [expected (.nat (duration.ticks duration.day duration.normal_year))] (|> /.year - (list\each /.days) - (list\mix n.+ 0) + (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) + (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) + (case (# /.codec decoded not_a_month) {try.#Failure error} (exception.match? /.not_a_month_of_the_year error) diff --git a/stdlib/source/test/lux/time/year.lux b/stdlib/source/test/lux/time/year.lux index f2b12e776..fab28f99b 100644 --- a/stdlib/source/test/lux/time/year.lux +++ b/stdlib/source/test/lux/time/year.lux @@ -12,7 +12,7 @@ ["[0]" try] ["[0]" exception]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [text ["%" format {"+" [format]}]]] [math @@ -47,7 +47,7 @@ [expected random.int] ($_ _.and (_.cover [/.year] - (bit\= (i.= +0 expected) + (bit#= (i.= +0 expected) (case (/.year expected) {try.#Success _} false @@ -73,7 +73,7 @@ (n.= (.nat (//duration.ticks //duration.day //duration.normal_year)) /.days)) (_.cover [/.epoch] - (\ /.equivalence = + (# /.equivalence = (//date.year (//instant.date //instant.epoch)) /.epoch)) (_.for [/.Period] 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 4e8a2c28b..cbc2b15aa 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 @@ -5,18 +5,18 @@ [data ["%" text/format {"+" [format]}] ["[0]" name]] - ["r" math/random {"+" [Random]} ("[1]\[0]" monad)] + ["r" math/random {"+" [Random]} ("[1]#[0]" monad)] ["_" test {"+" [Test]}] [control pipe ["[0]" maybe]] [data ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" monad)] + ["[0]" list ("[1]#[0]" monad)] ["[0]" set]]] ["[0]" type ["[0]" check]] @@ -45,7 +45,7 @@ {.#End} {.#Item head+ {.#End}} - (list\each (|>> list) head+) + (list#each (|>> list) head+) {.#Item head+ tail++} (do list.monad @@ -57,7 +57,7 @@ (-> Bit (List [Code Code]) Code (Random (List Code))) (case inputC [_ {.#Bit _}] - (r\in (list (' #0) (' #1))) + (r#in (list (' #0) (' #1))) (^template [<tag> <gen> <wrapper>] [[_ {<tag> _}] @@ -72,7 +72,7 @@ {.#None} (in (list (' _))))) - (r\in (list (' _))))]) + (r#in (list (' _))))]) ([.#Nat r.nat code.nat] [.#Int r.int code.int] [.#Rev r.rev code.rev] @@ -80,26 +80,26 @@ [.#Text (r.unicode 5) code.text]) (^ [_ {.#Tuple (list)}]) - (r\in (list (' []))) + (r#in (list (' []))) [_ {.#Tuple members}] (do [! r.monad] [member_wise_patterns (monad.each ! (exhaustive_branches allow_literals? variantTC) members)] (in (|> member_wise_patterns exhaustive_weaving - (list\each code.tuple)))) + (list#each code.tuple)))) (^ [_ {.#Record (list)}]) - (r\in (list (' {}))) + (r#in (list (' {}))) [_ {.#Record kvs}] (do [! r.monad] - [.let [ks (list\each product.left kvs) - vs (list\each product.right kvs)] + [.let [ks (list#each product.left kvs) + vs (list#each product.right kvs)] member_wise_patterns (monad.each ! (exhaustive_branches allow_literals? variantTC) vs)] (in (|> member_wise_patterns exhaustive_weaving - (list\each (|>> (list.zipped/2 ks) code.record))))) + (list#each (|>> (list.zipped/2 ks) code.record))))) (^ [_ {.#Form (list [_ {.#Tag _}] _)}]) (do [! r.monad] @@ -107,13 +107,13 @@ (function (_ [_tag _code]) (do ! [v_branches (exhaustive_branches allow_literals? variantTC _code)] - (in (list\each (function (_ pattern) (` ((~ _tag) (~ pattern)))) + (in (list#each (function (_ pattern) (` ((~ _tag) (~ pattern)))) v_branches)))) variantTC)] - (in (list\conjoint bundles))) + (in (list#conjoint bundles))) _ - (r\in (list)) + (r#in (list)) )) (def: .public (input variant_tags record_tags primitivesC) @@ -121,17 +121,17 @@ (r.rec (function (_ input) ($_ r.either - (r\each product.right _primitive.primitive) + (r#each product.right _primitive.primitive) (do [! r.monad] - [choice (|> r.nat (\ ! each (n.% (list.size variant_tags)))) + [choice (|> r.nat (# ! each (n.% (list.size variant_tags)))) .let [choiceT (maybe.trusted (list.item choice variant_tags)) choiceC (maybe.trusted (list.item choice primitivesC))]] (in (` ((~ choiceT) (~ choiceC))))) (do [! r.monad] - [size (|> r.nat (\ ! each (n.% 3))) + [size (|> r.nat (# ! each (n.% 3))) elems (r.list size input)] (in (code.tuple elems))) - (r\in (code.record (list.zipped/2 record_tags primitivesC))) + (r#in (code.record (list.zipped/2 record_tags primitivesC))) )))) (def: (branch body pattern) @@ -143,16 +143,16 @@ (do [! r.monad] [module_name (r.unicode 5) variant_name (r.unicode 5) - record_name (|> (r.unicode 5) (r.only (|>> (text\= variant_name) not))) - size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) - variant_tags (|> (r.set text.hash size (r.unicode 5)) (\ ! each set.list)) - record_tags (|> (r.set text.hash size (r.unicode 5)) (\ ! each set.list)) + record_name (|> (r.unicode 5) (r.only (|>> (text#= variant_name) not))) + size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) + variant_tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list)) + record_tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list)) primitivesTC (r.list size _primitive.primitive) - .let [primitivesT (list\each product.left primitivesTC) - primitivesC (list\each product.right primitivesTC) + .let [primitivesT (list#each product.left primitivesTC) + primitivesC (list#each product.right primitivesTC) code_tag (|>> [module_name] code.tag) - variant_tags+ (list\each code_tag variant_tags) - record_tags+ (list\each code_tag record_tags) + variant_tags+ (list#each code_tag variant_tags) + record_tags+ (list#each code_tag record_tags) variantTC (list.zipped/2 variant_tags+ primitivesC)] inputC (input variant_tags+ record_tags+ primitivesC) [outputT outputC] (r.only (|>> product.left (same? Any) not) @@ -170,7 +170,7 @@ (type.tuple primitivesT)})]) (//module.with_module 0 module_name)))] exhaustive_patterns (exhaustive_branches true variantTC inputC) - .let [exhaustive_branchesC (list\each (branch outputC) + .let [exhaustive_branchesC (list#each (branch outputC) exhaustive_patterns)]] ($_ _.and (_.test "Will reject empty pattern-matching (no branches)." @@ -186,7 +186,7 @@ _structure.check_fails))) (do ! [redundant_patterns (exhaustive_branches false variantTC inputC) - redundancy_idx (|> r.nat (\ ! each (n.% (list.size redundant_patterns)))) + redundancy_idx (|> r.nat (# ! each (n.% (list.size redundant_patterns)))) .let [redundant_branchesC (<| (list!each (branch outputC)) list.together (list (list.first redundancy_idx redundant_patterns) @@ -198,7 +198,7 @@ (do ! [[heterogeneousT heterogeneousC] (r.only (|>> product.left (check.subsumes? outputT) not) _primitive.primitive) - heterogeneous_idx (|> r.nat (\ ! each (n.% (list.size exhaustive_patterns)))) + heterogeneous_idx (|> r.nat (# ! each (n.% (list.size exhaustive_patterns)))) .let [heterogeneous_branchesC (list.together (list (list.first heterogeneous_idx exhaustive_branchesC) (list (let [[_pattern _body] (maybe.trusted (list.item heterogeneous_idx exhaustive_branchesC))] [_pattern heterogeneousC])) 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 4236d6022..9e41573a6 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 @@ -13,11 +13,11 @@ ["[0]" try]] [data ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] ["[0]" type] ["[0]" macro ["[0]" code]]] @@ -53,7 +53,7 @@ (def: abstraction (do r.monad [func_name (r.unicode 5) - arg_name (|> (r.unicode 5) (r.only (|>> (text\= func_name) not))) + arg_name (|> (r.unicode 5) (r.only (|>> (text#= func_name) not))) [outputT outputC] _primitive.primitive [inputT _] _primitive.primitive .let [g!arg (code.local_identifier arg_name)]] @@ -81,12 +81,12 @@ (def: apply (do [! r.monad] - [full_args (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) - partial_args (|> r.nat (\ ! each (n.% full_args))) - var_idx (|> r.nat (\ ! each (|>> (n.% full_args) (n.max 1)))) + [full_args (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) + partial_args (|> r.nat (# ! each (n.% full_args))) + var_idx (|> r.nat (# ! each (|>> (n.% full_args) (n.max 1)))) inputsTC (r.list full_args _primitive.primitive) - .let [inputsT (list\each product.left inputsTC) - inputsC (list\each product.right inputsTC)] + .let [inputsT (list#each product.left inputsTC) + inputsC (list#each product.right inputsTC)] [outputT outputC] _primitive.primitive .let [funcT (type.function inputsT outputT) partialT (type.function (list.after partial_args inputsT) outputT) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux index c81b5a62a..734078a84 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/primitive.lux @@ -6,7 +6,7 @@ [data ["%" text/format {"+" [format]}] ["[0]" name]] - ["r" math/random {"+" [Random]} ("[1]\[0]" monad)] + ["r" math/random {"+" [Random]} ("[1]#[0]" monad)] ["_" test {"+" [Test]}] [control pipe @@ -54,9 +54,9 @@ (Random [Type Code]) (`` ($_ r.either (~~ (template [<type> <code_wrapper> <value_gen>] - [(r.and (r\in <type>) (r\each <code_wrapper> <value_gen>))] + [(r.and (r#in <type>) (r#each <code_wrapper> <value_gen>))] - [Any code.tuple (r.list 0 (r\in (' [])))] + [Any code.tuple (r.list 0 (r#in (' [])))] [Bit code.bit r.bit] [Nat code.nat r.nat] [Int code.int r.int] 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 7fcc0f9e0..96bcf8507 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 @@ -3,17 +3,17 @@ [abstract ["[0]" monad {"+" [do]}]] [data - ["[0]" name ("[1]\[0]" equivalence)]] + ["[0]" name ("[1]#[0]" equivalence)]] ["r" math/random {"+" [Random]}] ["_" test {"+" [Test]}] [control pipe ["[0]" try {"+" [Try]}]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [number ["n" nat]]] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] [macro ["[0]" code]]] [// @@ -71,7 +71,7 @@ scope_name (r.unicode 5) var_name (r.unicode 5) dependent_module (|> (r.unicode 5) - (r.only (|>> (text\= def_module) not)))] + (r.only (|>> (text#= def_module) not)))] ($_ _.and (_.test "Can analyse variable." (|> (//scope.with_scope scope_name @@ -80,7 +80,7 @@ (_primitive.phase archive.empty (code.local_identifier var_name))))) (phase.result _primitive.state) (case> (^ {try.#Success [inferredT {////analysis.#Reference (////reference.local var)}]}) - (and (type\= expectedT inferredT) + (and (type#= expectedT inferredT) (n.= 0 var)) _ @@ -94,8 +94,8 @@ (//module.with_module 0 def_module) (phase.result _primitive.state) (case> (^ {try.#Success [_ inferredT {////analysis.#Reference (////reference.constant constant_name)}]}) - (and (type\= expectedT inferredT) - (name\= def_name constant_name)) + (and (type#= expectedT inferredT) + (name#= def_name constant_name)) _ false)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux index 9d3665427..463be39c2 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/structure.lux @@ -12,13 +12,13 @@ ["[0]" maybe] ["[0]" try]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" product] ["[0]" text] [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" functor)] + ["[0]" list ("[1]#[0]" functor)] ["[0]" set]]] ["[0]" type ["[0]" check]] @@ -63,7 +63,7 @@ actual//lefts (value@ ////analysis.#lefts variant)] (and (n.= expected//lefts actual//lefts) - (bit\= expected//right? + (bit#= expected//right? actual//right?)))) (def: (check_sum type tag size analysis) @@ -119,19 +119,19 @@ (def: sum (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) - choice (|> r.nat (\ ! each (n.% size))) + [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) + choice (|> r.nat (# ! each (n.% size))) primitives (r.list size _primitive.primitive) - +choice (|> r.nat (\ ! each (n.% (++ size)))) + +choice (|> r.nat (# ! each (n.% (++ size)))) [_ +valueC] _primitive.primitive - .let [variantT (type.variant (list\each product.left primitives)) + .let [variantT (type.variant (list#each product.left primitives)) [valueT valueC] (maybe.trusted (list.item choice primitives)) +size (++ size) +primitives (list.together (list (list.first choice primitives) (list [{.#Parameter 1} +valueC]) (list.after choice primitives))) [+valueT +valueC] (maybe.trusted (list.item +choice +primitives)) - +variantT (type.variant (list\each product.left +primitives))]] + +variantT (type.variant (list#each product.left +primitives))]] (<| (_.context (%.name (name_of /.sum))) ($_ _.and (_.test "Can analyse." @@ -171,21 +171,21 @@ (def: product (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) + [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) primitives (r.list size _primitive.primitive) - choice (|> r.nat (\ ! each (n.% size))) + choice (|> r.nat (# ! each (n.% size))) [_ +valueC] _primitive.primitive - .let [tupleT (type.tuple (list\each product.left primitives)) + .let [tupleT (type.tuple (list#each product.left primitives)) [singletonT singletonC] (|> primitives (list.item choice) maybe.trusted) +primitives (list.together (list (list.first choice primitives) (list [{.#Parameter 1} +valueC]) (list.after choice primitives))) - +tupleT (type.tuple (list\each product.left +primitives))]] + +tupleT (type.tuple (list#each product.left +primitives))]] (<| (_.context (%.name (name_of /.product))) ($_ _.and (_.test "Can analyse." (|> (//type.with_type tupleT - (/.product archive.empty _primitive.phase (list\each product.right primitives))) + (/.product archive.empty _primitive.phase (list#each product.right primitives))) (phase.result _primitive.state) (case> {try.#Success tupleA} (correct_size? size tupleA) @@ -194,7 +194,7 @@ false))) (_.test "Can infer." (|> (//type.with_inference - (/.product archive.empty _primitive.phase (list\each product.right primitives))) + (/.product archive.empty _primitive.phase (list#each product.right primitives))) (phase.result _primitive.state) (case> {try.#Success [_type tupleA]} (and (check.subsumes? tupleT _type) @@ -210,9 +210,9 @@ (|> (do phase.monad [[_ varT] (//type.with_env check.var) _ (//type.with_env - (check.check varT (type.tuple (list\each product.left primitives))))] + (check.check varT (type.tuple (list#each product.left primitives))))] (//type.with_type varT - (/.product archive.empty _primitive.phase (list\each product.right primitives)))) + (/.product archive.empty _primitive.phase (list#each product.right primitives)))) (phase.result _primitive.state) (case> {try.#Success tupleA} (correct_size? size tupleA) @@ -221,26 +221,26 @@ false))) (_.test "Can analyse through existential quantification." (|> (//type.with_type (type.ex_q 1 +tupleT) - (/.product archive.empty _primitive.phase (list\each product.right +primitives))) + (/.product archive.empty _primitive.phase (list#each product.right +primitives))) check_succeeds)) (_.test "Cannot analyse through universal quantification." (|> (//type.with_type (type.univ_q 1 +tupleT) - (/.product archive.empty _primitive.phase (list\each product.right +primitives))) + (/.product archive.empty _primitive.phase (list#each product.right +primitives))) check_fails)) )))) (def: variant (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) - tags (|> (r.set text.hash size (r.unicode 5)) (\ ! each set.list)) - choice (|> r.nat (\ ! each (n.% size))) - other_choice (|> r.nat (\ ! each (n.% size)) (r.only (|>> (n.= choice) not))) + [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) + tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list)) + choice (|> r.nat (# ! each (n.% size))) + other_choice (|> r.nat (# ! each (n.% size)) (r.only (|>> (n.= choice) not))) primitives (r.list size _primitive.primitive) module_name (r.unicode 5) type_name (r.unicode 5) .let [with_name (|>> {.#Named [module_name type_name]}) varT {.#Parameter 1} - primitivesT (list\each product.left primitives) + primitivesT (list#each product.left primitives) [choiceT choiceC] (maybe.trusted (list.item choice primitives)) [other_choiceT other_choiceC] (maybe.trusted (list.item other_choice primitives)) monoT (type.variant primitivesT) @@ -277,16 +277,16 @@ (def: record (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) - tags (|> (r.set text.hash size (r.unicode 5)) (\ ! each set.list)) + [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) + tags (|> (r.set text.hash size (r.unicode 5)) (# ! each set.list)) primitives (r.list size _primitive.primitive) module_name (r.unicode 5) type_name (r.unicode 5) - choice (|> r.nat (\ ! each (n.% size))) + choice (|> r.nat (# ! each (n.% size))) .let [varT {.#Parameter 1} - tagsC (list\each (|>> [module_name] code.tag) tags) - primitivesT (list\each product.left primitives) - primitivesC (list\each product.right primitives) + tagsC (list#each (|>> [module_name] code.tag) tags) + primitivesT (list#each product.left primitives) + primitivesC (list#each product.right primitives) monoT {.#Named [module_name type_name] (type.tuple primitivesT)} recordC (list.zipped/2 tagsC primitivesC) polyT (|> (type.tuple (list.together (list (list.first choice primitivesT) 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 528cc4ca9..c7bc89971 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 @@ -15,7 +15,7 @@ ["[0]" atom]]] [data ["[0]" product]] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] [macro ["[0]" code]]] [//// @@ -58,7 +58,7 @@ (do r.monad [[primT primC] ..primitive [antiT antiC] (|> ..primitive - (r.only (|>> product.left (type\= primT) not)))] + (r.only (|>> product.left (type#= primT) not)))] ($_ _.and (_.test "Can test for reference equality." (check_success+ "lux is" (list primC primC) Bit)) @@ -73,9 +73,9 @@ (def: i64 Test (do [! r.monad] - [subjectC (|> r.nat (\ ! each code.nat)) - signedC (|> r.int (\ ! each code.int)) - paramC (|> r.nat (\ ! each code.nat))] + [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)) @@ -100,8 +100,8 @@ (def: int Test (do [! r.monad] - [subjectC (|> r.int (\ ! each code.int)) - paramC (|> r.int (\ ! each code.int))] + [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)) @@ -120,9 +120,9 @@ (def: frac Test (do [! r.monad] - [subjectC (|> r.safe_frac (\ ! each code.frac)) - paramC (|> r.safe_frac (\ ! each code.frac)) - encodedC (|> r.safe_frac (\ ! each (|>> %.frac code.text)))] + [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)) @@ -155,11 +155,11 @@ (def: text Test (do [! r.monad] - [subjectC (|> (r.unicode 5) (\ ! each code.text)) - paramC (|> (r.unicode 5) (\ ! each code.text)) - replacementC (|> (r.unicode 5) (\ ! each code.text)) - fromC (|> r.nat (\ ! each code.nat)) - toC (|> r.nat (\ ! each code.nat))] + [subjectC (|> (r.unicode 5) (# ! each code.text)) + paramC (|> (r.unicode 5) (# ! each code.text)) + 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)) @@ -180,8 +180,8 @@ (def: io Test (do [! r.monad] - [logC (|> (r.unicode 5) (\ ! each code.text)) - exitC (|> r.int (\ ! each code.int))] + [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)) 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 9ef9354cf..876b9d819 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 @@ -6,7 +6,7 @@ ["[0]" monad {"+" [do]}]] [control [pipe {"+" [case>]}] - ["[0]" try ("[1]\[0]" functor)]] + ["[0]" try ("[1]#[0]" functor)]] [data ["[0]" sum] ["[0]" text @@ -17,7 +17,7 @@ ["[0]" rev] ["[0]" frac]] [collection - ["[0]" list ("[1]\[0]" functor mix monoid)] + ["[0]" list ("[1]#[0]" functor mix monoid)] ["[0]" set]]] [math ["[0]" random {"+" [Random]}]]] @@ -43,7 +43,7 @@ Test (do [! random.monad] [maskedA //primitive.primitive - temp (|> random.nat (\ ! each (n.% 100))) + temp (|> random.nat (# ! each (n.% 100))) .let [maskA (analysis.control/case [maskedA [[{analysis.#Bind temp} @@ -53,7 +53,7 @@ (|> maskA (//.phase archive.empty) (phase.result [///bundle.empty synthesis.init]) - (try\each (//primitive.corresponds? maskedA)) + (try#each (//primitive.corresponds? maskedA)) (try.default false))))) (def: let_test @@ -110,7 +110,7 @@ (def: random_member (Random synthesis.Member) (do [! random.monad] - [lefts (|> random.nat (\ ! each (n.% 10))) + [lefts (|> random.nat (# ! each (n.% 10))) right? random.bit] (in (if right? {.#Right lefts} @@ -119,7 +119,7 @@ (def: random_path (Random (analysis.Tuple synthesis.Member)) (do [! random.monad] - [size_1 (|> random.nat (\ ! each (|>> (n.% 10) ++)))] + [size_1 (|> random.nat (# ! each (|>> (n.% 10) ++)))] (random.list size_1 ..random_member))) (def: (get_pattern path) @@ -127,16 +127,16 @@ (Random [analysis.Pattern Register])) (do random.monad [@member random.nat] - (in [(list\mix (function (_ member inner) + (in [(list#mix (function (_ member inner) (case member {.#Left lefts} (analysis.pattern/tuple - (list\composite (list.repeated lefts (analysis.pattern/unit)) + (list#composite (list.repeated lefts (analysis.pattern/unit)) (list inner (analysis.pattern/unit)))) {.#Right lefts} (analysis.pattern/tuple - (list\composite (list.repeated (++ lefts) (analysis.pattern/unit)) + (list#composite (list.repeated (++ lefts) (analysis.pattern/unit)) (list inner))))) {analysis.#Bind @member} (list.reversed path)) @@ -146,9 +146,9 @@ Test (do [! random.monad] [recordA (|> random.nat - (\ ! each (|>> analysis.nat)) + (# ! each (|>> analysis.nat)) (random.list 10) - (\ ! each (|>> analysis.tuple))) + (# ! each (|>> analysis.tuple))) pathA ..random_path [pattern @member] (get_pattern pathA) .let [getA (analysis.control/case [recordA [[pattern @@ -159,7 +159,7 @@ (//.phase archive.empty) (phase.result [///bundle.empty synthesis.init]) (case> (^ {try.#Success (synthesis.branch/get [pathS recordS])}) - (and (\ (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS) + (and (# (list.equivalence (sum.equivalence n.= n.=)) = pathA pathS) (//primitive.corresponds? recordA recordS)) _ @@ -184,7 +184,7 @@ (All (_ a) (-> (Hash a) (Random a) (Random [a a a a a]))) (|> random_element (random.set hash 5) - (\ random.monad each (|>> set.list + (# random.monad each (|>> set.list (case> (^ (list s0 s1 s2 s3 s4)) [s0 s1 s2 s3 s4] @@ -262,7 +262,7 @@ (def: random_tuple (Random [Path Match]) (do [! random.monad] - [mid_size (\ ! each (n.% 4) random.nat) + [mid_size (# ! each (n.% 4) random.nat) value/first (random.unicode 1) value/mid (random.list mid_size (random.unicode 1)) @@ -290,26 +290,26 @@ branch (: (-> Nat Bit Text Frac Branch) (function (_ lefts right? value body) [analysis.#when (if right? - (analysis.pattern/tuple (list\composite (list.repeated (++ lefts) (analysis.pattern/unit)) + (analysis.pattern/tuple (list#composite (list.repeated (++ lefts) (analysis.pattern/unit)) (list (analysis.pattern/text value)))) - (analysis.pattern/tuple ($_ list\composite + (analysis.pattern/tuple ($_ list#composite (list.repeated lefts (analysis.pattern/unit)) (list (analysis.pattern/text value) (analysis.pattern/unit))))) analysis.#then (analysis.frac body)]))]] - (in [(list\mix (function (_ left right) + (in [(list#mix (function (_ left right) {synthesis.#Alt left right}) (path (++ mid_size) true value/last body/last) (|> (list.zipped/2 value/mid body/mid) {.#Item [value/first body/first]} list.enumeration - (list\each (function (_ [lefts' [value body]]) + (list#each (function (_ [lefts' [value body]]) (path lefts' false value body))) list.reversed)) [(branch 0 false value/first body/first) - (list\composite (|> (list.zipped/2 value/mid body/mid) + (list#composite (|> (list.zipped/2 value/mid body/mid) list.enumeration - (list\each (function (_ [lefts' [value body]]) + (list#each (function (_ [lefts' [value body]]) (branch (++ lefts') false value body)))) (list (branch (++ mid_size) true value/last body/last)))]]))) @@ -328,14 +328,14 @@ (def: case_test Test (do [! random.monad] - [expected_input (\ ! each (|>> .i64 synthesis.i64) random.nat) + [expected_input (# ! each (|>> .i64 synthesis.i64) random.nat) [expected_path match] ..random_case] (_.cover [/.synthesize_case] (|> (/.synthesize_case //.phase archive.empty expected_input match) (phase.result [///bundle.empty synthesis.init]) (case> (^ {try.#Success (synthesis.branch/case [actual_input actual_path])}) - (and (\ synthesis.equivalence = expected_input actual_input) - (\ synthesis.path_equivalence = expected_path actual_path)) + (and (# synthesis.equivalence = expected_input actual_input) + (# synthesis.path_equivalence = expected_path actual_path)) _ false))))) 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 dcc48735f..d7faa474e 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 @@ -12,7 +12,7 @@ [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" functor mix monoid)] + ["[0]" list ("[1]#[0]" functor mix monoid)] ["[0]" dictionary {"+" [Dictionary]}] ["[0]" set]]] [math @@ -50,11 +50,11 @@ (def: (n_abstraction arity body) (-> Arity Analysis Analysis) - (list\mix (function (_ arity_1 body) + (list#mix (function (_ arity_1 body) (case arity_1 0 {analysis.#Function (list) body} - _ {analysis.#Function ($_ list\composite - (list\each (|>> {variable.#Foreign}) + _ {analysis.#Function ($_ list#composite + (list#each (|>> {variable.#Foreign}) (list.indices arity_1)) (list {variable.#Local 1})) body})) @@ -80,7 +80,7 @@ (def: (random_unit output?) Scenario - (\ random.monad in + (# random.monad in [true (synthesis.text synthesis.unit) (analysis.unit)])) @@ -147,7 +147,7 @@ (def: (random_variable arity output?) (-> Arity Scenario) (do [! random.monad] - [register (\ ! each (|>> (n.% arity) ++) random.nat)] + [register (# ! each (|>> (n.% arity) ++) random.nat)] (in [(not (n.= 0 register)) (synthesis.variable/local register) (if (n.= arity register) @@ -177,7 +177,7 @@ text_test (random.unicode 1) [loop?_input expected_input actual_input] (random_value false) [loop?_output expected_output actual_output] (random_value output?) - lefts (|> random.nat (\ ! each (n.% 10))) + lefts (|> random.nat (# ! each (n.% 10))) right? random.bit .let [side|member (if right? {.#Right lefts} @@ -230,7 +230,7 @@ analysis.#value {analysis.#Bind 2}]) analysis.#then actual_output] [analysis.#when (analysis.pattern/tuple - (list\composite (list.repeated lefts (analysis.pattern/unit)) + (list#composite (list.repeated lefts (analysis.pattern/unit)) (if right? (list (analysis.pattern/unit) {analysis.#Bind 2}) (list {analysis.#Bind 2} (analysis.pattern/unit))))) @@ -279,7 +279,7 @@ (def: (random_get random_value output?) (-> Scenario Scenario) (do [! random.monad] - [lefts (|> random.nat (\ ! each (n.% 10))) + [lefts (|> random.nat (# ! each (n.% 10))) right? random.bit [loop?_record expected_record actual_record] (random_value false)] (in [loop?_record @@ -289,7 +289,7 @@ expected_record]) {analysis.#Case actual_record [[analysis.#when (analysis.pattern/tuple - (list\composite (list.repeated lefts (analysis.pattern/unit)) + (list#composite (list.repeated lefts (analysis.pattern/unit)) (if right? (list (analysis.pattern/unit) {analysis.#Bind 2}) (list {analysis.#Bind 2} (analysis.pattern/unit))))) @@ -308,27 +308,27 @@ (do [! random.monad] [resets (random.list arity (random_value false))] (in [true - (synthesis.loop/recur (list\each (|>> product.right product.left) resets)) + (synthesis.loop/recur (list#each (|>> product.right product.left) resets)) (analysis.apply [{analysis.#Reference (case arity 1 (reference.local 0) _ (reference.foreign 0))} - (list\each (|>> product.right product.right) resets)])]))) + (list#each (|>> product.right product.right) resets)])]))) (def: (random_scope arity output?) (-> Arity Scenario) (do [! random.monad] [resets (random.list arity (..random_variable arity output?)) [_ expected_output actual_output] (..random_nat output?)] - (in [(list\mix (function (_ new old) + (in [(list#mix (function (_ new old) (and new old)) true - (list\each product.left resets)) + (list#each product.left resets)) (synthesis.loop/scope [synthesis.#start (++ arity) - synthesis.#inits (list\each (|>> product.right product.left) resets) + synthesis.#inits (list#each (|>> product.right product.left) resets) synthesis.#iteration expected_output]) (analysis.apply [(..n_abstraction arity actual_output) - (list\each (|>> product.right product.right) resets)])]))) + (list#each (|>> product.right product.right) resets)])]))) (def: (random_loop arity random_value output?) (-> Arity Scenario Scenario) @@ -343,9 +343,9 @@ Scenario (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}) + arity (|> random.nat (# ! each (|>> (n.% 5) ++))) + .let [environment ($_ list#composite + (list#each (|>> {variable.#Foreign}) (list.indices arity)) (list {variable.#Local 1}))]] (in [true @@ -363,16 +363,16 @@ (-> Scenario Scenario) (do [! random.monad] [[loop?_abstraction expected_abstraction actual_abstraction] (..random_nat output?) - arity (|> random.nat (\ ! each (|>> (n.% 5) ++))) + arity (|> random.nat (# ! each (|>> (n.% 5) ++))) inputs (random.list arity (random_value false))] - (in [(list\mix (function (_ new old) + (in [(list#mix (function (_ new old) (and new old)) loop?_abstraction - (list\each product.left inputs)) + (list#each product.left inputs)) (synthesis.function/apply [expected_abstraction - (list\each (|>> product.right product.left) inputs)]) + (list#each (|>> product.right product.left) inputs)]) (analysis.apply [actual_abstraction - (list\each (|>> product.right product.right) inputs)])]))) + (list#each (|>> product.right product.right) inputs)])]))) (def: (random_function random_value output?) (-> Scenario Scenario) @@ -419,7 +419,7 @@ (def: random_abstraction (Random [Synthesis Analysis]) (do [! random.monad] - [arity (|> random.nat (\ ! each (|>> (n.% 5) ++))) + [arity (|> random.nat (# ! each (|>> (n.% 5) ++))) [loop? expected_body actual_body] (random_body arity true)] (in [(..n_function loop? arity expected_body) (..n_abstraction arity actual_body)]))) @@ -433,12 +433,12 @@ (//.phase archive.empty) (phase.result [///bundle.empty synthesis.init]) (!expect (^multi {try.#Success actual} - (\ synthesis.equivalence = expected actual))))))) + (# synthesis.equivalence = expected actual))))))) (def: application Test (do [! random.monad] - [arity (|> random.nat (\ ! each (|>> (n.% 10) (n.max 1)))) + [arity (|> random.nat (# ! each (|>> (n.% 10) (n.max 1)))) funcA //primitive.primitive argsA (random.list arity //primitive.primitive)] (_.cover [/.apply] 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 f34540102..bbd047ca5 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 @@ -10,9 +10,9 @@ [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]]] [\\ ["[0]" / [//// @@ -31,13 +31,13 @@ (`` ($_ random.either (~~ (template [<synthesis> <random>] [(do [! random.monad] - [example (\ ! each (|>> <synthesis>) <random>)] + [example (# ! each (|>> <synthesis>) <random>)] (in [next [example example]]))] [//.bit random.bit] - [//.i64 (\ ! each .i64 random.nat)] + [//.i64 (# ! each .i64 random.nat)] [//.f64 random.frac] [//.text (random.unicode 1)] )) @@ -55,7 +55,7 @@ (def: (variable offset arity next) (Scenario Variable) (let [local (do [! random.monad] - [register (\ ! each (|>> (n.% arity) ++) random.nat)] + [register (# ! each (|>> (n.% arity) ++) random.nat)] (in [next [{variable.#Local (/.register_optimization offset register)} {variable.#Local register}]]))] @@ -64,7 +64,7 @@ _ ($_ random.either local (do [! random.monad] - [foreign (\ ! each (n.% offset) random.nat)] + [foreign (# ! each (n.% offset) random.nat)] (in [next [{variable.#Local foreign} {variable.#Foreign foreign}]])))))) @@ -112,24 +112,24 @@ (let [pattern (: (Scenario Path) (.function (recur offset arity next) (`` ($_ random.either - (random\in [next + (random#in [next [//.path/pop //.path/pop]]) (~~ (template [<path> <random>] [(do [! random.monad] - [example (\ ! each (|>> <path>) <random>)] + [example (# ! each (|>> <path>) <random>)] (in [next [example example]]))] [//.path/bit random.bit] - [//.path/i64 (\ ! each .i64 random.nat)] + [//.path/i64 (# ! each .i64 random.nat)] [//.path/f64 random.frac] [//.path/text (random.unicode 1)] )) (~~ (template [<path>] [(do [! random.monad] - [example (\ ! each (|>> <path>) + [example (# ! each (|>> <path>) (random.or random.nat random.nat))] (in [next @@ -139,7 +139,7 @@ [//.path/side] [//.path/member] )) - (random\in [(++ next) + (random#in [(++ next) [(//.path/bind (/.register_optimization offset next)) (//.path/bind next)]]) )))) @@ -182,7 +182,7 @@ ($_ random.either (do [! random.monad] [[next [recordE recordA]] (..reference offset arity next) - path_length (\ ! each (|>> (n.% 5) ++) random.nat) + path_length (# ! each (|>> (n.% 5) ++) random.nat) path (random.list path_length random_member)] (in [next [(//.branch/get [path recordE]) @@ -219,7 +219,7 @@ (do [! random.monad] [[next [firstE firstA]] (..variable offset arity next) [next [secondE secondA]] (..variable offset arity next) - arity (\ ! each (n.max 1) random.nat) + arity (# ! each (n.max 1) random.nat) [next [bodyE bodyA]] (..primitive 0 arity next)] (in [next [(//.function/abstraction @@ -266,27 +266,27 @@ (<| (_.covering /._) ($_ _.and (do [! random.monad] - [expected_offset (\ ! each (|>> (n.% 5) (n.+ 2)) random.nat) - arity (\ ! each (|>> (n.% 5) ++) random.nat) + [expected_offset (# ! each (|>> (n.% 5) (n.+ 2)) random.nat) + arity (# ! each (|>> (n.% 5) ++) random.nat) expected_inits (|> random.nat - (\ ! each (|>> .i64 //.i64)) + (# ! 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}))) + (list#each (|>> {variable.#Local}))) //.#arity arity //.#body iteration]) (^ {.#Some (//.loop/scope [actual_offset actual_inits actual])}) (and (n.= expected_offset actual_offset) - (\ (list.equivalence //.equivalence) = + (# (list.equivalence //.equivalence) = expected_inits actual_inits) - (\ //.equivalence = expected actual)) + (# //.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 107cae01d..5940e03d2 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 @@ -11,7 +11,7 @@ ["n" nat]] [collection ["[0]" list]]] - ["r" math/random {"+" [Random]} ("[1]\[0]" monad)] + ["r" math/random {"+" [Random]} ("[1]#[0]" monad)] ["_" test {"+" [Test]}]] [\\ ["[0]" / "_" @@ -87,10 +87,10 @@ _ false))))] - [////analysis.#Unit ////synthesis.#Text (r\in ////synthesis.unit)] + [////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.#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 898187283..99c2d430d 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 @@ -11,7 +11,7 @@ pipe ["[0]" try]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" product] [number ["n" nat]] @@ -36,8 +36,8 @@ (def: variant Test (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 10) (n.+ 2)))) - tagA (|> r.nat (\ ! each (n.% size))) + [size (|> r.nat (# ! each (|>> (n.% 10) (n.+ 2)))) + tagA (|> r.nat (# ! each (n.% size))) .let [right? (n.= (-- size) tagA) lefts (if right? (-- tagA) @@ -50,7 +50,7 @@ (case> (^ {try.#Success (////synthesis.variant [leftsS right?S valueS])}) (let [tagS (if right?S (++ leftsS) leftsS)] (and (n.= tagA tagS) - (|> tagS (n.= (-- size)) (bit\= right?S)) + (|> tagS (n.= (-- size)) (bit#= right?S)) (//primitive.corresponds? memberA valueS))) _ @@ -59,7 +59,7 @@ (def: tuple Test (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2)))) + [size (|> r.nat (# ! each (|>> (n.% 10) (n.max 2)))) membersA (r.list size //primitive.primitive)] (_.test "Can synthesize tuple." (|> (////analysis.tuple membersA) 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 dbfa2ea78..b941d73e6 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 @@ -15,7 +15,7 @@ [number ["n" nat]] [collection - ["[0]" list ("[1]\[0]" functor mix)] + ["[0]" list ("[1]#[0]" functor mix)] ["[0]" dictionary {"+" [Dictionary]}]]]] [\\ ["[0]" / @@ -50,7 +50,7 @@ (<synthesis> value)])))] [bit_scenario synthesis.bit random.bit] - [i64_scenario synthesis.i64 (\ ! each .i64 random.nat)] + [i64_scenario synthesis.i64 (# ! each .i64 random.nat)] [f64_scenario synthesis.f64 random.frac] [text_scenario synthesis.text (random.unicode 1)] ) @@ -96,9 +96,9 @@ (def: (tuple_scenario context) (Scenario Synthesis) (let [registers (dictionary.entries (value@ #necessary context))] - (\ random.monad in - [(synthesis.tuple (list\each (|>> product.left synthesis.variable/local) registers)) - (synthesis.tuple (list\each (|>> product.right synthesis.variable/local) registers))]))) + (# random.monad in + [(synthesis.tuple (list#each (|>> product.left synthesis.variable/local) registers)) + (synthesis.tuple (list#each (|>> product.right synthesis.variable/local) registers))]))) (def: (structure_scenario context) (Scenario Synthesis) @@ -143,7 +143,7 @@ (def: (get_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do [! random.monad] - [length (\ ! each (|>> (n.% 5) ++) random.nat) + [length (# ! each (|>> (n.% 5) ++) random.nat) path (random.list length ..random_member) [expected_record actual_record] (scenario context)] (in [(synthesis.branch/get [path expected_record]) @@ -187,7 +187,7 @@ {synthesis.#Then actual_then}}]))] [synthesis.#Bit random.bit] - [synthesis.#I64 (\ ! each .i64 random.nat)] + [synthesis.#I64 (# ! each .i64 random.nat)] [synthesis.#F64 random.frac] [synthesis.#Text (random.unicode 1)] ))) @@ -244,23 +244,23 @@ inits (random.list ..scope_arity (scenario context)) [expected_iteration actual_iteration] (scenario (revised@ #necessary (function (_ necessary) - (list\mix (function (_ [idx _] context) + (list#mix (function (_ [idx _] context) (dictionary.has (n.+ real_start idx) (n.+ fake_start idx) context)) necessary (list.enumeration inits))) context))] - (in [(synthesis.loop/scope [real_start (list\each product.left inits) expected_iteration]) - (synthesis.loop/scope [fake_start (list\each product.right inits) actual_iteration])]))) + (in [(synthesis.loop/scope [real_start (list#each product.left inits) expected_iteration]) + (synthesis.loop/scope [fake_start (list#each product.right inits) actual_iteration])]))) (def: (recur_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do [! random.monad] [_ (in []) resets (random.list ..scope_arity (scenario context))] - (in [(synthesis.loop/recur (list\each product.left resets)) - (synthesis.loop/recur (list\each product.right resets))]))) + (in [(synthesis.loop/recur (list#each product.left resets)) + (synthesis.loop/recur (list#each product.right resets))]))) (def: (loop_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -274,8 +274,8 @@ (do [! random.monad] [_ (in []) .let [registers (dictionary.entries (value@ #necessary context)) - expected_environment (list\each (|>> product.left {variable.#Local}) registers) - actual_environment (list\each (|>> product.right {variable.#Local}) registers)] + expected_environment (list#each (|>> product.left {variable.#Local}) registers) + actual_environment (list#each (|>> product.right {variable.#Local}) registers)] [expected_body actual_body] (..primitive_scenario context)] (in [(synthesis.function/abstraction [expected_environment 1 expected_body]) (synthesis.function/abstraction [actual_environment 1 actual_body])]))) @@ -283,12 +283,12 @@ (def: (apply_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) (do [! random.monad] - [abstraction (\ ! each (|>> synthesis.constant) + [abstraction (# ! each (|>> synthesis.constant) (random.and (random.unicode 1) (random.unicode 1))) inputs (random.list ..scope_arity (scenario context))] - (in [(synthesis.function/apply [abstraction (list\each product.left inputs)]) - (synthesis.function/apply [abstraction (list\each product.right inputs)])]))) + (in [(synthesis.function/apply [abstraction (list#each product.left inputs)]) + (synthesis.function/apply [abstraction (list#each product.right inputs)])]))) (def: (function_scenario scenario context) (-> (Scenario Synthesis) (Scenario Synthesis)) @@ -331,5 +331,5 @@ (_.cover [/.optimization] (|> (/.optimization input) (!expect (^multi {try.#Success actual} - (\ synthesis.equivalence = expected 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 6683f7d8c..08cd0035a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/syntax.lux @@ -6,7 +6,7 @@ ["[0]" name] [number ["n" nat]]] - ["r" math/random {"+" [Random]} ("[1]\[0]" monad)] + ["r" math/random {"+" [Random]} ("[1]#[0]" monad)] ["_" test {"+" [Test]}] [control ["[0]" try] @@ -27,7 +27,7 @@ (def: name_part^ (Random Text) (do [! r.monad] - [size (|> r.nat (\ ! each (|>> (n.% 20) (n.max 1))))] + [size (|> r.nat (# ! each (|>> (n.% 20) (n.max 1))))] (r.ascii/lower_alpha size))) (def: name^ @@ -38,18 +38,18 @@ (Random Code) (let [numeric^ (: (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)))) + (|> r.bit (r#each code.bit)) + (|> r.nat (r#each code.nat)) + (|> r.int (r#each code.int)) + (|> r.rev (r#each code.rev)) + (|> r.safe_frac (r#each code.frac)))) textual^ (: (Random Code) ($_ r.either (do r.monad - [size (|> r.nat (r\each (n.% 20)))] - (|> (r.ascii/upper_alpha size) (r\each code.text))) - (|> name^ (r\each code.identifier)) - (|> name^ (r\each code.tag)))) + [size (|> r.nat (r#each (n.% 20)))] + (|> (r.ascii/upper_alpha size) (r#each code.text))) + (|> name^ (r#each code.identifier)) + (|> name^ (r#each code.tag)))) simple^ (: (Random Code) ($_ r.either numeric^ @@ -57,16 +57,16 @@ (r.rec (function (_ code^) (let [multi^ (do r.monad - [size (|> r.nat (r\each (n.% 3)))] + [size (|> r.nat (r#each (n.% 3)))] (r.list size code^)) composite^ (: (Random Code) ($_ r.either - (|> multi^ (r\each code.form)) - (|> multi^ (r\each code.tuple)) + (|> multi^ (r#each code.form)) + (|> multi^ (r#each code.tuple)) (do r.monad - [size (|> r.nat (r\each (n.% 3)))] + [size (|> r.nat (r#each (n.% 3)))] (|> (r.list size (r.and code^ code^)) - (r\each code.record)))))] + (r#each code.record)))))] ($_ r.either simple^ composite^)))))) @@ -84,7 +84,7 @@ false {.#Right [_ parsed]} - (\ code.equivalence = parsed sample))) + (# code.equivalence = parsed sample))) (do ! [other code^] (_.test "Can parse multiple Lux code nodes." @@ -102,15 +102,15 @@ false {.#Right [_ =other]} - (and (\ code.equivalence = sample =sample) - (\ code.equivalence = other =other))))))) + (and (# code.equivalence = sample =sample) + (# code.equivalence = other =other))))))) ))) (def: comment_text^ (Random Text) (let [char_gen (|> r.nat (r.only (|>> (n.= (`` (char (~~ (static text.new_line))))) not)))] (do r.monad - [size (|> r.nat (r\each (n.% 20)))] + [size (|> r.nat (r#each (n.% 20)))] (r.text char_gen size)))) (def: comment^ @@ -134,7 +134,7 @@ false {.#Right [_ parsed]} - (\ code.equivalence = parsed sample))) + (# code.equivalence = parsed sample))) ))) (def: .public test diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index 82798e7f3..b1abd1dc7 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -10,19 +10,19 @@ [pipe {"+" [case>]}] ["[0]" maybe]] [data - ["[0]" bit ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list] ["[0]" array]]] [macro - ["[0]" code ("[1]\[0]" equivalence)]] + ["[0]" code ("[1]#[0]" equivalence)]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\library - ["[0]" / ("[1]\[0]" equivalence)]] + ["[0]" / ("[1]#[0]" equivalence)]] ["[0]" / "_" ["[1][0]" abstract] ["[1][0]" check] @@ -38,7 +38,7 @@ (def: short (Random Text) (do [! random.monad] - [size (|> random.nat (\ ! each (n.% 10)))] + [size (|> random.nat (# ! each (n.% 10)))] (random.unicode size))) (def: name @@ -52,24 +52,24 @@ (let [pairG (random.and recur recur) un_parameterized (: (Random Type) ($_ random.either - (random\each (|>> {.#Primitive}) (random.and ..short (random.list 0 recur))) - (random\each (|>> {.#Primitive}) (random.and ..short (random.list 1 recur))) - (random\each (|>> {.#Primitive}) (random.and ..short (random.list 2 recur))) - (random\each (|>> {.#Sum}) pairG) - (random\each (|>> {.#Product}) pairG) - (random\each (|>> {.#Function}) pairG) + (random#each (|>> {.#Primitive}) (random.and ..short (random.list 0 recur))) + (random#each (|>> {.#Primitive}) (random.and ..short (random.list 1 recur))) + (random#each (|>> {.#Primitive}) (random.and ..short (random.list 2 recur))) + (random#each (|>> {.#Sum}) pairG) + (random#each (|>> {.#Product}) pairG) + (random#each (|>> {.#Function}) pairG) ))] (case parameters 0 un_parameterized _ (|> random.nat - (random\each (|>> (n.% parameters) {.#Parameter})) + (random#each (|>> (n.% parameters) {.#Parameter})) (random.either un_parameterized))))))) (def: .public (random parameters) (-> Nat (Random Type)) ($_ random.either - (random\each (/.univ_q parameters) (random' parameters)) - (random\each (/.ex_q parameters) (random' parameters)) + (random#each (/.univ_q parameters) (random' parameters)) + (random#each (/.ex_q parameters) (random' parameters)) )) (def: .public test @@ -89,11 +89,11 @@ aliasedT {.#Named name/1 namedT}]] ($_ _.and (_.cover [/.de_aliased] - (\ /.equivalence = namedT (/.de_aliased aliasedT))) + (# /.equivalence = namedT (/.de_aliased aliasedT))) (_.cover [/.anonymous] - (\ /.equivalence = anonymousT (/.anonymous aliasedT))))) + (# /.equivalence = anonymousT (/.anonymous aliasedT))))) (do [! random.monad] - [size (|> random.nat (\ ! each (n.% 3))) + [size (|> random.nat (# ! each (n.% 3))) members (|> (..random 0) (random.only (function (_ type) (case type @@ -104,15 +104,15 @@ #1))) (list.repeated size) (monad.all !)) - .let [(^open "/\[0]") /.equivalence - (^open "list\[0]") (list.equivalence /.equivalence)]] + .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)))))] + (or (list#= members flat) + (and (list#= (list) members) + (list#= (list <unit>) flat)))))] [/.variant /.flat_variant Nothing] [/.tuple /.flat_tuple Any] @@ -123,11 +123,11 @@ (do maybe.monad [partial (/.applied (list Bit) Ann) full (/.applied (list Int) partial)] - (in (\ /.equivalence = full {.#Product Bit Int})))) + (in (# /.equivalence = full {.#Product Bit Int})))) (|> (/.applied (list Bit) Text) (case> {.#None} #1 _ #0)))) (do [! random.monad] - [size (|> random.nat (\ ! each (n.% 3))) + [size (|> random.nat (# ! each (n.% 3))) members (monad.all ! (list.repeated size (..random 0))) extra (|> (..random 0) (random.only (function (_ type) @@ -137,19 +137,19 @@ _ #1)))) - .let [(^open "/\[0]") /.equivalence - (^open "list\[0]") (list.equivalence /.equivalence)]] + .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)))) + (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) ++))) + [size (|> random.nat (# ! each (|>> (n.% 3) ++))) body_type (|> (..random 0) (random.only (function (_ type) (case type @@ -158,13 +158,13 @@ _ #1)))) - .let [(^open "/\[0]") /.equivalence]] + .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))))] + (/#= body_type flat_body))))] [/.univ_q /.flat_univ_q] [/.ex_q /.flat_ex_q] @@ -175,21 +175,21 @@ (|> body_type (/.ex_q size) /.quantified?))) ))) (do [! random.monad] - [depth (|> random.nat (\ ! each (|>> (n.% 3) ++))) + [depth (|> random.nat (# ! each (|>> (n.% 3) ++))) element_type (|> (..random 0) (random.only (function (_ type) (case type (^ {.#Primitive name (list element_type)}) - (not (text\= array.type_name name)) + (not (text#= array.type_name name)) _ #1)))) - .let [(^open "/\[0]") /.equivalence]] + .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)))) + (/#= element_type flat_element)))) (_.cover [/.array?] (and (not (/.array? element_type)) (/.array? (/.array depth element_type)))) @@ -197,7 +197,7 @@ (_.cover [/.:by_example] (let [example (: (Maybe Nat) {.#None})] - (/\= (.type (List Nat)) + (/#= (.type (List Nat)) (/.:by_example [a] (Maybe a) example @@ -229,16 +229,16 @@ (I64 a) (.i64 expected))))) (do random.monad - [.let [(^open "/\[0]") /.equivalence] + [.let [(^open "/#[0]") /.equivalence] left (..random 0) right (..random 0)] ($_ _.and (_.cover [/.code] - (bit\= (/\= left right) - (code\= (/.code left) (/.code right)))) + (bit#= (/#= left right) + (code#= (/.code left) (/.code right)))) (_.cover [/.format] - (bit\= (/\= left right) - (text\= (/.format left) (/.format right)))) + (bit#= (/#= left right) + (text#= (/.format left) (/.format right)))) )) /abstract.test diff --git a/stdlib/source/test/lux/type/abstract.lux b/stdlib/source/test/lux/type/abstract.lux index 3f0e20752..ee1b7fc4a 100644 --- a/stdlib/source/test/lux/type/abstract.lux +++ b/stdlib/source/test/lux/type/abstract.lux @@ -11,7 +11,7 @@ [parser ["<[0]>" code]]] [data - ["[0]" text ("[1]\[0]" equivalence)]] + ["[0]" text ("[1]#[0]" equivalence)]] ["[0]" macro [syntax {"+" [syntax:]}] ["[0]" code] @@ -72,7 +72,7 @@ (/.:abstraction g!Foo) (: (g!Foo Bit)) (/.:representation g!Foo) - (text\= expected_foo)) + (text#= expected_foo)) (|> (/.:abstraction expected_bar) (: (g!Bar Bit)) /.:representation @@ -93,7 +93,7 @@ (and (let [(/.^:representation g!Foo actual_foo) (: (g!Foo .Module) (/.:abstraction g!Foo expected_foo))] - (text\= expected_foo actual_foo)) + (text#= expected_foo actual_foo)) (let [(/.^:representation actual_bar) (: (g!Bar .Module) (/.:abstraction expected_bar))] @@ -101,10 +101,10 @@ (_.for [/.Frame] ($_ _.and (_.cover [/.current] - (text\= (template.text [g!Bar]) + (text#= (template.text [g!Bar]) (..current))) (_.cover [/.specific] - (text\= (template.text [g!Foo]) + (text#= (template.text [g!Foo]) (..specific))) (_.cover [/.no_active_frames] (and no_current! diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 628b45d63..8b7011176 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -2,7 +2,7 @@ [library [lux {"-" [type]} ["_" test {"+" [Test]}] - ["[0]" type ("[1]\[0]" equivalence)] + ["[0]" type ("[1]#[0]" equivalence)] [abstract ["[0]" monad {"+" [do]}] [\\specification @@ -15,15 +15,15 @@ ["[0]" try] ["[0]" exception {"+" [exception:]}]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] ["[0]" product] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection - ["[0]" list ("[1]\[0]" functor monoid)] + ["[0]" list ("[1]#[0]" functor monoid)] ["[0]" set]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)] [number ["n" nat]]]]] [\\library @@ -43,25 +43,25 @@ (random.rec (function (_ recur) (let [pairG (random.and recur recur) - quantifiedG (random.and (random\in (list)) (type' (++ num_vars))) - random_pair (random.either (random.either (random\each (|>> {.#Sum}) pairG) - (random\each (|>> {.#Product}) pairG)) - (random.either (random\each (|>> {.#Function}) pairG) - (random\each (|>> {.#Apply}) pairG))) - random_id (let [random_id (random.either (random\each (|>> {.#Var}) random.nat) - (random\each (|>> {.#Ex}) random.nat))] + quantifiedG (random.and (random#in (list)) (type' (++ num_vars))) + random_pair (random.either (random.either (random#each (|>> {.#Sum}) pairG) + (random#each (|>> {.#Product}) pairG)) + (random.either (random#each (|>> {.#Function}) pairG) + (random#each (|>> {.#Apply}) pairG))) + random_id (let [random_id (random.either (random#each (|>> {.#Var}) random.nat) + (random#each (|>> {.#Ex}) random.nat))] (case num_vars 0 random_id - _ (random.either (random\each (|>> (n.% num_vars) (n.* 2) ++ {.#Parameter}) random.nat) + _ (random.either (random#each (|>> (n.% num_vars) (n.* 2) ++ {.#Parameter}) random.nat) random_id))) - random_quantified (random.either (random\each (|>> {.#UnivQ}) quantifiedG) - (random\each (|>> {.#ExQ}) quantifiedG))] + random_quantified (random.either (random#each (|>> {.#UnivQ}) quantifiedG) + (random#each (|>> {.#ExQ}) quantifiedG))] ($_ random.either - (random\each (|>> {.#Primitive}) (random.and ..short (random\in (list)))) + (random#each (|>> {.#Primitive}) (random.and ..short (random#in (list)))) random_pair random_id random_quantified - (random\each (|>> {.#Named}) (random.and ..name (type' 0))) + (random#each (|>> {.#Named}) (random.and ..name (type' 0))) ))))) (def: type @@ -91,7 +91,7 @@ (def: injection (Injection (All (_ a) (/.Check a))) - (\ /.monad in)) + (# /.monad in)) (def: comparison (Comparison (All (_ a) (/.Check a))) @@ -154,7 +154,7 @@ (case (/.result /.fresh_context (do /.monad [[var_id var_type] /.var] - (in (type\= var_type {.#Var var_id})))) + (in (type#= var_type {.#Var var_id})))) {try.#Success verdict} verdict {try.#Failure error} false)) (do random.monad @@ -442,8 +442,8 @@ _ (/.check var/head nominal/0) failures (monad.each ! (|>> (/.check nominal/1) ..verdict) (list& var/head var/tail+)) successes (monad.each ! (|>> (/.check nominal/0) ..verdict) (list& var/head var/tail+))] - (/.assertion "" (and (list.every? (bit\= false) failures) - (list.every? (bit\= true) successes))))) + (/.assertion "" (and (list.every? (bit#= false) failures) + (list.every? (bit#= true) successes))))) can_merge_multiple_rings_of_variables! (succeeds? (do [! /.monad] @@ -451,12 +451,12 @@ [var/head/1 var/tail+/1 var/last/1] (..build_ring tail_size) _ (/.check var/head/0 var/head/1) _ (/.check var/head/0 nominal/0) - .let [all_variables (list\composite (list& var/head/0 var/tail+/0) + .let [all_variables (list#composite (list& var/head/0 var/tail+/0) (list& var/head/1 var/tail+/1))] failures (monad.each ! (|>> (/.check nominal/1) ..verdict) all_variables) successes (monad.each ! (|>> (/.check nominal/0) ..verdict) all_variables)] - (/.assertion "" (and (list.every? (bit\= false) failures) - (list.every? (bit\= true) successes)))))] + (/.assertion "" (and (list.every? (bit#= false) failures) + (list.every? (bit#= true) successes)))))] (and can_create_rings_of_variables! can_bind_rings_of_variables! can_merge_multiple_rings_of_variables!))) @@ -613,11 +613,11 @@ Test (do [! random.monad] [nominal ..nominal - [name/0 name/1] (..non_twins text\= (random.ascii/upper 10)) - [parameter/0 parameter/1] (..non_twins type\= ..nominal) + [name/0 name/1] (..non_twins text#= (random.ascii/upper 10)) + [parameter/0 parameter/1] (..non_twins type#= ..nominal) left_name ..name right_name ..name - ring_tail_size (\ ! each (n.% 10) random.nat)] + ring_tail_size (# ! each (n.% 10) random.nat)] (_.cover [/.check] (and (..handles_nominal_types! name/0 name/1 parameter/0 parameter/1) (..handles_products! name/0 name/1) @@ -637,7 +637,7 @@ (random.rec (function (_ dirty_type) (`` ($_ random.either - (random\each (function (_ id) + (random#each (function (_ id) (function.constant {.#Ex id})) random.nat) (do random.monad @@ -685,7 +685,7 @@ (and (|> (do /.monad [[var_id varT] /.var cleanedT (/.clean (type_shape varT))] - (in (type\= (type_shape varT) + (in (type#= (type_shape varT) cleanedT))) (/.result /.fresh_context) (try.else false)) @@ -694,7 +694,7 @@ [_ replacementT] /.existential _ (/.check varT replacementT) cleanedT (/.clean (type_shape varT))] - (in (type\= (type_shape replacementT) + (in (type#= (type_shape replacementT) cleanedT))) (/.result /.fresh_context) (try.else false)) @@ -850,7 +850,7 @@ [expected random.nat] (_.cover [/.result] (case (/.result /.fresh_context - (\ /.monad in expected)) + (# /.monad in expected)) {try.#Success actual} (same? expected actual) {try.#Failure error} false))) ..error_handling diff --git a/stdlib/source/test/lux/type/dynamic.lux b/stdlib/source/test/lux/type/dynamic.lux index 0a85b8631..522e82882 100644 --- a/stdlib/source/test/lux/type/dynamic.lux +++ b/stdlib/source/test/lux/type/dynamic.lux @@ -8,7 +8,7 @@ ["[0]" try] ["[0]" exception]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random {"+" [Random]}] @@ -41,7 +41,7 @@ (_.cover [/.format] (case (/.format (/.:dynamic expected)) {try.#Success actual} - (text\= (%.nat expected) 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 dd5d5ea72..c1853f0b1 100644 --- a/stdlib/source/test/lux/type/implicit.lux +++ b/stdlib/source/test/lux/type/implicit.lux @@ -9,7 +9,7 @@ [monad {"+" [do]}] ["[0]" enum]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math @@ -25,7 +25,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [.let [digit (\ ! each (n.% 10) random.nat)] + [.let [digit (# ! each (n.% 10) random.nat)] left digit right digit .let [start (n.min left right) @@ -34,31 +34,31 @@ left random.nat right random.nat] ($_ _.and - (_.cover [/.\\] + (_.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))))) + (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) + (let [lln (/.## each (enum.range n.enum start) (enum.range n.enum start end))] - (/.\\ = lln lln))] + (/.## = lln lln))] (and first_order! second_order! third_order!))) (_.cover [/.with] (/.with [n.addition] - (n.= (\ n.addition composite left right) - (/.\\ composite left right)))) + (n.= (# n.addition composite left right) + (/.## composite left right)))) (_.cover [/.implicit:] - (n.= (\ n.multiplication composite left right) - (/.\\ composite left right))) + (n.= (# n.multiplication composite left right) + (/.## composite left right))) )))) diff --git a/stdlib/source/test/lux/type/poly/equivalence.lux b/stdlib/source/test/lux/type/poly/equivalence.lux index 738578386..3fa9e59f3 100644 --- a/stdlib/source/test/lux/type/poly/equivalence.lux +++ b/stdlib/source/test/lux/type/poly/equivalence.lux @@ -57,8 +57,8 @@ (def: random (Random Record) (do [! random.monad] - [size (\ ! each (n.% 2) random.nat) - .let [gen_int (|> random.int (\ ! each (|>> i.abs (i.% +1,000,000))))]] + [size (# ! each (n.% 2) random.nat) + .let [gen_int (|> random.int (# ! each (|>> i.abs (i.% +1,000,000))))]] ($_ random.and random.bit gen_int diff --git a/stdlib/source/test/lux/type/poly/json.lux b/stdlib/source/test/lux/type/poly/json.lux index 2be75b3e8..b9d16c2ed 100644 --- a/stdlib/source/test/lux/type/poly/json.lux +++ b/stdlib/source/test/lux/type/poly/json.lux @@ -86,12 +86,12 @@ (def: qty (All (_ unit) (Random (unit.Qty unit))) - (\ random.monad each (debug.private unit.in') random.int)) + (# random.monad each (debug.private unit.in') random.int)) (def: gen_record (Random Record) (do [! random.monad] - [size (\ ! each (n.% 2) random.nat)] + [size (# ! each (n.% 2) random.nat)] ($_ random.and random.bit random.safe_frac diff --git a/stdlib/source/test/lux/type/quotient.lux b/stdlib/source/test/lux/type/quotient.lux index f0ed3b638..a06999879 100644 --- a/stdlib/source/test/lux/type/quotient.lux +++ b/stdlib/source/test/lux/type/quotient.lux @@ -7,18 +7,18 @@ [\\specification ["$[0]" equivalence]]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random {"+" [Random]}] [number - ["n" nat ("[1]\[0]" equivalence)]]]]] + ["n" nat ("[1]#[0]" equivalence)]]]]] [\\library ["[0]" /]]) (def: .public (random class super) (All (_ t c %) (-> (/.Class t c %) (Random t) (Random (/.Quotient t c %)))) - (\ random.monad each (/.quotient class) super)) + (# random.monad each (/.quotient class) super)) (def: mod_10_class (/.class (|>> (n.% 10) %.nat))) @@ -49,7 +49,7 @@ (let [quotient (/.quotient (/.class class) value)] (and (same? value (/.value quotient)) - (text\= (class value) + (text#= (class value) (/.label quotient))))) (_.cover [/.type] (exec diff --git a/stdlib/source/test/lux/type/refinement.lux b/stdlib/source/test/lux/type/refinement.lux index de7b0070b..6dbe2447f 100644 --- a/stdlib/source/test/lux/type/refinement.lux +++ b/stdlib/source/test/lux/type/refinement.lux @@ -6,10 +6,10 @@ [predicate {"+" [Predicate]}] [monad {"+" [do]}]] [control - ["[0]" maybe ("[1]\[0]" monad)]] + ["[0]" maybe ("[1]#[0]" monad)]] [data [collection - ["[0]" list ("[1]\[0]" functor)]]] + ["[0]" list ("[1]#[0]" functor)]]] [math ["[0]" random] [number @@ -29,10 +29,10 @@ (_.for [/.Refined]) (do [! random.monad] [raw random.nat - modulus (\ ! each (|>> (n.% 10) (n.+ 2)) random.nat) + modulus (# ! each (|>> (n.% 10) (n.+ 2)) random.nat) .let [predicate (: (Predicate Nat) (|>> (n.% modulus) (n.= 0)))] - total_raws (\ ! each (|>> (n.% 20) ++) random.nat) + total_raws (# ! each (|>> (n.% 20) ++) random.nat) raws (random.list total_raws random.nat)] ($_ _.and (_.for [/.Refiner] @@ -46,23 +46,23 @@ (not (predicate raw)))) (_.cover [/.predicate] (|> (/.refiner predicate modulus) - (maybe\each (|>> /.predicate (same? predicate))) + (maybe#each (|>> /.predicate (same? predicate))) (maybe.else false))) )) (_.cover [/.value] (|> (/.refiner predicate modulus) - (maybe\each (|>> /.value (n.= 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#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#each (/.lifted (n.+ (++ modulus)))) + maybe#conjoint + (maybe#each (|>> /.value (n.= (n.+ modulus (++ modulus))))) (maybe.else false) not))) (_.cover [/.only] @@ -70,9 +70,9 @@ actual (/.only (/.refiner predicate) raws)] (and (n.= (list.size expected) (list.size actual)) - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected - (list\each /.value actual))))) + (list#each /.value actual))))) (_.cover [/.partition] (let [expected (list.only predicate raws) [actual alternative] (/.partition (/.refiner predicate) raws)] @@ -80,9 +80,9 @@ (list.size actual)) (n.= (n.- (list.size expected) total_raws) (list.size alternative)) - (\ (list.equivalence n.equivalence) = + (# (list.equivalence n.equivalence) = expected - (list\each /.value actual))))) + (list#each /.value actual))))) (_.cover [/.type] (exec (: (Maybe .._type) (.._refiner raw)) diff --git a/stdlib/source/test/lux/type/resource.lux b/stdlib/source/test/lux/type/resource.lux index 4f06802b3..a8514fcfc 100644 --- a/stdlib/source/test/lux/type/resource.lux +++ b/stdlib/source/test/lux/type/resource.lux @@ -16,7 +16,7 @@ ["<[0]>" code]]] [data ["[0]" identity {"+" [Identity]}] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] ["[0]" macro [syntax {"+" [syntax:]}] @@ -29,14 +29,14 @@ (def: pure Test (monad.do [! random.monad] - [pre (\ ! each %.nat random.nat) - post (\ ! each %.nat random.nat) + [pre (# ! each %.nat random.nat) + post (# ! each %.nat random.nat) .let [! identity.monad]] (_.for [/.Linear /.run! /.monad] (`` ($_ _.and (~~ (template [<coverage> <bindings>] [(_.cover <coverage> - (<| (text\= (format pre post)) + (<| (text#= (format pre post)) (: (Identity Text)) (/.run! !) (do (/.monad !) @@ -71,14 +71,14 @@ (def: sync Test (monad.do [! random.monad] - [pre (\ ! each %.nat random.nat) - post (\ ! each %.nat random.nat) + [pre (# ! each %.nat random.nat) + post (# ! each %.nat random.nat) .let [! io.monad]] (_.for [/.Linear /.run! /.monad] (`` ($_ _.and (~~ (template [<coverage> <bindings>] [(_.cover <coverage> - (<| (text\= (format pre post)) + (<| (text#= (format pre post)) io.run! (: (IO Text)) (/.run! !) @@ -114,8 +114,8 @@ (def: async Test (monad.do [! random.monad] - [pre (\ ! each %.nat random.nat) - post (\ ! each %.nat random.nat) + [pre (# ! each %.nat random.nat) + post (# ! each %.nat random.nat) .let [! async.monad]] (_.for [/.Linear /.run! /.monad] (`` ($_ _.and @@ -127,7 +127,7 @@ <bindings> (in (format left right))))] (_.cover' <coverage> - (text\= (format pre post) + (text#= (format pre post) outcome))))] [[/.Affine /.Key /.Res /.Ordered /.ordered diff --git a/stdlib/source/test/lux/type/unit.lux b/stdlib/source/test/lux/type/unit.lux index b7bcf40f3..3d5e6f74a 100644 --- a/stdlib/source/test/lux/type/unit.lux +++ b/stdlib/source/test/lux/type/unit.lux @@ -18,7 +18,7 @@ ["[0]" random {"+" [Random]}] [number ["i" int] - ["[0]" ratio ("[1]\[0]" equivalence)]]]]] + ["[0]" ratio ("[1]#[0]" equivalence)]]]]] [\\library ["[0]" /]]) @@ -26,9 +26,9 @@ [(def: (<name> range) (-> Nat (Random (/.Qty <type>))) (|> random.int - (\ random.monad each (i.% (.int range))) + (# random.monad each (i.% (.int range))) (random.only (|>> (i.= +0) not)) - (\ random.monad each (\ <unit> in))))] + (# random.monad each (# <unit> in))))] [meter /.Meter /.meter] [second /.Second /.second] @@ -56,8 +56,8 @@ (~~ (template [<type> <unit>] [(_.cover [<type> <unit>] (|> expected - (\ <unit> in) - (\ <unit> out) + (# <unit> in) + (# <unit> out) (i.= expected)))] [/.Gram /.gram] @@ -72,13 +72,13 @@ (i.= expected))) (_.cover [/.unit:] (|> expected - (\ ..what in) - (\ ..what out) + (# ..what in) + (# ..what out) (i.= expected))) ))))) (syntax: (natural []) - (\ meta.monad each + (# meta.monad each (|>> code.nat list) meta.seed)) @@ -95,28 +95,28 @@ Test (do [! random.monad] [small (|> random.int - (\ ! each (i.% +1,000)) - (\ ! each (\ /.meter in))) + (# ! each (i.% +1,000)) + (# ! each (# /.meter in))) large (|> random.int - (\ ! each (i.% +1,000)) - (\ ! each (i.* +1,000,000,000)) - (\ ! each (\ /.meter in))) - .let [(^open "meter\[0]") (: (Equivalence (/.Qty /.Meter)) + (# ! each (i.% +1,000)) + (# ! each (i.* +1,000,000,000)) + (# ! each (# /.meter in))) + .let [(^open "meter#[0]") (: (Equivalence (/.Qty /.Meter)) /.equivalence)] unscaled (|> random.int - (\ ! each (i.% +1,000)) - (\ ! each (i.* (.int how::to))) - (\ ! each (\ /.meter in)))] + (# ! each (i.% +1,000)) + (# ! each (i.* (.int how::to))) + (# ! each (# /.meter in)))] (_.for [/.Scale] (`` ($_ _.and (~~ (template [<type> <scale>] [(_.cover [<type> <scale>] (|> large - (\ <scale> scale) + (# <scale> scale) (: (/.Qty (<type> /.Meter))) - (\ <scale> de_scale) + (# <scale> de_scale) (: (/.Qty /.Meter)) - (meter\= large)))] + (meter#= large)))] [/.Kilo /.kilo] [/.Mega /.mega] @@ -125,11 +125,11 @@ (~~ (template [<type> <scale>] [(_.cover [<type> <scale>] (|> small - (\ <scale> scale) + (# <scale> scale) (: (/.Qty (<type> /.Meter))) - (\ <scale> de_scale) + (# <scale> de_scale) (: (/.Qty /.Meter)) - (meter\= small)))] + (meter#= small)))] [/.Milli /.milli] [/.Micro /.micro] @@ -137,41 +137,41 @@ )) (_.cover [/.re_scaled] (|> large (: (/.Qty /.Meter)) - (\ /.kilo scale) (: (/.Qty (/.Kilo /.Meter))) + (# /.kilo scale) (: (/.Qty (/.Kilo /.Meter))) (/.re_scaled /.kilo /.milli) (: (/.Qty (/.Milli /.Meter))) (/.re_scaled /.milli /.kilo) (: (/.Qty (/.Kilo /.Meter))) - (\ /.kilo de_scale) (: (/.Qty /.Meter)) - (meter\= large))) + (# /.kilo de_scale) (: (/.Qty /.Meter)) + (meter#= large))) (_.cover [/.scale:] (and (|> unscaled - (\ ..how scale) - (\ ..how de_scale) - (meter\= unscaled)) - (ratio\= [..how::from + (# ..how scale) + (# ..how de_scale) + (meter#= unscaled)) + (ratio#= [..how::from ..how::to] - (\ ..how ratio)))) + (# ..how ratio)))) ))))) (def: arithmetic Test (do random.monad - [.let [zero (\ /.meter in +0) - (^open "meter\[0]") (: (Equivalence (/.Qty /.Meter)) + [.let [zero (# /.meter in +0) + (^open "meter#[0]") (: (Equivalence (/.Qty /.Meter)) /.equivalence)] - left (random.only (|>> (meter\= zero) not) (..meter 1,000)) + 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))))] + (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)) + (let [expected (i.* (# /.meter out left) (# /.meter out right)) actual ((debug.private /.out') (: (/.Qty [/.Meter /.Meter]) (/.* left right)))] (i.= expected actual))) @@ -179,7 +179,7 @@ (|> right (/.* left) (/./ left) - (meter\= right))) + (meter#= right))) )))) (def: .public test diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux index f044be377..da25ac18a 100644 --- a/stdlib/source/test/lux/world/console.lux +++ b/stdlib/source/test/lux/world/console.lux @@ -9,7 +9,7 @@ ["[0]" try {"+" [Try]}] ["[0]" exception {"+" [exception:]}]] [data - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]]] [math ["[0]" random]]]] @@ -61,10 +61,10 @@ (io.run! (do io.monad [?_ (/.write_line expected console) - ?actual (\ console read_line [])] + ?actual (# console read_line [])] (in (<| (try.else false) (do try.monad [_ ?_ actual ?actual] - (in (text\= expected actual))))))))) + (in (text#= expected actual))))))))) ))) diff --git a/stdlib/source/test/lux/world/file/watch.lux b/stdlib/source/test/lux/world/file/watch.lux index 3e7b03015..5f4ae714d 100644 --- a/stdlib/source/test/lux/world/file/watch.lux +++ b/stdlib/source/test/lux/world/file/watch.lux @@ -11,13 +11,13 @@ [concurrency ["[0]" async {"+" [Async]}]]] [data - ["[0]" binary {"+" [Binary]} ("[1]\[0]" equivalence)] - ["[0]" text ("[1]\[0]" equivalence) + ["[0]" binary {"+" [Binary]} ("[1]#[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence) ["%" format {"+" [format]}]] [collection ["[0]" list]]] [math - ["[0]" random {"+" [Random]} ("[1]\[0]" monad)]]]] + ["[0]" random {"+" [Random]} ("[1]#[0]" monad)]]]] [\\library ["[0]" / ["/[1]" //]]] @@ -28,12 +28,12 @@ (def: concern (Random [/.Concern (Predicate /.Concern)]) ($_ random.either - (random\in [/.creation /.creation?]) - (random\in [/.modification /.modification?]) - (random\in [/.deletion /.deletion?]) + (random#in [/.creation /.creation?]) + (random#in [/.modification /.modification?]) + (random#in [/.deletion /.deletion?]) )) -(def: concern\\test +(def: concern##test Test (<| (_.for [/.Concern]) ($_ _.and @@ -72,8 +72,8 @@ .let [[fs watcher] (/.mock "/")]] ($_ _.and (in (do async.monad - [?concern (\ watcher concern directory) - ?stop (\ watcher stop directory)] + [?concern (# watcher concern directory) + ?stop (# watcher stop directory)] (_.cover' [/.not_being_watched] (and (case ?concern {try.#Failure error} @@ -92,21 +92,21 @@ (def: (no_events_prior_to_creation! fs watcher directory) (-> (//.System Async) (/.Watcher Async) //.Path (Async (Try Bit))) (do [! (try.with async.monad)] - [_ (\ fs make_directory directory) - _ (\ watcher start /.all directory)] - (|> (\ watcher poll []) - (\ ! each list.empty?)))) + [_ (# fs make_directory directory) + _ (# watcher start /.all directory)] + (|> (# watcher poll []) + (# ! each list.empty?)))) (def: (after_creation! fs watcher expected_path) (-> (//.System Async) (/.Watcher Async) //.Path (Async (Try Bit))) (do (try.with async.monad) [_ (: (Async (Try Any)) (//.make_file async.monad fs (binary.empty 0) expected_path)) - poll/pre (\ watcher poll []) - poll/post (\ watcher poll [])] + poll/pre (# watcher poll []) + poll/post (# watcher poll [])] (in (and (case poll/pre (^ (list [concern actual_path])) - (and (text\= expected_path actual_path) + (and (text#= expected_path actual_path) (and (/.creation? concern) (not (/.modification? concern)) (not (/.deletion? concern)))) @@ -119,12 +119,12 @@ (-> (//.System Async) (/.Watcher Async) Binary //.Path (Async (Try Bit))) (do (try.with async.monad) [_ (async.after 1 {try.#Success "Delay to make sure the over_write time-stamp always changes."}) - _ (\ fs write data expected_path) - poll/2 (\ watcher poll []) - poll/2' (\ watcher poll [])] + _ (# fs write data expected_path) + poll/2 (# watcher poll []) + poll/2' (# watcher poll [])] (in (and (case poll/2 (^ (list [concern actual_path])) - (and (text\= expected_path actual_path) + (and (text#= expected_path actual_path) (and (not (/.creation? concern)) (/.modification? concern) (not (/.deletion? concern)))) @@ -136,9 +136,9 @@ (def: (after_deletion! fs watcher expected_path) (-> (//.System Async) (/.Watcher Async) //.Path (Async (Try Bit))) (do (try.with async.monad) - [_ (\ fs delete expected_path) - poll/3 (\ watcher poll []) - poll/3' (\ watcher poll [])] + [_ (# fs delete expected_path) + poll/3 (# watcher poll []) + poll/3' (# watcher poll [])] (in (and (case poll/3 (^ (list [concern actual_path])) (and (not (/.creation? concern)) @@ -154,14 +154,14 @@ (<| (_.covering /._) (_.for [/.Watcher]) ($_ _.and - ..concern\\test + ..concern##test ..exception (do [! random.monad] [directory (random.ascii/alpha 5) .let [/ "/" [fs watcher] (/.mock /)] - expected_path (\ ! each (|>> (format directory /)) + expected_path (# ! each (|>> (format directory /)) (random.ascii/alpha 5)) data ($binary.random 10)] (in (do [! async.monad] @@ -188,7 +188,7 @@ .let [/ "/" [fs watcher] (/.mock /)]] (in (do async.monad - [started? ( \ watcher start /.all directory)] + [started? (# watcher start /.all directory)] (_.cover' [/.cannot_poll_a_non_existent_directory] (case started? {try.#Success _} diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux index 192c406c1..dcd14099c 100644 --- a/stdlib/source/test/lux/world/input/keyboard.lux +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -7,7 +7,7 @@ [control ["[0]" maybe]] [data - ["[0]" bit ("[1]\[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] [collection ["[0]" list] ["[0]" set {"+" [Set]}]]] @@ -140,7 +140,7 @@ (Random /.Key) (let [count (list.size ..listing)] (do [! random.monad] - [choice (\ ! each (n.% count) random.nat)] + [choice (# ! each (n.% count) random.nat)] (in (maybe.trusted (list.item choice ..listing)))))) (def: .public test @@ -160,7 +160,7 @@ [key ..random .let [sample (<function> key)]] (_.cover [<function>] - (and (bit\= <pressed?> (value@ /.#pressed? sample)) + (and (bit#= <pressed?> (value@ /.#pressed? sample)) (n.= key (value@ /.#input sample)))))] [#0 /.release] diff --git a/stdlib/source/test/lux/world/net/http/client.lux b/stdlib/source/test/lux/world/net/http/client.lux index 5160aae60..6dee42643 100644 --- a/stdlib/source/test/lux/world/net/http/client.lux +++ b/stdlib/source/test/lux/world/net/http/client.lux @@ -41,7 +41,7 @@ on_connect random.nat on_options random.nat on_trace random.nat - num_headers (\ ! each (nat.% 10) random.nat) + num_headers (# ! each (nat.% 10) random.nat) headers (random.dictionary text.hash num_headers (random.ascii/lower 3) (random.ascii/lower 3)) .let [mock (: (/.Client IO) (implementation @@ -57,8 +57,8 @@ {//.#Options} on_options {//.#Trace} on_trace) data (|> value - (\ nat.decimal encoded) - (\ utf8.codec encoded))] + (# nat.decimal encoded) + (# utf8.codec encoded))] {try.#Success [//status.ok [//.#headers headers //.#body (function (_ ?wanted_bytes) @@ -71,8 +71,8 @@ (do> try.monad [io.run!] [product.right (value@ //.#body) (function.on {.#None}) io.run!] - [product.right (\ utf8.codec decoded)] - [(\ nat.decimal decoded)] + [product.right (# utf8.codec decoded)] + [(# nat.decimal decoded)] [(nat.= <expected>) in]) (try.else false)))] diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux index 5c4990479..efd6e44dc 100644 --- a/stdlib/source/test/lux/world/output/video/resolution.lux +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -47,7 +47,7 @@ (Random /.Resolution) (let [count (list.size ..listing)] (do [! random.monad] - [choice (\ ! each (n.% count) random.nat)] + [choice (# ! each (n.% count) random.nat)] (in (maybe.trusted (list.item choice ..listing)))))) (def: .public test diff --git a/stdlib/source/test/lux/world/program.lux b/stdlib/source/test/lux/world/program.lux index e5909bcba..f65951af0 100644 --- a/stdlib/source/test/lux/world/program.lux +++ b/stdlib/source/test/lux/world/program.lux @@ -7,13 +7,13 @@ [control [pipe {"+" [case>]}] ["[0]" io] - ["[0]" maybe ("[1]\[0]" functor)] + ["[0]" maybe ("[1]#[0]" functor)] ["[0]" try] ["[0]" exception] [parser [environment {"+" [Environment]}]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" dictionary] ["[0]" list]]] @@ -42,7 +42,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [env_size (\ ! each (|>> (n.% 10) ++) random.nat) + [env_size (# ! each (|>> (n.% 10) ++) random.nat) environment (..environment env_size) home ..path directory ..path @@ -63,12 +63,12 @@ (list.every? (function (_ [key value]) (|> environment (dictionary.value key) - (maybe\each (text\= value)) + (maybe#each (text#= value)) (maybe.else false))))))))))) (_.cover [/.unknown_environment_variable] (let [program (/.mock environment home directory)] (|> unknown - (\ program variable) + (# program variable) io.run! (case> {try.#Success _} false diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index c79a2fa14..6525997bc 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -13,7 +13,7 @@ [parser ["[0]" environment {"+" [Environment]}]]] [data - ["[0]" text ("[1]\[0]" equivalence)] + ["[0]" text ("[1]#[0]" equivalence)] [collection ["[0]" list]]] [math @@ -98,28 +98,28 @@ .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 []) + [process (# shell execute [environment.empty "~" command (list)]) + read (# process read []) + failure (# process fail []) wrote! (do ! - [write (\ process write input)] + [write (# process write input)] (in {try.#Success (case write {try.#Success _} false {try.#Failure write} - (text\= input write))})) + (text#= input write))})) destroyed! (do ! - [destroy (\ process destroy [])] + [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) + (text#= destruction destroy))})) + await (# process await [])] + (in (and (text#= command read) + (text#= oops failure) wrote! destroyed! (i.= exit await))))] |