diff options
31 files changed, 452 insertions, 366 deletions
diff --git a/stdlib/source/lux/data/color.lux b/stdlib/source/lux/data/color.lux index 82d421715..85ebe77ba 100644 --- a/stdlib/source/lux/data/color.lux +++ b/stdlib/source/lux/data/color.lux @@ -22,11 +22,11 @@ (def: rgb_factor (|> top .int int.frac)) -(def: scale_down +(def: down (-> Nat Frac) (|>> .int int.frac (f./ rgb_factor))) -(def: scale_up +(def: up (-> Frac Nat) (|>> (f.* rgb_factor) f.int .nat)) @@ -131,9 +131,9 @@ (def: #export (to_hsl color) (-> Color HSL) (let [[red green blue] (to_rgb color) - red (scale_down red) - green (scale_down green) - blue (scale_down blue) + red (..down red) + green (..down green) + blue (..down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) luminance (|> (f.+ max min) (f./ +2.0))] @@ -186,7 +186,7 @@ (-> HSL Color) (if (f.= +0.0 saturation) ## Achromatic - (let [intensity (scale_up luminance)] + (let [intensity (..up luminance)] (from_rgb {#red intensity #green intensity #blue intensity})) @@ -196,16 +196,16 @@ (|> luminance (f.+ saturation) (f.- (f.* saturation luminance)))) p (|> luminance (f.* +2.0) (f.- q)) third (|> +1.0 (f./ +3.0))] - (from_rgb {#red (scale_up (|> hue (f.+ third) (hue_to_rgb p q))) - #green (scale_up (|> hue (hue_to_rgb p q))) - #blue (scale_up (|> hue (f.- third) (hue_to_rgb p q)))})))) + (from_rgb {#red (..up (|> hue (f.+ third) (hue_to_rgb p q))) + #green (..up (|> hue (hue_to_rgb p q))) + #blue (..up (|> hue (f.- third) (hue_to_rgb p q)))})))) (def: #export (to_hsb color) (-> Color HSB) (let [[red green blue] (to_rgb color) - red (scale_down red) - green (scale_down green) - blue (scale_down blue) + red (..down red) + green (..down green) + blue (..down blue) max ($_ f.max red green blue) min ($_ f.min red green blue) brightness max @@ -245,16 +245,16 @@ red (case mod 0 v 1 q 2 p 3 p 4 t 5 v _ (undefined)) green (case mod 0 t 1 v 2 v 3 q 4 p 5 p _ (undefined)) blue (case mod 0 p 1 p 2 t 3 v 4 v 5 q _ (undefined))] - (from_rgb {#red (scale_up red) - #green (scale_up green) - #blue (scale_up blue)}))) + (from_rgb {#red (..up red) + #green (..up green) + #blue (..up blue)}))) (def: #export (to_cmyk color) (-> Color CMYK) (let [[red green blue] (to_rgb color) - red (scale_down red) - green (scale_down green) - blue (scale_down blue) + red (..down red) + green (..down green) + blue (..down blue) key (|> +1.0 (f.- ($_ f.max red green blue))) f (if (f.< +1.0 key) (|> +1.0 (f./ (|> +1.0 (f.- key)))) @@ -279,9 +279,9 @@ (f.* (|> +1.0 (f.- key)))) blue (|> (|> +1.0 (f.- yellow)) (f.* (|> +1.0 (f.- key))))] - (from_rgb {#red (scale_up red) - #green (scale_up green) - #blue (scale_up blue)})))) + (from_rgb {#red (..up red) + #green (..up green) + #blue (..up blue)})))) (def: (normalize ratio) (-> Frac Frac) diff --git a/stdlib/source/lux/data/format/tar.lux b/stdlib/source/lux/data/format/tar.lux index 16b801676..168939344 100644 --- a/stdlib/source/lux/data/format/tar.lux +++ b/stdlib/source/lux/data/format/tar.lux @@ -807,7 +807,7 @@ ..from_big .int duration.from_millis - (duration.scale_up (|> duration.second duration.to_millis .nat)) + (duration.up (|> duration.second duration.to_millis .nat)) instant.absolute) (get@ #mode header) {#user {#name (get@ #user_name header) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index 8d24d729d..e5b753725 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -127,7 +127,25 @@ (-> Int Int Int) (case b +0 a - _ (gcd b (..mod b a)))) + _ (gcd b (..% b a)))) + +(def: #export (co-prime? a b) + (-> Int Int Bit) + (..= +1 (..gcd a b))) + +## https://en.wikipedia.org/wiki/Extended_Euclidean_algorithm +(def: #export (extended_gcd a b) + {#.doc "Extended euclidean algorithm."} + (-> Int Int [[Int Int] Int]) + (loop [x +1 x1 +0 + y +0 y1 +1 + a1 a b1 b] + (case b1 + +0 [[x y] a1] + _ (let [q (/ b1 a1)] + (recur x1 (- (* q x1) x) + y1 (- (* q y1) y) + b1 (- (* q b1) a1)))))) (def: #export (lcm a b) {#.doc "Least Common Multiple."} diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux index b1504f048..267846c89 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/data/number/nat.lux @@ -129,6 +129,10 @@ 0 a _ (gcd b (..% b a)))) +(def: #export (co-prime? a b) + (-> Nat Nat Bit) + (..= 1 (..gcd a b))) + (def: #export (lcm a b) {#.doc "Least Common Multiple."} (-> Nat Nat Nat) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index fb00b4cad..a57258bfc 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -106,8 +106,8 @@ (def: #export (mod modular) (All [m] (Format (modular.Mod m))) - (let [[modulus _] (modular.un_modular modular)] - (\ (modular.codec modulus) encode modular))) + (let [codec (modular.codec (modular.modulus modular))] + (\ codec encode modular))) (def: #export (list formatter) (All [a] (-> (Format a) (Format (List a)))) diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index a5777768c..755693576 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -3,6 +3,7 @@ [abstract [equivalence (#+ Equivalence)] [order (#+ Order)] + [monoid (#+ Monoid)] [codec (#+ Codec)] [monad (#+ do)]] [control @@ -12,36 +13,42 @@ ["<.>" text (#+ Parser)] ["<.>" code]]] [data + ["." product] + ["." text ("#\." monoid)] [number - ["i" int ("#\." decimal)]] - ["." text ("#\." monoid)]] + ["i" int ("#\." decimal)]]] [type abstract] [macro - ["." code] - [syntax (#+ syntax:)]]] - [// - ["/" modulus (#+ Modulus)]]) + [syntax (#+ syntax:)] + ["." code]]] + ["." // #_ + ["#" modulus (#+ Modulus)]]) (abstract: #export (Mod m) {#modulus (Modulus m) - #remainder Int} + #value Int} {#.doc "A number under a modulus."} (def: #export (modular modulus value) - (All [m] (-> (Modulus m) Int (Mod m))) + (All [%] (-> (Modulus %) Int (Mod %))) (:abstraction {#modulus modulus - #remainder (i.mod (/.divisor modulus) value)})) + #value (i.mod (//.divisor modulus) value)})) - (def: #export un_modular - (All [m] (-> (Mod m) [(Modulus m) Int])) - (|>> :representation)) + (template [<name> <type> <side>] + [(def: #export <name> + (All [%] (-> (Mod %) <type>)) + (|>> :representation <side>))] - (exception: #export [m] (incorrect_modulus {modulus (Modulus m)} + [modulus (Modulus %) product.left] + [value Int product.right] + ) + + (exception: #export [%] (incorrect_modulus {modulus (Modulus %)} {parsed Int}) (exception.report - ["Expected" (i\encode (/.divisor modulus))] + ["Expected" (i\encode (//.divisor modulus))] ["Actual" (i\encode parsed)])) (def: separator @@ -53,41 +60,26 @@ (<text>.and (<text>.one_of "-+") (<text>.many <text>.decimal)))) (structure: #export (codec expected) - (All [m] (-> (Modulus m) (Codec Text (Mod m)))) + (All [%] (-> (Modulus %) (Codec Text (Mod %)))) (def: (encode modular) - (let [[_ remainder] (:representation modular)] + (let [[_ value] (:representation modular)] ($_ text\compose - (i\encode remainder) + (i\encode value) ..separator - (i\encode (/.divisor expected))))) + (i\encode (//.divisor expected))))) (def: decode - (<text>.run (do <>.monad - [[remainder _ actual] ($_ <>.and intL (<text>.this ..separator) intL) - _ (<>.assert (exception.construct ..incorrect_modulus [expected actual]) - (i.= (/.divisor expected) actual))] - (wrap (..modular expected remainder)))))) - - (exception: #export [rm sm] (unequal_moduli {reference (Modulus rm)} - {subject (Modulus sm)}) - (exception.report - ["Reference" (i\encode (/.divisor reference))] - ["Subject" (i\encode (/.divisor subject))])) - - (def: #export (equalize reference subject) - (All [r s] (-> (Mod r) (Mod s) (Try (Mod r)))) - (let [[reference_modulus reference] (:representation reference) - [subject_modulus subject] (:representation subject)] - (if (i.= (/.divisor reference_modulus) - (/.divisor subject_modulus)) - (#try.Success (:abstraction {#modulus reference_modulus - #remainder subject})) - (exception.throw ..unequal_moduli [reference_modulus subject_modulus])))) + (<text>.run + (do <>.monad + [[value _ actual] ($_ <>.and intL (<text>.this ..separator) intL) + _ (<>.assert (exception.construct ..incorrect_modulus [expected actual]) + (i.= (//.divisor expected) actual))] + (wrap (..modular expected value)))))) (template [<name> <op>] [(def: #export (<name> reference subject) - (All [m] (-> (Mod m) (Mod m) Bit)) + (All [%] (-> (Mod %) (Mod %) Bit)) (let [[_ reference] (:representation reference) [_ subject] (:representation subject)] (<op> reference subject)))] @@ -112,36 +104,52 @@ (template [<name> <op>] [(def: #export (<name> param subject) - (All [m] (-> (Mod m) (Mod m) (Mod m))) + (All [%] (-> (Mod %) (Mod %) (Mod %))) (let [[modulus param] (:representation param) [_ subject] (:representation subject)] (:abstraction {#modulus modulus - #remainder (|> subject - (<op> param) - (i.mod (/.divisor modulus)))})))] + #value (|> subject + (<op> param) + (i.mod (//.divisor modulus)))})))] [+ i.+] [- i.-] [* i.*] ) - - (def: (gcd+ a b) - (-> Int Int [Int Int Int]) - (if (i.= +0 a) - [+0 +1 b] - (let [[ak bk gcd] (gcd+ (i.mod a b) a)] - [(i.- (i.* ak - (i./ a b)) - bk) - ak - gcd]))) + (template [<composition> <identity> <monoid>] + [(structure: #export (<monoid> modulus) + (All [%] (-> (Modulus %) (Monoid (Mod %)))) + + (def: identity + (..modular modulus <identity>)) + (def: compose + <composition>))] + + [..+ +0 addition] + [..* +1 multiplication] + ) + (def: #export (inverse modular) - (All [m] (-> (Mod m) (Maybe (Mod m)))) + (All [%] (-> (Mod %) (Maybe (Mod %)))) (let [[modulus value] (:representation modular) - [vk mk gcd] (gcd+ value (/.divisor modulus)) - co_prime? (i.= +1 gcd)] - (if co_prime? - (#.Some (..modular modulus vk)) - #.None))) + [[vk mk] gcd] (i.extended_gcd value (//.divisor modulus))] + (case gcd + +1 (#.Some (..modular modulus vk)) + _ #.None))) ) + +(exception: #export [r% s%] (moduli_are_not_equal {reference (Modulus r%)} + {subject (Modulus s%)}) + (exception.report + ["Reference" (i\encode (//.divisor reference))] + ["Subject" (i\encode (//.divisor subject))])) + +(def: #export (adapter reference subject) + (All [r% s%] + (-> (Modulus r%) (Modulus s%) + (Try (-> (Mod s%) (Mod r%))))) + (if (//.= reference subject) + (#try.Success (|>> ..value + (..modular reference))) + (exception.throw ..moduli_are_not_equal [reference subject]))) diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux index cc0cc1def..389ba9690 100644 --- a/stdlib/source/lux/math/random.lux +++ b/stdlib/source/lux/math/random.lux @@ -346,13 +346,13 @@ [(recur (update state)) (return state)]))) -(def: #export (pcg_32 [increase seed]) +(def: #export (pcg32 [increase seed]) {#.doc (doc "An implementation of the PCG32 algorithm." "For more information, please see: http://www.pcg-random.org/")} (-> [(I64 Any) (I64 Any)] PRNG) (let [magic 6364136223846793005] (function (_ _) - [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg_32) + [(|> seed .nat (n.* magic) ("lux i64 +" increase) [increase] pcg32) (let [rot (|> seed .i64 (i64.logic_right_shift 59))] (|> seed (i64.logic_right_shift 18) @@ -381,7 +381,8 @@ (-> Nat PRNG) (let [twist (: (-> Nat Nat Nat) (function (_ shift value) - (i64.xor (i64.logic_right_shift shift value) value))) + (i64.xor (i64.logic_right_shift shift value) + value))) mix n.*] (..prng (n.+ (hex "9E,37,79,B9,7F,4A,7C,15")) (|>> (twist 30) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 7a392995e..972e41d0b 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -14,7 +14,7 @@ ["." maybe] ["." product] ["." name] - [number + [number (#+ hex) ["n" nat] ["f" frac]] ["." text @@ -126,7 +126,9 @@ (-> Text (Random Bit) Test) (\ random.monad map (..assert message) random)) -(def: pcg_32_magic_inc Nat 12345) +(def: pcg32_magic_inc + Nat + (hex "FEDCBA9876543210")) (type: #export Seed {#.doc "The seed value used for random testing (if that feature is used)."} @@ -135,7 +137,7 @@ (def: #export (seed value test) (-> Seed Test Test) (function (_ prng) - (let [[_ result] (random.run (random.pcg_32 [..pcg_32_magic_inc value]) + (let [[_ result] (random.run (random.pcg32 [..pcg32_magic_inc value]) test)] [prng result]))) @@ -162,7 +164,7 @@ (do random.monad [seed random.nat] (function (_ prng) - (let [[prng' instance] (random.run (random.pcg_32 [..pcg_32_magic_inc seed]) test)] + (let [[prng' instance] (random.run (random.pcg32 [..pcg32_magic_inc seed]) test)] [prng' (do promise.monad [[counters documentation] instance] (if (failed? counters) @@ -227,7 +229,7 @@ (do promise.monad [pre (promise.future instant.now) #let [seed (instant.to_millis pre) - prng (random.pcg_32 [..pcg_32_magic_inc seed])] + prng (random.pcg32 [..pcg32_magic_inc seed])] [counters documentation] (|> test (random.run prng) product.right) post (promise.future instant.now) #let [duration (instant.span pre post) @@ -338,7 +340,7 @@ (-> (List Test) Test) (do random.monad [seed random.nat - #let [prng (random.pcg_32 [..pcg_32_magic_inc seed]) + #let [prng (random.pcg32 [..pcg32_magic_inc seed]) run! (: (-> Test Assertion) (function (_ test) (|> (case (|> test diff --git a/stdlib/source/lux/time.lux b/stdlib/source/lux/time.lux index ac22d4a3d..6b880316c 100644 --- a/stdlib/source/lux/time.lux +++ b/stdlib/source/lux/time.lux @@ -188,9 +188,9 @@ (def: #export (time clock) (-> Clock (Try Time)) (|> ($_ duration.merge - (duration.scale_up (get@ #hour clock) duration.hour) - (duration.scale_up (get@ #minute clock) duration.minute) - (duration.scale_up (get@ #second clock) duration.second) + (duration.up (get@ #hour clock) duration.hour) + (duration.up (get@ #minute clock) duration.minute) + (duration.up (get@ #second clock) duration.second) (duration.from_millis (.int (get@ #milli_second clock)))) duration.to_millis .nat diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux index aa2aeda01..a973eea89 100644 --- a/stdlib/source/lux/time/duration.lux +++ b/stdlib/source/lux/time/duration.lux @@ -45,8 +45,8 @@ (-> Nat Duration Duration) (|>> :representation (<op> (.int scalar)) :abstraction))] - [i.* scale_up] - [i./ scale_down] + [i.* up] + [i./ down] ) (def: #export inverse @@ -93,7 +93,7 @@ (template [<name> <scale> <base>] [(def: #export <name> - (..scale_up <scale> <base>))] + (..up <scale> <base>))] [second 1,000 milli_second] [minute 60 second] @@ -173,11 +173,11 @@ seconds (section ..second_suffix "") millis (section ..milli_second_suffix "") #let [span (|> ..empty - (..merge (..scale_up days ..day)) - (..merge (..scale_up hours ..hour)) - (..merge (..scale_up minutes ..minute)) - (..merge (..scale_up seconds ..second)) - (..merge (..scale_up millis ..milli_second)) + (..merge (..up days ..day)) + (..merge (..up hours ..hour)) + (..merge (..up minutes ..minute)) + (..merge (..up seconds ..second)) + (..merge (..up millis ..milli_second)) )]] (wrap (case sign (#.Left _) (..inverse span) diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux index 823db0687..707dac89a 100644 --- a/stdlib/source/lux/time/instant.lux +++ b/stdlib/source/lux/time/instant.lux @@ -134,10 +134,10 @@ _ (<t>.this ..time_suffix)] (wrap (|> (if (i.< +0 days) (|> duration.day - (duration.scale_up (.nat (i.* -1 days))) + (duration.up (.nat (i.* -1 days))) duration.inverse) - (duration.scale_up (.nat days) duration.day)) - (duration.merge (duration.scale_up time duration.milli_second)) + (duration.up (.nat days) duration.day)) + (duration.merge (duration.up time duration.milli_second)) ..absolute)))) (structure: #export codec diff --git a/stdlib/source/program/aedifex/cache.lux b/stdlib/source/program/aedifex/cache.lux index d36bb8dff..a7f6439df 100644 --- a/stdlib/source/program/aedifex/cache.lux +++ b/stdlib/source/program/aedifex/cache.lux @@ -33,7 +33,9 @@ ["#/." extension (#+ Extension)]] ["#." dependency (#+ Dependency) [resolution (#+ Resolution)] - ["#/." status (#+ Status)]]]) + ["#/." status (#+ Status)]] + ["#." repository #_ + ["#/." origin]]]) (def: (write! system content file) (-> (file.System Promise) Binary Path (Promise (Try Any))) @@ -130,7 +132,7 @@ [pom (..decode xml.codec pom) library_sha-1 (..decode //hash.sha-1_codec library_sha-1) library_md5 (..decode //hash.md5_codec library_md5)] - (wrap {#//package.origin #//package.Local + (wrap {#//package.origin (#//repository/origin.Local prefix) #//package.library [library (#//dependency/status.Verified library_sha-1 library_md5)] #//package.pom [pom #//dependency/status.Unverified]})))))) diff --git a/stdlib/source/program/aedifex/dependency/resolution.lux b/stdlib/source/program/aedifex/dependency/resolution.lux index 11c3cd057..e9d457ac9 100644 --- a/stdlib/source/program/aedifex/dependency/resolution.lux +++ b/stdlib/source/program/aedifex/dependency/resolution.lux @@ -34,12 +34,13 @@ ["#." status (#+ Status)] ["/#" // #_ ["/" profile] - ["#." repository (#+ Address Repository)] ["#." hash (#+ Hash SHA-1 MD5)] ["#." pom] ["#." package (#+ Package)] ["#." artifact (#+ Artifact) - ["#/." extension (#+ Extension)]]]]) + ["#/." extension (#+ Extension)]] + ["#." repository (#+ Address Repository) + ["#/." origin (#+ Origin)]]]]) (template [<name>] [(exception: #export (<name> {artifact Artifact} {extension Extension} {hash Text}) @@ -92,7 +93,7 @@ [pom (\ encoding.utf8 decode pom) pom (\ xml.codec decode pom) profile (<xml>.run ///pom.parser pom)] - (wrap {#///package.origin #///package.Remote + (wrap {#///package.origin (#///repository/origin.Remote "") #///package.library library_&_status #///package.pom [pom pom_status]})))))) diff --git a/stdlib/source/program/aedifex/package.lux b/stdlib/source/program/aedifex/package.lux index b3118a7e0..f6ba87078 100644 --- a/stdlib/source/program/aedifex/package.lux +++ b/stdlib/source/program/aedifex/package.lux @@ -15,28 +15,13 @@ [collection [set (#+ Set)]]]] ["." // #_ - [dependency (#+ Dependency) - ["#." status (#+ Status)]] ["/" profile] ["#." hash (#+ Hash SHA-1 MD5)] - ["#." pom]]) - -(type: #export Origin - #Local - #Remote) - -(structure: any_equivalence - (Equivalence Any) - - (def: (= _ _) - true)) - -(def: origin_equivalence - (Equivalence Origin) - ($_ sum.equivalence - ..any_equivalence - ..any_equivalence - )) + ["#." pom] + [dependency (#+ Dependency) + ["#." status (#+ Status)]] + [repository + ["#." origin (#+ Origin)]]]) (type: #export Package {#origin Origin @@ -44,17 +29,22 @@ #pom [XML Status]}) (template [<name> <tag>] - [(def: #export <name> + [(def: #export (<name> package) (-> Package Bit) - (|>> (get@ #origin) (\ ..origin_equivalence = <tag>)))] + (case (get@ #origin package) + (<tag> _) + true + + _ + false))] - [local? #Local] - [remote? #Remote] + [local? #//origin.Local] + [remote? #//origin.Remote] ) (def: #export (local pom library) (-> XML Binary Package) - {#origin #Local + {#origin (#//origin.Local "") #library [library #//status.Unverified] #pom [pom #//status.Unverified]}) @@ -68,7 +58,7 @@ (def: #export equivalence (Equivalence Package) ($_ product.equivalence - ..origin_equivalence + //origin.equivalence (product.equivalence binary.equivalence //status.equivalence) (product.equivalence xml.equivalence //status.equivalence) )) diff --git a/stdlib/source/program/aedifex/repository/origin.lux b/stdlib/source/program/aedifex/repository/origin.lux new file mode 100644 index 000000000..ca97a8cff --- /dev/null +++ b/stdlib/source/program/aedifex/repository/origin.lux @@ -0,0 +1,21 @@ +(.module: + [lux #* + [abstract + [equivalence (#+ Equivalence)]] + [data + ["." sum] + ["." text]] + [world + [file (#+ Path)] + [net (#+ URL)]]]) + +(type: #export Origin + (#Local Path) + (#Remote URL)) + +(def: #export equivalence + (Equivalence Origin) + ($_ sum.equivalence + text.equivalence + text.equivalence + )) diff --git a/stdlib/source/spec/lux/abstract/monoid.lux b/stdlib/source/spec/lux/abstract/monoid.lux index b3bcd7a67..1981c6107 100644 --- a/stdlib/source/spec/lux/abstract/monoid.lux +++ b/stdlib/source/spec/lux/abstract/monoid.lux @@ -10,7 +10,7 @@ [// [equivalence (#+ Equivalence)]]]}) -(def: #export (spec (^open "@//.") (^open "@//.") gen-sample) +(def: #export (spec (^open "\.") (^open "\.") gen-sample) (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test)) (do random.monad [sample gen-sample @@ -20,12 +20,12 @@ (<| (_.for [/.Monoid]) ($_ _.and (_.test "Left identity." - (@//= sample - (@//compose @//identity sample))) + (\= sample + (\compose \identity sample))) (_.test "Right identity." - (@//= sample - (@//compose sample @//identity))) + (\= sample + (\compose sample \identity))) (_.test "Associativity." - (@//= (@//compose left (@//compose mid right)) - (@//compose (@//compose left mid) right))) + (\= (\compose left (\compose mid right)) + (\compose (\compose left mid) right))) )))) diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index c4c2d044f..bc436733b 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -40,7 +40,9 @@ ["#." dependency (#+ Dependency) ["#/." resolution (#+ Resolution)]] ["#." artifact (#+ Artifact) - ["#/." type (#+ Type)]]]]}) + ["#/." type (#+ Type)]] + ["#." repository #_ + ["#/." origin]]]]}) (def: type (Random Type) @@ -72,7 +74,7 @@ content ..content] (wrap [{#//dependency.artifact identity #//dependency.type type} - (set@ #//package.origin #//package.Remote (//package.local pom content))]))) + (set@ #//package.origin (#//repository/origin.Remote "") (//package.local pom content))]))) (def: resolution (Random Resolution) @@ -92,7 +94,7 @@ ..profile) content ..content] (wrap [dependency - (set@ #//package.origin #//package.Remote (//package.local pom content))])))))] + (set@ #//package.origin (#//repository/origin.Remote "") (//package.local pom content))])))))] (wrap (dictionary.from_list //dependency.hash (list& [main_dependency main_package] dependencies))))) (def: singular @@ -113,7 +115,7 @@ [_ wrote! actual_package read!] (wrap (\ //package.equivalence = - (set@ #//package.origin #//package.Local expected_package) + (set@ #//package.origin (#//repository/origin.Local "") expected_package) actual_package))))))))) (def: plural @@ -135,7 +137,7 @@ actual read!] (wrap (\ //dependency/resolution.equivalence = (\ dictionary.functor map - (set@ #//package.origin #//package.Local) + (set@ #//package.origin (#//repository/origin.Local "")) expected) actual))))))))) diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 7002238e7..08345a0cb 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -40,12 +40,13 @@ ["#." pom] ["#." package] ["#." cache] - ["#." repository] ["#." artifact ["#/." type]] ["#." dependency ["#/." resolution] - ["#/." status]]]]]}) + ["#/." status]] + ["#." repository + ["#/." origin]]]]]}) (def: #export test Test @@ -78,10 +79,10 @@ try.assume) dependee_package (|> dependee_package - (set@ #///package.origin #///package.Remote) + (set@ #///package.origin (#///repository/origin.Remote "")) (set@ #///package.pom [dependee_pom #///dependency/status.Unverified])) depender_package (|> depender_package - (set@ #///package.origin #///package.Remote) + (set@ #///package.origin (#///repository/origin.Remote "")) (set@ #///package.pom [depender_pom #///dependency/status.Unverified])) fs (file.mock (\ file.default separator)) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 5f262bce4..4404cb32f 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -38,13 +38,14 @@ ["#" profile] ["#." package (#+ Package)] ["#." hash] - ["#." repository (#+ Simulation)] ["#." dependency ["#/." status]] ["#." pom] ["#." artifact (#+ Artifact) ["#/." type] - ["#/." extension]]]]}) + ["#/." extension]] + ["#." repository (#+ Simulation) + ["#/." origin]]]]}) (def: random (Random /.Resolution) @@ -178,7 +179,7 @@ (case actual_package (#try.Success actual_package) (\ ///package.equivalence = - (set@ #///package.origin #///package.Remote expected_package) + (set@ #///package.origin (#///repository/origin.Remote "") expected_package) actual_package) (#try.Failure _) @@ -291,7 +292,7 @@ (case actual_package (#try.Success actual_package) (\ ///package.equivalence = - (set@ #///package.origin #///package.Remote expected_package) + (set@ #///package.origin (#///repository/origin.Remote "") expected_package) actual_package) (#try.Failure _) diff --git a/stdlib/source/test/aedifex/repository.lux b/stdlib/source/test/aedifex/repository.lux index 7b99d080f..df8db3e88 100644 --- a/stdlib/source/test/aedifex/repository.lux +++ b/stdlib/source/test/aedifex/repository.lux @@ -23,6 +23,7 @@ ["." uri (#+ URI)]]]] ["." / #_ ["#." identity] + ["#." origin] [// ["@." artifact]]] {#spec @@ -69,5 +70,7 @@ ($/.spec (..artifact "1.2.3-YES") (..artifact "4.5.6-NO") (/.mock ..simulation ..empty))) + /identity.test + /origin.test ))) diff --git a/stdlib/source/test/aedifex/repository/identity.lux b/stdlib/source/test/aedifex/repository/identity.lux index 98d798cf7..d2a7ce185 100644 --- a/stdlib/source/test/aedifex/repository/identity.lux +++ b/stdlib/source/test/aedifex/repository/identity.lux @@ -5,9 +5,6 @@ {[0 #spec] [/ ["$." equivalence]]}] - [data - ["." product] - ["." text]] [math ["." random (#+ Random)]]] {#program diff --git a/stdlib/source/test/aedifex/repository/origin.lux b/stdlib/source/test/aedifex/repository/origin.lux new file mode 100644 index 000000000..4242a318a --- /dev/null +++ b/stdlib/source/test/aedifex/repository/origin.lux @@ -0,0 +1,27 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + {[0 #spec] + [/ + ["$." equivalence]]}] + [math + ["." random (#+ Random)]]] + {#program + ["." /]}) + +(def: #export random + (Random /.Origin) + ($_ random.or + (random.ascii/alpha 10) + (random.ascii/alpha 10) + )) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Origin] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + )))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index c00ef0964..60fc409ad 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -232,50 +232,50 @@ (def: test (<| (_.context (name.module (name_of /._))) - (_.in_parallel - (list (!bundle ($_ _.and - (<| (_.context "Identity.") - ..identity) - (<| (_.context "Increment & decrement.") - ..increment_and_decrement) - (<| (_.context "Even or odd.") - ($_ _.and - (<| (_.context "Natural numbers.") - (..even_or_odd random.nat n.even? n.odd?)) - (<| (_.context "Integers.") - (..even_or_odd random.int i.even? i.odd?)))) - (<| (_.context "Minimum and maximum.") - (`` ($_ _.and - (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>] - [(<| (_.context <context>) - (..minimum_and_maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] + ($_ _.and + (<| (_.context "Identity.") + ..identity) + (<| (_.context "Increment & decrement.") + ..increment_and_decrement) + (<| (_.context "Even or odd.") + ($_ _.and + (<| (_.context "Natural numbers.") + (..even_or_odd random.nat n.even? n.odd?)) + (<| (_.context "Integers.") + (..even_or_odd random.int i.even? i.odd?)))) + (<| (_.context "Minimum and maximum.") + (`` ($_ _.and + (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>] + [(<| (_.context <context>) + (..minimum_and_maximum <gen> <=> [<lt> <min>] [<gt> <max>]))] - [i.= i.< i.min i.> i.max random.int "Integers."] - [n.= n.< n.min n.> n.max random.nat "Natural numbers."] - [r.= r.< r.min r.> r.max random.rev "Revolutions."] - [f.= f.< f.min f.> f.max random.safe_frac "Fractions."] - ))))) - (<| (_.context "Conversion.") - (`` ($_ _.and - (~~ (template [<=> <forward> <backward> <gen>] - [(<| (_.context (format (%.name (name_of <forward>)) - " " (%.name (name_of <backward>)))) - (..conversion <gen> <forward> <backward> <=>))] + [i.= i.< i.min i.> i.max random.int "Integers."] + [n.= n.< n.min n.> n.max random.nat "Natural numbers."] + [r.= r.< r.min r.> r.max random.rev "Revolutions."] + [f.= f.< f.min f.> f.max random.safe_frac "Fractions."] + ))))) + (<| (_.context "Conversion.") + (`` ($_ _.and + (~~ (template [<=> <forward> <backward> <gen>] + [(<| (_.context (format (%.name (name_of <forward>)) + " " (%.name (name_of <backward>)))) + (..conversion <gen> <forward> <backward> <=>))] - [i.= .nat .int (random\map (i.% +1,000,000) random.int)] - [n.= .int .nat (random\map (n.% 1,000,000) random.nat)] - [i.= i.frac f.int (random\map (i.% +1,000,000) random.int)] - [f.= f.int i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)] - [r.= r.frac f.rev frac_rev] - ))))) - (<| (_.context "Prelude macros.") - ..prelude_macros) - (<| (_.context "Templates.") - ..templates) - (<| (_.context "Cross-platform support.") - ..cross_platform_support))) - ..sub_tests - )))) + [i.= .nat .int (random\map (i.% +1,000,000) random.int)] + [n.= .int .nat (random\map (n.% 1,000,000) random.nat)] + [i.= i.frac f.int (random\map (i.% +1,000,000) random.int)] + [f.= f.int i.frac (random\map (|>> (i.% +1,000,000) i.frac) random.int)] + [r.= r.frac f.rev frac_rev] + ))))) + (<| (_.context "Prelude macros.") + ..prelude_macros) + (<| (_.context "Templates.") + ..templates) + (<| (_.context "Cross-platform support.") + ..cross_platform_support) + + ..sub_tests + ))) (program: args (<| io diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 2652be103..d48e1b1ae 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -16,8 +16,7 @@ [text ["%" format (#+ format)]] [number - ["n" nat] - ["." i64]] + ["n" nat]] [collection ["." list ("#\." fold monoid)] ["." row (#+ Row)]]] @@ -26,7 +25,7 @@ {1 ["." / [// - ["." promise ("#\." monad)] + ["." promise (#+ Promise) ("#\." monad)] ["." atom (#+ Atom atom)]]]}) (def: injection @@ -49,11 +48,27 @@ _ false)))))) +(def: (take_amount amount_of_polls [channel sink]) + (All [a] (-> Nat [(/.Channel a) (/.Sink a)] (Promise (List a)))) + (case amount_of_polls + 0 (do promise.monad + [_ (promise.future (\ sink close))] + (wrap #.Nil)) + _ (do {! promise.monad} + [event channel] + (case event + #.None + (wrap #.Nil) + + (#.Some [head tail]) + (\ ! map (|>> (#.Cons head)) + (take_amount (dec amount_of_polls) [channel sink])))))) + (def: #export test Test (<| (_.covering /._) (let [(^open "list\.") (list.equivalence n.equivalence)] - (do random.monad + (do {! random.monad} [inputs (random.list 5 random.nat) sample random.nat distint/0 random.nat @@ -69,7 +84,7 @@ ($apply.spec ..injection ..comparison /.apply)) (_.for [/.monad] ($monad.spec ..injection ..comparison /.monad)) - + (_.cover [/.Channel /.Sink /.channel] (case (io.run (do (try.with io.monad) @@ -125,19 +140,22 @@ (list\= (list.filter n.even? inputs) output)))) (wrap (do {! promise.monad} - [#let [sink (: (Atom (Row Nat)) - (atom.atom row.empty)) - channel (/.sequential 0 (list\compose inputs inputs))] + [#let [[?signal !signal] (: [(promise.Promise Any) (promise.Resolver Any)] + (promise.promise [])) + sink (: (Atom (Row Nat)) + (atom.atom row.empty))] _ (promise.future (/.subscribe (function (_ value) (do {! io.monad} [current (atom.read sink) _ (atom.update (row.add value) sink)] - (wrap (if (n.< (list.size inputs) - (inc (row.size current))) - (#.Some []) - #.None)))) - channel)) - _ (/.consume channel) + (if (n.< (list.size inputs) + (inc (row.size current))) + (wrap (#.Some [])) + (do ! + [_ (!signal [])] + (wrap #.None))))) + (/.sequential 0 (list\compose inputs inputs)))) + _ ?signal listened (|> sink atom.read promise.future @@ -172,36 +190,24 @@ (_.cover' [/.distinct] (list\= (list distint/0 distint/1 distint/2) actual)))) - (let [polling_delay 1 - amount_of_polls 5 - wiggle_room ($_ n.* - (i64.left_shift 6 1) - amount_of_polls - polling_delay) - total_delay (|> polling_delay - (n.* amount_of_polls) - (n.+ wiggle_room))] + (do ! + [polling_delay (\ ! map (|>> (n.% 10) inc) random.nat) + amount_of_polls (\ ! map (|>> (n.% 10) inc) random.nat)] ($_ _.and - (wrap (do promise.monad - [#let [[channel sink] (/.poll polling_delay (: (IO Nat) (io.io sample)))] - _ (promise.delay total_delay []) - _ (promise.future (\ sink close)) - actual (/.consume channel) + (wrap (do {! promise.monad} + [actual (..take_amount amount_of_polls (/.poll polling_delay (: (IO Nat) (io.io sample)))) #let [correct_values! (list.every? (n.= sample) actual) - + enough_polls! - (n.>= amount_of_polls (list.size actual))]] + (n.= amount_of_polls (list.size actual))]] (_.cover' [/.poll] (and correct_values! enough_polls!)))) - (wrap (do promise.monad - [#let [[channel sink] (/.periodic polling_delay)] - _ (promise.delay total_delay []) - _ (promise.future (\ sink close)) - actual (/.consume channel)] + (wrap (do {! promise.monad} + [actual (..take_amount amount_of_polls (/.periodic polling_delay))] (_.cover' [/.periodic] - (n.>= amount_of_polls (list.size actual))))))) + (n.= amount_of_polls (list.size actual))))))) (wrap (do promise.monad [#let [max_iterations 10] actual (|> [0 sample] diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 21633f293..18b040acf 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -48,7 +48,7 @@ Test (<| (_.covering /._) (do {! random.monad} - [to_wait (|> random.nat (\ ! map (|>> (n.% 100) (n.max 10)))) + [to_wait (|> random.nat (\ ! map (|>> (n.% 10) (n.+ 10)))) expected random.nat dummy random.nat #let [not_dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 19c8f44f9..6f1e53122 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -10,6 +10,7 @@ [parser ["<c>" code]]] [data + [number (#+ hex)] ["." product] ["." text ["%" format (#+ format)]]] @@ -65,7 +66,8 @@ today (instant.date now) yesterday (instant.date (instant.shift (duration.inverse duration.week) now)) tomorrow (instant.date (instant.shift duration.week now)) - prng (random.pcg_32 [123 (instant.to_millis now)]) + prng (random.pcg32 [(hex "0123456789ABCDEF") + (instant.to_millis now)]) message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] (do meta.monad diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux index 33b2927e4..24155602b 100644 --- a/stdlib/source/test/lux/data/number/int.lux +++ b/stdlib/source/test/lux/data/number/int.lux @@ -143,6 +143,22 @@ (let [gcd (/.gcd left right)] (and (/.= +0 (/.% gcd left)) (/.= +0 (/.% gcd right))))) + (_.cover [/.extended_gcd] + (let [[[left_k right_k] gcd] (/.extended_gcd left right) + + same_gcd! + (/.= gcd + (/.gcd left right)) + + bezout_identity! + (/.= gcd + (/.+ (/.* left_k left) + (/.* right_k right)))] + (and same_gcd! + bezout_identity!))) + (_.cover [/.co-prime?] + (bit\= (/.= +1 (/.gcd left right)) + (/.co-prime? left right))) (_.cover [/.lcm] (let [lcm (/.lcm left right)] (and (/.= +0 (/.% left lcm)) diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux index 97f93dc53..a2d0fd655 100644 --- a/stdlib/source/test/lux/data/number/nat.lux +++ b/stdlib/source/test/lux/data/number/nat.lux @@ -112,6 +112,9 @@ (let [gcd (/.gcd left right)] (and (/.= 0 (/.% gcd left)) (/.= 0 (/.% gcd right))))) + (_.cover [/.co-prime?] + (bit\= (/.= 1 (/.gcd left right)) + (/.co-prime? left right))) (_.cover [/.lcm] (let [lcm (/.lcm left right)] (and (/.= 0 (/.% left lcm)) diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/modular.lux index 66eb047fc..849159da2 100644 --- a/stdlib/source/test/lux/math/modular.lux +++ b/stdlib/source/test/lux/math/modular.lux @@ -3,7 +3,13 @@ ["_" test (#+ Test)] ["." type ("#\." equivalence)] [abstract - [monad (#+ do)]] + [monad (#+ do)] + {[0 #spec] + [/ + ["$." equivalence] + ["$." order] + ["$." monoid] + ["$." codec]]}] [control ["." try] ["." exception]] @@ -14,133 +20,103 @@ ["i" int]]] [math ["." random (#+ Random)]]] + ["$." // #_ + ["#" modulus]] {1 ["." / ["/#" // #_ ["#" modulus]]]}) -(def: %3 (//.literal +3)) -(`` (type: Mod3 (~~ (:of %3)))) - -(def: modulusR - (Random Int) - (|> random.int - (\ random.monad map (i.% +1000)) - (random.filter (|>> (i.= +0) not)))) - -(def: valueR - (Random Int) - (|> random.int (\ random.monad map (i.% +1000)))) - -(def: (modR modulus) - (All [m] (-> (//.Modulus m) (Random [Int (/.Mod m)]))) - (do random.monad - [raw valueR] - (wrap [raw (/.modular modulus raw)]))) - -(def: value - (All [m] (-> (/.Mod m) Int)) - (|>> /.un_modular product.right)) - -(def: (comparison m/? i/?) - (All [m] - (-> (-> (/.Mod m) (/.Mod m) Bit) - (-> Int Int Bit) - (-> (/.Mod m) (/.Mod m) Bit))) - (function (_ param subject) - (bit\= (m/? param subject) - (i/? (value param) - (value subject))))) - -(def: (arithmetic modulus m/! i/!) - (All [m] - (-> (//.Modulus m) - (-> (/.Mod m) (/.Mod m) (/.Mod m)) - (-> Int Int Int) - (-> (/.Mod m) (/.Mod m) Bit))) - (function (_ param subject) - (|> (i/! (value param) - (value subject)) - (/.modular modulus) - (/.= (m/! param subject))))) +(def: #export (random modulus) + (All [%] (-> (//.Modulus %) (Random (/.Mod %)))) + (\ random.monad map + (/.modular modulus) + random.int)) (def: #export test Test (<| (_.covering /._) + (_.for [/.Mod]) (do random.monad - [_normalM modulusR - _alternativeM (|> modulusR (random.filter (|>> (i.= _normalM) not))) - #let [normalM (|> _normalM //.modulus try.assume) - alternativeM (|> _alternativeM //.modulus try.assume)] - [_param param] (modR normalM) - [_subject subject] (modR normalM) - #let [copyM (|> normalM //.divisor //.modulus try.assume)]] - ($_ _.and - (_.test "Every modulus has a unique type, even if the numeric value is the same as another." - (and (type\= (:of normalM) - (:of normalM)) - (not (type\= (:of normalM) - (:of alternativeM))) - (not (type\= (:of normalM) - (:of copyM))))) - ## (_.test "Can extract the original integer from the modulus." - ## (i.= _normalM - ## (//.divisor normalM))) - ## (_.test "Can compare mod'ed values." - ## (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\= (/.< 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 /.+ 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 - ## (/.* subject^-1) - ## (/.= (/.modular normalM +1))) - - ## #.None - ## true)) - ## (_.test "Can encode/decode to text." - ## (let [(^open "mod/.") (/.codec normalM)] - ## (case (|> subject mod/encode mod/decode) - ## (#try.Success output) - ## (/.= subject output) - - ## (#try.Failure error) - ## false))) - ## (_.test "Can equalize 2 moduli if they are equal." - ## (case (/.equalize (/.modular normalM _subject) - ## (/.modular copyM _param)) - ## (#try.Success paramC) - ## (/.= param paramC) + [param\\% ($//.random +1,000,000) + param (..random param\\%) - ## (#try.Failure error) - ## false)) - ## (_.test "Cannot equalize 2 moduli if they are the different." - ## (case (/.equalize (/.modular normalM _subject) - ## (/.modular alternativeM _param)) - ## (#try.Success paramA) - ## false + subject\\% (random.filter (|>> (//.= param\\%) not) + ($//.random +1,000,000)) + subject (..random subject\\%) + another (..random subject\\%)] + (`` ($_ _.and + (_.for [/.equivalence /.=] + ($equivalence.spec /.equivalence (..random subject\\%))) + (_.for [/.order /.<] + ($order.spec /.order (..random subject\\%))) + (~~ (template [<compose> <monoid>] + [(_.for [<monoid> <compose>] + ($monoid.spec /.equivalence (<monoid> subject\\%) (..random subject\\%)))] + + [/.+ /.addition] + [/.* /.multiplication] + )) + (_.for [/.codec] + ($codec.spec /.equivalence (/.codec subject\\%) (..random subject\\%))) - ## (#try.Failure error) - ## true)) - ## (_.test "All numbers are congruent to themselves." - ## (//.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) - ## (/.= param subject))) - )))) + (_.cover [/.incorrect_modulus] + (case (|> param + (\ (/.codec param\\%) encode) + (\ (/.codec subject\\%) decode)) + (#try.Failure error) + (exception.match? /.incorrect_modulus error) + + (#try.Success _) + false)) + (_.cover [/.modulus] + (and (type\= (:of (/.modulus subject)) + (:of (/.modulus subject))) + (not (type\= (:of (/.modulus subject)) + (:of (/.modulus param)))))) + (_.cover [/.modular /.value] + (/.= subject + (/.modular (/.modulus subject) (/.value subject)))) + (_.cover [/.>] + (bit\= (/.> another subject) + (/.< subject another))) + (_.cover [/.<= /.>=] + (bit\= (/.<= another subject) + (/.>= subject another))) + (_.cover [/.-] + (let [zero (/.modular (/.modulus subject) +0)] + (and (/.= zero + (/.- subject subject)) + (/.= subject + (/.- zero subject))))) + (_.cover [/.inverse] + (let [one (/.modular (/.modulus subject) +1) + co-prime? (i.co-prime? (//.divisor (/.modulus subject)) + (/.value subject))] + (case (/.inverse subject) + (#.Some subject^-1) + (and co-prime? + (|> subject + (/.* subject^-1) + (/.= one))) + + #.None + (not co-prime?)))) + (_.cover [/.adapter] + (<| (try.default false) + (do try.monad + [copy\\% (//.modulus (//.divisor subject\\%)) + adapt (/.adapter subject\\% copy\\%)] + (wrap (|> subject + /.value + (/.modular copy\\%) + adapt + (/.= subject)))))) + (_.cover [/.moduli_are_not_equal] + (case (/.adapter subject\\% param\\%) + (#try.Failure error) + (exception.match? /.moduli_are_not_equal error) + + (#try.Success _) + false)) + ))))) diff --git a/stdlib/source/test/lux/math/modulus.lux b/stdlib/source/test/lux/math/modulus.lux index 58d16666f..7fec2db0d 100644 --- a/stdlib/source/test/lux/math/modulus.lux +++ b/stdlib/source/test/lux/math/modulus.lux @@ -25,14 +25,19 @@ 0 +1 _ (.int divisor))))))) +(def: #export (random range) + (Ex [%] (-> Int (Random (/.Modulus %)))) + (|> random.int + (\ random.monad map (i.% range)) + (random.one (|>> /.modulus try.to_maybe)))) + (def: #export test Test (<| (_.covering /._) (_.for [/.Modulus]) (do random.monad [divisor random.int - modulus (random.one (|>> /.modulus try.to_maybe) - random.int) + modulus (..random +1,000,000) dividend random.int] ($_ _.and (_.cover [/.modulus /.divisor] diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index 89d9a4db7..272532324 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -43,9 +43,9 @@ #let [(^open "/\.") /.order]] ($_ _.and (_.test "Can scale a duration." - (|> sample (/.scale_up factor) (/.query sample) (i.= (.int factor)))) + (|> sample (/.up factor) (/.query sample) (i.= (.int factor)))) (_.test "Scaling a duration by one does not change it." - (|> sample (/.scale_up 1) (/\= sample))) + (|> sample (/.up 1) (/\= sample))) (_.test "Merging a duration with it's opposite yields an empty duration." (|> sample (/.merge (/.inverse sample)) (/\= /.empty))))) ))) |