diff options
Diffstat (limited to '')
28 files changed, 206 insertions, 206 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 879c0c722..2a8f519fa 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -38,7 +38,7 @@ (if (n.< size idx) (do random.monad [byte random.nat] - (exec (try.assume (/.write/8 idx byte output)) + (exec (try.assumed (/.write/8 idx byte output)) (recur (inc idx)))) (\ random.monad wrap output))))) @@ -113,7 +113,7 @@ (_.cover [/.read/64 /.write/64] (..binary_io 3 /.read/64 /.write/64 value)))) (_.cover [/.slice] - (let [random_slice (try.assume (/.slice offset length sample)) + (let [random_slice (try.assumed (/.slice offset length sample)) idxs (: (List Nat) (case length 0 (list) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index ccf1d3484..29f0c733a 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -24,7 +24,7 @@ (def: injection (Injection Array) - (|>> list /.from_list)) + (|>> list /.of_list)) (def: bounded_size (Random Nat) @@ -96,7 +96,7 @@ [size ..bounded_size base random.nat shift random.nat - dummy (random.filter (|>> (n.= base) not) random.nat) + dummy (random.only (|>> (n.= base) not) random.nat) #let [expected (n.+ base shift)] the_array (random.array size random.nat)] ($_ _.and @@ -182,10 +182,10 @@ (/.vacancy the_array))))))) (do ! [the_list (random.list size random.nat)] - (_.cover [/.from_list /.to_list] - (and (|> the_list /.from_list /.to_list + (_.cover [/.of_list /.to_list] + (and (|> the_list /.of_list /.to_list (\ (list.equivalence n.equivalence) = the_list)) - (|> the_array /.to_list /.from_list + (|> the_array /.to_list /.of_list (\ (/.equivalence n.equivalence) = the_array))))) (do ! [amount (\ ! map (n.% (inc size)) random.nat)] @@ -201,8 +201,8 @@ (and (not (is? 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?))] + evens (|> the_array /.to_list (list.only n.even?)) + odds (|> the_array /.to_list (list.only n.odd?))] (_.cover [/.filter!] (exec (/.filter! n.even? the_array) (and (n.= (list.size evens) (/.occupancy the_array)) @@ -210,11 +210,11 @@ (|> 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))] - default (random.filter (function (_ value) - (not (or (n.even? value) - (set.member? members value)))) - random.nat)] + members (|> the_array /.to_list (set.of_list n.hash))] + default (random.only (function (_ value) + (not (or (n.even? value) + (set.member? members value)))) + random.nat)] (_.cover [/.to_list'] (exec (/.filter! n.even? the_array) (list.every? (function (_ value) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 541092b4e..fb82ed6c9 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -26,7 +26,7 @@ (def: injection (Injection (/.Dictionary Nat)) - (|>> [0] list (/.from_list n.hash))) + (|>> [0] list (/.of_list n.hash))) (def: for_dictionaries Test @@ -34,10 +34,10 @@ [#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.filter (|>> (/.key? dict) not) - random.nat) - test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) - random.nat)] + non_key (random.only (|>> (/.key? dict) not) + random.nat) + test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) + random.nat)] ($_ _.and (_.cover [/.size] (n.= size (/.size dict))) @@ -72,7 +72,7 @@ unique_keys! (|> entries (list\map product.left) - (set.from_list n.hash) + (set.of_list n.hash) set.size (n.= (/.size dict))) @@ -95,7 +95,7 @@ unique_keys! (|> keys - (set.from_list n.hash) + (set.of_list n.hash) set.size (n.= (/.size dict))) @@ -113,7 +113,7 @@ (= dict (/.merge dict dict))) overwritting_keys (let [dict' (|> dict /.entries (list\map (function (_ [k v]) [k (inc v)])) - (/.from_list n.hash)) + (/.of_list n.hash)) (^open ".") (/.equivalence n.equivalence)] (= dict' (/.merge dict' dict)))] (and merging_with_oneself @@ -124,10 +124,10 @@ (list.zip/2 (/.values dict) (/.values (/.merge_with n.+ dict dict))))) - (_.cover [/.from_list] + (_.cover [/.of_list] (let [(^open ".") (/.equivalence n.equivalence)] (and (= dict dict) - (|> dict /.entries (/.from_list n.hash) (= dict))))) + (|> dict /.entries (/.of_list n.hash) (= dict))))) ))) (def: for_entries @@ -136,10 +136,10 @@ [#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.filter (|>> (/.key? dict) not) - random.nat) - test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) - random.nat)] + non_key (random.only (|>> (/.key? dict) not) + random.nat) + test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) + random.nat)] ($_ _.and (_.cover [/.key?] (list.every? (/.key? dict) @@ -256,10 +256,10 @@ [#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.filter (|>> (/.key? dict) not) - random.nat) - test_val (random.filter (|>> (list.member? n.equivalence (/.values dict)) not) - random.nat)] + non_key (random.only (|>> (/.key? dict) not) + random.nat) + test_val (random.only (|>> (list.member? n.equivalence (/.values dict)) not) + random.nat)] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index bfa0175bb..6884c0e28 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -32,8 +32,8 @@ _ (do random.monad [partial (dictionary order gen_key gen_value (dec size)) - key (random.filter (|>> (/.key? partial) not) - gen_key) + key (random.only (|>> (/.key? partial) not) + gen_key) value gen_value] (wrap (/.put key value partial))))) @@ -45,13 +45,13 @@ [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) - random.nat) + extra_key (random.only (|>> (set.member? keys) not) + random.nat) extra_value random.nat shift random.nat #let [pairs (list.zip/2 (set.to_list keys) (set.to_list values)) - sample (/.from_list n.order pairs) + sample (/.of_list n.order pairs) sorted_pairs (list.sort (function (_ [left _] [right _]) (n.< left right)) pairs) @@ -98,9 +98,9 @@ (_.cover [/.keys /.values] (list\= (/.entries sample) (list.zip/2 (/.keys sample) (/.values sample)))) - (_.cover [/.from_list] + (_.cover [/.of_list] (|> sample - /.entries (/.from_list n.order) + /.entries (/.of_list n.order) (/\= sample))) (_.cover [/.key?] (and (list.every? (/.key? sample) diff --git a/stdlib/source/test/lux/data/collection/dictionary/plist.lux b/stdlib/source/test/lux/data/collection/dictionary/plist.lux index 450d3b733..f86f4c13c 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/plist.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/plist.lux @@ -37,9 +37,9 @@ size (\ ! map (n.% 100) random.nat) sample (..random size gen_key random.nat) - #let [keys (|> sample /.keys (set.from_list text.hash))] - extra_key (random.filter (|>> (set.member? keys) not) - gen_key) + #let [keys (|> sample /.keys (set.of_list text.hash))] + extra_key (random.only (|>> (set.member? keys) not) + gen_key) extra_value random.nat shift random.nat] ($_ _.and diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 5f1befd45..a19738802 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -181,15 +181,15 @@ (let [(^open "/\.") (/.equivalence n.equivalence) (^open "/\.") /.monoid] (do {! random.monad} - [sample (random.filter (|>> /.size (n.> 0)) - ..random) + [sample (random.only (|>> /.size (n.> 0)) + ..random) #let [size (/.size sample)] idx (\ ! map (n.% size) random.nat) chunk_size (\ ! map (|>> (n.% size) inc) random.nat)] ($_ _.and - (_.cover [/.filter] - (let [positives (/.filter n.even? sample) - negatives (/.filter (bit.complement n.even?) sample)] + (_.cover [/.only] + (let [positives (/.only n.even? sample) + negatives (/.only (bit.complement n.even?) sample)] (and (/.every? n.even? positives) (not (/.any? n.even? negatives)) @@ -198,9 +198,9 @@ (/.size negatives)))))) (_.cover [/.partition] (let [[positives negatives] (/.partition n.even? sample)] - (and (/\= (/.filter n.even? sample) + (and (/\= (/.only n.even? sample) positives) - (/\= (/.filter (bit.complement n.even?) sample) + (/\= (/.only (bit.complement n.even?) sample) negatives)))) (_.cover [/.split] (let [[left right] (/.split idx sample)] @@ -362,7 +362,7 @@ ($_ _.and (_.cover [/.one] (case [(|> sample - (/.filter n.even?) + (/.only n.even?) (/\map (\ n.decimal encode)) /.head) (/.one choose sample)] @@ -377,7 +377,7 @@ (_.cover [/.all] (\ (/.equivalence text.equivalence) = (|> sample - (/.filter n.even?) + (/.only n.even?) (/\map (\ n.decimal encode))) (/.all choose sample))) (_.cover [/.find] diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 3181c9bcc..3bc695aca 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -21,7 +21,7 @@ (def: injection (Injection /.Queue) - (|>> list /.from_list)) + (|>> list /.of_list)) (def: #export test Test @@ -30,18 +30,18 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) members (random.set n.hash size random.nat) - non_member (random.filter (|>> (set.member? members) not) - random.nat) + non_member (random.only (|>> (set.member? members) not) + random.nat) #let [members (set.to_list members) - sample (/.from_list members)]] + sample (/.of_list members)]] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.queue size random.nat))) (_.for [/.functor] ($functor.spec ..injection /.equivalence /.functor)) - (_.cover [/.from_list /.to_list] - (|> members /.from_list /.to_list + (_.cover [/.of_list /.to_list] + (|> members /.of_list /.to_list (\ (list.equivalence n.equivalence) = members))) (_.cover [/.size] (n.= size (/.size sample))) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 55d643aa8..a43b0e278 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -32,12 +32,12 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) sample (..random size) - non-member-priority random.nat - non-member (random.filter (|>> (/.member? n.equivalence sample) not) - random.nat) + non_member_priority random.nat + non_member (random.only (|>> (/.member? n.equivalence sample) not) + random.nat) - max-member random.nat - min-member random.nat] + max_member random.nat + min_member random.nat] ($_ _.and (_.cover [/.size] (n.= size (/.size sample))) @@ -61,11 +61,11 @@ #.None (/.empty? sample))) (_.cover [/.push] - (let [sample+ (/.push non-member-priority non-member sample)] - (and (not (/.member? n.equivalence sample non-member)) + (let [sample+ (/.push non_member_priority non_member sample)] + (and (not (/.member? n.equivalence sample non_member)) (n.= (inc (/.size sample)) (/.size sample+)) - (/.member? n.equivalence sample+ non-member)))) + (/.member? n.equivalence sample+ non_member)))) (_.cover [/.pop] (let [sample- (/.pop sample)] (or (and (/.empty? sample) @@ -76,18 +76,18 @@ ($_ _.and (_.cover [/.max] (|> /.empty - (/.push /.min min-member) - (/.push /.max max-member) + (/.push /.min min_member) + (/.push /.max max_member) /.peek - (maybe\map (n.= max-member)) + (maybe\map (n.= max_member)) (maybe.default false))) (_.cover [/.min] (|> /.empty - (/.push /.max max-member) - (/.push /.min min-member) + (/.push /.max max_member) + (/.push /.min min_member) /.pop /.peek - (maybe\map (n.= min-member)) + (maybe\map (n.= min_member)) (maybe.default false))) )) )))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 6b7b09fdc..fdd2c6276 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -50,7 +50,7 @@ (do {! random.monad} [size (\ ! map (n.% 100) random.nat) sample (random.set n.hash size random.nat) - #let [sample (|> sample set.to_list /.from_list)] + #let [sample (|> sample set.to_list /.of_list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (_.cover [/.size] @@ -59,8 +59,8 @@ (bit\= (/.empty? sample) (n.= 0 (/.size sample)))) (_.cover [/.empty] (/.empty? /.empty)) - (_.cover [/.to_list /.from_list] - (|> sample /.to_list /.from_list (/\= sample))) + (_.cover [/.to_list /.of_list] + (|> sample /.to_list /.of_list (/\= sample))) (_.cover [/.reverse] (or (n.< 2 (/.size sample)) (let [not_same! @@ -87,9 +87,9 @@ [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) - random.nat) - #let [sample (|> sample set.to_list /.from_list)]] + non_member (random.only (|>> (set.member? sample) not) + random.nat) + #let [sample (|> sample set.to_list /.of_list)]] ($_ _.and (_.cover [/.nth] (case (/.nth good_index sample) @@ -142,9 +142,9 @@ (do ! [sample (random.set n.hash size random.nat) - non_member (random.filter (|>> (set.member? sample) not) - random.nat) - #let [sample (|> sample set.to_list /.from_list)] + non_member (random.only (|>> (set.member? sample) not) + random.nat) + #let [sample (|> sample set.to_list /.of_list)] #let [(^open "/\.") (/.equivalence n.equivalence)]] ($_ _.and (do ! @@ -152,7 +152,7 @@ value/1 random.nat value/2 random.nat] (_.cover [/.row] - (/\= (/.from_list (list value/0 value/1 value/2)) + (/\= (/.of_list (list value/0 value/1 value/2)) (/.row value/0 value/1 value/2)))) (_.cover [/.member?] (and (list.every? (/.member? n.equivalence sample) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 8a8adf0a0..5058fae08 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -84,9 +84,9 @@ (_.cover [/.tail] (list\= (enum.range n.enum (inc offset) (n.+ size offset)) (/.take size (/.tail (/.iterate inc offset))))) - (_.cover [/.filter] + (_.cover [/.only] (list\= (list\map (n.* 2) (enum.range n.enum 0 (dec size))) - (/.take size (/.filter n.even? (/.iterate inc 0))))) + (/.take size (/.only n.even? (/.iterate inc 0))))) (_.cover [/.partition] (let [[evens odds] (/.partition n.even? (/.iterate inc 0))] (and (n.= (n.* 2 offset) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 021df152d..64556ed63 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -36,7 +36,7 @@ ($equivalence.spec /.equivalence (random.set n.hash size random.nat))) (_.for [/.hash] (|> random.nat - (\ random.monad map (|>> list (/.from_list n.hash))) + (\ random.monad map (|>> list (/.of_list n.hash))) ($hash.spec /.hash))) (_.for [/.monoid] ($monoid.spec /.equivalence (/.monoid n.hash) (random.set n.hash size random.nat))) @@ -46,8 +46,8 @@ sizeR ..gen_nat setL (random.set n.hash sizeL random.nat) setR (random.set n.hash sizeR random.nat) - non_memberL (random.filter (|>> (/.member? setL) not) - random.nat)] + non_memberL (random.only (|>> (/.member? setL) not) + random.nat)] ($_ _.and (_.cover [/.new] (/.empty? (/.new n.hash))) @@ -67,8 +67,8 @@ (_.cover [/.empty?] (bit\= (/.empty? setL) (n.= 0 (/.size setL)))) - (_.cover [/.to_list /.from_list] - (|> setL /.to_list (/.from_list n.hash) (\= setL))) + (_.cover [/.to_list /.of_list] + (|> setL /.to_list (/.of_list n.hash) (\= setL))) (_.cover [/.member?] (and (list.every? (/.member? setL) (/.to_list setL)) (not (/.member? setL non_memberL)))) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux index 1fd15a14f..aa85116f6 100644 --- a/stdlib/source/test/lux/data/collection/set/multi.lux +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -115,16 +115,16 @@ (do {! random.monad} [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) + non_member (random.only (predicate.complement (set.member? (/.support sample))) + random.nat) addition_count ..count partial_removal_count (\ ! map (n.% addition_count) random.nat) another (..random diversity n.hash ..count random.nat)] ($_ _.and - (_.cover [/.to_list /.from_list] + (_.cover [/.to_list /.of_list] (|> sample /.to_list - (/.from_list n.hash) + (/.of_list n.hash) (\ /.equivalence = sample))) (_.cover [/.size] (n.= (list.size (/.to_list sample)) @@ -194,17 +194,17 @@ (and null_scenario! partial_scenario! total_scenario!))) - (_.cover [/.from_set] - (let [unary (|> sample /.support /.from_set)] + (_.cover [/.of_set] + (let [unary (|> sample /.support /.of_set)] (list.every? (|>> (/.multiplicity unary) (n.= 1)) (/.to_list unary)))) (_.cover [/.sub?] - (let [unary (|> sample /.support /.from_set)] + (let [unary (|> sample /.support /.of_set)] (and (/.sub? sample unary) (or (not (/.sub? unary sample)) (\ /.equivalence = sample unary))))) (_.cover [/.super?] - (let [unary (|> sample /.support /.from_set)] + (let [unary (|> sample /.support /.of_set)] (and (/.super? unary sample) (or (not (/.super? sample unary)) (\ /.equivalence = sample unary))))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index dd3ba8802..260ab946f 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -32,8 +32,8 @@ _ (do random.monad [partial (random (dec size) &order gen_value) - value (random.filter (|>> (/.member? partial) not) - gen_value)] + value (random.only (|>> (/.member? partial) not) + gen_value)] (wrap (/.add value partial))))) (def: #export test @@ -44,13 +44,13 @@ [sizeL ..size sizeR ..size usetL (random.set n.hash sizeL random.nat) - non_memberL (random.filter (|>> (//.member? usetL) not) - random.nat) + non_memberL (random.only (|>> (//.member? usetL) not) + random.nat) #let [listL (//.to_list usetL)] 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) + setL (/.of_list n.order listL) + setR (/.of_list n.order listR) empty (/.new n.order)]] (`` ($_ _.and (_.for [/.equivalence] @@ -65,11 +65,11 @@ (/.empty? (/.new n.order))) (_.cover [/.to_list] (\ (list.equivalence n.equivalence) = - (/.to_list (/.from_list n.order listL)) + (/.to_list (/.of_list n.order listL)) (list.sort (\ n.order <) listL))) - (_.cover [/.from_list] + (_.cover [/.of_list] (|> setL - /.to_list (/.from_list n.order) + /.to_list (/.of_list n.order) (/\= setL))) (~~ (template [<coverage> <comparison>] [(_.cover [<coverage>] diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index c007ee050..6340c6fbd 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -28,7 +28,7 @@ (do random.monad [size (\ random.monad map (n.% 100) random.nat) sample (random.stack size random.nat) - expected-top random.nat] + expected_top random.nat] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence) (random.stack size random.nat))) @@ -59,10 +59,10 @@ sample (/.push top remaining)))) (_.cover [/.push] - (case (/.pop (/.push expected-top sample)) - (#.Some [actual-top actual-sample]) - (and (is? expected-top actual-top) - (is? sample actual-sample)) + (case (/.pop (/.push expected_top sample)) + (#.Some [actual_top actual_sample]) + (and (is? expected_top actual_top) + (is? sample actual_sample)) #.None false)) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux index c34449027..f92d75440 100644 --- a/stdlib/source/test/lux/data/collection/tree/finger.lux +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -33,8 +33,8 @@ (_.for [/.Tree]) (do {! random.monad} [tag_left (random.ascii/alpha_num 1) - tag_right (random.filter (|>> (text\= tag_left) not) - (random.ascii/alpha_num 1)) + tag_right (random.only (|>> (text\= tag_left) not) + (random.ascii/alpha_num 1)) expected_left random.nat expected_right random.nat] ($_ _.and @@ -91,16 +91,16 @@ (list.zip/2 tags/T values/T))] (and (\ tags_equivalence = (list& tags/H tags/T) (/.tags tree)) (\ values_equivalence = (list& values/H values/T) (/.values tree)))))) - (_.cover [/.search] + (_.cover [/.one] (let [can_find_correct_one! (|> (\ ..builder leaf tag_left expected_left) - (/.search (text.contains? tag_left)) + (/.one (text.contains? tag_left)) (maybe\map (n.= expected_left)) (maybe.default false)) cannot_find_incorrect_one! (|> (\ ..builder leaf tag_right expected_right) - (/.search (text.contains? tag_left)) + (/.one (text.contains? tag_left)) (maybe\map (n.= expected_left)) (maybe.default false) not) @@ -109,7 +109,7 @@ (|> (\ ..builder branch (\ ..builder leaf tag_left expected_left) (\ ..builder leaf tag_right expected_right)) - (/.search (text.contains? tag_left)) + (/.one (text.contains? tag_left)) (maybe\map (n.= expected_left)) (maybe.default false)) @@ -117,33 +117,33 @@ (|> (\ ..builder branch (\ ..builder leaf tag_left expected_left) (\ ..builder leaf tag_right expected_right)) - (/.search (text.contains? tag_right)) + (/.one (text.contains? tag_right)) (maybe\map (n.= expected_right)) (maybe.default false))] (and can_find_correct_one! cannot_find_incorrect_one! can_find_left! can_find_right!))) - (_.cover [/.found?] + (_.cover [/.exists?] (let [can_find_correct_one! - (/.found? (text.contains? tag_left) - (\ ..builder leaf tag_left expected_left)) + (/.exists? (text.contains? tag_left) + (\ ..builder leaf tag_left expected_left)) cannot_find_incorrect_one! - (not (/.found? (text.contains? tag_left) - (\ ..builder leaf tag_right expected_right))) + (not (/.exists? (text.contains? tag_left) + (\ ..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))) + (/.exists? (text.contains? tag_left) + (\ ..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)))] + (/.exists? (text.contains? tag_right) + (\ ..builder branch + (\ ..builder leaf tag_left expected_left) + (\ ..builder leaf tag_right expected_right)))] (and can_find_correct_one! cannot_find_incorrect_one! can_find_left! diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index d04b3b8e9..6487e5685 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -29,7 +29,7 @@ Test (do random.monad [expected random.nat - dummy (random.filter (|>> (n.= expected) not) random.nat)] + dummy (random.only (|>> (n.= expected) not) random.nat)] ($_ _.and (_.cover [/.down] (|> (tree.branch dummy (list (tree.leaf expected))) @@ -158,7 +158,7 @@ (do {! random.monad} [[size sample] (//.tree random.nat) expected random.nat - dummy (random.filter (|>> (n.= expected) not) random.nat) + dummy (random.only (|>> (n.= expected) not) random.nat) #let [(^open "tree\.") (tree.equivalence n.equivalence) (^open "list\.") (list.equivalence n.equivalence)]] ($_ _.and diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index 578771b59..c118a98ad 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -26,7 +26,7 @@ (def: #export random (Random /.Color) (|> ($_ random.and random.nat random.nat random.nat) - (\ random.monad map /.from_rgb))) + (\ random.monad map /.of_rgb))) (def: scale (-> Nat Frac) @@ -71,19 +71,19 @@ (def: (encoding expected) (-> /.Color Test) ($_ _.and - (_.cover [/.RGB /.to_rgb /.from_rgb] - (|> expected /.to_rgb /.from_rgb + (_.cover [/.RGB /.to_rgb /.of_rgb] + (|> expected /.to_rgb /.of_rgb (\ /.equivalence = expected))) - (_.cover [/.HSL /.to_hsl /.from_hsl] - (|> expected /.to_hsl /.from_hsl + (_.cover [/.HSL /.to_hsl /.of_hsl] + (|> expected /.to_hsl /.of_hsl (distance/3 expected) (f.<= ..rgb_error_margin))) - (_.cover [/.HSB /.to_hsb /.from_hsb] - (|> expected /.to_hsb /.from_hsb + (_.cover [/.HSB /.to_hsb /.of_hsb] + (|> expected /.to_hsb /.of_hsb (distance/3 expected) (f.<= ..rgb_error_margin))) - (_.cover [/.CMYK /.to_cmyk /.from_cmyk] - (|> expected /.to_cmyk /.from_cmyk + (_.cover [/.CMYK /.to_cmyk /.of_cmyk] + (|> expected /.to_cmyk /.of_cmyk (distance/3 expected) (f.<= ..rgb_error_margin))) )) @@ -92,14 +92,14 @@ Test (do random.monad [colorful (|> ..random - (random.filter (function (_ color) (|> (distance/3 color /.black) (f.>= +100.0)))) - (random.filter (function (_ color) (|> (distance/3 color /.white) (f.>= +100.0))))) + (random.only (function (_ color) (|> (distance/3 color /.black) (f.>= +100.0)))) + (random.only (function (_ color) (|> (distance/3 color /.white) (f.>= +100.0))))) mediocre (|> ..random - (random.filter (|>> saturation - ((function (_ saturation) - (and (f.>= +0.25 saturation) - (f.<= +0.75 saturation))))))) - ratio (|> random.safe_frac (random.filter (f.>= +0.5)))] + (random.only (|>> saturation + ((function (_ saturation) + (and (f.>= +0.25 saturation) + (f.<= +0.75 saturation))))))) + ratio (|> random.safe_frac (random.only (f.>= +0.5)))] ($_ _.and (_.cover [/.darker /.brighter] (and (f.<= (distance/3 colorful /.black) @@ -145,7 +145,7 @@ (~~ (template [<brightness> <palette>] [(_.cover [<palette>] (let [eB <brightness> - expected (/.from_hsb [eH eS eB]) + expected (/.of_hsb [eH eS eB]) palette (<palette> spread variations expected)] (and (n.= variations (list.size palette)) (not (list.any? (\ /.equivalence = expected) palette)))))] @@ -154,7 +154,7 @@ )) (~~ (template [<palette>] [(_.cover [<palette>] - (let [expected (/.from_hsb [eH eS +0.5]) + (let [expected (/.of_hsb [eH eS +0.5]) [c0 c1 c2] (<palette> expected)] (and (\ /.equivalence = expected c0) (not (\ /.equivalence = expected c1)) @@ -165,7 +165,7 @@ [/.split_complement])) (~~ (template [<palette>] [(_.cover [<palette>] - (let [expected (/.from_hsb [eH eS +0.5]) + (let [expected (/.of_hsb [eH eS +0.5]) [c0 c1 c2 c3] (<palette> expected)] (and (\ /.equivalence = expected c0) (not (\ /.equivalence = expected c1)) diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux index 9e027d74d..11c699932 100644 --- a/stdlib/source/test/lux/data/color/named.lux +++ b/stdlib/source/test/lux/data/color/named.lux @@ -204,13 +204,13 @@ (list.concat (`` (list (~~ (template [<definition> <by_letter>] [((: (-> Any (List //.Color)) (function (_ _) - (`` (list (~~ (template.splice <by_letter>)))))) + (`` (list (~~ (template.spliced <by_letter>)))))) 123)] <colors>)))))) (def: unique_colors - (set.from_list //.hash ..all_colors)) + (set.of_list //.hash ..all_colors)) (def: verdict (n.= (list.size ..all_colors) diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 9bd1c09b5..2fe36607d 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -112,8 +112,8 @@ )) (do random.monad [key (random.ascii/alpha 1) - unknown (random.filter (|>> (\ text.equivalence = key) not) - (random.ascii/alpha 1)) + unknown (random.only (|>> (\ text.equivalence = key) not) + (random.ascii/alpha 1)) expected random.safe_frac] (_.cover [/.set] (<| (try.default false) diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux index 8b0655555..fedcdd251 100644 --- a/stdlib/source/test/lux/data/format/tar.lux +++ b/stdlib/source/test/lux/data/format/tar.lux @@ -158,7 +158,7 @@ Test (do {! random.monad} [expected_path (random.ascii/lower (dec /.path_size)) - expected_moment (\ ! map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from_millis) + expected_moment (\ ! map (|>> (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) @@ -252,7 +252,7 @@ [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from_millis +0) + (instant.of_millis +0) expected_mode {#/.user {#/.name /.anonymous #/.id /.no_id} @@ -275,7 +275,7 @@ [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from_millis +0) + (instant.of_millis +0) <expected_mode> {#/.user {#/.name /.anonymous #/.id /.no_id} @@ -342,7 +342,7 @@ content (/.content (binary.create 0)) expected (/.name expected) tar (|> (row.row (#/.Normal [path - (instant.from_millis +0) + (instant.of_millis +0) /.none {#/.user {#/.name expected #/.id /.no_id} @@ -366,7 +366,7 @@ [path (/.path path) content (/.content (binary.create 0)) tar (|> (row.row (#/.Normal [path - (instant.from_millis +0) + (instant.of_millis +0) /.none {#/.user {#/.name /.anonymous #/.id /.no_id} diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index fd361c2f6..867d8bb84 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -21,8 +21,8 @@ (do random.monad [expected random.nat shift random.nat - dummy (random.filter (|>> (n.= expected) not) - random.nat)] + dummy (random.only (|>> (n.= expected) not) + random.nat)] ($_ _.and (_.for [/.equivalence] ($equivalence.spec (/.equivalence n.equivalence i.equivalence) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index cff19b801..05a2746f7 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -100,10 +100,10 @@ (: (List (| Nat Nat))) /.partition)] (and (\ (list.equivalence n.equivalence) = - (list.filter n.even? expected) + (list.only n.even? expected) lefts) (\ (list.equivalence n.equivalence) = - (list.filter (|>> n.even? not) expected) + (list.only (|>> n.even? not) expected) rights)))) )) )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 73696ae46..7223497d1 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -52,8 +52,8 @@ Test (do {! random.monad} [inner (random.unicode 1) - outer (random.filter (|>> (\ /.equivalence = inner) not) - (random.unicode 1)) + outer (random.only (|>> (\ /.equivalence = inner) not) + (random.unicode 1)) left (random.unicode 1) right (random.unicode 1) #let [full (\ /.monoid compose inner outer) @@ -81,8 +81,8 @@ Test (do {! random.monad} [inner (random.unicode 1) - outer (random.filter (|>> (\ /.equivalence = inner) not) - (random.unicode 1)) + outer (random.only (|>> (\ /.equivalence = inner) not) + (random.unicode 1)) #let [fake_index (dec 0)]] ($_ _.and (_.cover [/.contains?] @@ -145,7 +145,7 @@ (def: char Test ($_ _.and - (_.for [/.Char /.from_code] + (_.for [/.Char /.of_code] (`` ($_ _.and (~~ (template [<short> <long>] [(_.cover [<short> <long>] @@ -171,7 +171,7 @@ (_.cover [/.nth] (case (/.nth expected sample) (#.Some char) - (case (/.index_of (/.from_code char) sample) + (case (/.index_of (/.of_code char) sample) (#.Some actual) (n.= expected actual) @@ -198,12 +198,12 @@ (do {! random.monad} [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)) + separator (random.only (|>> (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) - (random.ascii/alpha 1))] + #let [dynamic (random.only (|>> (\ /.equivalence = static) not) + (random.ascii/alpha 1))] pre dynamic post dynamic @@ -217,7 +217,7 @@ (and (|> (set.to_list characters) (/.join_with separator) (/.split_all_with separator) - (set.from_list /.hash) + (set.of_list /.hash) (\ set.equivalence = characters)) (\ /.equivalence = (/.concat (set.to_list characters)) @@ -339,7 +339,7 @@ sep1 (random.text normal_char_gen 1) sep2 (random.text normal_char_gen 1) #let [part_gen (|> (random.text normal_char_gen sizeP) - (random.filter (|>> (/.contains? sep1) not)))] + (random.only (|>> (/.contains? sep1) not)))] parts (random.list sizeL part_gen) #let [sample1 (/.concat (list.interpose sep1 parts)) sample2 (/.concat (list.interpose sep2 parts)) diff --git a/stdlib/source/test/lux/data/text/encoding.lux b/stdlib/source/test/lux/data/text/encoding.lux index ea8605b82..3b7f83b72 100644 --- a/stdlib/source/test/lux/data/text/encoding.lux +++ b/stdlib/source/test/lux/data/text/encoding.lux @@ -185,7 +185,7 @@ <named> (template [<definition> <by_letter>] [((: (-> Any (List /.Encoding)) (function (_ _) - (`` (list (~~ (template.splice <by_letter>)))))) + (`` (list (~~ (template.spliced <by_letter>)))))) [])] <encodings>)] @@ -205,7 +205,7 @@ (template [<definition> <by_letter>] [(def: <definition> Test - (`` (_.cover [/.name (~~ (template.splice <by_letter>))] + (`` (_.cover [/.name (~~ (template.spliced <by_letter>))] ..verdict)))] <encodings>) diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index bee4a7560..203cf9b81 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -56,18 +56,18 @@ (def: valid_sigils (Set Char) - (set.from_list n.hash - (list (debug.private /.\0_sigil) - (debug.private /.\a_sigil) - (debug.private /.\b_sigil) - (debug.private /.\t_sigil) - (debug.private /.\n_sigil) - (debug.private /.\v_sigil) - (debug.private /.\f_sigil) - (debug.private /.\r_sigil) - (debug.private /.\''_sigil) - (debug.private /.\\_sigil) - (debug.private /.\u_sigil)))) + (set.of_list n.hash + (list (debug.private /.\0_sigil) + (debug.private /.\a_sigil) + (debug.private /.\b_sigil) + (debug.private /.\t_sigil) + (debug.private /.\n_sigil) + (debug.private /.\v_sigil) + (debug.private /.\f_sigil) + (debug.private /.\r_sigil) + (debug.private /.\''_sigil) + (debug.private /.\\_sigil) + (debug.private /.\u_sigil)))) (syntax: (static_sample) (do meta.monad @@ -100,7 +100,7 @@ [left (random.char unicode.character) right (random.char unicode.character)] (_.cover [/.escape /.un_escape] - (let [expected (format (text.from_code left) (text.from_code right))] + (let [expected (format (text.of_code left) (text.of_code right))] (if (or (/.escapable? left) (/.escapable? right)) (let [escaped (/.escape expected)] @@ -114,7 +114,7 @@ (text\= expected (/.escape expected)))))) (do {! random.monad} [dummy (|> (random.char unicode.character) - (\ ! map text.from_code))] + (\ ! map text.of_code))] (_.cover [/.dangling_escape] (case (/.un_escape (format (/.escape dummy) "\")) (#try.Success _) @@ -124,8 +124,8 @@ (exception.match? /.dangling_escape error)))) (do {! random.monad} [dummy (|> (random.char unicode.character) - (random.filter (|>> (set.member? ..valid_sigils) not)) - (\ ! map text.from_code))] + (random.only (|>> (set.member? ..valid_sigils) not)) + (\ ! map text.of_code))] (_.cover [/.invalid_escape] (case (/.un_escape (format "\" dummy)) (#try.Success _) @@ -137,10 +137,10 @@ [too_short (|> (random.char unicode.character) (\ ! map (n.% (hex "1000")))) code (|> (random.unicode 4) - (random.filter (function (_ code) - (case (\ n.hex decode code) - (#try.Failure error) true - (#try.Success _) false))))] + (random.only (function (_ code) + (case (\ n.hex decode code) + (#try.Failure error) true + (#try.Success _) false))))] (_.cover [/.invalid_unicode_escape] (template.let [(!invalid <code>) [(case (/.un_escape (format "\u" <code>)) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index e7a34a90c..d339e0717 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -175,7 +175,7 @@ (/.maybe /.nat sample))))) (do {! random.monad} [modulus (random.one (|>> modulus.modulus - try.to_maybe) + try.maybe) random.int) sample (\ ! map (modular.modular modulus) random.int)] diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index cb481b97a..50498f396 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -132,9 +132,9 @@ (should_fail (/.regex "\p{Blank}") "."))) (_.test "ASCII." (and (should_pass (/.regex "\p{ASCII}") text.tab) - (should_fail (/.regex "\p{ASCII}") (text.from_code (hex "1234"))))) + (should_fail (/.regex "\p{ASCII}") (text.of_code (hex "1234"))))) (_.test "Control characters." - (and (should_pass (/.regex "\p{Contrl}") (text.from_code (hex "12"))) + (and (should_pass (/.regex "\p{Contrl}") (text.of_code (hex "12"))) (should_fail (/.regex "\p{Contrl}") "a"))) (_.test "Punctuation." (and (should_pass (/.regex "\p{Punct}") "@") @@ -143,8 +143,8 @@ (and (should_pass (/.regex "\p{Graph}") "@") (should_fail (/.regex "\p{Graph}") " "))) (_.test "Print." - (and (should_pass (/.regex "\p{Print}") (text.from_code (hex "20"))) - (should_fail (/.regex "\p{Print}") (text.from_code (hex "1234"))))) + (and (should_pass (/.regex "\p{Print}") (text.of_code (hex "20"))) + (should_fail (/.regex "\p{Print}") (text.of_code (hex "1234"))))) )) (def: custom_character_classes diff --git a/stdlib/source/test/lux/data/text/unicode/block.lux b/stdlib/source/test/lux/data/text/unicode/block.lux index 3b1f3866c..b895df0de 100644 --- a/stdlib/source/test/lux/data/text/unicode/block.lux +++ b/stdlib/source/test/lux/data/text/unicode/block.lux @@ -149,16 +149,16 @@ <named> (template [<definition> <part>] [((: (-> Any (List /.Block)) (function (_ _) - (`` (list (~~ (template.splice <part>)))))) + (`` (list (~~ (template.spliced <part>)))))) [])] <blocks>)] (template [<definition> <part>] [(def: <definition> Test - (`` (_.cover [(~~ (template.splice <part>))] + (`` (_.cover [(~~ (template.spliced <part>))] (let [all (list.concat (list <named>)) - unique (set.from_list /.hash all)] + unique (set.of_list /.hash all)] (n.= (list.size all) (set.size unique))))))] |