diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
32 files changed, 168 insertions, 168 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 9d843b540..6ee71541c 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -79,13 +79,13 @@ Test (<| (_.covering /._) (do {! random.monad} - [.let [gen_size (|> random.nat (\ ! map (|>> (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 (\ ! map (n.% size)))] + .let [gen_idx (|> random.nat (\ ! each (n.% size)))] offset gen_idx - length (\ ! map (n.% (n.- offset size)) random.nat)] + length (\ ! each (n.% (n.- offset size)) random.nat)] (_.for [/.Binary] ($_ _.and (_.for [/.equivalence] @@ -121,8 +121,8 @@ reader (function (_ binary idx) (/.read/8! idx binary))] (and (n.= length (/.size random_slice)) - (case [(monad.map try.monad (|>> (n.+ offset) (reader sample)) idxs) - (monad.map try.monad (reader random_slice) idxs)] + (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) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index c7fad1619..03ff479ff 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 map (|>> (n.% 100) (n.+ 1)) + (\ random.monad each (|>> (n.% 100) (n.+ 1)) random.nat)) (def: structures @@ -169,7 +169,7 @@ _ false))) (do ! - [occupancy (\ ! map (n.% (++ size)) random.nat)] + [occupancy (\ ! each (n.% (++ size)) random.nat)] (_.cover [/.occupancy /.vacancy] (let [the_array (loop [output (: (Array Nat) (/.empty size)) @@ -189,7 +189,7 @@ (|> the_array /.list /.of_list (\ (/.equivalence n.equivalence) = the_array))))) (do ! - [amount (\ ! map (n.% (++ size)) random.nat)] + [amount (\ ! each (n.% (++ size)) random.nat)] (_.cover [/.copy!] (let [copy (: (Array Nat) (/.empty size))] diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index c0e54e3bb..3d28272fb 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 map (|>> (n.% (++ max)) (n.max min))))) + (\ random.monad each (|>> (n.% (++ max)) (n.max min))))) (def: .public random (Random Bits) (do {! random.monad} - [size (\ ! map (n.% 1,000) random.nat)] + [size (\ ! each (n.% 1,000) random.nat)] (case size 0 (in /.empty) _ (do {! random.monad} - [idx (|> random.nat (\ ! map (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 (\ ! map (|>> (n.% 1,000) ++) random.nat) - idx (\ ! map (n.% size) random.nat) + [size (\ ! each (|>> (n.% 1,000) ++) random.nat) + idx (\ ! each (n.% size) random.nat) sample ..random] ($_ _.and (_.cover [/.bit /.one] diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 446c4e354..60312b812 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -31,7 +31,7 @@ (def: for_dictionaries Test (do {! random.monad} - [.let [capped_nat (\ random.monad map (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\map 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\map (n.= value)) + (maybe\each (n.= value)) (maybe.else false))) entries)] (and correct_size! @@ -112,7 +112,7 @@ (let [merging_with_oneself (let [(^open ".") (/.equivalence n.equivalence)] (= dict (/.merged dict dict))) overwritting_keys (let [dict' (|> dict /.entries - (list\map (function (_ [k v]) [k (++ v)])) + (list\each (function (_ [k v]) [k (++ v)])) (/.of_list n.hash)) (^open ".") (/.equivalence n.equivalence)] (= dict' (/.merged dict' dict)))] @@ -133,7 +133,7 @@ (def: for_entries Test (do random.monad - [.let [capped_nat (\ random.monad map (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 map (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 7f6178f8e..739756640 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 /._) (_.for [/.Dictionary]) (do {! random.monad} - [size (\ ! map (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,7 +56,7 @@ sorted_pairs (list.sorted (function (_ [left _] [right _]) (n.< left right)) pairs) - sorted_values (list\map product.right sorted_pairs) + sorted_values (list\each product.right sorted_pairs) (^open "list\.") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) (and (n.= kr ks) @@ -132,6 +132,6 @@ (/.has extra_key extra_value) (/.revised extra_key (n.+ shift)) (/.value extra_key) - (maybe\map (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 2172fbd44..f83e4cf82 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -35,7 +35,7 @@ (_.for [/.PList]) (do {! random.monad} [.let [gen_key (random.ascii/alpha 10)] - size (\ ! map (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))] @@ -75,14 +75,14 @@ (|> sample (/.has extra_key extra_value) (/.value extra_key) - (maybe\map (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\map (n.= (n.+ shift extra_value))) + (maybe\each (n.= (n.+ shift extra_value))) (maybe.else false))) (_.cover [/.lacks] (|> sample diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 41139da07..1f6749dc3 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -34,7 +34,7 @@ (def: bounded_size (Random Nat) - (\ random.monad map (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) - (\ ! map set.list)))) + (\ ! each set.list)))) (def: signatures Test @@ -52,7 +52,7 @@ ($equivalence.spec (/.equivalence n.equivalence) ..random)) (_.for [/.hash] (|> random.nat - (\ random.monad map (|>> list)) + (\ random.monad each (|>> list)) ($hash.spec (/.hash n.hash)))) (_.for [/.monoid] ($monoid.spec (/.equivalence n.equivalence) /.monoid ..random)) @@ -88,7 +88,7 @@ (do {! random.monad} [size ..bounded_size .let [(^open "/\.") (/.equivalence n.equivalence)] - sample (\ ! map set.list (random.set n.hash size random.nat))] + sample (\ ! each set.list (random.set n.hash size random.nat))] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) @@ -158,11 +158,11 @@ has_correct_indices! (/\= (/.indices (/.size enumeration)) - (/\map product.left enumeration)) + (/\each product.left enumeration)) has_correct_values! (/\= sample - (/\map product.right enumeration))] + (/\each product.right enumeration))] (and has_correct_indices! has_correct_values!))) (_.cover [/.item] @@ -184,8 +184,8 @@ [sample (random.only (|>> /.size (n.> 0)) ..random) .let [size (/.size sample)] - idx (\ ! map (n.% size) random.nat) - sub_size (\ ! map (|>> (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) @@ -205,19 +205,19 @@ (_.cover [/.split_at] (let [[left right] (/.split_at idx sample)] (/\= sample - (/\compose left right)))) + (/\composite left right)))) (_.cover [/.split_when] (let [[left right] (/.split_when n.even? sample)] (/\= sample - (/\compose left right)))) + (/\composite left right)))) (_.cover [/.first /.after] (/\= sample - (/\compose (/.first idx sample) - (/.after idx sample)))) + (/\composite (/.first idx sample) + (/.after idx sample)))) (_.cover [/.while /.until] (/\= sample - (/\compose (/.while n.even? sample) - (/.until n.even? 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) @@ -293,9 +293,9 @@ can_extract_values! (and (/\= (/.first zipped::size sample/0) - (/\map product.left zipped)) + (/\each product.left zipped)) (/\= (/.first zipped::size sample/1) - (/\map product.right zipped)))] + (/\each product.right zipped)))] (and size_of_smaller_list! can_extract_values!))) (_.cover [/.zipped/3] @@ -311,11 +311,11 @@ can_extract_values! (and (/\= (/.first zipped::size sample/0) - (/\map product.left zipped)) + (/\each product.left zipped)) (/\= (/.first zipped::size sample/1) - (/\map (|>> product.right product.left) zipped)) + (/\each (|>> product.right product.left) zipped)) (/\= (/.first zipped::size sample/2) - (/\map (|>> product.right product.right) zipped)))] + (/\each (|>> product.right product.right) zipped)))] (and size_of_smaller_list! can_extract_values!))) (_.cover [/.zipped] @@ -327,14 +327,14 @@ ((/.zipped 3) sample/0 sample/1 sample/2)))) (_.cover [/.zipped_with/2] - (/\= (/\map (function (_ [left right]) - (+/2 left right)) - (/.zipped/2 sample/0 sample/1)) + (/\= (/\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] - (/\= (/\map (function (_ [left mid right]) - (+/3 left mid right)) - (/.zipped/3 sample/0 sample/1 sample/2)) + (/\= (/\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) @@ -342,9 +342,9 @@ (/\= (/.zipped_with/3 +/3 sample/0 sample/1 sample/2) ((/.zipped_with 3) +/3 sample/0 sample/1 sample/2)))) (_.cover [/.together] - (and (/\= (/\compose sample/0 sample/1) + (and (/\= (/\composite sample/0 sample/1) (/.together (list sample/0 sample/1))) - (/\= ($_ /\compose sample/0 sample/1 sample/2) + (/\= ($_ /\composite sample/0 sample/1 sample/2) (/.together (list sample/0 sample/1 sample/2))))) )))) @@ -363,7 +363,7 @@ (_.cover [/.one] (case [(|> sample (/.only n.even?) - (/\map (\ n.decimal encoded)) + (/\each (\ n.decimal encoded)) /.head) (/.one choose sample)] [(#.Some expected) (#.Some actual)] @@ -378,7 +378,7 @@ (\ (/.equivalence text.equivalence) = (|> sample (/.only n.even?) - (/\map (\ n.decimal encoded))) + (/\each (\ n.decimal encoded))) (/.all choose sample))) (_.cover [/.example] (case (/.example n.even? sample) @@ -423,9 +423,9 @@ #.None)) 0))))) (_.cover [/.mixes] - (/\= (/\map (function (_ index) - (\ /.mix mix n.+ 0 (/.first index sample))) - (/.indices (++ (/.size sample)))) + (/\= (/\each (function (_ index) + (\ /.mix mix n.+ 0 (/.first index sample))) + (/.indices (++ (/.size sample)))) (/.mixes n.+ 0 sample))) (do random.monad [expected random.nat diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index cdb7198b5..064f1891e 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -28,7 +28,7 @@ (<| (_.covering /._) (_.for [/.Queue]) (do {! random.monad} - [size (\ ! map (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) @@ -88,7 +88,7 @@ has_expected_order! (\ (list.equivalence n.equivalence) = - (list\compose (/.list sample) (list non_member)) + (list\composite (/.list sample) (list non_member)) (/.list pushed))] (and size_increases! new_member_is_identified! diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 1e199d23e..da99e408d 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -31,7 +31,7 @@ (<| (_.covering /._) (_.for [/.Queue]) (do {! random.monad} - [size (\ ! map (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) @@ -80,7 +80,7 @@ (/.end /.min min_member) (/.end /.max max_member) /.front - (maybe\map (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\map (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 a8ff3a7ab..b5ba88171 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 (\ ! each (n.% 100) random.nat)] ($_ _.and (_.for [/.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 (\ ! each (n.% 100) random.nat) sample (random.set n.hash size random.nat) .let [sample (|> sample set.list /.of_list)] .let [(^open "/\.") (/.equivalence n.equivalence)]] @@ -81,10 +81,10 @@ (def: index_based Test (do {! random.monad} - [size (\ ! map (|>> (n.% 100) ++) random.nat)] + [size (\ ! each (|>> (n.% 100) ++) random.nat)] ($_ _.and (do ! - [good_index (|> random.nat (\ ! map (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 (\ ! map (|>> (n.% 100) ++) random.nat)] + [size (\ ! each (|>> (n.% 100) ++) 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 fc67cf27d..ace5fa0cb 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -45,9 +45,9 @@ (let [(^open "list\.") (list.equivalence n.equivalence)]) (do {! random.monad} [repeated random.nat - index (\ ! map (n.% 100) random.nat) - size (\ ! map (|>> (n.% 10) ++) random.nat) - offset (\ ! map (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 @@ -94,7 +94,7 @@ (list\= (enum.range n.enum (++ offset) (n.+ size offset)) (/.first size (/.tail (..iterations ++ offset))))) (_.cover [/.only] - (list\= (list\map (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))] @@ -106,7 +106,7 @@ (let [(^open "/\.") /.functor (^open "list\.") (list.equivalence text.equivalence)] (list\= (/.first size - (/\map %.nat (..iterations ++ offset))) + (/\each %.nat (..iterations ++ offset))) (/.first size (/.iterations (function (_ n) [(++ n) (%.nat n)]) offset))))) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 66ecd0ca3..2ed9fb511 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -22,7 +22,7 @@ (def: gen_nat (Random Nat) - (\ random.monad map (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 map (|>> 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,13 +52,13 @@ (_.cover [/.empty] (/.empty? (/.empty n.hash))) (do ! - [hash (\ ! map (function (_ constant) - (: (Hash Nat) - (implementation - (def: &equivalence n.equivalence) - - (def: (hash _) - constant)))) + [hash (\ ! each (function (_ constant) + (: (Hash Nat) + (implementation + (def: &equivalence n.equivalence) + + (def: (hash _) + constant)))) random.nat)] (_.cover [/.member_hash] (same? hash (/.member_hash (/.empty hash))))) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 0afe973ef..55928932f 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -23,7 +23,7 @@ (def: count (Random Nat) - (\ random.monad map (|>> (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)))) @@ -39,21 +39,21 @@ (def: signature Test (do {! random.monad} - [diversity (\ ! map (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 map (function (_ single) - (/.has 1 single (/.empty n.hash)))) + (\ random.monad each (function (_ single) + (/.has 1 single (/.empty n.hash)))) ($hash.spec /.hash))) ))) (def: composition Test (do {! random.monad} - [diversity (\ ! map (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,12 +113,12 @@ (<| (_.covering /._) (_.for [/.Set]) (do {! random.monad} - [diversity (\ ! map (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 (\ ! map (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] diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index b753ac1af..31b8b0405 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 each (n.% 100) random.nat)) (def: .public (random size &order gen_value) (All [a] (-> Nat (Order a) (Random a) (Random (Set a)))) @@ -47,7 +47,7 @@ non_memberL (random.only (|>> (//.member? usetL) not) random.nat) .let [listL (//.list usetL)] - listR (|> (random.set n.hash sizeR random.nat) (\ ! map //.list)) + listR (|> (random.set n.hash sizeR random.nat) (\ ! each //.list)) .let [(^open "/\.") /.equivalence setL (/.of_list n.order listL) setR (/.of_list n.order listR) diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 79355156f..a6aa8c1dc 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -27,7 +27,7 @@ (<| (_.covering /._) (_.for [/.Stack]) (do random.monad - [size (\ random.monad map (n.% 100) random.nat) + [size (\ random.monad each (n.% 100) random.nat) sample (random.stack size random.nat) expected_top random.nat] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index be610c25d..d48a8d208 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -23,13 +23,13 @@ (All [a] (-> (Random a) (Random [Nat (Tree a)]))) (do {! random.monad} [value gen_value - num_children (\ ! map (n.% 2) random.nat) + num_children (\ ! each (n.% 2) random.nat) children (random.list num_children (tree gen_value))] (in [(|> children - (list\map product.left) + (list\each product.left) (list\mix n.+ 1)) {#/.value value - #/.children (list\map 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 map product.right) + (\ random.monad each product.right) ($equivalence.spec (/.equivalence n.equivalence)))) (_.for [/.mix] ($mix.spec /.leaf /.equivalence /.mix)) @@ -58,12 +58,12 @@ (/.flat (/.leaf expected))))) (do {! random.monad} [value random.nat - num_children (\ ! map (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& value children) - (/.flat (/.branch value (list\map /.leaf children)))))) + (/.flat (/.branch value (list\each /.leaf children)))))) (do random.monad [expected/0 random.nat expected/1 random.nat diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index 53631edbf..5ec0569bb 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -45,7 +45,7 @@ (_.cover [/.tag] (and (text\= tag_left (/.tag (\ ..builder leaf tag_left expected_left))) - (text\= (text\compose tag_left tag_right) + (text\= (text\composite tag_left tag_right) (/.tag (\ ..builder branch (\ ..builder leaf tag_left expected_left) (\ ..builder leaf tag_right expected_right)))))) @@ -96,13 +96,13 @@ (let [can_find_correct_one! (|> (\ ..builder leaf tag_left expected_left) (/.one (text.contains? tag_left)) - (maybe\map (n.= expected_left)) + (maybe\each (n.= expected_left)) (maybe.else false)) cannot_find_incorrect_one! (|> (\ ..builder leaf tag_right expected_right) (/.one (text.contains? tag_left)) - (maybe\map (n.= expected_left)) + (maybe\each (n.= expected_left)) (maybe.else false) not) @@ -111,7 +111,7 @@ (\ ..builder leaf tag_left expected_left) (\ ..builder leaf tag_right expected_right)) (/.one (text.contains? tag_left)) - (maybe\map (n.= expected_left)) + (maybe\each (n.= expected_left)) (maybe.else false)) can_find_right! @@ -119,7 +119,7 @@ (\ ..builder leaf tag_left expected_left) (\ ..builder leaf tag_right expected_right)) (/.one (text.contains? tag_right)) - (maybe\map (n.= expected_right)) + (maybe\each (n.= expected_right)) (maybe.else false))] (and can_find_correct_one! cannot_find_incorrect_one! diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 2b20582e9..d134be2ca 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 (_.for [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (\ ! map (|>> 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] @@ -197,7 +197,7 @@ (|> sample /.zipper /.end - (maybe\map /.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 67158dc10..2665beb41 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 map /.of_rgb))) + (\ random.monad each /.of_rgb))) (def: scale (-> Nat Frac) @@ -131,15 +131,15 @@ Test (_.for [/.Spread /.Palette] (do {! random.monad} - [eH (\ ! map (|>> 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 (\ ! map (|>> (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 (\ ! map (|>> 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>] diff --git a/stdlib/source/test/lux/data/format/binary.lux b/stdlib/source/test/lux/data/format/binary.lux index 107d95714..842186da7 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 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 9e5a03843..9b885e9de 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -36,7 +36,7 @@ (random.rec (function (_ recur) (do {! random.monad} - [size (\ ! map (n.% 2) random.nat)] + [size (\ ! each (n.% 2) random.nat)] ($_ random.or (\ ! in []) random.bit @@ -85,20 +85,20 @@ (|> expected /.format (\ /.codec decoded) - (try\map (\= expected)) + (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\map (|>> #/.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\map product.left expected) + (list\each product.left expected) actual) (#try.Failure error) @@ -106,7 +106,7 @@ (_.cover [/.field] (list.every? (function (_ [key expected]) (|> (/.field key object) - (try\map (\= expected)) + (try\each (\= expected)) (try.else false))) expected)) )) @@ -122,7 +122,7 @@ .let [can_find_known_key! (|> object (/.field key) - (try\map (\= (#/.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\map (\ <equivalence> = value)) + (try\each (\ <equivalence> = value)) (try.else false))))] [/.Boolean /.boolean_field #/.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 7a84f12fd..2567d277f 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -108,8 +108,8 @@ Test (_.for [/.Small] (do {! random.monad} - [expected (|> random.nat (\ ! map (n.% /.small_limit))) - invalid (|> random.nat (\ ! map (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 (\ ! map (n.% /.big_limit))) - invalid (|> random.nat (\ ! map (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,10 +158,10 @@ Test (do {! random.monad} [expected_path (random.ascii/lower (-- /.path_size)) - expected_moment (\ ! map (|>> (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 (\ ! map (n.% 100) random.nat) + chunks (\ ! each (n.% 100) random.nat) .let [content (|> chunk (list.repeated chunks) text.together @@ -402,11 +402,11 @@ (|> row.empty (format.result /.writer) (<b>.result /.parser) - (\ try.monad map 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\compose 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 0ce833e92..0d9f9ead4 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -36,13 +36,13 @@ (def: char (Random Nat) (do {! random.monad} - [idx (|> random.nat (\ ! map (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\map constraint random.nat))) + (random\each constraint random.nat))) (def: (text bottom top) (-> Nat Nat (Random Text)) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 0a882efaf..ef4057d1c 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -30,12 +30,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 (\ ! each (n.% 100))) + sizeS1 (|> random.nat (\ ! each (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..random sizeM1 sizeS1) ... Second Name - sizeM2 (|> random.nat (\ ! map (n.% 100))) - sizeS2 (|> random.nat (\ ! map (|>> (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,7 +43,7 @@ ($equivalence.spec /.equivalence (..random sizeM1 sizeS1))) (_.for [/.hash] (|> (random.ascii 1) - (\ ! map (|>> [""])) + (\ ! each (|>> [""])) ($hash.spec /.hash))) (_.for [/.order] ($order.spec /.order (..random sizeM1 sizeS1))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 61b9c43a1..44588b3b6 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -23,7 +23,7 @@ (def: .public test Test (<| (_.covering /._) - (_.for [.Variant .Or]) + (_.for [.Union .Or]) (do {! random.monad} [expected random.nat shift random.nat] @@ -70,12 +70,12 @@ (/.then (n.+ shift) (n.- shift)) (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) (do ! - [size (\ ! map (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\map /.left expected))] + (list\each /.left expected))] (and (\ (list.equivalence n.equivalence) = expected (/.lefts actual)) @@ -84,7 +84,7 @@ (/.rights actual))))) (_.cover [/.rights] (let [actual (: (List (Or Nat Nat)) - (list\map /.right expected))] + (list\each /.right expected))] (and (\ (list.equivalence n.equivalence) = expected (/.rights actual)) @@ -93,10 +93,10 @@ (/.lefts actual))))) (_.cover [/.partition] (let [[lefts rights] (|> expected - (list\map (function (_ value) - (if (n.even? value) - (/.left value) - (/.right value)))) + (list\each (function (_ value) + (if (n.even? value) + (/.left value) + (/.right value)))) (: (List (Or Nat Nat))) /.partition)] (and (\ (list.equivalence n.equivalence) = diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 832c5a094..df0c6000c 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 map (|>> (n.% 20) (n.+ 1))))) + (\ random.monad each (|>> (n.% 20) (n.+ 1))))) (def: size Test (do {! random.monad} - [size (\ ! map (n.% 10) random.nat) + [size (\ ! each (n.% 10) random.nat) sample (random.unicode size)] ($_ _.and (_.cover [/.size] @@ -56,7 +56,7 @@ (random.unicode 1)) left (random.unicode 1) right (random.unicode 1) - .let [full (\ /.monoid compose inner outer) + .let [full (\ /.monoid composite inner outer) fake_index (-- 0)]] (`` ($_ _.and (~~ (template [<affix> <predicate>] @@ -86,18 +86,18 @@ .let [fake_index (-- 0)]] ($_ _.and (_.cover [/.contains?] - (let [full (\ /.monoid compose inner outer)] + (let [full (\ /.monoid composite inner outer)] (and (/.contains? inner full) (/.contains? outer full)))) (_.cover [/.index] - (and (|> (/.index inner (\ /.monoid compose inner outer)) + (and (|> (/.index inner (\ /.monoid composite inner outer)) (maybe.else fake_index) (n.= 0)) - (|> (/.index outer (\ /.monoid compose inner outer)) + (|> (/.index outer (\ /.monoid composite inner outer)) (maybe.else fake_index) (n.= 1)))) (_.cover [/.index'] - (let [full (\ /.monoid compose inner outer)] + (let [full (\ /.monoid composite inner outer)] (and (|> (/.index' 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 compose) outer inner outer)] + (let [full ($_ (\ /.monoid composite) outer inner outer)] (and (|> (/.last_index inner full) (maybe.else fake_index) (n.= 1)) @@ -146,10 +146,10 @@ (\ /.equivalence = /.new_line /.line_feed)) ))) (do {! random.monad} - [size (\ ! map (|>> (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 (\ ! map (n.% size) random.nat)] + expected (\ ! each (n.% size) random.nat)] (_.cover [/.char] (case (/.char expected sample) (#.Some char) @@ -178,7 +178,7 @@ (def: manipulation Test (do {! random.monad} - [size (\ ! map (|>> (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)) @@ -206,10 +206,10 @@ (/.interposed "" (set.list characters))))) (_.cover [/.replaced/1] (\ /.equivalence = - (\ /.monoid compose post static) - (/.replaced/1 pre post (\ /.monoid compose pre static)))) + (\ /.monoid composite post static) + (/.replaced/1 pre post (\ /.monoid composite pre static)))) (_.cover [/.split_by] - (case (/.split_by static ($_ (\ /.monoid compose) pre static post)) + (case (/.split_by static ($_ (\ /.monoid composite) pre static post)) (#.Some [left right]) (and (\ /.equivalence = pre left) (\ /.equivalence = post right)) @@ -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 (\ ! map (|>> (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) diff --git a/stdlib/source/test/lux/data/text/buffer.lux b/stdlib/source/test/lux/data/text/buffer.lux index 7d502d2fb..aa88a2ac3 100644 --- a/stdlib/source/test/lux/data/text/buffer.lux +++ b/stdlib/source/test/lux/data/text/buffer.lux @@ -17,7 +17,7 @@ (def: part (Random Text) (do {! random.monad} - [size (\ ! map (|>> (n.% 10) ++) random.nat)] + [size (\ ! each (|>> (n.% 10) ++) random.nat)] (random.ascii/alpha size))) (def: .public test diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index ca28e316d..c17b7ce36 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -214,7 +214,7 @@ (Random /.Encoding) (let [options (list.size ..all_encodings)] (do {! random.monad} - [choice (\ ! map (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 49b125cba..855064059 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -34,7 +34,7 @@ (def: (range max min) (-> Char Char (Random Char)) (let [range (n.- min max)] - (\ random.monad map + (\ random.monad each (|>> (n.% range) (n.+ min)) random.nat))) @@ -114,7 +114,7 @@ (text\= expected (/.escaped expected)))))) (do {! random.monad} [dummy (|> (random.char unicode.character) - (\ ! map 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)) - (\ ! map text.of_char))] + (\ ! each text.of_char))] (_.cover [/.invalid_escape] (case (/.un_escaped (format "\" dummy)) (#try.Success _) @@ -135,7 +135,7 @@ (exception.match? /.invalid_escape error)))) (do {! random.monad} [too_short (|> (random.char unicode.character) - (\ ! map (n.% (hex "1000")))) + (\ ! each (n.% (hex "1000")))) code (|> (random.unicode 4) (random.only (function (_ code) (case (\ n.hex decoded code) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index cbeedd65a..5f604f1f8 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -159,7 +159,7 @@ (_.cover [/.list] (text\= (/.list /.nat members) (|> members - (list\map /.nat) + (list\each /.nat) (text.interposed " ") list (/.list (|>>)))))) @@ -177,7 +177,7 @@ [modulus (random.one (|>> modulus.modulus try.maybe) random.int) - sample (\ ! map (modular.modular modulus) + sample (\ ! each (modular.modular modulus) random.int)] (_.cover [/.mod] (text\= (\ (modular.codec modulus) encoded sample) diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index 926a56446..3c006d6d8 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 (\ ! map (n.% 1,000,000) random.nat) - additional (\ ! map (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 (\ ! map (|>> (n.% top_start) ++) random.nat) - end (\ ! map (|>> (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 (\ ! map + 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 b0be9c914..2ff6ade86 100644 --- a/stdlib/source/test/lux/data/text/unicode/set.lux +++ b/stdlib/source/test/lux/data/text/unicode/set.lux @@ -36,7 +36,7 @@ (_.for [/.Set]) (do {! random.monad} [block //block.random - inside (\ ! map + inside (\ ! each (|>> (n.% (block.size block)) (n.+ (block.start block))) random.nat) |