From 30c19b40f5fd583d19aa7cf495a19c1b91f86320 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 24 Jul 2019 23:23:13 -0400 Subject: No more "f/"-prefixed functions. + No more "m/"-prefixed functions.--- stdlib/source/test/lux.lux | 36 ++++++++------ stdlib/source/test/lux/data/color.lux | 45 +++++++++-------- stdlib/source/test/lux/data/number/complex.lux | 69 +++++++++++++------------- stdlib/source/test/lux/data/number/frac.lux | 13 ++--- stdlib/source/test/lux/macro/code.lux | 11 ++-- stdlib/source/test/lux/math.lux | 29 +++++------ stdlib/source/test/lux/math/infix.lux | 6 ++- stdlib/source/test/lux/math/modular.lux | 44 ++++++++-------- 8 files changed, 134 insertions(+), 119 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 945fd9c54..e1039d506 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -1,10 +1,10 @@ (.with-expansions [ (.as-is [runtime (#+)] [primitive (#+)] [structure (#+)] + [function (#+)] [reference (#+)] [case (#+)] [loop (#+)] - [function (#+)] [extension (#+)])] (.module: ["/" lux #* @@ -19,7 +19,10 @@ [data ["." name] [number - ["." i64]]] + ["." i64] + ["." int] + ["." rev] + ["f" frac]]] ["." math] ["_" test (#+ Test)] ## These modules do not need to be tested. @@ -35,7 +38,7 @@ [format [css (#+)] [markdown (#+)]]] - [target + ["@" target [js (#+)] [python (#+)] [lua (#+)] @@ -47,6 +50,8 @@ [compiler [phase [generation + [jvm (#+) + ] [js (#+) ] [python (#+) @@ -291,9 +296,10 @@ on-default))) (_.test "Can pick code depending on the host/platform being targeted." (n/= on-valid-host - (for {"JVM" on-valid-host - "JS" on-valid-host} - on-default)))))) + (`` (for {(~~ (static @.old)) on-valid-host + (~~ (static @.jvm)) on-valid-host + (~~ (static @.js)) on-valid-host} + on-default))))))) (def: test (<| (_.context (name.module (name-of /._))) @@ -314,10 +320,10 @@ [(<| (_.context ) (..minimum-and-maximum <=> [ ] [ ]))] - [i/= i/< i/min i/> i/max r.int "Integers."] - [n/= n/< n/min n/> n/max r.nat "Natural numbers."] - [r/= r/< r/min r/> r/max r.rev "Revolutions."] - [f/= f/< f/min f/> f/max r.frac "Fractions."] + [i/= i/< i/min i/> i/max r.int "Integers."] + [n/= n/< n/min n/> n/max r.nat "Natural numbers."] + [r/= r/< r/min r/> r/max r.rev "Revolutions."] + [f.= f.< f.min f.> f.max r.safe-frac "Fractions."] ))))) (<| (_.context "Conversion.") (`` ($_ _.and @@ -326,11 +332,11 @@ " " (%.name (name-of )))) (..conversion <=>))] - [i/= .nat .int (r@map (i/% +1,000,000) r.int)] - [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] - [i/= .int-to-frac .frac-to-int (r@map (i/% +1,000,000) r.int)] - [f/= .frac-to-int .int-to-frac (r@map (|>> (i/% +1,000,000) .int-to-frac) r.int)] - [r/= .rev-to-frac .frac-to-rev frac-rev] + [i/= .nat .int (r@map (i/% +1,000,000) r.int)] + [n/= .int .nat (r@map (n/% 1,000,000) r.nat)] + [i/= int.frac f.int (r@map (i/% +1,000,000) r.int)] + [f.= f.int int.frac (r@map (|>> (i/% +1,000,000) int.frac) r.int)] + [r/= rev.frac f.rev frac-rev] ))))) (<| (_.context "Prelude macros.") ..prelude-macros) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index ee3bdffb1..79e771ce9 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -9,7 +9,8 @@ [data ["%" text/format (#+ format)] [number - ["." frac]]] + ["." int] + ["f" frac]]] ["." math ["r" random (#+ Random)]]] {1 @@ -22,7 +23,7 @@ (def: scale (-> Nat Frac) - (|>> .int int-to-frac)) + (|>> .int int.frac)) (def: square (-> Frac Frac) (math.pow +2.0)) @@ -30,10 +31,10 @@ (-> Color Color Frac) (let [[fr fg fb] (/.to-rgb from) [tr tg tb] (/.to-rgb to)] - (math.pow +0.5 ($_ f/+ - (|> (scale tr) (f/- (scale fr)) square) - (|> (scale tg) (f/- (scale fg)) square) - (|> (scale tb) (f/- (scale fb)) square))))) + (math.pow +0.5 ($_ f.+ + (|> (scale tr) (f.- (scale fr)) square) + (|> (scale tg) (f.- (scale fg)) square) + (|> (scale tb) (f.- (scale fb)) square))))) (def: error-margin Frac +1.8) @@ -56,32 +57,32 @@ (do r.monad [any ..color colorful (|> color - (r.filter (function (_ color) (|> (distance color black) (f/>= +100.0)))) - (r.filter (function (_ color) (|> (distance color white) (f/>= +100.0))))) + (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 ((function (_ saturation) - (and (f/>= +0.25 saturation) - (f/<= +0.75 saturation))))))) - ratio (|> r.safe-frac (r.filter (f/>= +0.5)))] + (and (f.>= +0.25 saturation) + (f.<= +0.75 saturation))))))) + ratio (|> r.safe-frac (r.filter (f.>= +0.5)))] ($_ _.and ($equivalence.spec /.equivalence ..color) (_.test "Can convert to/from HSL." (|> any /.to-hsl /.from-hsl (distance any) - (f/<= error-margin))) + (f.<= error-margin))) (_.test "Can convert to/from HSB." (|> any /.to-hsb /.from-hsb (distance any) - (f/<= error-margin))) + (f.<= error-margin))) (_.test "Can convert to/from CMYK." (|> any /.to-cmyk /.from-cmyk (distance any) - (f/<= error-margin))) + (f.<= error-margin))) (_.test "Can interpolate between 2 colors." - (and (f/<= (distance colorful black) + (and (f.<= (distance colorful black) (distance (/.darker ratio colorful) black)) - (f/<= (distance colorful white) + (f.<= (distance colorful white) (distance (/.brighter ratio colorful) white)))) (_.test "Can calculate complement." (let [~any (/.complement any) @@ -89,17 +90,17 @@ (and (not (/@= any ~any)) (/@= any (/.complement ~any))))) (_.test "Can saturate color." - (f/> (saturation mediocre) + (f.> (saturation mediocre) (saturation (/.saturate ratio mediocre)))) (_.test "Can de-saturate color." - (f/< (saturation mediocre) + (f.< (saturation mediocre) (saturation (/.de-saturate ratio mediocre)))) (_.test "Can gray-scale color." (let [gray'ed (/.gray-scale mediocre)] - (and (f/= +0.0 + (and (f.= +0.0 (saturation gray'ed)) (|> (luminance gray'ed) - (f/- (luminance mediocre)) - frac.abs - (f/<= error-margin))))) + (f.- (luminance mediocre)) + f.abs + (f.<= error-margin))))) )))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 52e43a77e..1aa14e5be 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -11,7 +11,8 @@ ["$." codec]]}] [data [number - ["." frac]] + ["." int] + ["f" frac]] [collection ["." list ("#@." functor)]]] ["." math @@ -23,19 +24,19 @@ (def: (within? margin standard value) (-> Frac Complex Complex Bit) - (let [real-dist (frac.abs (f/- (get@ #/.real standard) - (get@ #/.real value))) - imgn-dist (frac.abs (f/- (get@ #/.imaginary standard) - (get@ #/.imaginary value)))] - (and (f/< margin real-dist) - (f/< margin imgn-dist)))) + (let [real-dist (f.abs (f.- (get@ #/.real standard) + (get@ #/.real value))) + imgn-dist (f.abs (f.- (get@ #/.imaginary standard) + (get@ #/.imaginary value)))] + (and (f.< margin real-dist) + (f.< margin imgn-dist)))) (def: dimension (Random Frac) (do r.monad [factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) - measure (|> r.safe-frac (r.filter (f/> +0.0)))] - (wrap (f/* (|> factor .int int-to-frac) + measure (|> r.safe-frac (r.filter (f.> +0.0)))] + (wrap (f.* (|> factor .int int.frac) measure)))) (def: #export complex @@ -53,11 +54,11 @@ ($_ _.and (_.test "Can build and tear apart complex numbers" (let [r+i (/.complex real imaginary)] - (and (f/= real (get@ #/.real r+i)) - (f/= imaginary (get@ #/.imaginary r+i))))) + (and (f.= real (get@ #/.real r+i)) + (f.= imaginary (get@ #/.imaginary r+i))))) (_.test "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (/.not-a-number? (/.complex frac.not-a-number imaginary)) - (/.not-a-number? (/.complex real frac.not-a-number)))) + (and (/.not-a-number? (/.complex f.not-a-number imaginary)) + (/.not-a-number? (/.complex real f.not-a-number)))) ))) (def: absolute-value @@ -69,16 +70,16 @@ (_.test "Absolute value of complex >= absolute value of any of the parts." (let [r+i (/.complex real imaginary) abs (get@ #/.real (/.abs r+i))] - (and (f/>= (frac.abs real) abs) - (f/>= (frac.abs imaginary) abs)))) + (and (f.>= (f.abs real) abs) + (f.>= (f.abs imaginary) abs)))) (_.test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value." - (and (frac.not-a-number? (get@ #/.real (/.abs (/.complex frac.not-a-number imaginary)))) - (frac.not-a-number? (get@ #/.real (/.abs (/.complex real frac.not-a-number)))))) + (and (f.not-a-number? (get@ #/.real (/.abs (/.complex f.not-a-number imaginary)))) + (f.not-a-number? (get@ #/.real (/.abs (/.complex real f.not-a-number)))))) (_.test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.positive-infinity imaginary)))) - (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.positive-infinity)))) - (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex frac.negative-infinity imaginary)))) - (f/= frac.positive-infinity (get@ #/.real (/.abs (/.complex real frac.negative-infinity)))))) + (and (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.positive-infinity imaginary)))) + (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.positive-infinity)))) + (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex f.negative-infinity imaginary)))) + (f.= f.positive-infinity (get@ #/.real (/.abs (/.complex real f.negative-infinity)))))) ))) (def: number @@ -91,16 +92,16 @@ (_.test "Adding 2 complex numbers is the same as adding their parts." (let [z (/.+ y x)] (and (/.= z - (/.complex (f/+ (get@ #/.real y) + (/.complex (f.+ (get@ #/.real y) (get@ #/.real x)) - (f/+ (get@ #/.imaginary y) + (f.+ (get@ #/.imaginary y) (get@ #/.imaginary x))))))) (_.test "Subtracting 2 complex numbers is the same as adding their parts." (let [z (/.- y x)] (and (/.= z - (/.complex (f/- (get@ #/.real y) + (/.complex (f.- (get@ #/.real y) (get@ #/.real x)) - (f/- (get@ #/.imaginary y) + (f.- (get@ #/.imaginary y) (get@ #/.imaginary x))))))) (_.test "Subtraction is the inverse of addition." (and (|> x (/.+ y) (/.- y) (within? margin-of-error x)) @@ -127,9 +128,9 @@ ($_ _.and (_.test "Conjugate has same real part as original, and opposite of imaginary part." (let [cx (/.conjugate x)] - (and (f/= (get@ #/.real x) + (and (f.= (get@ #/.real x) (get@ #/.real cx)) - (f/= (frac.negate (get@ #/.imaginary x)) + (f.= (f.negate (get@ #/.imaginary x)) (get@ #/.imaginary cx))))) (_.test "The reciprocal functions is its own inverse." (|> x /.reciprocal /.reciprocal (within? margin-of-error x))) @@ -137,16 +138,16 @@ (|> x (/.* (/.reciprocal x)) (within? margin-of-error /.one))) (_.test "Absolute value of signum is always root2(2), 1 or 0." (let [signum-abs (|> x /.signum /.abs (get@ #/.real))] - (or (f/= +0.0 signum-abs) - (f/= +1.0 signum-abs) - (f/= (math.pow +0.5 +2.0) signum-abs)))) + (or (f.= +0.0 signum-abs) + (f.= +1.0 signum-abs) + (f.= (math.pow +0.5 +2.0) signum-abs)))) (_.test "Negation is its own inverse." (let [there (/.negate x) back-again (/.negate there)] (and (not (/.= there x)) (/.= back-again x)))) (_.test "Negation doesn't change the absolute value." - (f/= (get@ #/.real (/.abs x)) + (f.= (get@ #/.real (/.abs x)) (get@ #/.real (/.abs (/.negate x))))) ))) @@ -158,8 +159,8 @@ (def: trigonometry Test (do r.monad - [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f/% +1.0)) - (update@ #/.imaginary (f/% +1.0)))))] + [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f.% +1.0)) + (update@ #/.imaginary (f.% +1.0)))))] ($_ _.and (_.test "Arc-sine is the inverse of sine." (trigonometric-symmetry /.sin /.asin angle)) @@ -187,7 +188,7 @@ (_.test "Can calculate the N roots for any complex number." (|> sample (/.roots degree) - (list@map (/.pow' (|> degree .int int-to-frac))) + (list@map (/.pow' (|> degree .int int.frac))) (list.every? (within? margin-of-error sample)))))) (def: #export test diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux index 736f82457..257d4c049 100644 --- a/stdlib/source/test/lux/data/number/frac.lux +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -14,11 +14,12 @@ ["r" random]]] {1 ["." / - //]}) + [// #* + ["." int]]]}) (def: #export test Test - (let [gen-frac (:: r.monad map (|>> (i/% +100) .int-to-frac) r.int)] + (let [gen-frac (:: r.monad map (|>> (i/% +100) int.frac) r.int)] (<| (_.context (%.name (name-of /._))) (`` ($_ _.and ($equivalence.spec /.equivalence gen-frac) @@ -38,15 +39,15 @@ ## )) (_.test "Alternate notations." - (and (f/= (bin "+1100.1001") + (and (/.= (bin "+1100.1001") (bin "+11,00.10,01")) - (f/= (oct "-6152.43") + (/.= (oct "-6152.43") (oct "-615,2.43")) - (f/= (hex "+deadBE.EF") + (/.= (hex "+deadBE.EF") (hex "+dead,BE.EF")))) (do r.monad [sample gen-frac] (_.test (format (%.name (name-of /.to-bits)) " & " (%.name (name-of /.from-bits))) - (|> sample /.to-bits /.from-bits (f/= sample)))) + (|> sample /.to-bits /.from-bits (/.= sample)))) ))))) diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index f395c5509..e0bcd9df4 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -5,7 +5,10 @@ ["r" math/random (#+ Random)] ["_" test (#+ Test)] [data - ["." text ("#@." equivalence)]]] + ["." text ("#@." equivalence)] + [number + ["." int] + ["f" frac]]]] {1 ["." /]}) @@ -21,9 +24,9 @@ below (:: @ map (i/% +100) r.int) #let [frac (|> below (i// +100) - .int-to-frac - (f/+ (.int-to-frac above)) - (f/* -1.0))] + int.frac + (f.+ (int.frac above)) + (f.* -1.0))] text (r.ascii 10) short (r.ascii/alpha 10) module (r.ascii/alpha 10) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 46b5171ee..ffe990c50 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -7,7 +7,8 @@ [data ["." bit ("#@." equivalence)] [number - ["." frac]]]] + ["." int] + ["f" frac]]]] {1 ["." /]} ["." / #_ @@ -19,8 +20,8 @@ (def: (within? margin-of-error standard value) (-> Frac Frac Frac Bit) - (f/< margin-of-error - (frac.abs (f/- standard value)))) + (f.< margin-of-error + (f.abs (f.- standard value)))) (def: margin Frac +0.0000001) @@ -35,7 +36,7 @@ ($_ _.and (<| (_.context "Trigonometry") (do r.monad - [angle (|> r.safe-frac (:: @ map (f/* /.tau)))] + [angle (|> r.safe-frac (:: @ map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." (trigonometric-symmetry /.sin /.asin angle)) @@ -46,26 +47,26 @@ ))) (<| (_.context "Rounding") (do r.monad - [sample (|> r.safe-frac (:: @ map (f/* +1000.0)))] + [sample (|> r.safe-frac (:: @ map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (/.ceil sample)] - (and (|> ceil'd frac-to-int int-to-frac (f/= ceil'd)) - (f/>= sample ceil'd) - (f/<= +1.0 (f/- sample ceil'd))))) + (and (|> ceil'd f.int int.frac (f.= ceil'd)) + (f.>= sample ceil'd) + (f.<= +1.0 (f.- sample ceil'd))))) (_.test "The floor will be an integer value, and will be <= the original." (let [floor'd (/.floor sample)] - (and (|> floor'd frac-to-int int-to-frac (f/= floor'd)) - (f/<= sample floor'd) - (f/<= +1.0 (f/- floor'd sample))))) + (and (|> floor'd f.int int.frac (f.= floor'd)) + (f.<= sample floor'd) + (f.<= +1.0 (f.- floor'd sample))))) (_.test "The round will be an integer value, and will be < or > or = the original." (let [round'd (/.round sample)] - (and (|> round'd frac-to-int int-to-frac (f/= round'd)) - (f/<= +1.0 (frac.abs (f/- sample round'd)))))) + (and (|> round'd f.int int.frac (f.= round'd)) + (f.<= +1.0 (f.abs (f.- sample round'd)))))) ))) (<| (_.context "Exponentials and logarithms") (do r.monad - [sample (|> r.safe-frac (:: @ map (f/* +10.0)))] + [sample (|> r.safe-frac (:: @ map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index bbad48621..e2850f549 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -5,7 +5,9 @@ ["r" math/random] ["_" test (#+ Test)] [data - ["." bit ("#@." equivalence)]]] + ["." bit ("#@." equivalence)] + [number + ["f" frac]]]] {1 ["." / ["." //]]}) @@ -26,7 +28,7 @@ (n/= (//.n/gcd parameter subject) (/.infix [subject //.n/gcd parameter]))) (_.test "Can call unary functions." - (f/= (//.sin angle) + (f.= (//.sin angle) (/.infix [//.sin angle]))) (_.test "Can use regular syntax in the middle of infix code." (n/= (//.n/gcd extra (n/* parameter subject)) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index a600acfab..8a2ba754d 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -56,7 +56,7 @@ (|> (i/! (value param) (value subject)) (/.mod modulus) - (/.m/= (m/! param subject))))) + (/.= (m/! param subject))))) (def: #export test Test @@ -81,30 +81,30 @@ (i/= _normalM (/.to-int normalM))) (_.test "Can compare mod'ed values." - (and (/.m/= subject subject) - ((comparison /.m/= i/=) param subject) - ((comparison /.m/< i/<) param subject) - ((comparison /.m/<= i/<=) param subject) - ((comparison /.m/> i/>) param subject) - ((comparison /.m/>= i/>=) param subject))) + (and (/.= subject subject) + ((comparison /.= i/=) param subject) + ((comparison /.< i/<) param subject) + ((comparison /.<= i/<=) param subject) + ((comparison /.> i/>) param subject) + ((comparison /.>= i/>=) param subject))) (_.test "Mod'ed values are ordered." - (and (bit@= (/.m/< param subject) - (not (/.m/>= param subject))) - (bit@= (/.m/> param subject) - (not (/.m/<= param subject))) - (bit@= (/.m/= param subject) - (not (or (/.m/< param subject) - (/.m/> param subject)))))) + (and (bit@= (/.< param subject) + (not (/.>= param subject))) + (bit@= (/.> param subject) + (not (/.<= param subject))) + (bit@= (/.= param subject) + (not (or (/.< param subject) + (/.> param subject)))))) (_.test "Can do arithmetic." - (and ((arithmetic normalM /.m/+ i/+) param subject) - ((arithmetic normalM /.m/- i/-) param subject) - ((arithmetic normalM /.m/* i/*) param subject))) + (and ((arithmetic normalM /.+ i/+) param subject) + ((arithmetic normalM /.- i/-) param subject) + ((arithmetic normalM /.* i/*) param subject))) (_.test "Can sometimes find multiplicative inverse." (case (/.inverse subject) (#.Some subject^-1) (|> subject - (/.m/* subject^-1) - (/.m/= (/.mod normalM +1))) + (/.* subject^-1) + (/.= (/.mod normalM +1))) #.None true)) @@ -112,7 +112,7 @@ (let [(^open "mod/.") (/.codec normalM)] (case (|> subject mod/encode mod/decode) (#try.Success output) - (/.m/= subject output) + (/.= subject output) (#try.Failure error) false))) @@ -120,7 +120,7 @@ (case (/.equalize (/.mod normalM _subject) (/.mod copyM _param)) (#try.Success paramC) - (/.m/= param paramC) + (/.= param paramC) (#try.Failure error) false)) @@ -136,5 +136,5 @@ (/.congruent? normalM _subject _subject)) (_.test "If 2 numbers are congruent under a modulus, then they must also be equal under the same modulus." (bit@= (/.congruent? normalM _param _subject) - (/.m/= param subject))) + (/.= param subject))) )))) -- cgit v1.2.3