From 8003796cce911fa7c4958a83a2c55e6cbe16c8aa Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 27 Nov 2017 02:34:07 -0400 Subject: - Got rid of even more dots. --- stdlib/test/test/lux.lux | 4 +- stdlib/test/test/lux/cli.lux | 2 +- stdlib/test/test/lux/control/interval.lux | 8 ++-- stdlib/test/test/lux/data/coll/array.lux | 6 +-- stdlib/test/test/lux/data/coll/list.lux | 2 +- stdlib/test/test/lux/data/coll/ordered/dict.lux | 2 +- stdlib/test/test/lux/data/coll/priority-queue.lux | 2 +- stdlib/test/test/lux/data/coll/sequence.lux | 2 +- stdlib/test/test/lux/data/coll/stream.lux | 4 +- stdlib/test/test/lux/data/coll/tree/rose.lux | 2 +- stdlib/test/test/lux/data/color.lux | 4 +- stdlib/test/test/lux/data/format/xml.lux | 4 +- stdlib/test/test/lux/data/ident.lux | 4 +- stdlib/test/test/lux/data/number.lux | 4 +- stdlib/test/test/lux/data/number/complex.lux | 56 +++++++++++------------ stdlib/test/test/lux/data/number/ratio.lux | 50 ++++++++++---------- stdlib/test/test/lux/data/text.lux | 4 +- stdlib/test/test/lux/data/text/lexer.lux | 4 +- stdlib/test/test/lux/host.jvm.lux | 2 +- stdlib/test/test/lux/lang/syntax.lux | 35 +++++++------- stdlib/test/test/lux/lang/type/check.lux | 4 +- stdlib/test/test/lux/macro/poly/eq.lux | 2 +- stdlib/test/test/lux/math.lux | 4 +- stdlib/test/test/lux/math/random.lux | 2 +- stdlib/test/test/lux/time/duration.lux | 2 +- stdlib/test/test/lux/time/instant.lux | 2 +- stdlib/test/test/lux/type/object.lux | 4 +- stdlib/test/test/lux/world/blob.lux | 4 +- stdlib/test/test/lux/world/file.lux | 6 +-- stdlib/test/test/lux/world/net/tcp.lux | 4 +- stdlib/test/test/lux/world/net/udp.lux | 4 +- 31 files changed, 120 insertions(+), 119 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index d73f0c5a9..cfc562686 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -14,7 +14,7 @@ (context: "Value identity." (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +10)))) + [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) x (r;text size) y (r;text size)] ($_ seq @@ -124,7 +124,7 @@ [x (:: @ map rand-gen) y (|> rand-gen (:: @ map ) - (r;filter (|>. (= <0>) not))) + (r;filter (|>> (= <0>) not))) #let [r (<%> y x) x' (- r x)]] (test "" diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index bb3765e63..37e954e76 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -22,7 +22,7 @@ #let [(^open "Nat/") number;Codec gen-arg (:: @ map Nat/encode r;nat)] yes gen-arg - #let [gen-ignore (|> (r;text +5) (r;filter (|>. (text/= yes) not)))] + #let [gen-ignore (|> (r;text +5) (r;filter (|>> (text/= yes) not)))] no gen-ignore pre-ignore (r;list +5 gen-ignore) post-ignore (r;list +5 gen-ignore)] diff --git a/stdlib/test/test/lux/control/interval.lux b/stdlib/test/test/lux/control/interval.lux index a8d5c3c9e..1dc6e0afa 100644 --- a/stdlib/test/test/lux/control/interval.lux +++ b/stdlib/test/test/lux/control/interval.lux @@ -60,7 +60,7 @@ (r;Random (&;Interval Int)) (do r;Monad [bottom r;int - top (|> r;int (r;filter (|>. (i/= bottom) not)))] + top (|> r;int (r;filter (|>> (i/= bottom) not)))] (if ( top bottom) (wrap (&;between number;Enum bottom top)) (wrap (&;between number;Enum top bottom)))))] @@ -142,7 +142,7 @@ (<| (times +100) (do @ [[l m r] (|> (r;set number;Hash +3 r;int) - (:: @ map (|>. S;to-list + (:: @ map (|>> S;to-list (L;sort i/<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -164,7 +164,7 @@ (<| (times +100) (do @ [[b t1 t2] (|> (r;set number;Hash +3 r;int) - (:: @ map (|>. S;to-list + (:: @ map (|>> S;to-list (L;sort i/<) (case> (^ (list b t1 t2)) [b t1 t2] @@ -191,7 +191,7 @@ (do @ [some-interval gen-interval [x0 x1 x2 x3] (|> (r;set number;Hash +4 r;int) - (:: @ map (|>. S;to-list + (:: @ map (|>> S;to-list (L;sort i/<) (case> (^ (list x0 x1 x2 x3)) [x0 x1 x2 x3] diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index 663592c34..6d30f3e1e 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -13,7 +13,7 @@ (def: bounded-size (r;Random Nat) (|> r;nat - (:: r;Monad map (|>. (n/% +100) (n/+ +1))))) + (:: r;Monad map (|>> (n/% +100) (n/+ +1))))) (context: "Arrays and their copies" (<| (times +100) @@ -55,7 +55,7 @@ [size bounded-size 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))]] ($_ seq (test "Shouldn't be able to find a value in an unoccupied cell." @@ -82,7 +82,7 @@ (do @ [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?))))] ($_ seq (test "Can find values inside arrays." (|> (@;find n/even? array) diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux index 942a2aa56..501c2cfc8 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -15,7 +15,7 @@ (def: bounded-size (r;Random Nat) (|> r;nat - (:: r;Monad map (|>. (n/% +100) (n/+ +10))))) + (:: r;Monad map (|>> (n/% +100) (n/+ +10))))) (context: "Lists: Part 1" (<| (times +100) diff --git a/stdlib/test/test/lux/data/coll/ordered/dict.lux b/stdlib/test/test/lux/data/coll/ordered/dict.lux index 93774eb99..b3a6d6f58 100644 --- a/stdlib/test/test/lux/data/coll/ordered/dict.lux +++ b/stdlib/test/test/lux/data/coll/ordered/dict.lux @@ -18,7 +18,7 @@ [size (|> r;nat (:: @ map (n/% +100))) keys (r;set number;Hash size r;nat) values (r;set number;Hash size r;nat) - extra-key (|> r;nat (r;filter (|>. (s;member? keys) not))) + extra-key (|> r;nat (r;filter (|>> (s;member? keys) not))) extra-value r;nat #let [pairs (list;zip2 (s;to-list keys) (s;to-list values)) diff --git a/stdlib/test/test/lux/data/coll/priority-queue.lux b/stdlib/test/test/lux/data/coll/priority-queue.lux index f1f7999a0..8b94d0612 100644 --- a/stdlib/test/test/lux/data/coll/priority-queue.lux +++ b/stdlib/test/test/lux/data/coll/priority-queue.lux @@ -25,7 +25,7 @@ [size (|> r;nat (:: @ map (n/% +100))) sample (gen-queue size) non-member-priority r;nat - non-member (|> r;nat (r;filter (|>. (&;member? number;Eq sample) not)))] + non-member (|> r;nat (r;filter (|>> (&;member? number;Eq sample) not)))] ($_ seq (test "I can query the size of a queue (and empty queues have size 0)." (n/= size (&;size sample))) diff --git a/stdlib/test/test/lux/data/coll/sequence.lux b/stdlib/test/test/lux/data/coll/sequence.lux index 234456d1e..222feeacc 100644 --- a/stdlib/test/test/lux/data/coll/sequence.lux +++ b/stdlib/test/test/lux/data/coll/sequence.lux @@ -14,7 +14,7 @@ (context: "Sequences" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +1)))) + [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) idx (|> r;nat (:: @ map (n/% size))) sample (r;sequence size r;nat) other-sample (r;sequence size r;nat) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux index 8c3db3ac4..725426f1b 100644 --- a/stdlib/test/test/lux/data/coll/stream.lux +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -16,9 +16,9 @@ (context: "Streams" (<| (times +100) (do @ - [size (|> 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)))) + 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))) diff --git a/stdlib/test/test/lux/data/coll/tree/rose.lux b/stdlib/test/test/lux/data/coll/tree/rose.lux index 09f3f13f6..9fe725f9b 100644 --- a/stdlib/test/test/lux/data/coll/tree/rose.lux +++ b/stdlib/test/test/lux/data/coll/tree/rose.lux @@ -15,7 +15,7 @@ (r;Random [Nat (&;Tree Nat)]) (r;rec (function [gen-tree] - (r;either (:: r;Monad map (|>. &;leaf [+1]) r;nat) + (r;either (:: r;Monad map (|>> &;leaf [+1]) r;nat) (do r;Monad [value r;nat num-children (|> r;nat (:: @ map (n/% +3))) diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux index 6a97b0e72..b4597b22a 100644 --- a/stdlib/test/test/lux/data/color.lux +++ b/stdlib/test/test/lux/data/color.lux @@ -15,7 +15,7 @@ (def: scale (-> Nat Frac) - (|>. nat-to-int int-to-frac)) + (|>> nat-to-int int-to-frac)) (def: square (-> Frac Frac) (math;pow 2.0)) @@ -51,7 +51,7 @@ (r;filter (function [color] (|> (distance color black) (f/>= 100.0)))) (r;filter (function [color] (|> (distance color white) (f/>= 100.0))))) mediocre (|> color - (r;filter (|>. saturation + (r;filter (|>> saturation ((function [saturation] (and (f/>= 0.25 saturation) (f/<= 0.75 saturation))))))) diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index bcbf63f9e..55709facc 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -30,7 +30,7 @@ (def: (size^ bottom top) (-> Nat Nat (r;Random Nat)) - (let [constraint (|>. (n/% top) (n/max bottom))] + (let [constraint (|>> (n/% top) (n/max bottom))] (r/map constraint r;nat))) (def: (xml-text^ bottom top) @@ -85,7 +85,7 @@ value (xml-text^ +1 +10) #let [node (#&;Node tag (dict;put attr value &;attrs) - (L/map (|>. #&;Text) children))]] + (L/map (|>> #&;Text) children))]] ($_ seq (test "Can parse text." (E;default false diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index f03cfa9a2..a096892ca 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -18,13 +18,13 @@ (do @ [## First Ident sizeM1 (|> r;nat (:: @ map (n/% +100))) - sizeN1 (|> r;nat (:: @ map (|>. (n/% +100) (n/max +1)))) + sizeN1 (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) module1 (gen-part sizeM1) name1 (gen-part sizeN1) #let [ident1 [module1 name1]] ## Second Ident sizeM2 (|> r;nat (:: @ map (n/% +100))) - sizeN2 (|> r;nat (:: @ map (|>. (n/% +100) (n/max +1)))) + sizeN2 (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) module2 (gen-part sizeM2) name2 (gen-part sizeN2) #let [ident2 [module2 name2]] diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 2fe050740..7522f46ef 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -92,7 +92,7 @@ [(context: (format "[" category "] " "Monoid") (<| (times +100) (do @ - [x (|> rand-gen (:: @ map (|>. (:: abs) )) (r;filter )) + [x (|> rand-gen (:: @ map (|>> (:: abs) )) (r;filter )) #let [(^open) (^open) (^open) ]] @@ -159,7 +159,7 @@ (<| (times +100) (do @ [raw r;frac - factor (|> r;nat (:: @ map (|>. (n/% +1000) (n/max +1)))) + factor (|> r;nat (:: @ map (|>> (n/% +1000) (n/max +1)))) #let [sample (|> factor nat-to-int int-to-frac (f/* raw))]] (test "Can convert frac values to/from their bit patterns." (|> sample frac-to-bits bits-to-frac (f/= sample)))))) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index c7b0691df..e642256b9 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -25,7 +25,7 @@ (def: gen-dim (r;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;frac (r;filter (f/> 0.0)))] (wrap (f/* (|> factor nat-to-int int-to-frac) measure)))) @@ -61,19 +61,19 @@ ($_ seq (test "Absolute value of complex >= absolute value of any of the parts." (let [r+i (&;complex real imaginary) - abs (get@ #&;real (&;c.abs r+i))] + abs (get@ #&;real (&;c/abs r+i))] (and (f/>= (frac/abs real) abs) (f/>= (frac/abs imaginary) abs)))) (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (number;not-a-number? (get@ #&;real (&;c.abs (&;complex number;not-a-number imaginary)))) - (number;not-a-number? (get@ #&;real (&;c.abs (&;complex real number;not-a-number)))))) + (and (number;not-a-number? (get@ #&;real (&;c/abs (&;complex number;not-a-number imaginary)))) + (number;not-a-number? (get@ #&;real (&;c/abs (&;complex real number;not-a-number)))))) (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f/= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) - (f/= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) - (f/= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) - (f/= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) + (and (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex number;positive-infinity imaginary)))) + (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex real number;positive-infinity)))) + (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex number;negative-infinity imaginary)))) + (f/= number;positive-infinity (get@ #&;real (&;c/abs (&;complex real number;negative-infinity)))))) )))) (context: "Addidion, substraction, multiplication and division" @@ -84,40 +84,40 @@ factor gen-dim] ($_ seq (test "Adding 2 complex numbers is the same as adding their parts." - (let [z (&;c.+ y x)] - (and (&;c.= z + (let [z (&;c/+ y x)] + (and (&;c/= z (&;complex (f/+ (get@ #&;real y) (get@ #&;real x)) (f/+ (get@ #&;imaginary y) (get@ #&;imaginary x))))))) (test "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (&;c.- y x)] - (and (&;c.= z + (let [z (&;c/- y x)] + (and (&;c/= z (&;complex (f/- (get@ #&;real y) (get@ #&;real x)) (f/- (get@ #&;imaginary y) (get@ #&;imaginary x))))))) (test "Subtraction is the inverse of addition." - (and (|> x (&;c.+ y) (&;c.- y) (within? margin-of-error x)) - (|> x (&;c.- y) (&;c.+ y) (within? margin-of-error x)))) + (and (|> x (&;c/+ y) (&;c/- y) (within? margin-of-error x)) + (|> x (&;c/- y) (&;c/+ y) (within? margin-of-error x)))) (test "Division is the inverse of multiplication." - (|> x (&;c.* y) (&;c./ y) (within? margin-of-error x))) + (|> x (&;c/* y) (&;c// y) (within? margin-of-error x))) (test "Scalar division is the inverse of scalar multiplication." - (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x))) + (|> x (&;c/*' factor) (&;c//' factor) (within? margin-of-error x))) (test "If you subtract the remainder, all divisions must be exact." - (let [rem (&;c.% y x) - quotient (|> x (&;c.- rem) (&;c./ y)) + (let [rem (&;c/% y x) + quotient (|> x (&;c/- rem) (&;c// y)) floored (|> quotient (update@ #&;real math;floor) (update@ #&;imaginary math;floor))] (within? 0.000000000001 x - (|> quotient (&;c.* y) (&;c.+ rem))))) + (|> quotient (&;c/* y) (&;c/+ rem))))) )))) (context: "Conjugate, reciprocal, signum, negation" @@ -136,23 +136,23 @@ (|> x &;reciprocal &;reciprocal (within? margin-of-error x))) (test "x*(x^-1) = 1" - (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one))) + (|> x (&;c/* (&;reciprocal x)) (within? margin-of-error &;one))) (test "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))] + (let [signum-abs (|> x &;c/signum &;c/abs (get@ #&;real))] (or (f/= 0.0 signum-abs) (f/= 1.0 signum-abs) (f/= (math;root2 2.0) signum-abs)))) (test "Negation is its own inverse." - (let [there (&;c.negate x) - back-again (&;c.negate there)] - (and (not (&;c.= there x)) - (&;c.= back-again x)))) + (let [there (&;c/negate x) + back-again (&;c/negate there)] + (and (not (&;c/= there x)) + (&;c/= back-again x)))) (test "Negation doesn't change the absolute value." - (f/= (get@ #&;real (&;c.abs x)) - (get@ #&;real (&;c.abs (&;c.negate x))))) + (f/= (get@ #&;real (&;c/abs x)) + (get@ #&;real (&;c/abs (&;c/negate x))))) )))) (context: "Trigonometry" @@ -185,7 +185,7 @@ (<| (times +100) (do @ [sample gen-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 (&;nth-roots degree) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index 0cd1f58ea..cd6657f8a 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -14,14 +14,14 @@ (def: gen-part (r;Random Nat) - (|> r;nat (:: r;Monad map (|>. (n/% +1000) (n/max +1))))) + (|> r;nat (:: r;Monad map (|>> (n/% +1000) (n/max +1))))) (def: gen-ratio (r;Random &;Ratio) (do r;Monad [numerator gen-part denominator (|> gen-part - (r;filter (|>. (n/= +0) not)) + (r;filter (|>> (n/= +0) not)) (r;filter (. not (n/= numerator))))] (wrap (&;ratio numerator denominator)))) @@ -33,11 +33,11 @@ sample gen-ratio] ($_ seq (test "All zeroes are the same." - (&;q.= (&;ratio +0 denom1) + (&;r/= (&;ratio +0 denom1) (&;ratio +0 denom2))) (test "All ratios are built normalized." - (|> sample &;normalize (&;q.= sample))) + (|> sample &;normalize (&;r/= sample))) )))) (context: "Arithmetic" @@ -45,29 +45,29 @@ (do @ [x gen-ratio y gen-ratio - #let [min (&;q.min x y) - max (&;q.max x y)]] + #let [min (&;r/min x y) + max (&;r/max x y)]] ($_ seq (test "Addition and subtraction are opposites." - (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max)) - (|> max (&;q.+ min) (&;q.- min) (&;q.= max)))) + (and (|> max (&;r/- min) (&;r/+ min) (&;r/= max)) + (|> max (&;r/+ min) (&;r/- min) (&;r/= max)))) (test "Multiplication and division are opposites." - (and (|> max (&;q./ min) (&;q.* min) (&;q.= max)) - (|> max (&;q.* min) (&;q./ min) (&;q.= max)))) + (and (|> max (&;r// min) (&;r/* min) (&;r/= max)) + (|> max (&;r/* min) (&;r// min) (&;r/= max)))) (test "Modulus by a larger ratio doesn't change the value." - (|> min (&;q.% max) (&;q.= min))) + (|> min (&;r/% max) (&;r/= min))) (test "Modulus by a smaller ratio results in a value smaller than the limit." - (|> max (&;q.% min) (&;q.< min))) + (|> max (&;r/% min) (&;r/< min))) (test "Can get the remainder of a division." - (let [remainder (&;q.% min max) - multiple (&;q.- remainder max) - factor (&;q./ min multiple)] + (let [remainder (&;r/% min max) + multiple (&;r/- remainder max) + factor (&;r// min multiple)] (and (|> factor (get@ #&;denominator) (n/= +1)) - (|> factor (&;q.* min) (&;q.+ remainder) (&;q.= max))))) + (|> factor (&;r/* min) (&;r/+ remainder) (&;r/= max))))) )))) (context: "Negation, absolute value and signum" @@ -78,14 +78,14 @@ (test "Negation is it's own inverse." (let [there (&/negate sample) back-again (&/negate there)] - (and (not (&;q.= there sample)) - (&;q.= back-again sample)))) + (and (not (&;r/= there sample)) + (&;r/= back-again sample)))) (test "All ratios are already at their absolute value." - (|> sample &/abs (&;q.= sample))) + (|> sample &/abs (&;r/= sample))) (test "Signum is the identity." - (|> sample (&;q.* (&/signum sample)) (&;q.= sample))) + (|> sample (&;r/* (&/signum sample)) (&;r/= sample))) )))) (context: "Order" @@ -95,10 +95,10 @@ y gen-ratio] ($_ seq (test "Can compare ratios." - (and (or (&;q.<= y x) - (&;q.> y x)) - (or (&;q.>= y x) - (&;q.< y x)))) + (and (or (&;r/<= y x) + (&;r/> y x)) + (or (&;r/>= y x) + (&;r/< y x)))) )))) (context: "Codec" @@ -109,7 +109,7 @@ (test "Can encode/decode ratios." (|> sample &/encode &/decode (case> (#;Right output) - (&;q.= sample output) + (&;r/= sample output) _ false)))))) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index a0747866e..2091bf8ba 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -22,7 +22,7 @@ (def: bounded-size (r;Random Nat) (|> r;nat - (:: r;Monad map (|>. (n/% +20) (n/+ +1))))) + (:: r;Monad map (|>> (n/% +20) (n/+ +1))))) (context: "Locations" (<| (times +100) @@ -104,7 +104,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) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index bdac87f89..331ca42ea 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -72,10 +72,10 @@ (context: "Literals" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +10)))) + [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) sample (r;text size) non-sample (|> (r;text size) - (r;filter (|>. (text/= sample) not)))] + (r;filter (|>> (text/= sample) not)))] ($_ seq (test "Can find literal text fragments." (and (|> (&;run sample diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 97f13f2df..064b4c360 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -112,7 +112,7 @@ (context: "Arrays" (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +1)))) + [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1)))) idx (|> r;nat (:: @ map (n/% size))) value r;int] ($_ seq diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux index e93ef3f83..cc1338374 100644 --- a/stdlib/test/test/lux/lang/syntax.lux +++ b/stdlib/test/test/lux/lang/syntax.lux @@ -31,7 +31,7 @@ (r;filter (function [sample] (not (text;contains? (text;from-code sample) invalid-range)))))] - size (|> r;nat (:: @ map (|>. (n/% +20) (n/max +1))))] + size (|> r;nat (:: @ map (|>> (n/% +20) (n/max +1))))] (r;text' char-gen size))) (def: ident^ @@ -42,18 +42,18 @@ (r;Random Code) (let [numeric^ (: (r;Random Code) ($_ r;either - (|> r;bool (r/map (|>. #;Bool [default-cursor]))) - (|> r;nat (r/map (|>. #;Nat [default-cursor]))) - (|> r;int (r/map (|>. #;Int [default-cursor]))) - (|> r;deg (r/map (|>. #;Deg [default-cursor]))) - (|> r;frac (r/map (|>. #;Frac [default-cursor]))))) + (|> r;bool (r/map (|>> #;Bool [default-cursor]))) + (|> r;nat (r/map (|>> #;Nat [default-cursor]))) + (|> r;int (r/map (|>> #;Int [default-cursor]))) + (|> r;deg (r/map (|>> #;Deg [default-cursor]))) + (|> r;frac (r/map (|>> #;Frac [default-cursor]))))) textual^ (: (r;Random Code) ($_ r;either (do r;Monad [size (|> r;nat (r/map (n/% +20)))] - (|> (r;text size) (r/map (|>. #;Text [default-cursor])))) - (|> ident^ (r/map (|>. #;Symbol [default-cursor]))) - (|> ident^ (r/map (|>. #;Tag [default-cursor]))))) + (|> (r;text size) (r/map (|>> #;Text [default-cursor])))) + (|> ident^ (r/map (|>> #;Symbol [default-cursor]))) + (|> ident^ (r/map (|>> #;Tag [default-cursor]))))) simple^ (: (r;Random Code) ($_ r;either numeric^ @@ -65,17 +65,18 @@ (r;list size code^)) composite^ (: (r;Random Code) ($_ r;either - (|> multi^ (r/map (|>. #;Form [default-cursor]))) - (|> multi^ (r/map (|>. #;Tuple [default-cursor]))) + (|> multi^ (r/map (|>> #;Form [default-cursor]))) + (|> multi^ (r/map (|>> #;Tuple [default-cursor]))) (do r;Monad [size (|> r;nat (r/map (n/% +3)))] (|> (r;list size (r;seq code^ code^)) - (r/map (|>. #;Record [default-cursor]))))))] + (r/map (|>> #;Record [default-cursor]))))))] (r;either simple^ composite^)))))) (context: "Lux code syntax." - (<| (times +100) + (<| (seed +7998490996744206936) + ## (times +100) (do @ [sample code^ other code^] @@ -108,13 +109,13 @@ (def: nat-to-frac (-> Nat Frac) - (|>. nat-to-int int-to-frac)) + (|>> nat-to-int int-to-frac)) (context: "Frac special syntax." (<| (times +100) (do @ - [numerator (|> r;nat (:: @ map (|>. (n/% +100) nat-to-frac))) - denominator (|> r;nat (:: @ map (|>. (n/% +100) (n/max +1) nat-to-frac))) + [numerator (|> r;nat (:: @ map (|>> (n/% +100) nat-to-frac))) + denominator (|> r;nat (:: @ map (|>> (n/% +100) (n/max +1) nat-to-frac))) signed? r;bool #let [expected (|> numerator (f// denominator) (f/* (if signed? -1.0 1.0)))]] (test "Can parse frac ratio syntax." @@ -178,7 +179,7 @@ x char-gen y char-gen z char-gen - offset-size (|> r;nat (r/map (|>. (n/% +10) (n/max +1)))) + offset-size (|> r;nat (r/map (|>> (n/% +10) (n/max +1)))) #let [offset (text;join-with "" (list;repeat offset-size " "))] sample code^ comment comment^ diff --git a/stdlib/test/test/lux/lang/type/check.lux b/stdlib/test/test/lux/lang/type/check.lux index 06c5c3d6b..c0cd5ac1e 100644 --- a/stdlib/test/test/lux/lang/type/check.lux +++ b/stdlib/test/test/lux/lang/type/check.lux @@ -141,7 +141,7 @@ [nameL gen-name nameR (|> gen-name (r;filter (. not (text/= nameL)))) paramL gen-type - paramR (|> gen-type (r;filter (|>. (@;checks? paramL) not)))] + paramR (|> gen-type (r;filter (|>> (@;checks? paramL) not)))] ($_ seq (test "Primitive types match when they have the same name and the same parameters." (@;checks? (#;Primitive nameL (list paramL)) @@ -207,7 +207,7 @@ (<| (times +100) (do @ [num-connections (|> r;nat (:: @ map (n/% +100))) - boundT (|> gen-type (r;filter (|>. (case> (#;Var _) false _ true)))) + boundT (|> gen-type (r;filter (|>> (case> (#;Var _) false _ true)))) pick-pcg (r;seq r;nat r;nat)] ($_ seq (test "Can create rings of variables." diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index e071ba043..bd3239cf6 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -47,7 +47,7 @@ (r;Random Record) (do r;Monad [size (:: @ map (n/% +2) r;nat) - #let [gen-int (|> r;int (:: @ map (|>. int/abs (i/% 1_000_000))))]] + #let [gen-int (|> r;int (:: @ map (|>> int/abs (i/% 1_000_000))))]] ($_ r;seq (:: @ wrap []) r;bool diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index c79720956..3852ace0d 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -33,7 +33,7 @@ (context: "Roots" (<| (times +100) (do @ - [factor (|> r;nat (:: @ map (|>. (n/% +1000) + [factor (|> r;nat (:: @ map (|>> (n/% +1000) (n/max +1) nat-to-int int-to-frac))) @@ -79,7 +79,7 @@ (context: "Greatest-Common-Divisor and Least-Common-Multiple" (<| (times +100) (do @ - [#let [gen-nat (|> r;nat (:: @ map (|>. (n/% +1000) (n/max +1))))] + [#let [gen-nat (|> r;nat (:: @ map (|>> (n/% +1000) (n/max +1))))] x gen-nat y gen-nat] ($_ (test "GCD" diff --git a/stdlib/test/test/lux/math/random.lux b/stdlib/test/test/lux/math/random.lux index 9aefcc8f7..5fc91db75 100644 --- a/stdlib/test/test/lux/math/random.lux +++ b/stdlib/test/test/lux/math/random.lux @@ -17,7 +17,7 @@ (context: "Random." (<| (times +100) (do @ - [size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +10)))) + [size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) _list (r;list size r;nat) _sequence (r;sequence size r;nat) _array (r;array size r;nat) diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux index b56e828bf..e84ef6471 100644 --- a/stdlib/test/test/lux/time/duration.lux +++ b/stdlib/test/test/lux/time/duration.lux @@ -43,7 +43,7 @@ (do @ [sample (|> duration (:: @ map (@;frame @;day))) frame duration - factor (|> r;int (:: @ map (|>. (i/% 10) (i/max 1)))) + factor (|> r;int (:: @ map (|>> (i/% 10) (i/max 1)))) #let [(^open "@/") @;Order]] ($_ seq (test "Can scale a duration." diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux index db99c8628..d56ef1062 100644 --- a/stdlib/test/test/lux/time/instant.lux +++ b/stdlib/test/test/lux/time/instant.lux @@ -18,7 +18,7 @@ (def: #export instant (r;Random @;Instant) - (|> r;int (:: r;Monad map (|>. (i/% boundary) @;from-millis)))) + (|> r;int (:: r;Monad map (|>> (i/% boundary) @;from-millis)))) (context: "Conversion." (<| (times +100) diff --git a/stdlib/test/test/lux/type/object.lux b/stdlib/test/test/lux/type/object.lux index 96c71a75c..4884f342a 100644 --- a/stdlib/test/test/lux/type/object.lux +++ b/stdlib/test/test/lux/type/object.lux @@ -37,10 +37,10 @@ (List a) (def: (add elem) - (update@Collection (|>. (#;Cons elem)))) + (update@Collection (|>> (#;Cons elem)))) (def: size - (|>. get@Collection list;size))) + (|>> get@Collection list;size))) (interface: (Iterable a) #super (Collection a) diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux index 3986a6a23..90d2a9af0 100644 --- a/stdlib/test/test/lux/world/blob.lux +++ b/stdlib/test/test/lux/world/blob.lux @@ -35,7 +35,7 @@ (context: "Blob." (<| (times +100) (do @ - [blob-size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +8)))) + [blob-size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +8)))) random-blob (blob blob-size) #let [clean-blob (@;create blob-size) size (@;size clean-blob)] @@ -43,7 +43,7 @@ idx (|> r;nat (:: @ map (n/% size))) [from to] (|> (r;list +2 (|> r;nat (:: @ map (n/% size)))) (:: @ map - (|>. (list;sort n/<) + (|>> (list;sort n/<) (pipe;case> (^ (list from to)) [from to] diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index 5c68c1097..b33978531 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -17,15 +17,15 @@ (// ["_;" blob])) (def: truncate-millis - (|>. (i// 1_000) (i/* 1_000))) + (|>> (i// 1_000) (i/* 1_000))) (context: "File system." (do @ - [file-size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +10)))) + [file-size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) dataL (_blob;blob file-size) dataR (_blob;blob file-size) code r;nat - last-modified (|> r;int (:: @ map (|>. (:: number;Number abs) + last-modified (|> r;int (:: @ map (|>> (:: number;Number abs) truncate-millis d;from-millis i;absolute)))] diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux index c18d3929b..a57ab0544 100644 --- a/stdlib/test/test/lux/world/net/tcp.lux +++ b/stdlib/test/test/lux/world/net/tcp.lux @@ -21,7 +21,7 @@ (r;Random net;Port) (|> r;nat (:: r;Monad map - (|>. (n/% +1000) + (|>> (n/% +1000) (n/+ +8000))))) (exception: Empty-Channel) @@ -40,7 +40,7 @@ (context: "TCP networking." (do @ [port ;;port - size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +10)))) + size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) from (_blob;blob size) to (_blob;blob size) #let [temp (blob;create size)]] diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux index a4707744e..cc3ad6fc7 100644 --- a/stdlib/test/test/lux/world/net/udp.lux +++ b/stdlib/test/test/lux/world/net/udp.lux @@ -21,7 +21,7 @@ (r;Random net;Port) (|> r;nat (:: r;Monad map - (|>. (n/% +1000) + (|>> (n/% +1000) (n/+ +8000))))) (exception: Empty-Channel) @@ -40,7 +40,7 @@ (context: "UDP networking." (do @ [port ;;port - size (|> r;nat (:: @ map (|>. (n/% +100) (n/max +10)))) + size (|> r;nat (:: @ map (|>> (n/% +100) (n/max +10)))) from (_blob;blob size) to (_blob;blob size) #let [temp (blob;create size)]] -- cgit v1.2.3