diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
38 files changed, 330 insertions, 330 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index d3bd06b58..b9fe6c207 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.assume (/.write/8 idx byte output)) (recur (inc idx)))) - (:: random.monad wrap output))))) + (\ random.monad wrap output))))) (def: (throws? exception try) (All [e a] (-> (Exception e) (Try a) Bit)) @@ -78,11 +78,11 @@ Test (<| (_.covering /._) (do {! random.monad} - [#let [gen-size (|> random.nat (:: ! map (|>> (n.% 100) (n.max 8))))] + [#let [gen-size (|> random.nat (\ ! map (|>> (n.% 100) (n.max 8))))] size gen-size sample (..random size) value random.nat - #let [gen-idx (|> random.nat (:: ! map (n.% size)))] + #let [gen-idx (|> random.nat (\ ! map (n.% size)))] [from to] (random.and gen-idx gen-idx) #let [[from to] [(n.min from to) (n.max from to)]]] (_.with-cover [/.Binary] @@ -92,13 +92,13 @@ (_.with-cover [/.monoid] ($monoid.spec /.equivalence /.monoid (..random size))) (_.cover [/.fold] - (n.= (:: list.fold fold n.+ 0 (..as-list sample)) + (n.= (\ list.fold fold n.+ 0 (..as-list sample)) (/.fold n.+ 0 sample))) (_.cover [/.create] - (:: /.equivalence = - (/.create size) - (/.create size))) + (\ /.equivalence = + (/.create size) + (/.create size))) (_.cover [/.size] (|> (/.create size) /.size (n.= size))) (_.with-cover [/.index-out-of-bounds] @@ -120,7 +120,7 @@ (case [(monad.map try.monad (reader random-slice) idxs) (monad.map try.monad (|>> (n.+ from) (reader sample)) idxs)] [(#try.Success slice-vals) (#try.Success binary-vals)] - (:: (list.equivalence n.equivalence) = slice-vals binary-vals) + (\ (list.equivalence n.equivalence) = slice-vals binary-vals) _ #0)))) @@ -131,8 +131,8 @@ (or (throws? /.inverted-slice (/.slice to from sample)) (n.= to from))) (_.cover [/.drop] - (and (:: /.equivalence = sample (/.drop 0 sample)) - (:: /.equivalence = (/.create 0) (/.drop size sample)) + (and (\ /.equivalence = sample (/.drop 0 sample)) + (\ /.equivalence = (/.create 0) (/.drop size sample)) (case (list.reverse (..as-list sample)) #.Nil false @@ -144,7 +144,7 @@ (and (case (/.copy size 0 sample 0 (/.create size)) (#try.Success output) (and (not (is? 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 0be42e466..0b3eab351 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -31,6 +31,6 @@ ($codec.spec /.equivalence /.codec random.bit)) (_.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 5a94f13b7..99ae8e06d 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -30,8 +30,8 @@ (def: bounded-size (Random Nat) - (:: random.monad map (|>> (n.% 100) (n.+ 1)) - random.nat)) + (\ random.monad map (|>> (n.% 100) (n.+ 1)) + random.nat)) (def: structures Test @@ -58,9 +58,9 @@ the-array (random.array size random.nat)] ($_ _.and (_.cover [/.find] - (:: (maybe.equivalence n.equivalence) = - (/.find n.even? the-array) - (list.find n.even? (/.to-list the-array)))) + (\ (maybe.equivalence n.equivalence) = + (/.find n.even? the-array) + (list.find n.even? (/.to-list the-array)))) (_.cover [/.find+] (case [(/.find n.even? the-array) (/.find+ (function (_ idx member) @@ -78,13 +78,13 @@ [#.None #.None] true)) (_.cover [/.every?] - (:: bit.equivalence = - (list.every? n.even? (/.to-list the-array)) - (/.every? n.even? the-array))) + (\ bit.equivalence = + (list.every? n.even? (/.to-list the-array)) + (/.every? n.even? the-array))) (_.cover [/.any?] - (:: bit.equivalence = - (list.any? n.even? (/.to-list the-array)) - (/.any? n.even? the-array))) + (\ bit.equivalence = + (list.any? n.even? (/.to-list the-array)) + (/.any? n.even? the-array))) ))) (def: #export test @@ -167,7 +167,7 @@ _ false))) (do ! - [occupancy (:: ! map (n.% (inc size)) random.nat)] + [occupancy (\ ! map (n.% (inc size)) random.nat)] (_.cover [/.occupancy /.vacancy] (let [the-array (loop [output (: (Array Nat) (/.new size)) @@ -183,22 +183,22 @@ [the-list (random.list size random.nat)] (_.cover [/.from-list /.to-list] (and (|> the-list /.from-list /.to-list - (:: (list.equivalence n.equivalence) = the-list)) + (\ (list.equivalence n.equivalence) = the-list)) (|> the-array /.to-list /.from-list - (:: (/.equivalence n.equivalence) = the-array))))) + (\ (/.equivalence n.equivalence) = the-array))))) (do ! - [amount (:: ! map (n.% (inc size)) random.nat)] + [amount (\ ! map (n.% (inc size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.new size))] (exec (/.copy! amount 0 the-array 0 copy) - (:: (list.equivalence n.equivalence) = - (list.take amount (/.to-list the-array)) - (/.to-list copy)))))) + (\ (list.equivalence n.equivalence) = + (list.take amount (/.to-list the-array)) + (/.to-list copy)))))) (_.cover [/.clone] (let [clone (/.clone the-array)] (and (not (is? the-array clone)) - (:: (/.equivalence n.equivalence) = the-array clone)))) + (\ (/.equivalence n.equivalence) = the-array clone)))) (let [the-array (/.clone the-array) evens (|> the-array /.to-list (list.filter n.even?)) odds (|> the-array /.to-list (list.filter n.odd?))] @@ -206,7 +206,7 @@ (exec (/.filter! n.even? the-array) (and (n.= (list.size evens) (/.occupancy the-array)) (n.= (list.size odds) (/.vacancy the-array)) - (|> the-array /.to-list (:: (list.equivalence n.equivalence) = evens)))))) + (|> the-array /.to-list (\ (list.equivalence n.equivalence) = evens)))))) (do ! [#let [the-array (/.clone the-array) members (|> the-array /.to-list (set.from-list n.hash))] diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index a31fec37c..cb5ecf681 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -18,16 +18,16 @@ (def: (size min max) (-> Nat Nat (Random Nat)) (|> random.nat - (:: random.monad map (|>> (n.% (inc max)) (n.max min))))) + (\ random.monad map (|>> (n.% (inc max)) (n.max min))))) (def: #export random (Random Bits) (do {! random.monad} - [size (:: ! map (n.% 1,000) random.nat)] + [size (\ ! map (n.% 1,000) random.nat)] (case size 0 (wrap /.empty) _ (do {! random.monad} - [idx (|> random.nat (:: ! map (n.% size)))] + [idx (|> random.nat (\ ! map (n.% size)))] (wrap (/.set idx /.empty)))))) (def: #export test @@ -48,8 +48,8 @@ (/.empty? /.empty)) (do {! random.monad} - [size (:: ! map (|>> (n.% 1,000) inc) random.nat) - idx (:: ! map (n.% size) random.nat) + [size (\ ! map (|>> (n.% 1,000) inc) random.nat) + idx (\ ! map (n.% size) random.nat) sample ..random] ($_ _.and (_.cover [/.get /.set] @@ -80,17 +80,17 @@ (_.cover [/.not] (and (is? /.empty (/.not /.empty)) (or (is? /.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 (is? /.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)) (is? /.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 6d35fd15b..718c9f0c9 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -29,7 +29,7 @@ (def: for-dictionaries Test (do random.monad - [#let [capped-nat (:: random.monad map (n.% 100) random.nat)] + [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] size capped-nat dict (random.dictionary n.hash size random.nat capped-nat) non-key (|> random.nat (random.filter (function (_ key) (not (/.contains? key dict))))) @@ -49,10 +49,10 @@ (/.empty? sample)))) (_.cover [/.entries /.keys /.values] - (:: (list.equivalence (equivalence.product n.equivalence n.equivalence)) = - (/.entries dict) - (list.zip/2 (/.keys dict) - (/.values dict)))) + (\ (list.equivalence (equivalence.product n.equivalence n.equivalence)) = + (/.entries dict) + (list.zip/2 (/.keys dict) + (/.values dict)))) (_.cover [/.merge] (let [merging-with-oneself (let [(^open ".") (/.equivalence n.equivalence)] @@ -79,7 +79,7 @@ (def: for-entries Test (do random.monad - [#let [capped-nat (:: random.monad map (n.% 100) random.nat)] + [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] size capped-nat dict (random.dictionary n.hash size random.nat capped-nat) non-key (|> random.nat (random.filter (function (_ key) (not (/.contains? key dict))))) @@ -197,7 +197,7 @@ (<| (_.covering /._) (_.with-cover [/.Dictionary]) (do random.monad - [#let [capped-nat (:: random.monad map (n.% 100) random.nat)] + [#let [capped-nat (\ random.monad map (n.% 100) random.nat)] size capped-nat dict (random.dictionary n.hash size random.nat capped-nat) non-key (|> random.nat (random.filter (function (_ key) (not (/.contains? key dict))))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index a1d776d10..c34f3e3cf 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -43,7 +43,7 @@ (<| (_.covering /._) (_.with-cover [/.Dictionary]) (do {! random.monad} - [size (:: ! map (n.% 100) random.nat) + [size (\ ! map (n.% 100) random.nat) keys (random.set n.hash size random.nat) values (random.set n.hash size random.nat) extra-key (random.filter (|>> (set.member? keys) not) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index 3ffcc816c..7d8d3a662 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -34,7 +34,7 @@ (_.with-cover [/.PList]) (do {! random.monad} [#let [gen-key (random.ascii/alpha 10)] - size (:: ! map (n.% 100) random.nat) + size (\ ! map (n.% 100) random.nat) sample (..random size gen-key random.nat) #let [keys (|> sample /.keys (set.from-list text.hash))] @@ -55,10 +55,10 @@ (_.cover [/.empty] (/.empty? /.empty)) (_.cover [/.keys /.values] - (:: (/.equivalence n.equivalence) = - sample - (list.zip/2 (/.keys sample) - (/.values sample)))) + (\ (/.equivalence n.equivalence) = + sample + (list.zip/2 (/.keys sample) + (/.values sample)))) (_.cover [/.contains?] (and (list.every? (function (_ key) (/.contains? key sample)) @@ -87,5 +87,5 @@ (|> sample (/.put extra-key extra-value) (/.remove 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 ca432bcb4..7f3ed62e6 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -34,8 +34,8 @@ (def: bounded-size (Random Nat) - (:: random.monad map (n.% 100) - random.nat)) + (\ random.monad map (n.% 100) + random.nat)) (def: random (Random (List Nat)) @@ -43,7 +43,7 @@ [size ..bounded-size] (|> random.nat (random.set n.hash size) - (:: ! map set.to-list)))) + (\ ! map set.to-list)))) (def: signatures Test @@ -84,14 +84,14 @@ (do {! random.monad} [size ..bounded-size #let [(^open "/\.") (/.equivalence n.equivalence)] - sample (:: ! map set.to-list (random.set n.hash size random.nat))] + sample (\ ! map set.to-list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] - (:: bit.equivalence = - (/.empty? sample) - (n.= 0 (/.size sample)))) + (\ bit.equivalence = + (/.empty? sample) + (n.= 0 (/.size sample)))) (_.cover [/.repeat] (n.= size (/.size (/.repeat size [])))) (_.cover [/.reverse] @@ -180,8 +180,8 @@ [sample (random.filter (|>> /.size (n.> 0)) ..random) #let [size (/.size sample)] - idx (:: ! map (n.% size) random.nat) - chunk-size (:: ! map (|>> (n.% size) inc) random.nat)] + idx (\ ! map (n.% size) random.nat) + chunk-size (\ ! map (|>> (n.% size) inc) random.nat)] ($_ _.and (_.cover [/.filter] (let [positives (/.filter n.even? sample) @@ -315,12 +315,12 @@ (and size-of-smaller-list! can-extract-values!))) (_.cover [/.zip] - (and (:: (/.equivalence (equivalence.product n.equivalence n.equivalence)) = - (/.zip/2 sample/0 sample/1) - ((/.zip 2) sample/0 sample/1)) - (:: (/.equivalence ($_ equivalence.product n.equivalence n.equivalence n.equivalence)) = - (/.zip/3 sample/0 sample/1 sample/2) - ((/.zip 3) sample/0 sample/1 sample/2)))) + (and (\ (/.equivalence (equivalence.product n.equivalence n.equivalence)) = + (/.zip/2 sample/0 sample/1) + ((/.zip 2) sample/0 sample/1)) + (\ (/.equivalence ($_ equivalence.product n.equivalence n.equivalence n.equivalence)) = + (/.zip/3 sample/0 sample/1 sample/2) + ((/.zip 3) sample/0 sample/1 sample/2)))) (_.cover [/.zip-with/2] (/\= (/\map (function (_ [left right]) @@ -351,7 +351,7 @@ choose (: (-> Nat (Maybe Text)) (function (_ value) (if (n.even? value) - (#.Some (:: n.decimal encode value)) + (#.Some (\ n.decimal encode value)) #.None)))] (do {! random.monad} [sample ..random] @@ -359,7 +359,7 @@ (_.cover [/.one] (case [(|> sample (/.filter n.even?) - (/\map (:: n.decimal encode)) + (/\map (\ n.decimal encode)) /.head) (/.one choose sample)] [(#.Some expected) (#.Some actual)] @@ -371,11 +371,11 @@ _ false)) (_.cover [/.all] - (:: (/.equivalence text.equivalence) = - (|> sample - (/.filter n.even?) - (/\map (:: n.decimal encode))) - (/.all choose sample))) + (\ (/.equivalence text.equivalence) = + (|> sample + (/.filter n.even?) + (/\map (\ n.decimal encode))) + (/.all choose sample))) (_.cover [/.find] (case (/.find n.even? sample) (#.Some found) @@ -420,7 +420,7 @@ 0))))) (_.cover [/.folds] (/\= (/\map (function (_ index) - (:: /.fold fold n.+ 0 (/.take index sample))) + (\ /.fold fold n.+ 0 (/.take index sample))) (/.indices (inc (/.size sample)))) (/.folds n.+ 0 sample))) ))))) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 3cd4d6db2..1eb6efe1b 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -29,7 +29,7 @@ (<| (_.covering /._) (_.with-cover [/.Queue]) (do {! random.monad} - [size (:: ! map (n.% 100) random.nat) + [size (\ ! map (n.% 100) random.nat) members (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? members) not) random.nat) @@ -43,7 +43,7 @@ (_.cover [/.from-list /.to-list] (|> members /.from-list /.to-list - (:: (list.equivalence n.equivalence) = members))) + (\ (list.equivalence n.equivalence) = members))) (_.cover [/.size] (n.= size (/.size sample))) (_.cover [/.empty?] @@ -54,9 +54,9 @@ all-empty-queues-look-the-same! (bit\= (/.empty? sample) - (:: (/.equivalence n.equivalence) = - sample - /.empty))] + (\ (/.equivalence n.equivalence) = + sample + /.empty))] (and empty-is-empty! all-empty-queues-look-the-same!))) (_.cover [/.peek] @@ -88,9 +88,9 @@ (/.member? n.equivalence pushed non-member) has-expected-order! - (:: (list.equivalence n.equivalence) = - (list\compose (/.to-list sample) (list non-member)) - (/.to-list pushed))] + (\ (list.equivalence n.equivalence) = + (list\compose (/.to-list sample) (list non-member)) + (/.to-list pushed))] (and size-increases! new-member-is-identified! has-expected-order!))) @@ -107,9 +107,9 @@ (not (/.member? n.equivalence popped target)) has-expected-order! - (:: (list.equivalence n.equivalence) = - expected - (/.to-list popped))] + (\ (list.equivalence n.equivalence) = + expected + (/.to-list popped))] (and size-decreases! popped-member-is-not-identified! has-expected-order!)) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 37e52d598..545c1e2a1 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -29,7 +29,7 @@ (<| (_.covering /._) (_.with-cover [/.Queue]) (do {! random.monad} - [size (:: ! map (n.% 100) random.nat) + [size (\ ! map (n.% 100) random.nat) sample (..random size) non-member-priority random.nat non-member (random.filter (|>> (/.member? n.equivalence sample) not) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 7a51ff797..17dae6904 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -29,7 +29,7 @@ (def: signatures Test (do {! random.monad} - [size (:: ! map (n.% 100) random.nat)] + [size (\ ! map (n.% 100) random.nat)] ($_ _.and (_.with-cover [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.row size random.nat))) @@ -48,7 +48,7 @@ (def: whole Test (do {! random.monad} - [size (:: ! map (n.% 100) random.nat) + [size (\ ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) #let [sample (|> sample set.to-list /.from-list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] @@ -81,10 +81,10 @@ (def: index-based Test (do {! random.monad} - [size (:: ! map (|>> (n.% 100) inc) random.nat)] + [size (\ ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and (do ! - [good-index (|> random.nat (:: ! map (n.% size))) + [good-index (|> random.nat (\ ! map (n.% size))) #let [bad-index (n.+ size good-index)] sample (random.set n.hash size random.nat) non-member (random.filter (|>> (set.member? sample) not) @@ -134,7 +134,7 @@ (<| (_.covering /._) (_.with-cover [/.Row]) (do {! random.monad} - [size (:: ! map (|>> (n.% 100) inc) random.nat)] + [size (\ ! map (|>> (n.% 100) inc) random.nat)] ($_ _.and ..signatures ..whole diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index e255fd5f5..7ffadccad 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -27,9 +27,9 @@ (All [a] (-> (Equivalence a) (Equivalence (/.Sequence a)))) (def: (= reference subject) - (:: (list.equivalence super) = - (/.take 100 reference) - (/.take 100 subject)))) + (\ (list.equivalence super) = + (/.take 100 reference) + (/.take 100 subject)))) (def: #export test Test @@ -38,9 +38,9 @@ (let [(^open "list\.") (list.equivalence n.equivalence)]) (do {! random.monad} [repeated random.nat - index (:: ! map (n.% 100) random.nat) - size (:: ! map (|>> (n.% 10) inc) random.nat) - offset (:: ! map (n.% 100) random.nat) + index (\ ! map (n.% 100) random.nat) + size (\ ! map (|>> (n.% 10) inc) random.nat) + offset (\ ! map (n.% 100) random.nat) cycle-start random.nat cycle-next (random.list size random.nat)] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 83cfe60fb..147fe6beb 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -21,8 +21,8 @@ (def: gen-nat (Random Nat) - (:: random.monad map (n.% 100) - random.nat)) + (\ random.monad map (n.% 100) + random.nat)) (def: #export test Test @@ -47,14 +47,14 @@ (_.cover [/.new] (/.empty? (/.new n.hash))) (do ! - [hash (:: ! map (function (_ constant) - (: (Hash Nat) - (structure - (def: &equivalence n.equivalence) - - (def: (hash _) - constant)))) - random.nat)] + [hash (\ ! map (function (_ constant) + (: (Hash Nat) + (structure + (def: &equivalence n.equivalence) + + (def: (hash _) + constant)))) + random.nat)] (_.cover [/.member-hash] (is? hash (/.member-hash (/.new hash))))) (_.cover [/.size] diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 8e376ba17..e49c325ba 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -22,7 +22,7 @@ (def: count (Random Nat) - (:: random.monad map (|>> (n.% 10) inc) random.nat)) + (\ random.monad map (|>> (n.% 10) inc) random.nat)) (def: #export (random size hash count element) (All [a] (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a)))) @@ -40,12 +40,12 @@ (<| (_.covering /._) (_.with-cover [/.Set]) (do {! random.monad} - [diversity (:: ! map (n.% 10) random.nat) + [diversity (\ ! map (n.% 10) random.nat) sample (..random diversity n.hash ..count random.nat) non-member (random.filter (predicate.complement (set.member? (/.support sample))) random.nat) addition-count ..count - partial-removal-count (:: ! map (n.% addition-count) random.nat) + partial-removal-count (\ ! map (n.% addition-count) random.nat) another (..random diversity n.hash ..count random.nat)] (`` ($_ _.and (_.with-cover [/.equivalence] @@ -55,7 +55,7 @@ (|> sample /.to-list (/.from-list n.hash) - (:: /.equivalence = sample))) + (\ /.equivalence = sample))) (_.cover [/.size] (n.= (list.size (/.to-list sample)) (/.size sample))) @@ -89,7 +89,7 @@ (let [null-scenario! (|> sample (/.add 0 non-member) - (:: /.equivalence = sample)) + (\ /.equivalence = sample)) normal-scenario! (let [sample+ (/.add addition-count non-member sample)] @@ -100,12 +100,12 @@ normal-scenario!))) (_.cover [/.remove] (let [null-scenario! - (:: /.equivalence = - (|> sample - (/.add addition-count non-member)) - (|> sample - (/.add addition-count non-member) - (/.remove 0 non-member))) + (\ /.equivalence = + (|> sample + (/.add addition-count non-member)) + (|> sample + (/.add addition-count non-member) + (/.remove 0 non-member))) partial-scenario! (let [sample* (|> sample @@ -120,7 +120,7 @@ (|> sample (/.add addition-count non-member) (/.remove addition-count non-member) - (:: /.equivalence = sample))] + (\ /.equivalence = sample))] (and null-scenario! partial-scenario! total-scenario!))) @@ -132,12 +132,12 @@ (let [unary (|> sample /.support /.from-set)] (and (/.sub? sample unary) (or (not (/.sub? unary sample)) - (:: /.equivalence = sample unary))))) + (\ /.equivalence = sample unary))))) (_.cover [/.super?] (let [unary (|> sample /.support /.from-set)] (and (/.super? unary sample) (or (not (/.super? sample unary)) - (:: /.equivalence = sample unary))))) + (\ /.equivalence = sample unary))))) (~~ (template [<name> <composition>] [(_.cover [<name>] (let [|sample| (/.support sample) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 1734d80c4..eaa8bab4b 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -21,7 +21,7 @@ (def: size (random.Random Nat) - (:: random.monad map (n.% 100) random.nat)) + (\ random.monad map (n.% 100) random.nat)) (def: #export (random size &order gen-value) (All [a] (-> Nat (Order a) (Random a) (Random (Set a)))) @@ -47,7 +47,7 @@ non-memberL (random.filter (|>> (//.member? usetL) not) random.nat) #let [listL (//.to-list usetL)] - listR (|> (random.set n.hash sizeR random.nat) (:: ! map //.to-list)) + listR (|> (random.set n.hash sizeR random.nat) (\ ! map //.to-list)) #let [(^open "/\.") /.equivalence setL (/.from-list n.order listL) setR (/.from-list n.order listR) @@ -64,9 +64,9 @@ (_.cover [/.new] (/.empty? (/.new n.order))) (_.cover [/.to-list] - (:: (list.equivalence n.equivalence) = - (/.to-list (/.from-list n.order listL)) - (list.sort (:: n.order <) listL))) + (\ (list.equivalence n.equivalence) = + (/.to-list (/.from-list n.order listL)) + (list.sort (\ n.order <) listL))) (_.cover [/.from-list] (|> setL /.to-list (/.from-list n.order) @@ -101,7 +101,7 @@ (|> setL (/.add non-memberL) (/.remove non-memberL) - (:: /.equivalence = setL))) + (\ /.equivalence = setL))) (_.cover [/.sub?] (let [self! (/.sub? setL setL) @@ -126,23 +126,23 @@ (~~ (template [<coverage> <relation> <empty?>] [(_.cover [<coverage>] (let [self! - (:: /.equivalence = - setL - (<coverage> setL setL)) + (\ /.equivalence = + setL + (<coverage> setL setL)) super! (and (<relation> (<coverage> setL setR) setL) (<relation> (<coverage> setL setR) setR)) empty! - (:: /.equivalence = - (if <empty?> empty setL) - (<coverage> setL empty)) + (\ /.equivalence = + (if <empty?> empty setL) + (<coverage> setL empty)) idempotence! - (:: /.equivalence = - (<coverage> setL (<coverage> setL setR)) - (<coverage> setR (<coverage> setL setR)))] + (\ /.equivalence = + (<coverage> setL (<coverage> setL setR)) + (<coverage> setR (<coverage> setL setR)))] (and self! super! empty! @@ -155,21 +155,21 @@ (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)) (/.to-list setL))) idempotence! - (:: /.equivalence = - (/.difference setL setR) - (/.difference setL (/.difference setL setR)))] + (\ /.equivalence = + (/.difference setL setR) + (/.difference setL (/.difference setL setR)))] (and self! empty! difference! diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index bc2082846..6cc4c5b10 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -26,7 +26,7 @@ (<| (_.covering /._) (_.with-cover [/.Stack]) (do random.monad - [size (:: random.monad map (n.% 100) random.nat) + [size (\ random.monad map (n.% 100) random.nat) sample (random.stack size random.nat) expected-top random.nat] ($_ _.and @@ -55,9 +55,9 @@ (/.empty? sample) (#.Some [top remaining]) - (:: (/.equivalence n.equivalence) = - sample - (/.push top remaining)))) + (\ (/.equivalence n.equivalence) = + sample + (/.push top remaining)))) (_.cover [/.push] (case (/.pop (/.push expected-top sample)) (#.Some [actual-top actual-sample]) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 9224e5654..ad5766525 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -23,7 +23,7 @@ (All [a] (-> (Random a) (Random [Nat (Tree a)]))) (do {! random.monad} [value gen-value - num-children (:: ! map (n.% 2) random.nat) + num-children (\ ! map (n.% 2) random.nat) children (random.list num-children (tree gen-value))] (wrap [(|> children (list\map product.left) @@ -38,7 +38,7 @@ ($_ _.and (_.with-cover [/.equivalence] (|> (..tree random.nat) - (:: random.monad map product.right) + (\ random.monad map product.right) ($equivalence.spec (/.equivalence n.equivalence)))) (_.with-cover [/.fold] ($fold.spec /.leaf /.equivalence /.fold)) @@ -53,17 +53,17 @@ (do random.monad [expected random.nat] (_.cover [/.leaf] - (:: (list.equivalence n.equivalence) = - (list expected) - (/.flatten (/.leaf expected))))) + (\ (list.equivalence n.equivalence) = + (list expected) + (/.flatten (/.leaf expected))))) (do {! random.monad} [value random.nat - num-children (:: ! map (n.% 3) random.nat) + num-children (\ ! map (n.% 3) random.nat) children (random.list num-children random.nat)] (_.cover [/.branch] - (:: (list.equivalence n.equivalence) = - (list& value children) - (/.flatten (/.branch value (list\map /.leaf children)))))) + (\ (list.equivalence n.equivalence) = + (list& value children) + (/.flatten (/.branch value (list\map /.leaf children)))))) (do random.monad [expected/0 random.nat expected/1 random.nat @@ -72,20 +72,20 @@ expected/4 random.nat expected/5 random.nat] (_.cover [/.tree] - (and (:: (list.equivalence n.equivalence) = - (list expected/0) - (/.flatten (/.tree expected/0))) - (:: (list.equivalence n.equivalence) = - (list expected/0 expected/1 expected/2) - (/.flatten (/.tree expected/0 - {expected/1 {} - expected/2 {}}))) - (:: (list.equivalence n.equivalence) = - (list expected/0 expected/1 expected/2 - expected/3 expected/4 expected/5) - (/.flatten (/.tree expected/0 - {expected/1 {} - expected/2 {expected/3 {} - expected/4 {expected/5 {}}}}))) + (and (\ (list.equivalence n.equivalence) = + (list expected/0) + (/.flatten (/.tree expected/0))) + (\ (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2) + (/.flatten (/.tree expected/0 + {expected/1 {} + expected/2 {}}))) + (\ (list.equivalence n.equivalence) = + (list expected/0 expected/1 expected/2 + expected/3 expected/4 expected/5) + (/.flatten (/.tree expected/0 + {expected/1 {} + expected/2 {expected/3 {} + expected/4 {expected/5 {}}}}))) ))) ))) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index 7c93fb0c1..d5f4dba52 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -39,21 +39,21 @@ true)) (_.cover [/.tag] (and (text\= tag-left - (/.tag (:: ..builder leaf tag-left expected-left))) + (/.tag (\ ..builder leaf tag-left expected-left))) (text\= (text\compose tag-left tag-right) - (/.tag (:: ..builder branch - (:: ..builder leaf tag-left expected-left) - (:: ..builder leaf tag-right expected-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 @@ -68,37 +68,37 @@ 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)))))) (_.cover [/.search] (let [can-find-correct-one! - (|> (:: ..builder leaf tag-left expected-left) + (|> (\ ..builder leaf tag-left expected-left) (/.search (text.contains? tag-left)) (maybe\map (n.= expected-left)) (maybe.default false)) cannot-find-incorrect-one! - (|> (:: ..builder leaf tag-right expected-right) + (|> (\ ..builder leaf tag-right expected-right) (/.search (text.contains? tag-left)) (maybe\map (n.= expected-left)) (maybe.default 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)) (/.search (text.contains? tag-left)) (maybe\map (n.= expected-left)) (maybe.default 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)) (/.search (text.contains? tag-right)) (maybe\map (n.= expected-right)) (maybe.default false))] @@ -109,23 +109,23 @@ (_.cover [/.found?] (let [can-find-correct-one! (/.found? (text.contains? tag-left) - (:: ..builder leaf tag-left expected-left)) + (\ ..builder leaf tag-left expected-left)) cannot-find-incorrect-one! (not (/.found? (text.contains? tag-left) - (:: ..builder leaf tag-right expected-right))) + (\ ..builder leaf tag-right expected-right))) can-find-left! (/.found? (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! (/.found? (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 f934879ee..b32ddecc2 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -163,7 +163,7 @@ (^open "list\.") (list.equivalence n.equivalence)]] ($_ _.and (_.with-cover [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (:: ! map (|>> product.right /.zip) (//.tree random.nat)))) + ($equivalence.spec (/.equivalence n.equivalence) (\ ! map (|>> product.right /.zip) (//.tree random.nat)))) (_.with-cover [/.functor] ($functor.spec (|>> tree.leaf /.zip) /.equivalence /.functor)) (_.with-cover [/.comonad] diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 77b3652a1..3b84f1b68 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -25,7 +25,7 @@ (def: #export color (Random Color) (|> ($_ random.and random.nat random.nat random.nat) - (:: random.monad map /.from-rgb))) + (\ random.monad map /.from-rgb))) (def: scale (-> Nat Frac) @@ -67,7 +67,7 @@ ($_ _.and (_.cover [/.RGB /.to-rgb /.from-rgb] (|> expected /.to-rgb /.from-rgb - (:: /.equivalence = expected))) + (\ /.equivalence = expected))) (_.cover [/.HSL /.to-hsl /.from-hsl] (|> expected /.to-hsl /.from-hsl (distance/3 expected) @@ -125,16 +125,16 @@ Test (_.with-cover [/.Spread /.Palette] (do {! random.monad} - [eH (:: ! map (|>> f.abs (f.% +0.9) (f.+ +0.05)) - random.safe-frac) + [eH (\ ! map (|>> f.abs (f.% +0.9) (f.+ +0.05)) + random.safe-frac) #let [eS +0.5] - variations (:: ! map (|>> (n.% 3) (n.+ 2)) random.nat) + variations (\ ! map (|>> (n.% 3) (n.+ 2)) random.nat) #let [max-spread (f./ (|> variations inc .int int.frac) +1.0) min-spread (f./ +2.0 max-spread) spread-space (f.- min-spread max-spread)] - spread (:: ! map (|>> f.abs (f.% spread-space) (f.+ min-spread)) - random.safe-frac)] + spread (\ ! map (|>> f.abs (f.% spread-space) (f.+ min-spread)) + random.safe-frac)] (`` ($_ _.and (~~ (template [<brightness> <palette>] [(_.cover [<palette>] @@ -142,7 +142,7 @@ expected (/.from-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] )) @@ -150,9 +150,9 @@ [(_.cover [<palette>] (let [expected (/.from-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] @@ -161,10 +161,10 @@ [(_.cover [<palette>] (let [expected (/.from-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])) @@ -191,8 +191,8 @@ (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 (_.with-cover [/.Alpha /.Pigment] diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 609c847cf..fce2e0d90 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 9b00113f0..5c819299f 100644 --- a/stdlib/source/test/lux/data/format/binary.lux +++ b/stdlib/source/test/lux/data/format/binary.lux @@ -23,7 +23,7 @@ (def: random (Random /.Specification) - (:: random.monad map /.nat random.nat)) + (\ random.monad map /.nat random.nat)) (def: #export test Test diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 22834745d..ebfc6a4d5 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -36,9 +36,9 @@ (random.rec (function (_ recur) (do {! random.monad} - [size (:: ! map (n.% 2) random.nat)] + [size (\ ! map (n.% 2) random.nat)] ($_ random.or - (:: ! wrap []) + (\ ! wrap []) random.bit random.safe-frac (random.unicode size) @@ -74,17 +74,17 @@ (do random.monad [sample ..json] (_.cover [/.Null /.null?] - (:: bit.equivalence = - (/.null? sample) - (case sample - #/.Null true - _ false)))) + (\ bit.equivalence = + (/.null? sample) + (case sample + #/.Null true + _ false)))) (do random.monad [expected ..json] (_.cover [/.format] (|> expected /.format - (:: /.codec decode) + (\ /.codec decode) (try\map (\= expected)) (try.default false)))) (do random.monad @@ -97,9 +97,9 @@ (_.cover [/.object /.fields] (case (/.fields object) (#try.Success actual) - (:: (list.equivalence text.equivalence) = - (list\map product.left expected) - actual) + (\ (list.equivalence text.equivalence) = + (list\map product.left expected) + actual) (#try.Failure error) false)) @@ -112,7 +112,7 @@ )) (do random.monad [key (random.ascii/alpha 1) - unknown (random.filter (|>> (:: text.equivalence = key) not) + unknown (random.filter (|>> (\ text.equivalence = key) not) (random.ascii/alpha 1)) expected random.safe-frac] (_.cover [/.set] @@ -141,7 +141,7 @@ (_.cover [<type> <get>] (|> (/.object (list [key (<tag> value)])) (<get> key) - (try\map (:: <equivalence> = value)) + (try\map (\ <equivalence> = value)) (try.default false))))] [/.Boolean /.get-boolean #/.Boolean random.bit bit.equivalence] diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 9c83040fa..374c068a8 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -102,8 +102,8 @@ Test (_.with-cover [/.Small] (do {! random.monad} - [expected (|> random.nat (:: ! map (n.% /.small-limit))) - invalid (|> random.nat (:: ! map (n.max /.small-limit)))] + [expected (|> random.nat (\ ! map (n.% /.small-limit))) + invalid (|> random.nat (\ ! map (n.max /.small-limit)))] (`` ($_ _.and (_.cover [/.small /.from-small] (case (/.small expected) @@ -126,8 +126,8 @@ Test (_.with-cover [/.Big] (do {! random.monad} - [expected (|> random.nat (:: ! map (n.% /.big-limit))) - invalid (|> random.nat (:: ! map (n.max /.big-limit)))] + [expected (|> random.nat (\ ! map (n.% /.big-limit))) + invalid (|> random.nat (\ ! map (n.max /.big-limit)))] (`` ($_ _.and (_.cover [/.big /.from-big] (case (/.big expected) @@ -152,10 +152,10 @@ Test (do {! random.monad} [expected-path (random.ascii/lower-alpha (dec /.path-size)) - expected-moment (:: ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) - random.nat) + expected-moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis) + random.nat) chunk (random.ascii/lower-alpha chunk-size) - chunks (:: ! map (n.% 100) random.nat) + chunks (\ ! map (n.% 100) random.nat) #let [content (|> chunk (list.repeat chunks) (text.join-with "") @@ -394,7 +394,7 @@ (|> row.empty (format.run /.writer) (<b>.run /.parser) - (:: try.monad map row.empty?) + (\ try.monad map row.empty?) (try.default false))) ..path ..name diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 9798625d5..7ac52ef02 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -36,7 +36,7 @@ (def: char (Random Nat) (do {! random.monad} - [idx (|> random.nat (:: ! map (n.% (text.size char-range))))] + [idx (|> random.nat (\ ! map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) (def: (size bottom top) diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index 440aa0316..dc305ae33 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -24,11 +24,11 @@ (def: comparison (Comparison Lazy) (function (_ ==) - (:: (/.equivalence ==) =))) + (\ (/.equivalence ==) =))) (def: #export lazy (All [a] (-> (Random a) (Random (Lazy a)))) - (:: random.functor map (|>> /.freeze))) + (\ random.functor map (|>> /.freeze))) (def: #export test Test diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index 139c63e4c..fa863cdae 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -71,7 +71,7 @@ (do random.monad [value random.nat] (_.cover [/.to-list] - (:: (list.equivalence n.equivalence) = - (list value) - (/.to-list (#.Some value))))) + (\ (list.equivalence n.equivalence) = + (list value) + (/.to-list (#.Some value))))) )))) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index e3778202c..fd6f5b546 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -34,12 +34,12 @@ (<| (_.covering /._) (do {! random.monad} [## First Name - sizeM1 (|> random.nat (:: ! map (n.% 100))) - sizeS1 (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1)))) + sizeM1 (|> random.nat (\ ! map (n.% 100))) + sizeS1 (|> random.nat (\ ! map (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..name sizeM1 sizeS1) ## Second Name - sizeM2 (|> random.nat (:: ! map (n.% 100))) - sizeS2 (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1)))) + sizeM2 (|> random.nat (\ ! map (n.% 100))) + sizeS2 (|> random.nat (\ ! map (|>> (n.% 100) (n.max 1)))) (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] (_.with-cover [.Name] ($_ _.and diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux index 9458bb12c..d1d812aa9 100644 --- a/stdlib/source/test/lux/data/number.lux +++ b/stdlib/source/test/lux/data/number.lux @@ -35,7 +35,7 @@ ($_ _.and (_.cover [/.bin] (`` (and (~~ (template [<=> <codec> <number>] - [(case (:: <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean-commas <number>)) (#try.Success actual) (<=> (/.bin <number>) actual) @@ -56,7 +56,7 @@ ))))) (_.cover [/.oct] (`` (and (~~ (template [<=> <codec> <number>] - [(case (:: <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean-commas <number>)) (#try.Success actual) (<=> (/.oct <number>) actual) @@ -77,7 +77,7 @@ ))))) (_.cover [/.hex] (`` (and (~~ (template [<=> <codec> <number>] - [(case (:: <codec> decode (..clean-commas <number>)) + [(case (\ <codec> decode (..clean-commas <number>)) (#try.Success actual) (<=> (/.hex <number>) actual) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 6b623388c..0a3866371 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -27,7 +27,7 @@ (def: dimension (Random Frac) (do {! random.monad} - [factor (|> random.nat (:: ! map (|>> (n.% 1000) (n.max 1)))) + [factor (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1)))) measure (|> random.safe-frac (random.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) @@ -41,10 +41,10 @@ (def: angle (Random /.Complex) - (:: random.monad map - (|>> (update@ #/.real (f.% +1.0)) - (update@ #/.imaginary (f.% +1.0))) - ..random)) + (\ random.monad map + (|>> (update@ #/.real (f.% +1.0)) + (update@ #/.imaginary (f.% +1.0))) + ..random)) (def: construction Test @@ -259,7 +259,7 @@ Test (do {! random.monad} [sample ..random - degree (|> random.nat (:: ! map (|>> (n.max 1) (n.% 5))))] + degree (|> random.nat (\ ! map (|>> (n.max 1) (n.% 5))))] (_.cover [/.roots] (|> sample (/.roots degree) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index fcffb7c45..ca3d4d21c 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -23,7 +23,7 @@ (def: random (Random Frac) - (:: random.monad map (|>> (i.% +1,000,000) i.frac) random.int)) + (\ random.monad map (|>> (i.% +1,000,000) i.frac) random.int)) (def: signature Test @@ -73,7 +73,7 @@ Test (do {! random.monad} [sample ..random - shift (:: ! map /.abs ..random)] + shift (\ ! map /.abs ..random)] ($_ _.and (_.cover [/.negative?] (bit\= (/.negative? sample) @@ -98,16 +98,16 @@ Test ($_ _.and (do {! random.monad} - [expected (:: ! map (n.% 1,000,000) random.nat)] + [expected (\ ! map (n.% 1,000,000) random.nat)] (_.cover [/.nat] (|> expected n.frac /.nat (n.= expected)))) (do {! random.monad} - [expected (:: ! map (i.% +1,000,000) random.int)] + [expected (\ ! map (i.% +1,000,000) random.int)] (_.cover [/.int] (|> expected i.frac /.int (i.= expected)))) (do {! random.monad} - [expected (:: ! map (|>> (i64.left-shift 32) .rev) - random.nat)] + [expected (\ ! map (|>> (i64.left-shift 32) .rev) + random.nat)] (_.cover [/.rev] (|> expected r.frac /.rev (r.= expected)))) )) diff --git a/stdlib/source/test/lux/data/number/i16.lux b/stdlib/source/test/lux/data/number/i16.lux index edfadf62d..f3d8030c0 100644 --- a/stdlib/source/test/lux/data/number/i16.lux +++ b/stdlib/source/test/lux/data/number/i16.lux @@ -18,7 +18,7 @@ (def: #export i16 (Random /.I16) - (:: r.functor map /.i16 r.i64)) + (\ r.functor map /.i16 r.i64)) (def: mask Mask @@ -29,11 +29,11 @@ Test (<| (_.context (name.module (name-of /._))) (do {! r.monad} - [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] + [expected (\ ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i16) (_.test "Can convert between I64 and I16" (let [actual (|> expected /.i16 /.i64)] - (:: //i64.equivalence = expected actual))) + (\ //i64.equivalence = expected actual))) )))) diff --git a/stdlib/source/test/lux/data/number/i32.lux b/stdlib/source/test/lux/data/number/i32.lux index f5d32ba21..1bf6bfee7 100644 --- a/stdlib/source/test/lux/data/number/i32.lux +++ b/stdlib/source/test/lux/data/number/i32.lux @@ -18,7 +18,7 @@ (def: #export i32 (Random /.I32) - (:: r.functor map /.i32 r.i64)) + (\ r.functor map /.i32 r.i64)) (def: mask Mask @@ -29,11 +29,11 @@ Test (<| (_.context (name.module (name-of /._))) (do {! r.monad} - [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] + [expected (\ ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i32) (_.test "Can convert between I64 and I32" (let [actual (|> expected /.i32 /.i64)] - (:: //i64.equivalence = expected actual))) + (\ //i64.equivalence = expected actual))) )))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 6834f6276..4d9b9f468 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -24,7 +24,7 @@ (<| (_.context (name.module (name-of /._))) (do {! r.monad} [pattern r.nat - idx (:: ! map (//nat.% /.width) r.nat)] + idx (\ ! map (//nat.% /.width) r.nat)] ($_ _.and ($equivalence.spec /.equivalence r.i64) ($monoid.spec //nat.equivalence /.disjunction r.nat) @@ -89,9 +89,9 @@ (i.>= +0 (/.arithmetic-right-shift idx value))))) (_.cover [/.mask] (let [mask (/.mask idx) - idempotent? (:: /.equivalence = - (/.and mask pattern) - (/.and mask (/.and mask pattern))) + idempotent? (\ /.equivalence = + (/.and mask pattern) + (/.and mask (/.and mask pattern))) limit (inc (.nat mask)) below-limit? (if (//nat.< limit pattern) diff --git a/stdlib/source/test/lux/data/number/i8.lux b/stdlib/source/test/lux/data/number/i8.lux index 53b196e41..88f456bca 100644 --- a/stdlib/source/test/lux/data/number/i8.lux +++ b/stdlib/source/test/lux/data/number/i8.lux @@ -18,7 +18,7 @@ (def: #export i8 (Random /.I8) - (:: r.functor map /.i8 r.i64)) + (\ r.functor map /.i8 r.i64)) (def: mask Mask @@ -29,11 +29,11 @@ Test (<| (_.context (name.module (name-of /._))) (do {! r.monad} - [expected (:: ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] + [expected (\ ! map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i8) (_.test "Can convert between I64 and I8" (let [actual (|> expected /.i8 /.i64)] - (:: //i64.equivalence = expected actual))) + (\ //i64.equivalence = expected actual))) )))) diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux index a774b5e81..38a3ab9f3 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/data/number/ratio.lux @@ -20,7 +20,7 @@ (def: part (Random Nat) - (|> r.nat (:: r.monad map (|>> (n.% 1,000,000) (n.max 1))))) + (|> r.nat (\ r.monad map (|>> (n.% 1,000,000) (n.max 1))))) (def: #export ratio (Random Ratio) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 3ae126887..7484eac15 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -60,27 +60,27 @@ (/.each (n.+ shift) (n.- shift)) (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) (do ! - [size (:: ! map (n.% 5) random.nat) + [size (\ ! map (n.% 5) random.nat) expected (random.list size random.nat)] ($_ _.and (_.cover [/.lefts] (let [actual (: (List (| Nat Nat)) (list\map /.left expected))] - (and (:: (list.equivalence n.equivalence) = - expected - (/.lefts actual)) - (:: (list.equivalence n.equivalence) = - (list) - (/.rights actual))))) + (and (\ (list.equivalence n.equivalence) = + expected + (/.lefts actual)) + (\ (list.equivalence n.equivalence) = + (list) + (/.rights actual))))) (_.cover [/.rights] (let [actual (: (List (| Nat Nat)) (list\map /.right expected))] - (and (:: (list.equivalence n.equivalence) = - expected - (/.rights actual)) - (:: (list.equivalence n.equivalence) = - (list) - (/.lefts actual))))) + (and (\ (list.equivalence n.equivalence) = + expected + (/.rights actual)) + (\ (list.equivalence n.equivalence) = + (list) + (/.lefts actual))))) (_.cover [/.partition] (let [[lefts rights] (|> expected (list\map (function (_ value) @@ -89,11 +89,11 @@ (/.right value)))) (: (List (| Nat Nat))) /.partition)] - (and (:: (list.equivalence n.equivalence) = - (list.filter n.even? expected) - lefts) - (:: (list.equivalence n.equivalence) = - (list.filter (|>> n.even? not) expected) - rights)))) + (and (\ (list.equivalence n.equivalence) = + (list.filter n.even? expected) + lefts) + (\ (list.equivalence n.equivalence) = + (list.filter (|>> n.even? not) expected) + rights)))) )) ))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 7849ee04a..ce645f46e 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -25,12 +25,12 @@ (def: bounded-size (random.Random Nat) (|> random.nat - (:: random.monad map (|>> (n.% 20) (n.+ 1))))) + (\ random.monad map (|>> (n.% 20) (n.+ 1))))) (def: size Test (do {! random.monad} - [size (:: ! map (n.% 10) random.nat) + [size (\ ! map (n.% 10) random.nat) sample (random.unicode size)] ($_ _.and (_.cover [/.size] @@ -43,11 +43,11 @@ Test (do {! random.monad} [inner (random.unicode 1) - outer (random.filter (|>> (:: /.equivalence = inner) not) + outer (random.filter (|>> (\ /.equivalence = inner) not) (random.unicode 1)) left (random.unicode 1) right (random.unicode 1) - #let [full (:: /.monoid compose inner outer) + #let [full (\ /.monoid compose inner outer) fake-index (.nat -1)]] (`` ($_ _.and (~~ (template [<affix> <predicate>] @@ -72,23 +72,23 @@ Test (do {! random.monad} [inner (random.unicode 1) - outer (random.filter (|>> (:: /.equivalence = inner) not) + outer (random.filter (|>> (\ /.equivalence = inner) not) (random.unicode 1)) #let [fake-index (.nat -1)]] ($_ _.and (_.cover [/.contains?] - (let [full (:: /.monoid compose inner outer)] + (let [full (\ /.monoid compose inner outer)] (and (/.contains? inner full) (/.contains? outer full)))) (_.cover [/.index-of] - (and (|> (/.index-of inner (:: /.monoid compose inner outer)) + (and (|> (/.index-of inner (\ /.monoid compose inner outer)) (maybe.default fake-index) (n.= 0)) - (|> (/.index-of outer (:: /.monoid compose inner outer)) + (|> (/.index-of outer (\ /.monoid compose inner outer)) (maybe.default fake-index) (n.= 1)))) (_.cover [/.index-of'] - (let [full (:: /.monoid compose inner outer)] + (let [full (\ /.monoid compose inner outer)] (and (|> (/.index-of' inner 0 full) (maybe.default fake-index) (n.= 0)) @@ -106,7 +106,7 @@ (maybe.default fake-index) (n.= fake-index))))) (_.cover [/.last-index-of] - (let [full ($_ (:: /.monoid compose) outer inner outer)] + (let [full ($_ (\ /.monoid compose) outer inner outer)] (and (|> (/.last-index-of inner full) (maybe.default fake-index) (n.= 1)) @@ -114,7 +114,7 @@ (maybe.default fake-index) (n.= 2))))) (_.cover [/.last-index-of'] - (let [full ($_ (:: /.monoid compose) outer inner outer)] + (let [full ($_ (\ /.monoid compose) outer inner outer)] (and (|> (/.last-index-of' inner 0 full) (maybe.default fake-index) (n.= 1)) @@ -140,7 +140,7 @@ (`` ($_ _.and (~~ (template [<short> <long>] [(_.cover [<short> <long>] - (:: /.equivalence = <short> <long>))] + (\ /.equivalence = <short> <long>))] [/.\0 /.null] [/.\a /.alarm] @@ -152,13 +152,13 @@ [/.\r /.carriage-return] [/.\'' /.double-quote])) (_.cover [/.line-feed] - (:: /.equivalence = /.new-line /.line-feed)) + (\ /.equivalence = /.new-line /.line-feed)) ))) (do {! random.monad} - [size (:: ! map (|>> (n.% 10) inc) random.nat) + [size (\ ! map (|>> (n.% 10) inc) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) #let [sample (|> characters set.to-list /.concat)] - expected (:: ! map (n.% size) random.nat)] + expected (\ ! map (n.% size) random.nat)] (_.cover [/.nth] (case (/.nth expected sample) (#.Some char) @@ -187,13 +187,13 @@ (def: manipulation Test (do {! random.monad} - [size (:: ! map (|>> (n.% 10) (n.+ 2)) random.nat) + [size (\ ! map (|>> (n.% 10) (n.+ 2)) random.nat) characters (random.set /.hash size (random.ascii/alpha 1)) separator (random.filter (|>> (set.member? characters) not) (random.ascii/alpha 1)) #let [with-no-separator (|> characters set.to-list /.concat)] static (random.ascii/alpha 1) - #let [dynamic (random.filter (|>> (:: /.equivalence = static) not) + #let [dynamic (random.filter (|>> (\ /.equivalence = static) not) (random.ascii/alpha 1))] pre dynamic post dynamic] @@ -206,19 +206,19 @@ (/.join-with separator) (/.split-all-with separator) (set.from-list /.hash) - (:: set.equivalence = characters)) - (:: /.equivalence = - (/.concat (set.to-list characters)) - (/.join-with "" (set.to-list characters))))) + (\ set.equivalence = characters)) + (\ /.equivalence = + (/.concat (set.to-list characters)) + (/.join-with "" (set.to-list characters))))) (_.cover [/.replace-once] - (:: /.equivalence = - (:: /.monoid compose post static) - (/.replace-once pre post (:: /.monoid compose pre static)))) + (\ /.equivalence = + (\ /.monoid compose post static) + (/.replace-once pre post (\ /.monoid compose pre static)))) (_.cover [/.split-with] - (case (/.split-with static ($_ (:: /.monoid compose) pre static post)) + (case (/.split-with static ($_ (\ /.monoid compose) pre static post)) (#.Some [left right]) - (and (:: /.equivalence = pre left) - (:: /.equivalence = post right)) + (and (\ /.equivalence = pre left) + (\ /.equivalence = post right)) #.None false)) @@ -280,7 +280,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 (:: ! map (|>> (n.% 128) (n.max 1))))] + normal-char-gen (|> random.nat (\ ! map (|>> (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) |