diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
26 files changed, 335 insertions, 319 deletions
diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 4b1ff0c54..9889fa0ae 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -13,7 +13,7 @@ [data [number ["." i64] - ["." nat]] + ["n" nat]] [collection ["." list]]]] {1 @@ -32,7 +32,7 @@ (-> Nat (Random Binary)) (let [output (/.create size)] (loop [idx 0] - (if (n/< size idx) + (if (n.< size idx) (do r.monad [byte r.nat] (exec (try.assume (/.write/8 idx byte output)) @@ -44,29 +44,29 @@ (let [binary (/.create bytes) cap (case bytes 8 (dec 0) - _ (|> 1 (i64.left-shift (n/* 8 bytes)) dec)) + _ (|> 1 (i64.left-shift (n.* 8 bytes)) dec)) capped-value (i64.and cap value)] (succeed (do try.monad [_ (write 0 value binary) output (read 0 binary)] - (wrap (n/= capped-value output)))))) + (wrap (n.= capped-value output)))))) (def: #export test Test (<| (_.context (%.name (name-of /._))) (do r.monad - [#let [gen-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 8))))] + [#let [gen-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 8))))] binary-size gen-size random-binary (binary binary-size) value r.nat - #let [gen-idx (|> r.nat (:: @ map (n/% binary-size)))] + #let [gen-idx (|> r.nat (:: @ map (n.% binary-size)))] [from to] (r.and gen-idx gen-idx) - #let [[from to] [(n/min from to) (n/max from to)]]] + #let [[from to] [(n.min from to) (n.max from to)]]] ($_ _.and ($equivalence.spec /.equivalence (binary binary-size)) (_.test "Can get size of binary." - (|> random-binary /.size (n/= binary-size))) + (|> random-binary /.size (n.= binary-size))) (_.test "Can read/write 8-bit values." (bits-io 1 /.read/8 /.write/8 value)) (_.test "Can read/write 16-bit values." @@ -76,15 +76,15 @@ (_.test "Can read/write 64-bit values." (bits-io 8 /.read/64 /.write/64 value)) (_.test "Can slice binaries." - (let [slice-size (|> to (n/- from) inc) + (let [slice-size (|> to (n.- from) inc) random-slice (try.assume (/.slice from to random-binary)) idxs (list.n/range 0 (dec slice-size)) reader (function (_ binary idx) (/.read/8 idx binary))] - (and (n/= slice-size (/.size random-slice)) + (and (n.= slice-size (/.size random-slice)) (case [(monad.map try.monad (reader random-slice) idxs) - (monad.map try.monad (|>> (n/+ from) (reader random-binary)) idxs)] + (monad.map try.monad (|>> (n.+ from) (reader random-binary)) idxs)] [(#try.Success slice-vals) (#try.Success binary-vals)] - (:: (list.equivalence nat.equivalence) = slice-vals binary-vals) + (:: (list.equivalence n.equivalence) = slice-vals binary-vals) _ #0)))) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index 50b1fcc71..c6dc407eb 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -15,7 +15,7 @@ [data ["." maybe] [number - ["." nat]] + ["n" nat]] [collection ["." list]]] [math @@ -30,7 +30,7 @@ (def: bounded-size (Random Nat) (|> r.nat - (:: r.monad map (|>> (n/% 100) (n/+ 1))))) + (:: r.monad map (|>> (n.% 100) (n.+ 1))))) (def: #export test Test @@ -38,8 +38,8 @@ (do r.monad [size bounded-size] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (r.array size r.nat)) - ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.array size r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (r.array size r.nat)) + ($monoid.spec (/.equivalence n.equivalence) /.monoid (r.array size r.nat)) ($functor.spec ..injection /.equivalence /.functor) ($fold.spec ..injection /.equivalence /.fold) @@ -48,16 +48,16 @@ original (r.array size r.nat)] ($_ _.and (_.test "Size function must correctly return size of array." - (n/= size (/.size original))) + (n.= size (/.size original))) (_.test "Cloning an array should yield and identical array, but not the same one." (let [clone (/.clone original)] - (and (:: (/.equivalence nat.equivalence) = original clone) + (and (:: (/.equivalence n.equivalence) = original clone) (not (is? original clone))))) (_.test "Full-range manual copies should give the same result as cloning." (let [copy (: (Array Nat) (/.new size))] (exec (/.copy size 0 original 0 copy) - (and (:: (/.equivalence nat.equivalence) = original copy) + (and (:: (/.equivalence n.equivalence) = original copy) (not (is? original copy)))))) (_.test "Array folding should go over all values." (let [manual-copy (: (Array Nat) @@ -68,17 +68,17 @@ (inc idx))) 0 original) - (:: (/.equivalence nat.equivalence) = original manual-copy)))) + (:: (/.equivalence n.equivalence) = original manual-copy)))) (_.test "Transformations between (full) arrays and lists shouldn't cause lose or change any values." (|> original /.to-list /.from-list - (:: (/.equivalence nat.equivalence) = original))) + (:: (/.equivalence n.equivalence) = original))) )) (do r.monad [size bounded-size - idx (:: @ map (n/% size) r.nat) + idx (:: @ map (n.% size) r.nat) array (|> (r.array size r.nat) - (r.filter (|>> /.to-list (list.any? n/odd?)))) + (r.filter (|>> /.to-list (list.any? n.odd?)))) #let [value (maybe.assume (/.read idx array))]] ($_ _.and (_.test "Shouldn't be able to find a value in an unoccupied cell." @@ -87,31 +87,31 @@ #.None true)) (_.test "You should be able to access values put into the array." (case (/.read idx (/.write idx value array)) - (#.Some value') (n/= value' value) + (#.Some value') (n.= value' value) #.None false)) (_.test "All cells should be occupied on a full array." - (and (n/= size (/.occupied array)) - (n/= 0 (/.vacant array)))) + (and (n.= size (/.occupied array)) + (n.= 0 (/.vacant array)))) (_.test "Filtering mutates the array to remove invalid values." - (exec (/.filter! n/even? array) - (and (n/< size (/.occupied array)) - (n/> 0 (/.vacant array)) - (n/= size (n/+ (/.occupied array) + (exec (/.filter! n.even? array) + (and (n.< size (/.occupied array)) + (n.> 0 (/.vacant array)) + (n.= size (n.+ (/.occupied array) (/.vacant array)))))) )) (do r.monad [size bounded-size array (|> (r.array size r.nat) - (r.filter (|>> /.to-list (list.any? n/even?))))] + (r.filter (|>> /.to-list (list.any? n.even?))))] ($_ _.and (_.test "Can find values inside arrays." - (|> (/.find n/even? array) + (|> (/.find n.even? array) (case> (#.Some _) true #.None false))) (_.test "Can find values inside arrays (with access to indices)." (|> (/.find+ (function (_ idx n) - (and (n/even? n) - (n/< size idx))) + (and (n.even? n) + (n.< size idx))) array) (case> (#.Some _) true #.None false))))) diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index b0f4dec0e..77e346116 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -8,6 +8,9 @@ {[0 #test] [/ ["$." equivalence]]}] + [data + [number + ["n" nat]]] [math ["r" random (#+ Random)]]] {1 @@ -16,13 +19,13 @@ (def: (size min max) (-> Nat Nat (Random Nat)) (|> r.nat - (:: r.monad map (|>> (n/% max) (n/max min))))) + (:: r.monad map (|>> (n.% max) (n.max min))))) (def: #export bits (Random Bits) (do r.monad [size (size 1 1,000) - idx (|> r.nat (:: @ map (n/% size)))] + idx (|> r.nat (:: @ map (n.% size)))] (wrap (|> /.empty (/.set idx))))) (def: #export test @@ -32,7 +35,7 @@ ($equivalence.spec /.equivalence ..bits) (do r.monad [size (size 1 1,000) - idx (|> r.nat (:: @ map (n/% size))) + idx (|> r.nat (:: @ map (n.% size))) sample bits] ($_ _.and (_.test "Can set individual bits." @@ -44,14 +47,14 @@ (and (|> /.empty (/.flip idx) (/.get idx)) (|> /.empty (/.flip idx) (/.flip idx) (/.get idx) not))) (_.test "Bits (only) grow when (and as much as) necessary." - (and (n/= 0 (/.capacity /.empty)) + (and (n.= 0 (/.capacity /.empty)) (|> /.empty (/.set idx) /.capacity - (n/- idx) - (predicate.unite (n/>= 0) - (n/< /.chunk-size))))) + (n.- idx) + (predicate.unite (n.>= 0) + (n.< /.chunk-size))))) (_.test "Bits (must) shrink when (and as much as) possible." (let [grown (/.flip idx /.empty)] - (and (n/> 0 (/.capacity grown)) + (and (n.> 0 (/.capacity grown)) (is? /.empty (/.flip idx grown))))) (_.test "Intersection can be detected when there are set bits in common." (and (not (/.intersects? /.empty @@ -68,12 +71,12 @@ (is? /.empty (/.and sample (/.not sample)))) (_.test "'or' with one's opposite fully saturates a bit-set." - (n/= (/.size (/.or sample (/.not sample))) + (n.= (/.size (/.or sample (/.not sample))) (/.capacity sample))) (_.test "'xor' with oneself yields the empty bit-set." (is? /.empty (/.xor sample sample))) (_.test "'xor' with one's opposite fully saturates a bit-set." - (n/= (/.size (/.xor sample (/.not sample))) + (n.= (/.size (/.xor sample (/.not sample))) (/.capacity sample))) (_.test "Double negation results in original bit-set." (:: /.equivalence = sample (/.not (/.not sample)))) diff --git a/stdlib/source/test/lux/data/collection/dictionary.lux b/stdlib/source/test/lux/data/collection/dictionary.lux index 4512c0bec..432909629 100644 --- a/stdlib/source/test/lux/data/collection/dictionary.lux +++ b/stdlib/source/test/lux/data/collection/dictionary.lux @@ -12,7 +12,7 @@ [data ["." maybe] [number - ["." nat]] + ["n" nat]] [collection ["." list ("#@." functor)]]] [math @@ -22,30 +22,30 @@ (def: injection (Injection (/.Dictionary Nat)) - (|>> [0] list (/.from-list nat.hash))) + (|>> [0] list (/.from-list n.hash))) (def: #export test Test (<| (_.context (%.name (name-of /.Dictionary))) (do r.monad - [#let [capped-nat (:: r.monad map (n/% 100) r.nat)] + [#let [capped-nat (:: r.monad map (n.% 100) r.nat)] size capped-nat - dict (r.dictionary nat.hash size r.nat capped-nat) + dict (r.dictionary n.hash size r.nat capped-nat) non-key (|> r.nat (r.filter (function (_ key) (not (/.contains? key dict))))) - test-val (|> r.nat (r.filter (function (_ val) (not (list.member? nat.equivalence (/.values dict) val)))))] + test-val (|> r.nat (r.filter (function (_ val) (not (list.member? n.equivalence (/.values dict) val)))))] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) - (r.dictionary nat.hash size r.nat r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) + (r.dictionary n.hash size r.nat r.nat)) ($functor.spec ..injection /.equivalence /.functor) (_.test "Size function should correctly represent Dictionary size." - (n/= size (/.size dict))) + (n.= size (/.size dict))) (_.test "Dictionaries of size 0 should be considered empty." - (if (n/= 0 size) + (if (n.= 0 size) (/.empty? dict) (not (/.empty? dict)))) (_.test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list.equivalence (eq.product nat.equivalence nat.equivalence)) = + (:: (list.equivalence (eq.product n.equivalence n.equivalence)) = (/.entries dict) (list.zip2 (/.keys dict) (/.values dict)))) @@ -63,18 +63,18 @@ _ #1)) (_.test "Should be able to put and then get a value." (case (/.get non-key (/.put non-key test-val dict)) - (#.Some v) (n/= test-val v) + (#.Some v) (n.= test-val v) _ #1)) (_.test "Should be able to try-put and then get a value." (case (/.get non-key (/.try-put non-key test-val dict)) - (#.Some v) (n/= test-val v) + (#.Some v) (n.= test-val v) _ #1)) (_.test "Shouldn't be able to try-put an existing key." - (or (n/= 0 size) + (or (n.= 0 size) (let [first-key (|> dict /.keys list.head maybe.assume)] (case (/.get first-key (/.try-put first-key test-val dict)) - (#.Some v) (not (n/= test-val v)) + (#.Some v) (not (n.= test-val v)) _ #1)))) (_.test "Removing a key should make it's value inaccessible." (let [base (/.put non-key test-val dict)] @@ -85,45 +85,45 @@ updt (/.update non-key inc base)] (case [(/.get non-key base) (/.get non-key updt)] [(#.Some x) (#.Some y)] - (n/= (inc x) y) + (n.= (inc x) y) _ #0))) (_.test "Additions and removals to a Dictionary should affect its size." (let [plus (/.put non-key test-val dict) base (/.remove non-key plus)] - (and (n/= (inc (/.size dict)) (/.size plus)) - (n/= (dec (/.size plus)) (/.size base))))) + (and (n.= (inc (/.size dict)) (/.size plus)) + (n.= (dec (/.size plus)) (/.size base))))) (_.test "A Dictionary should equal itself & going to<->from lists shouldn't change that." - (let [(^open ".") (/.equivalence nat.equivalence)] + (let [(^open ".") (/.equivalence n.equivalence)] (and (= dict dict) - (|> dict /.entries (/.from-list nat.hash) (= dict))))) + (|> dict /.entries (/.from-list n.hash) (= dict))))) (_.test "Merging a Dictionary to itself changes nothing." - (let [(^open ".") (/.equivalence nat.equivalence)] + (let [(^open ".") (/.equivalence n.equivalence)] (= dict (/.merge dict dict)))) (_.test "If you merge, and the second dict has overlapping keys, it should overwrite yours." (let [dict' (|> dict /.entries (list@map (function (_ [k v]) [k (inc v)])) - (/.from-list nat.hash)) - (^open ".") (/.equivalence nat.equivalence)] + (/.from-list n.hash)) + (^open ".") (/.equivalence n.equivalence)] (= dict' (/.merge dict' dict)))) (_.test "Can merge values in such a way that they become combined." - (list.every? (function (_ [x x*2]) (n/= (n/* 2 x) x*2)) + (list.every? (function (_ [x x*2]) (n.= (n.* 2 x) x*2)) (list.zip2 (/.values dict) - (/.values (/.merge-with n/+ dict dict))))) + (/.values (/.merge-with n.+ dict dict))))) (_.test "Should be able to select subset of keys from dict." (|> dict (/.put non-key test-val) (/.select (list non-key)) /.size - (n/= 1))) + (n.= 1))) (_.test "Should be able to re-bind existing values to different keys." - (or (n/= 0 size) + (or (n.= 0 size) (let [first-key (|> dict /.keys list.head maybe.assume) rebound (/.re-bind first-key non-key dict)] - (and (n/= (/.size dict) (/.size rebound)) + (and (n.= (/.size dict) (/.size rebound)) (/.contains? non-key rebound) (not (/.contains? first-key rebound)) - (n/= (maybe.assume (/.get first-key dict)) + (n.= (maybe.assume (/.get first-key dict)) (maybe.assume (/.get non-key rebound))))))) )))) diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 28119cd93..19b124c40 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -12,7 +12,7 @@ [data ["." product] [number - ["." nat]] + ["n" nat]] [collection ["." set] ["." list ("#@." functor)]]] @@ -41,31 +41,31 @@ Test (<| (_.context (%.name (name-of /.Dictionary))) (do r.monad - [size (|> r.nat (:: @ map (n/% 100))) - keys (r.set nat.hash size r.nat) - values (r.set nat.hash size r.nat) + [size (|> r.nat (:: @ map (n.% 100))) + keys (r.set n.hash size r.nat) + values (r.set n.hash size r.nat) extra-key (|> r.nat (r.filter (|>> (set.member? keys) not))) extra-value r.nat #let [pairs (list.zip2 (set.to-list keys) (set.to-list values)) - sample (/.from-list nat.order pairs) + sample (/.from-list n.order pairs) sorted-pairs (list.sort (function (_ [left _] [right _]) - (n/< left right)) + (n.< left right)) pairs) sorted-values (list@map product.right sorted-pairs) - (^open "/@.") (/.equivalence nat.equivalence)]] + (^open "/@.") (/.equivalence n.equivalence)]] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (..dictionary nat.order r.nat r.nat size)) + ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order r.nat r.nat size)) (_.test "Can query the size of a dictionary." - (n/= size (/.size sample))) + (n.= size (/.size sample))) (_.test "Can query value for minimum key." (case [(/.min sample) (list.head sorted-values)] [#.None #.None] #1 [(#.Some reference) (#.Some sample)] - (n/= reference sample) + (n.= reference sample) _ #0)) @@ -75,19 +75,19 @@ #1 [(#.Some reference) (#.Some sample)] - (n/= reference sample) + (n.= reference sample) _ #0)) (_.test "Converting dictionaries to/from lists cannot change their values." (|> sample - /.entries (/.from-list nat.order) + /.entries (/.from-list n.order) (/@= sample))) (_.test "Order is preserved." (let [(^open "list@.") (list.equivalence (: (Equivalence [Nat Nat]) (function (_ [kr vr] [ks vs]) - (and (n/= kr ks) - (n/= vr vs)))))] + (and (n.= kr ks) + (n.= vr vs)))))] (list@= (/.entries sample) sorted-pairs))) (_.test "Every key in a dictionary must be identifiable." @@ -102,7 +102,7 @@ (case [(/.get extra-key sample') (/.get extra-key sample'')] [(#.Some found) #.None] - (n/= extra-value found) + (n.= extra-value found) _ #0))) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 77d473fd6..954e3f15d 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -20,7 +20,7 @@ ["." product] ["." maybe] [number - ["." nat] + ["n" nat] ["." int]]] [math ["r" random]]] @@ -30,15 +30,15 @@ (def: bounded-size (r.Random Nat) (|> r.nat - (:: r.monad map (|>> (n/% 100) (n/+ 10))))) + (:: r.monad map (|>> (n.% 100) (n.+ 10))))) (def: signatures Test (do r.monad [size bounded-size] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (r.list size r.nat)) - ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.list size r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (r.list size r.nat)) + ($monoid.spec (/.equivalence n.equivalence) /.monoid (r.list size r.nat)) ($fold.spec /@wrap /.equivalence /.fold) ($functor.spec /@wrap /.equivalence /.functor) ($apply.spec /@wrap /.equivalence /.apply) @@ -49,14 +49,14 @@ subject r.nat] (let [lift (/.lift io.monad) (^open "io@.") io.monad - expected (n/+ parameter subject)] + expected (n.+ parameter subject)] (_.test "Can add list functionality to any monad." (|> (io.run (do (/.with io.monad) [a (lift (io@wrap parameter)) b (wrap subject)] - (wrap (n/+ a b)))) + (wrap (n.+ a b)))) (case> (^ (list actual)) - (n/= expected actual) + (n.= expected actual) _ false))))) @@ -67,10 +67,10 @@ (<| (_.context (%.name (name-of .List))) (do r.monad [size bounded-size - #let [(^open "/@.") (/.equivalence nat.equivalence) + #let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor (^open "/@.") /.monoid] - idx (:: @ map (n/% size) r.nat) + idx (:: @ map (n.% size) r.nat) sample (r.list size r.nat) other-size bounded-size other-sample (r.list other-size r.nat) @@ -79,31 +79,31 @@ ..signatures (_.test "The size function should correctly portray the size of the list." - (n/= size (/.size sample))) + (n.= size (/.size sample))) (_.test "The repeat function should produce as many elements as asked of it." - (n/= size (/.size (/.repeat size [])))) + (n.= size (/.size (/.repeat size [])))) (_.test "Reversing a list does not change it's size." - (n/= (/.size sample) + (n.= (/.size sample) (/.size (/.reverse sample)))) (_.test "Reversing a list twice results in the original list." (/@= sample (/.reverse (/.reverse sample)))) (_.test "Filtering by a predicate and its complement should result in a number of elements equal to the original list." - (and (n/= (/.size sample) - (n/+ (/.size (/.filter n/even? sample)) - (/.size (/.filter (bit.complement n/even?) sample)))) - (let [[plus minus] (/.partition n/even? sample)] - (n/= (/.size sample) - (n/+ (/.size plus) + (and (n.= (/.size sample) + (n.+ (/.size (/.filter n.even? sample)) + (/.size (/.filter (bit.complement n.even?) sample)))) + (let [[plus minus] (/.partition n.even? sample)] + (n.= (/.size sample) + (n.+ (/.size plus) (/.size minus)))))) (_.test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." - (if (/.every? n/even? sample) - (and (not (/.any? (bit.complement n/even?) sample)) - (/.empty? (/.filter (bit.complement n/even?) sample))) - (/.any? (bit.complement n/even?) sample))) + (if (/.every? n.even? sample) + (and (not (/.any? (bit.complement n.even?) sample)) + (/.empty? (/.filter (bit.complement n.even?) sample))) + (/.any? (bit.complement n.even?) sample))) (_.test "Any element of the list can be considered its member." (let [elem (maybe.assume (/.nth idx sample))] - (/.member? nat.equivalence sample elem))) + (/.member? n.equivalence sample elem))) (_.test "Appending the head and the tail should yield the original list." (let [head (maybe.assume (/.head sample)) tail (maybe.assume (/.tail sample))] @@ -116,7 +116,7 @@ (/@compose inits (list last))))) (_.test "Splitting a list into chunks and re-appending them should yield the original list." (let [[left right] (/.split idx sample) - [left' right'] (/.split-with n/even? sample)] + [left' right'] (/.split-with n.even? sample)] (and (/@= sample (/@compose left right)) (/@= sample @@ -125,21 +125,21 @@ (/@compose (/.take idx sample) (/.drop idx sample))) (/@= sample - (/@compose (/.take-while n/even? sample) - (/.drop-while n/even? sample))) + (/@compose (/.take-while n.even? sample) + (/.drop-while n.even? sample))) ))) (_.test "Segmenting the list in pairs should yield as many elements as N/2." - (n/= (n// 2 size) + (n.= (n./ 2 size) (/.size (/.as-pairs sample)))) (_.test "Sorting a list shouldn't change it's size." - (n/= (/.size sample) - (/.size (/.sort n/< sample)))) + (n.= (/.size sample) + (/.size (/.sort n.< sample)))) (_.test "Sorting a list with one order should yield the reverse of sorting it with the opposite order." - (/@= (/.sort n/< sample) - (/.reverse (/.sort n/> sample)))) + (/@= (/.sort n.< sample) + (/.reverse (/.sort n.> sample)))) (_.test "If you zip 2 lists, the result's size will be that of the smaller list." - (n/= (/.size (/.zip2 sample other-sample)) - (n/min (/.size sample) (/.size other-sample)))) + (n.= (/.size (/.zip2 sample other-sample)) + (n.min (/.size sample) (/.size other-sample)))) (_.test "I can pair-up elements of a list in order." (let [zipped (/.zip2 sample other-sample) num-zipper (/.size zipped)] @@ -147,32 +147,32 @@ (|> zipped (/@map product.right) (/@= (/.take num-zipper other-sample)))))) (_.test "You can generate indices for any size, and they will be in ascending order." (let [indices (/.indices size)] - (and (n/= size (/.size indices)) + (and (n.= size (/.size indices)) (/@= indices - (/.sort n/< indices)) - (/.every? (n/= (dec size)) - (/.zip2-with n/+ + (/.sort n.< indices)) + (/.every? (n.= (dec size)) + (/.zip2-with n.+ indices - (/.sort n/> indices))) + (/.sort n.> indices))) ))) (_.test "The 'interpose' function places a value between every member of a list." (let [sample+ (/.interpose separator sample)] - (and (n/= (|> size (n/* 2) dec) + (and (n.= (|> size (n.* 2) dec) (/.size sample+)) - (|> sample+ /.as-pairs (/@map product.right) (/.every? (n/= separator)))))) + (|> sample+ /.as-pairs (/@map product.right) (/.every? (n.= separator)))))) (_.test "You can find any value that satisfies some criterium, if such values exist in the list." - (case (/.find n/even? sample) + (case (/.find n.even? sample) (#.Some found) - (and (n/even? found) - (/.any? n/even? sample) - (not (/.every? (bit.complement n/even?) sample))) + (and (n.even? found) + (/.any? n.even? sample) + (not (/.every? (bit.complement n.even?) sample))) #.None - (and (not (/.any? n/even? sample)) - (/.every? (bit.complement n/even?) sample)))) + (and (not (/.any? n.even? sample)) + (/.every? (bit.complement n.even?) sample)))) (_.test "You can iteratively construct a list, generating values until you're done." (/@= (/.n/range 0 (dec size)) - (/.iterate (function (_ n) (if (n/< size n) (#.Some (inc n)) #.None)) + (/.iterate (function (_ n) (if (n.< size n) (#.Some (inc n)) #.None)) 0))) (_.test "Can enumerate all elements in a list." (let [enum-sample (/.enumerate sample)] @@ -181,8 +181,8 @@ (/@= sample (/@map product.right enum-sample))))) (do r.monad - [from (|> r.nat (:: @ map (n/% 10))) - to (|> r.nat (:: @ map (n/% 10)))] + [from (|> r.nat (:: @ map (n.% 10))) + to (|> r.nat (:: @ map (n.% 10)))] (_.test "Ranges can be constructed forward and backwards." (and (/@= (/.n/range from to) (/.reverse (/.n/range to from))) diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index f9a32c0c8..64e9c5e56 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -10,7 +10,7 @@ ["$." functor (#+ Injection)]]}] [data [number - ["." nat]]] + ["n" nat]]] [math ["r" random]]] {1 @@ -24,25 +24,25 @@ Test (<| (_.context (%.name (name-of /.Queue))) (do r.monad - [size (:: @ map (n/% 100) r.nat) + [size (:: @ map (n.% 100) r.nat) sample (r.queue size r.nat) non-member (|> r.nat - (r.filter (|>> (/.member? nat.equivalence sample) not)))] + (r.filter (|>> (/.member? n.equivalence sample) not)))] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (r.queue size r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (r.queue size r.nat)) ($functor.spec ..injection /.equivalence /.functor) (_.test "I can query the size of a queue (and empty queues have size 0)." - (if (n/= 0 size) + (if (n.= 0 size) (/.empty? sample) - (n/= size (/.size sample)))) + (n.= size (/.size sample)))) (_.test "Enqueueing and dequeing affects the size of queues." - (and (n/= (inc size) (/.size (/.push non-member sample))) + (and (n.= (inc size) (/.size (/.push non-member sample))) (or (/.empty? sample) - (n/= (dec size) (/.size (/.pop sample)))) - (n/= size (/.size (/.pop (/.push non-member sample)))))) + (n.= (dec size) (/.size (/.pop sample)))) + (n.= size (/.size (/.pop (/.push non-member sample)))))) (_.test "Transforming to/from list can't change the queue." - (let [(^open "/;.") (/.equivalence nat.equivalence)] + (let [(^open "/;.") (/.equivalence n.equivalence)] (|> sample /.to-list /.from-list (/;= sample)))) @@ -51,14 +51,14 @@ #.None (/.empty? sample) (#.Some _) #1)) (_.test "I can query whether an element belongs to a queue." - (and (not (/.member? nat.equivalence sample non-member)) - (/.member? nat.equivalence (/.push non-member sample) + (and (not (/.member? n.equivalence sample non-member)) + (/.member? n.equivalence (/.push non-member sample) non-member) (case (/.peek sample) #.None (/.empty? sample) (#.Some first) - (and (/.member? nat.equivalence sample first) - (not (/.member? nat.equivalence (/.pop sample) first)))))) + (and (/.member? n.equivalence sample first) + (not (/.member? n.equivalence (/.pop sample) first)))))) )))) diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 9464819a3..78e4bc2b8 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -7,7 +7,7 @@ [data ["." maybe] [number - ["." nat]]] + ["n" nat]]] [math ["r" random (#+ Random)]]] {1 @@ -28,29 +28,29 @@ Test (<| (_.context (%.name (name-of /.Queue))) (do r.monad - [size (|> r.nat (:: @ map (n/% 100))) + [size (|> r.nat (:: @ map (n.% 100))) sample (..queue size) non-member-priority r.nat - non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not)))] + non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not)))] ($_ _.and (_.test "I can query the size of a queue (and empty queues have size 0)." - (n/= size (/.size sample))) + (n.= size (/.size sample))) (_.test "Enqueueing and dequeing affects the size of queues." - (and (n/= (inc size) + (and (n.= (inc size) (/.size (/.push non-member-priority non-member sample))) - (or (n/= 0 (/.size sample)) - (n/= (dec size) + (or (n.= 0 (/.size sample)) + (n.= (dec size) (/.size (/.pop sample)))))) (_.test "I can query whether an element belongs to a queue." - (and (and (not (/.member? nat.equivalence sample non-member)) - (/.member? nat.equivalence + (and (and (not (/.member? n.equivalence sample non-member)) + (/.member? n.equivalence (/.push non-member-priority non-member sample) non-member)) - (or (n/= 0 (/.size sample)) - (and (/.member? nat.equivalence + (or (n.= 0 (/.size sample)) + (and (/.member? n.equivalence sample (maybe.assume (/.peek sample))) - (not (/.member? nat.equivalence + (not (/.member? n.equivalence (/.pop sample) (maybe.assume (/.peek sample)))))))) )))) diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index 7afbafd59..80917c7eb 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -15,7 +15,7 @@ [data ["." maybe] [number - ["." nat]] + ["n" nat]] [collection ["." list ("#@." fold)]]] [math @@ -27,32 +27,32 @@ Test (<| (_.context (%.name (name-of /._))) (do r.monad - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] + [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (r.row size r.nat)) - ($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.row size r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (r.row size r.nat)) + ($monoid.spec (/.equivalence n.equivalence) /.monoid (r.row size r.nat)) ($fold.spec /@wrap /.equivalence /.fold) ($functor.spec /@wrap /.equivalence /.functor) ($apply.spec /@wrap /.equivalence /.apply) ($monad.spec /@wrap /.equivalence /.monad) (do @ - [idx (|> r.nat (:: @ map (n/% size))) + [idx (|> r.nat (:: @ map (n.% size))) sample (r.row size r.nat) other-sample (r.row size r.nat) - non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not))) - #let [(^open "/@.") (/.equivalence nat.equivalence)]] + non-member (|> r.nat (r.filter (|>> (/.member? n.equivalence sample) not))) + #let [(^open "/@.") (/.equivalence n.equivalence)]] ($_ _.and (_.test (format (%.name (name-of /.size)) " " (%.name (name-of /.empty?))) (if (/.empty? sample) - (and (n/= 0 size) - (n/= 0 (/.size sample))) - (n/= size (/.size sample)))) + (and (n.= 0 size) + (n.= 0 (/.size sample))) + (n.= size (/.size sample)))) (_.test (format (%.name (name-of /.add)) " " (%.name (name-of /.pop))) - (and (n/= (inc size) (/.size (/.add non-member sample))) - (n/= (dec size) (/.size (/.pop sample))))) + (and (n.= (inc size) (/.size (/.add non-member sample))) + (n.= (dec size) (/.size (/.pop sample))))) (_.test (format (%.name (name-of /.put)) " " (%.name (name-of /.nth))) (|> sample @@ -64,13 +64,13 @@ (|> sample (/.put idx non-member) (/.update idx inc) (/.nth idx) maybe.assume - (n/= (inc non-member)))) + (n.= (inc non-member)))) (_.test (format (%.name (name-of /.to-list)) " " (%.name (name-of /.from-list))) (|> sample /.to-list /.from-list (/@= sample))) (_.test (%.name (name-of /.member?)) - (and (not (/.member? nat.equivalence sample non-member)) - (/.member? nat.equivalence (/.add non-member sample) non-member))) + (and (not (/.member? n.equivalence sample non-member)) + (/.member? n.equivalence (/.add non-member sample) non-member))) (_.test (%.name (name-of /.reverse)) (and (not (/@= sample (/.reverse sample))) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 2beb3599f..6e4f59930 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -9,7 +9,7 @@ [data ["." maybe] [number - ["." nat ("#@." decimal)]] + ["n" nat ("#@." decimal)]] ["." text ("#@." monoid)] [collection ["." list]]] @@ -22,80 +22,80 @@ Test (<| (_.context (%.name (name-of /.Sequence))) (do r.monad - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2)))) - offset (|> r.nat (:: @ map (n/% 100))) - factor (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2)))) + [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2)))) + offset (|> r.nat (:: @ map (n.% 100))) + factor (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2)))) elem r.nat cycle-seed (r.list size r.nat) - cycle-sample-idx (|> r.nat (:: @ map (n/% 1000))) - #let [(^open "list@.") (list.equivalence nat.equivalence) + cycle-sample-idx (|> r.nat (:: @ map (n.% 1000))) + #let [(^open "list@.") (list.equivalence n.equivalence) sample0 (/.iterate inc 0) sample1 (/.iterate inc offset)]] ($_ _.and (_.test "Can move along a sequence and take slices off it." (and (and (list@= (list.n/range 0 (dec size)) (/.take size sample0)) - (list@= (list.n/range offset (dec (n/+ offset size))) + (list@= (list.n/range offset (dec (n.+ offset size))) (/.take size (/.drop offset sample0))) (let [[drops takes] (/.split size sample0)] (and (list@= (list.n/range 0 (dec size)) drops) - (list@= (list.n/range size (dec (n/* 2 size))) + (list@= (list.n/range size (dec (n.* 2 size))) (/.take size takes))))) (and (list@= (list.n/range 0 (dec size)) - (/.take-while (n/< size) sample0)) - (list@= (list.n/range offset (dec (n/+ offset size))) - (/.take-while (n/< (n/+ offset size)) - (/.drop-while (n/< offset) sample0))) - (let [[drops takes] (/.split-while (n/< size) sample0)] + (/.take-while (n.< size) sample0)) + (list@= (list.n/range offset (dec (n.+ offset size))) + (/.take-while (n.< (n.+ offset size)) + (/.drop-while (n.< offset) sample0))) + (let [[drops takes] (/.split-while (n.< size) sample0)] (and (list@= (list.n/range 0 (dec size)) drops) - (list@= (list.n/range size (dec (n/* 2 size))) - (/.take-while (n/< (n/* 2 size)) takes))))) + (list@= (list.n/range size (dec (n.* 2 size))) + (/.take-while (n.< (n.* 2 size)) takes))))) )) (_.test "Can repeat any element and infinite number of times." - (n/= elem (/.nth offset (/.repeat elem)))) + (n.= elem (/.nth offset (/.repeat elem)))) (_.test "Can obtain the head & tail of a sequence." - (and (n/= offset (/.head sample1)) - (list@= (list.n/range (inc offset) (n/+ offset size)) + (and (n.= offset (/.head sample1)) + (list@= (list.n/range (inc offset) (n.+ offset size)) (/.take size (/.tail sample1))))) (_.test "Can filter sequences." - (and (n/= (n/* 2 offset) + (and (n.= (n.* 2 offset) (/.nth offset - (/.filter n/even? sample0))) - (let [[evens odds] (/.partition n/even? (/.iterate inc 0))] - (and (n/= (n/* 2 offset) + (/.filter n.even? sample0))) + (let [[evens odds] (/.partition n.even? (/.iterate inc 0))] + (and (n.= (n.* 2 offset) (/.nth offset evens)) - (n/= (inc (n/* 2 offset)) + (n.= (inc (n.* 2 offset)) (/.nth offset odds)))))) (_.test "Functor goes over 'all' elements in a sequence." (let [(^open "/@.") /.functor - there (/@map (n/* factor) sample0) - back-again (/@map (n// factor) there)] + there (/@map (n.* factor) sample0) + back-again (/@map (n./ factor) there)] (and (not (list@= (/.take size sample0) (/.take size there))) (list@= (/.take size sample0) (/.take size back-again))))) (_.test "CoMonad produces a value for every element in a sequence." (let [(^open "/@.") /.functor] - (list@= (/.take size (/@map (n/* factor) sample1)) + (list@= (/.take size (/@map (n.* factor) sample1)) (/.take size (be /.comonad [inputs sample1] - (n/* factor (/.head inputs))))))) + (n.* factor (/.head inputs))))))) (_.test "'unfold' generalizes 'iterate'." (let [(^open "/@.") /.functor (^open "list@.") (list.equivalence text.equivalence)] (list@= (/.take size - (/@map nat@encode (/.iterate inc offset))) + (/@map n@encode (/.iterate inc offset))) (/.take size - (/.unfold (function (_ n) [(inc n) (nat@encode n)]) + (/.unfold (function (_ n) [(inc n) (n@encode n)]) offset))))) (_.test "Can cycle over the same elements as an infinite sequence." (|> (/.cycle cycle-seed) maybe.assume (/.nth cycle-sample-idx) - (n/= (|> cycle-seed - (list.nth (n/% size cycle-sample-idx)) + (n.= (|> cycle-seed + (list.nth (n.% size cycle-sample-idx)) maybe.assume)))) )))) diff --git a/stdlib/source/test/lux/data/collection/set.lux b/stdlib/source/test/lux/data/collection/set.lux index 6e668af56..d742352ec 100644 --- a/stdlib/source/test/lux/data/collection/set.lux +++ b/stdlib/source/test/lux/data/collection/set.lux @@ -10,7 +10,7 @@ ["$." monoid]]}] [data [number - ["." nat]] + ["n" nat]] [collection ["." list]]] [math @@ -21,7 +21,7 @@ (def: gen-nat (r.Random Nat) (|> r.nat - (:: r.monad map (n/% 100)))) + (:: r.monad map (n.% 100)))) (def: #export test Test @@ -29,24 +29,24 @@ (do r.monad [size gen-nat] ($_ _.and - ($equivalence.spec /.equivalence (r.set nat.hash size r.nat)) - ($monoid.spec /.equivalence (/.monoid nat.hash) (r.set nat.hash size r.nat)) + ($equivalence.spec /.equivalence (r.set n.hash size r.nat)) + ($monoid.spec /.equivalence (/.monoid n.hash) (r.set n.hash size r.nat)) (do r.monad [sizeL gen-nat sizeR gen-nat - setL (r.set nat.hash sizeL gen-nat) - setR (r.set nat.hash sizeR gen-nat) + setL (r.set n.hash sizeL gen-nat) + setR (r.set n.hash sizeR gen-nat) non-member (|> gen-nat (r.filter (|>> (/.member? setL) not))) #let [(^open "/@.") /.equivalence]] ($_ _.and (_.test "I can query the size of a set." - (and (n/= sizeL (/.size setL)) - (n/= sizeR (/.size setR)))) + (and (n.= sizeL (/.size setL)) + (n.= sizeR (/.size setR)))) (_.test "Converting sets to/from lists can't change their values." (|> setL - /.to-list (/.from-list nat.hash) + /.to-list (/.from-list n.hash) (/@= setL))) (_.test "Every set is a sub-set of the union of itself with another." (let [setLR (/.union setL setR)] @@ -58,10 +58,10 @@ (/.super? setLR setR)))) (_.test "Union with the empty set leaves a set unchanged." (/@= setL - (/.union (/.new nat.hash) + (/.union (/.new n.hash) setL))) (_.test "Intersection with the empty set results in the empty set." - (let [empty-set (/.new nat.hash)] + (let [empty-set (/.new n.hash)] (/@= empty-set (/.intersection empty-set setL)))) (_.test "After substracting a set A from another B, no member of A can be a member of B." diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index fa7c00798..30ff8f6db 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -10,7 +10,7 @@ ["$." equivalence]]}] [data [number - ["." nat]] + ["n" nat]] [collection ["." list]]] [math @@ -22,7 +22,7 @@ (def: gen-nat (r.Random Nat) (|> r.nat - (:: r.monad map (n/% 100)))) + (:: r.monad map (n.% 100)))) (def: #export (set &order gen-value size) (All [a] (-> (Order a) (Random a) Nat (Random (Set a)))) @@ -44,29 +44,29 @@ (do r.monad [size gen-nat] ($_ _.and - ($equivalence.spec /.equivalence (..set nat.order r.nat size)) + ($equivalence.spec /.equivalence (..set n.order r.nat size)) )) (do r.monad [sizeL gen-nat sizeR gen-nat - listL (|> (r.set nat.hash sizeL gen-nat) (:: @ map //.to-list)) - listR (|> (r.set nat.hash sizeR gen-nat) (:: @ map //.to-list)) + listL (|> (r.set n.hash sizeL gen-nat) (:: @ map //.to-list)) + listR (|> (r.set n.hash sizeR gen-nat) (:: @ map //.to-list)) #let [(^open "/@.") /.equivalence - setL (/.from-list nat.order listL) - setR (/.from-list nat.order listR) - sortedL (list.sort n/< listL) + setL (/.from-list n.order listL) + setR (/.from-list n.order listR) + sortedL (list.sort n.< listL) minL (list.head sortedL) maxL (list.last sortedL)]] ($_ _.and (_.test "I can query the size of a set." - (n/= sizeL (/.size setL))) + (n.= sizeL (/.size setL))) (_.test "Can query minimum value." (case [(/.min setL) minL] [#.None #.None] true [(#.Some reference) (#.Some sample)] - (n/= reference sample) + (n.= reference sample) _ false)) @@ -76,19 +76,19 @@ true [(#.Some reference) (#.Some sample)] - (n/= reference sample) + (n.= reference sample) _ false)) (_.test "Converting sets to/from lists can't change their values." (|> setL - /.to-list (/.from-list nat.order) + /.to-list (/.from-list n.order) (/@= setL))) (_.test "Order is preserved." (let [listL (/.to-list setL) - (^open "list@.") (list.equivalence nat.equivalence)] + (^open "list@.") (list.equivalence n.equivalence)] (list@= listL - (list.sort n/< listL)))) + (list.sort n.< listL)))) (_.test "Every set is a sub-set of the union of itself with another." (let [setLR (/.union setL setR)] (and (/.sub? setLR setL) @@ -99,10 +99,10 @@ (/.super? setLR setR)))) (_.test "Union with the empty set leaves a set unchanged." (/@= setL - (/.union (/.new nat.order) + (/.union (/.new n.order) setL))) (_.test "Intersection with the empty set results in the empty set." - (let [empty-set (/.new nat.order)] + (let [empty-set (/.new n.order)] (/@= empty-set (/.intersection empty-set setL)))) (_.test "After substracting a set A from another B, no member of A can be a member of B." diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux index 74ddf6c86..a71b128a8 100644 --- a/stdlib/source/test/lux/data/collection/stack.lux +++ b/stdlib/source/test/lux/data/collection/stack.lux @@ -11,7 +11,7 @@ [data ["." maybe] [number - ["." nat]]] + ["n" nat]]] [math ["r" random]]] {1 @@ -24,7 +24,7 @@ (def: gen-nat (r.Random Nat) (|> r.nat - (:: r.monad map (n/% 100)))) + (:: r.monad map (n.% 100)))) (def: #export test Test @@ -34,11 +34,11 @@ sample (r.stack size gen-nat) new-top gen-nat] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (r.stack size r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (r.stack size r.nat)) ($functor.spec ..injection /.equivalence /.functor) (_.test (%.name (name-of /.size)) - (n/= size (/.size sample))) + (n.= size (/.size sample))) (_.test (%.name (name-of /.peek)) (case (/.peek sample) #.None (/.empty? sample) @@ -53,7 +53,7 @@ false) expected (case (/.pop sample) (#.Some sample') - (and (n/= (dec expected) (/.size sample')) + (and (n.= (dec expected) (/.size sample')) (not (/.empty? sample))) #.None @@ -61,7 +61,7 @@ (_.test (%.name (name-of /.push)) (and (is? sample (|> sample (/.push new-top) /.pop maybe.assume)) - (n/= (inc (/.size sample)) + (n.= (inc (/.size sample)) (/.size (/.push new-top sample))) (|> (/.push new-top sample) /.peek maybe.assume (is? new-top)))) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index 1506494c8..f42bc4f4d 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -11,7 +11,7 @@ ["$." functor]]}] [data [number - ["." nat]] + ["n" nat]] [collection ["." list ("#@." functor fold)]]] [math @@ -39,8 +39,8 @@ (do r.monad [value gen-value #let [size (dec size)] - left (tree (n// 2 size) gen-value) - right (tree (n/+ (n/% 2 size) (n// 2 size)) + left (tree (n./ 2 size) gen-value) + right (tree (n.+ (n.% 2 size) (n./ 2 size)) gen-value)] (wrap (/.branch value (list left right)))) ))) @@ -49,15 +49,15 @@ Test (<| (_.context (%.name (name-of /.Tree))) (do r.monad - [size (:: @ map (|>> (n/% 100) (n/+ 1)) r.nat)] + [size (:: @ map (|>> (n.% 100) (n.+ 1)) r.nat)] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (..tree size r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (..tree size r.nat)) ($fold.spec /.leaf /.equivalence /.fold) ($functor.spec /.leaf /.equivalence /.functor) (do @ [sample (..tree size r.nat)] (_.test "Can flatten a tree to get all the nodes as a flat tree." - (n/= size + (n.= size (list.size (/.flatten sample))))) )))) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 71d5a71cd..9ed7da62e 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -9,7 +9,7 @@ ["." maybe] ["." text] [number - ["." nat]] + ["n" nat]] [collection ["." list]]] [math @@ -24,14 +24,14 @@ Test (<| (_.context (%.name (name-of /.Zipper))) (do r.monad - [size (:: @ map (|>> (n/% 90) (n/+ 10)) r.nat) + [size (:: @ map (|>> (n.% 90) (n.+ 10)) r.nat) sample (//.tree size r.nat) mid-val r.nat new-val r.nat pre-val r.nat post-val r.nat - #let [(^open "tree@.") (tree.equivalence nat.equivalence) - (^open "list@.") (list.equivalence nat.equivalence)]] + #let [(^open "tree@.") (tree.equivalence n.equivalence) + (^open "list@.") (list.equivalence n.equivalence)]] ($_ _.and (_.test "Trees can be converted to/from zippers." (|> sample @@ -86,14 +86,14 @@ (case> (#.Some _) false #.None true)))))) (_.test "Can set and update the value of a node." - (|> sample /.zip (/.set new-val) /.value (n/= new-val))) + (|> sample /.zip (/.set new-val) /.value (n.= new-val))) (_.test "Zipper traversal follows the outline of the tree depth-first." (let [root (/.zip sample)] (list@= (tree.flatten sample) (loop [zipper (/.start root)] (let [zipper' (/.next zipper)] (#.Cons (/.value zipper) - (if (:: (/.equivalence nat.equivalence) = root zipper') + (if (:: (/.equivalence n.equivalence) = root zipper') (list) (recur zipper')))))))) (_.test "Backwards zipper traversal yield reverse tree flatten." @@ -101,7 +101,7 @@ (list@= (list.reverse (tree.flatten sample)) (loop [zipper (/.end root)] (#.Cons (/.value zipper) - (if (:: (/.equivalence nat.equivalence) = root zipper) + (if (:: (/.equivalence n.equivalence) = root zipper) (list) (recur (/.prev zipper)))))))) (_.test "Can remove nodes (except start nodes)." diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 4ccd4e337..6f16a0088 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -18,6 +18,7 @@ ["." maybe] ["." text] [number + ["n" nat] ["." frac]] [collection [row (#+ row)] @@ -50,7 +51,7 @@ (Random JSON) (r.rec (function (_ recur) (do r.monad - [size (:: @ map (n/% 2) r.nat)] + [size (:: @ map (n.% 2) r.nat)] ($_ r.or (:: @ wrap []) r.bit diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index a7236ede6..a3dc6b0e0 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -17,6 +17,8 @@ ["." name] ["." maybe] ["." text ("#@." equivalence)] + [number + ["n" nat]] [collection ["." dictionary] ["." list ("#@." functor)]]] @@ -34,12 +36,12 @@ (def: char (Random Nat) (do r.monad - [idx (|> r.nat (:: @ map (n/% (text.size char-range))))] + [idx (|> r.nat (:: @ map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) - (let [constraint (|>> (n/% top) (n/max bottom))] + (let [constraint (|>> (n.% top) (n.max bottom))] (r@map constraint r.nat))) (def: (text bottom top) @@ -73,7 +75,7 @@ (do r.monad [text (..text 1 10) - num-children (|> r.nat (:: @ map (n/% 5))) + num-children (|> r.nat (:: @ map (n.% 5))) children (r.list num-children (..text 1 10)) tag xml-identifier^ attr xml-identifier^ diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index cfc096326..a52326bef 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -12,7 +12,7 @@ [data ["%" text/format (#+ format)] [number - ["." nat]]] + ["n" nat]]] [math ["r" random (#+ Random)]]] {1 @@ -37,16 +37,16 @@ (do r.monad [left r.nat right r.nat - #let [lazy (/.freeze (n/* left right)) - expected (n/* left right)]] + #let [lazy (/.freeze (n.* left right)) + expected (n.* left right)]] ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (..lazy r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (..lazy r.nat)) ($functor.spec ..injection ..comparison /.functor) ($apply.spec ..injection ..comparison /.apply) ($monad.spec ..injection ..comparison /.monad) (_.test "Freezing does not alter the expected value." - (n/= expected + (n.= expected (/.thaw lazy))) (_.test "Lazy values only evaluate once." (and (not (is? expected diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index 60d154a7a..18d2f4248 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -16,7 +16,7 @@ ["." text ["%" format (#+ format)]] [number - ["." nat]]] + ["n" nat]]] [math ["r" random (#+ Random)]]] {1 @@ -30,7 +30,7 @@ Test (<| (_.context (%.name (name-of .Maybe))) ($_ _.and - ($equivalence.spec (/.equivalence nat.equivalence) (..maybe r.nat)) + ($equivalence.spec (/.equivalence n.equivalence) (..maybe r.nat)) ($functor.spec /@wrap /.equivalence /.functor) ($apply.spec /@wrap /.equivalence /.apply) ($monad.spec /@wrap /.equivalence /.monad) @@ -38,15 +38,15 @@ (do r.monad [left r.nat right r.nat - #let [expected (n/+ left right)]] + #let [expected (n.+ left right)]] (let [lift (/.lift io.monad)] (_.test "Can add maybe functionality to any monad." (|> (io.run (do (/.with io.monad) [a (lift (io@wrap left)) b (wrap right)] - (wrap (n/+ a b)))) + (wrap (n.+ a b)))) (case> (#.Some actual) - (n/= expected actual) + (n.= expected actual) _ false))))) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 63acad50b..6190ab19a 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -10,6 +10,8 @@ [control pipe] [data + [number + ["n" nat]] ["." text ("#@." equivalence) ["%" format (#+ format)]]] [math @@ -31,12 +33,12 @@ (<| (_.context (%.name (name-of .Name))) (do r.monad [## First Name - sizeM1 (|> r.nat (:: @ map (n/% 100))) - sizeS1 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) + sizeM1 (|> r.nat (:: @ map (n.% 100))) + sizeS1 (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) (^@ name1 [module1 short1]) (..name sizeM1 sizeS1) ## Second Name - sizeM2 (|> r.nat (:: @ map (n/% 100))) - sizeS2 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) + sizeM2 (|> r.nat (:: @ map (n.% 100))) + sizeS2 (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] ($_ _.and ($equivalence.spec /.equivalence (..name sizeM1 sizeS1)) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 1aa14e5be..5890ce0d4 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -11,6 +11,7 @@ ["$." codec]]}] [data [number + ["n" nat] ["." int] ["f" frac]] [collection @@ -34,7 +35,7 @@ (def: dimension (Random Frac) (do r.monad - [factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) + [factor (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1)))) measure (|> r.safe-frac (r.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) measure)))) @@ -184,7 +185,7 @@ Test (do r.monad [sample ..complex - degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))] + degree (|> r.nat (:: @ map (|>> (n.max 1) (n.% 5))))] (_.test "Can calculate the N roots for any complex number." (|> sample (/.roots degree) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index fbfecf07a..838746854 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -16,7 +16,7 @@ ["r" random]]] {1 ["." / - ["." // #_ + ["/#" // #_ ["#." nat]]]}) (def: #export test @@ -24,21 +24,21 @@ (<| (_.context (name.module (name-of /._))) (do r.monad [pattern r.nat - idx (:: @ map (n/% /.width) r.nat)] + idx (:: @ map (//nat.% /.width) r.nat)] ($_ _.and ($equivalence.spec /.equivalence r.i64) ($monoid.spec //nat.equivalence /.disjunction r.nat) ($monoid.spec //nat.equivalence /.conjunction r.nat) (_.test "Clearing and settings bits should alter the count." - (and (n/= (dec (/.count (/.set idx pattern))) - (/.count (/.clear idx pattern))) + (and (//nat.= (dec (/.count (/.set idx pattern))) + (/.count (/.clear idx pattern))) (|> (/.count pattern) - (n/- (/.count (/.clear idx pattern))) - (n/<= 1)) + (//nat.- (/.count (/.clear idx pattern))) + (//nat.<= 1)) (|> (/.count (/.set idx pattern)) - (n/- (/.count pattern)) - (n/<= 1)))) + (//nat.- (/.count pattern)) + (//nat.<= 1)))) (_.test "Can query whether a bit is set." (and (or (and (/.set? idx pattern) (not (/.set? idx (/.clear idx pattern)))) @@ -50,38 +50,38 @@ (and (not (/.set? idx pattern)) (/.set? idx (/.flip idx pattern)))))) (_.test "The negation of a bit pattern should have a complementary bit-count." - (n/= /.width - (n/+ (/.count pattern) - (/.count (/.not pattern))))) + (//nat.= /.width + (//nat.+ (/.count pattern) + (/.count (/.not pattern))))) (_.test "Can do simple binary logic." - (and (n/= 0 - (/.and pattern - (/.not pattern))) - (n/= (/.not 0) - (/.or pattern - (/.not pattern))) - (n/= (/.not 0) - (/.xor pattern - (/.not pattern))) - (n/= 0 - (/.xor pattern - pattern)))) + (and (//nat.= 0 + (/.and pattern + (/.not pattern))) + (//nat.= (/.not 0) + (/.or pattern + (/.not pattern))) + (//nat.= (/.not 0) + (/.xor pattern + (/.not pattern))) + (//nat.= 0 + (/.xor pattern + pattern)))) (_.test "rotate-left and rotate-right are inverses of one another." (and (|> pattern (/.rotate-left idx) (/.rotate-right idx) - (n/= pattern)) + (//nat.= pattern)) (|> pattern (/.rotate-right idx) (/.rotate-left idx) - (n/= pattern)))) + (//nat.= pattern)))) (_.test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." (and (|> pattern (/.rotate-left /.width) - (n/= pattern)) + (//nat.= pattern)) (|> pattern (/.rotate-right /.width) - (n/= pattern)))) + (//nat.= pattern)))) (_.test "Shift right respect the sign of ints." (let [value (.int pattern)] (if (i.< +0 value) diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux index 9a7f5907c..2a96ef9d5 100644 --- a/stdlib/source/test/lux/data/number/nat.lux +++ b/stdlib/source/test/lux/data/number/nat.lux @@ -40,10 +40,10 @@ )) (_.test "Alternate notations." - (and (n/= (bin "11001001") + (and (/.= (bin "11001001") (bin "11,00,10,01")) - (n/= (oct "615243") + (/.= (oct "615243") (oct "615,243")) - (n/= (hex "deadBEEF") + (/.= (hex "deadBEEF") (hex "dead,BEEF")))) )))) diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux index f2162681d..fa3d6a01e 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/data/number/ratio.lux @@ -10,6 +10,9 @@ ["$." order] ["$." monoid] ["$." codec]]}] + [data + [number + ["n" nat]]] [math ["r" random (#+ Random)]]] {1 @@ -17,13 +20,13 @@ (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) (do r.monad [numerator ..part - denominator (r.filter (|>> (n/= 0) not) ..part)] + denominator (r.filter (|>> (n.= 0) not) ..part)] (wrap (/.ratio numerator denominator)))) (def: #export test diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index 29e02de04..b90206fe7 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -6,6 +6,8 @@ pipe] [data ["." text] + [number + ["n" nat]] [collection ["." list]]]] {1 @@ -30,10 +32,10 @@ (/.rights (: (List (| Text Text)) (list (0 "0") (1 "1") (0 "2")))))))) (_.test "Can apply a function to an Either value depending on the case." - (and (n/= 10 (/.either (function (_ _) 10) + (and (n.= 10 (/.either (function (_ _) 10) (function (_ _) 20) (: (| Text Text) (0 "")))) - (n/= 20 (/.either (function (_ _) 10) + (n.= 20 (/.either (function (_ _) 10) (function (_ _) 20) (: (| Text Text) (1 "")))))) )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 8adabf715..b3cd2e735 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -11,6 +11,8 @@ [control pipe] [data + [number + ["n" nat]] [collection ["." list]]] [math @@ -21,7 +23,7 @@ (def: bounded-size (r.Random Nat) (|> r.nat - (:: r.monad map (|>> (n/% 20) (n/+ 1))))) + (:: r.monad map (|>> (n.% 20) (n.+ 1))))) (def: #export test Test @@ -31,17 +33,17 @@ ($order.spec /.order (r.ascii 2)) (do r.monad - [size (:: @ map (n/% 10) r.nat) + [size (:: @ map (n.% 10) r.nat) sample (r.unicode size)] ($_ _.and (_.test "Can get the size of text." - (n/= size (/.size sample))) + (n.= size (/.size sample))) (_.test "Text with size 0 is considered 'empty'." - (or (not (n/= 0 size)) + (or (not (n.= 0 size)) (/.empty? sample))))) (do r.monad [size bounded-size - idx (:: @ map (n/% size) r.nat) + idx (:: @ map (n.% size) r.nat) sample (r.unicode size)] (_.test "Character locations." (|> sample @@ -54,11 +56,11 @@ (/.last-index-of' char idx sample)] [(#.Some io) (#.Some lio) (#.Some io') (#.Some lio')]]) - (and (n/<= idx io) - (n/>= idx lio) + (and (n.<= idx io) + (n.>= idx lio) - (n/= idx io') - (n/>= idx lio') + (n.= idx io') + (n.>= idx lio') (/.contains? char sample)) @@ -114,7 +116,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 (|> r.nat (:: @ map (|>> (n/% 128) (n/max 1))))] + normal-char-gen (|> r.nat (:: @ map (|>> (n.% 128) (n.max 1))))] sep1 (r.text normal-char-gen 1) sep2 (r.text normal-char-gen 1) #let [part-gen (|> (r.text normal-char-gen sizeP) @@ -125,7 +127,7 @@ (^open "/@.") /.equivalence]] ($_ _.and (_.test "Can split text multiple times through a separator." - (n/= (list.size parts) + (n.= (list.size parts) (list.size (/.split-all-with sep1 sample1)))) (_.test "Can replace occurrences of a piece of text inside a larger text." |