diff options
Diffstat (limited to '')
42 files changed, 920 insertions, 753 deletions
diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux index a001e3a44..60e452c54 100644 --- a/stdlib/source/lux/control/interval.lux +++ b/stdlib/source/lux/control/interval.lux @@ -5,7 +5,6 @@ ["." order] [enum (#+ Enum)]]]) -## Signatures (signature: #export (Interval a) {#.doc "A representation of top and bottom boundaries for an ordered type."} (: (Enum a) diff --git a/stdlib/source/lux/data/bit.lux b/stdlib/source/lux/data/bit.lux index 613d923b3..ab8c24a8e 100644 --- a/stdlib/source/lux/data/bit.lux +++ b/stdlib/source/lux/data/bit.lux @@ -25,8 +25,8 @@ (def: identity <identity>) (def: (compose x y) (<op> x y)))] - [ or-monoid #0 or] - [and-monoid #1 and] + [disjunction #0 or] + [conjunction #1 and] ) (structure: #export codec (Codec Text Bit) diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux index 284576264..6847d4a59 100644 --- a/stdlib/source/lux/data/number/frac.lux +++ b/stdlib/source/lux/data/number/frac.lux @@ -126,7 +126,7 @@ (let [whole-part ("lux text clip" repr 0 split-index) decimal-part ("lux text clip" repr (inc split-index) ("lux text size" repr))] (case [(:: <int> decode whole-part) - (:: <int> decode decimal-part)] + (:: <int> decode ("lux text concat" "+" decimal-part))] (^multi [(#error.Success whole) (#error.Success decimal)] (i/>= +0 decimal)) (let [sign (if (i/< +0 whole) diff --git a/stdlib/source/lux/data/number/i64.lux b/stdlib/source/lux/data/number/i64.lux index 93d95f02c..6f30bcb44 100644 --- a/stdlib/source/lux/data/number/i64.lux +++ b/stdlib/source/lux/data/number/i64.lux @@ -1,4 +1,7 @@ -(.module: [lux (#- and or not)]) +(.module: + [lux (#- and or not) + [control + [monoid (#+ Monoid)]]]) (def: #export bits-per-byte 8) @@ -20,6 +23,25 @@ [xor "lux i64 xor" "Bitwise xor."] ) +(def: #export not + {#.doc "Bitwise negation."} + (All [s] (-> (I64 s) (I64 s))) + (xor (:coerce I64 -1))) + +(structure: #export disjunction + (All [a] (Monoid (I64 a))) + + (def: identity (.i64 0)) + (def: compose ..or) + ) + +(structure: #export conjunction + (All [a] (Monoid (I64 a))) + + (def: identity (.i64 (..not 0))) + (def: compose ..and) + ) + (do-template [<name> <op> <doc>] [(def: #export (<name> param subject) {#.doc <doc>} @@ -52,11 +74,6 @@ (add-shift 32) (..and 127)))) -(def: #export not - {#.doc "Bitwise negation."} - (All [s] (-> (I64 s) (I64 s))) - (xor (:coerce I64 -1))) - (def: (flag idx) (-> Nat I64) (|> 1 (:coerce I64) (left-shift idx))) diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux index bd3c4d9b5..8126bc0c3 100644 --- a/stdlib/source/lux/data/number/nat.lux +++ b/stdlib/source/lux/data/number/nat.lux @@ -55,8 +55,8 @@ [addition n/+ 0] [multiplication n/* 1] - [maximum n/max (:: ..interval bottom)] [minimum n/min (:: ..interval top)] + [maximum n/max (:: ..interval bottom)] ) (def: #export (binary-character value) diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux index 907cb950f..21176e998 100644 --- a/stdlib/source/lux/data/number/ratio.lux +++ b/stdlib/source/lux/data/number/ratio.lux @@ -31,72 +31,34 @@ {#numerator (n// common numerator) #denominator (n// common denominator)})) -(def: #export (* param input) - (-> Ratio Ratio Ratio) - (normalize [(n/* (get@ #numerator param) - (get@ #numerator input)) - (n/* (get@ #denominator param) - (get@ #denominator input))])) - -(def: #export (/ param input) - (-> Ratio Ratio Ratio) - (normalize [(n/* (get@ #denominator param) - (get@ #numerator input)) - (n/* (get@ #numerator param) - (get@ #denominator input))])) - -(def: #export (+ param input) - (-> Ratio Ratio Ratio) - (normalize [(n/+ (n/* (get@ #denominator input) - (get@ #numerator param)) - (n/* (get@ #denominator param) - (get@ #numerator input))) - (n/* (get@ #denominator param) - (get@ #denominator input))])) - -(def: #export (- param input) - (-> Ratio Ratio Ratio) - (normalize [(n/- (n/* (get@ #denominator input) - (get@ #numerator param)) - (n/* (get@ #denominator param) - (get@ #numerator input))) - (n/* (get@ #denominator param) - (get@ #denominator input))])) - -(def: #export (% param input) - (-> Ratio Ratio Ratio) - (let [quot (n// (n/* (get@ #denominator input) - (get@ #numerator param)) - (n/* (get@ #denominator param) - (get@ #numerator input)))] - (- (update@ #numerator (n/* quot) param) - input))) - -(def: #export (= param input) - (-> Ratio Ratio Bit) - (and (n/= (get@ #numerator param) - (get@ #numerator input)) - (n/= (get@ #denominator param) - (get@ #denominator input)))) - -(do-template [<name> <op>] - [(def: #export (<name> param input) - (-> Ratio Ratio Bit) - (and (<op> (n/* (get@ #denominator input) - (get@ #numerator param)) - (n/* (get@ #denominator param) - (get@ #numerator input)))))] - - [< n/<] - [<= n/<=] - [> n/>] - [>= n/>=] - ) +(structure: #export equivalence (Equivalence Ratio) + (def: (= param input) + (and (n/= (get@ #numerator param) + (get@ #numerator input)) + (n/= (get@ #denominator param) + (get@ #denominator input))))) + +(`` (structure: #export order (Order Ratio) + (def: &equivalence ..equivalence) + + (~~ (do-template [<name> <op>] + [(def: (<name> param input) + (and (<op> (n/* (get@ #denominator input) + (get@ #numerator param)) + (n/* (get@ #denominator param) + (get@ #numerator input)))))] + + [< n/<] + [<= n/<=] + [> n/>] + [>= n/>=] + )) + )) (do-template [<name> <comp>] [(def: #export (<name> left right) (-> Ratio Ratio Ratio) - (if (<comp> left right) + (if (:: ..order <comp> left right) right left))] @@ -104,29 +66,57 @@ [max >] ) -(structure: #export equivalence (Equivalence Ratio) - (def: = ..=)) +(def: (- param input) + (normalize [(n/- (n/* (get@ #denominator input) + (get@ #numerator param)) + (n/* (get@ #denominator param) + (get@ #numerator input))) + (n/* (get@ #denominator param) + (get@ #denominator input))])) -(structure: #export order (Order Ratio) - (def: &equivalence ..equivalence) - (def: < ..<) - (def: <= ..<=) - (def: > ..>) - (def: >= ..>=)) +(structure: #export number + (Number Ratio) + + (def: (+ param input) + (normalize [(n/+ (n/* (get@ #denominator input) + (get@ #numerator param)) + (n/* (get@ #denominator param) + (get@ #numerator input))) + (n/* (get@ #denominator param) + (get@ #denominator input))])) -(structure: #export number (Number Ratio) - (def: + ..+) (def: - ..-) - (def: * ..*) - (def: / ../) - (def: % ..%) + + (def: (* param input) + (normalize [(n/* (get@ #numerator param) + (get@ #numerator input)) + (n/* (get@ #denominator param) + (get@ #denominator input))])) + + (def: (/ param input) + (normalize [(n/* (get@ #denominator param) + (get@ #numerator input)) + (n/* (get@ #numerator param) + (get@ #denominator input))])) + + (def: (% param input) + (let [quot (n// (n/* (get@ #denominator input) + (get@ #numerator param)) + (n/* (get@ #denominator param) + (get@ #numerator input)))] + (..- (update@ #numerator (n/* quot) param) + input))) + (def: (negate (^slots [#numerator #denominator])) {#numerator denominator #denominator numerator}) + (def: abs function.identity) + (def: (signum x) {#numerator 1 - #denominator 1})) + #denominator 1}) + ) (def: separator Text ":") diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index bf1011080..6543576a2 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -119,10 +119,6 @@ ## [data ## [product (#+)] ## [sum (#+)] - ## [number (#+) ## TODO: FIX Specially troublesome... - ## [i64 (#+)] - ## [ratio (#+)] - ## [complex (#+)]] ## [text (#+) ## ## [format (#+)] ## [lexer (#+)] @@ -388,11 +384,11 @@ (..conversion <gen> <forward> <backward> <=>))] ["Int -> Nat" - i/= .nat .int (r;map (i/% +1,000,000) r.int)] + i/= .nat .int (r;map (i/% +1,000,000) r.int)] ["Nat -> Int" - n/= .int .nat (r;map (n/% 1,000,000) r.nat)] + n/= .int .nat (r;map (n/% 1,000,000) r.nat)] ["Int -> Frac" - i/= int-to-frac frac-to-int (r;map (i/% +1,000,000) r.int)] + i/= int-to-frac frac-to-int (r;map (i/% +1,000,000) r.int)] ["Frac -> Int" f/= frac-to-int int-to-frac (r;map math.floor r.frac)] ["Rev -> Frac" diff --git a/stdlib/source/test/lux/control/apply.lux b/stdlib/source/test/lux/control/apply.lux index 1cd756509..881e5d127 100644 --- a/stdlib/source/test/lux/control/apply.lux +++ b/stdlib/source/test/lux/control/apply.lux @@ -61,7 +61,7 @@ (injection decrease) (injection sample)))))) -(def: #export (laws injection comparison apply) +(def: #export (spec injection comparison apply) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (_.context (%name (name-of /.Apply)) ($_ _.and diff --git a/stdlib/source/test/lux/control/codec.lux b/stdlib/source/test/lux/control/codec.lux index 22c161616..e061f9e36 100644 --- a/stdlib/source/test/lux/control/codec.lux +++ b/stdlib/source/test/lux/control/codec.lux @@ -13,8 +13,8 @@ [// [equivalence (#+ Equivalence)]]]}) -(def: #export (test (^open "/@.") (^open "/@.") generator) - (All [m a] (-> (Codec m a) (Equivalence a) (Random a) Test)) +(def: #export (spec (^open "/@.") (^open "/@.") generator) + (All [m a] (-> (Equivalence a) (Codec m a) (Random a) Test)) (do r.monad [expected generator] (<| (_.context (%name (name-of /.Codec))) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index cb238cd88..b676c67ff 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -5,9 +5,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data [number ["." nat]] @@ -38,13 +38,13 @@ (^open "_;.") /.monad] elems (r.list 3 r.nat)] ($_ _.and + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Can run continuations to compute their values." (n/= sample (/.run (_;wrap sample)))) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) - (_.test "Can use the current-continuation as a escape hatch." (n/= (n/* 2 sample) (/.run (do /.monad diff --git a/stdlib/source/test/lux/control/enum.lux b/stdlib/source/test/lux/control/enum.lux new file mode 100644 index 000000000..030dee037 --- /dev/null +++ b/stdlib/source/test/lux/control/enum.lux @@ -0,0 +1,28 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + ["." function] + [control + [monad (#+ do)]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Enum)]}) + +(def: #export (spec (^open "_@.") gen-sample) + (All [a] (-> (Enum a) (Random a) Test)) + (do r.monad + [sample gen-sample] + (<| (_.context (%name (name-of /.Order))) + ($_ _.and + (_.test "Successor and predecessor are inverse functions." + (and (_@= (|> sample _@succ _@pred) + (function.identity sample)) + (_@= (|> sample _@pred _@succ) + (function.identity sample)) + (not (_@= (|> sample _@succ) + (function.identity sample))) + (not (_@= (|> sample _@pred) + (function.identity sample))))) + )))) diff --git a/stdlib/source/test/lux/control/equivalence.lux b/stdlib/source/test/lux/control/equivalence.lux index 4e7992d58..3e3b91a04 100644 --- a/stdlib/source/test/lux/control/equivalence.lux +++ b/stdlib/source/test/lux/control/equivalence.lux @@ -11,7 +11,7 @@ {1 ["." / (#+ Equivalence)]}) -(def: #export (test (^open "_;.") generator) +(def: #export (spec (^open "_@.") generator) (All [a] (-> (Equivalence a) (Random a) Test)) (do r.monad [left generator @@ -19,8 +19,8 @@ (<| (_.context (%name (name-of /.Equivalence))) ($_ _.and (_.test "Reflexivity." - (_;= left left)) + (_@= left left)) (_.test "Symmetry." - (if (_;= left right) - (_;= right left) - (not (_;= right left)))))))) + (if (_@= left right) + (_@= right left) + (not (_@= right left)))))))) diff --git a/stdlib/source/test/lux/control/functor.lux b/stdlib/source/test/lux/control/functor.lux index 08b706b03..a8fbfa6fc 100644 --- a/stdlib/source/test/lux/control/functor.lux +++ b/stdlib/source/test/lux/control/functor.lux @@ -50,7 +50,7 @@ (|> sample (_;map increase) (_;map decrease)) (|> sample (_;map (|>> increase decrease))))))) -(def: #export (laws injection comparison functor) +(def: #export (spec injection comparison functor) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (_.context (%name (name-of /.Functor)) ($_ _.and diff --git a/stdlib/source/test/lux/control/interval.lux b/stdlib/source/test/lux/control/interval.lux index dbac4cc8e..a32333ba1 100644 --- a/stdlib/source/test/lux/control/interval.lux +++ b/stdlib/source/test/lux/control/interval.lux @@ -15,12 +15,12 @@ [math ["r" random (#+ Random)]]] {1 - ["." / (#+ Interval) ("_;." equivalence)]} + ["." / (#+ Interval) ("_@." equivalence)]} {0 [test [lux [control - [".T" equivalence]]]]}) + ["$." equivalence]]]]}) (do-template [<name> <cmp>] [(def: #export <name> @@ -80,7 +80,7 @@ right-outer ..outer] ($_ _.and (_.test "The union of an interval to itself yields the same interval." - (_;= some-interval (/.union some-interval some-interval))) + (_@= some-interval (/.union some-interval some-interval))) (_.test "The union of 2 inner intervals is another inner interval." (/.inner? (/.union left-inner right-inner))) (_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do." @@ -101,7 +101,7 @@ right-outer ..outer] ($_ _.and (_.test "The intersection of an interval to itself yields the same interval." - (_;= some-interval (/.intersection some-interval some-interval))) + (_@= some-interval (/.intersection some-interval some-interval))) (_.test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't." (if (/.overlaps? left-inner right-inner) (/.inner? (/.intersection left-inner right-inner)) @@ -116,7 +116,7 @@ [some-interval ..interval] ($_ _.and (_.test "The complement of a complement is the same as the original." - (_;= some-interval (|> some-interval /.complement /.complement))) + (_@= some-interval (|> some-interval /.complement /.complement))) (_.test "The complement of an interval does not overlap it." (not (/.overlaps? some-interval (/.complement some-interval)))) ))) @@ -219,7 +219,7 @@ Test (<| (_.context (%name (name-of /.Interval))) ($_ _.and - (equivalenceT.test /.equivalence ..interval) + ($equivalence.spec /.equivalence ..interval) (<| (_.context "Boundaries.") ..boundaries) (<| (_.context "Union.") @@ -233,4 +233,17 @@ (<| (_.context "Touching intervals.") ..touch) (<| (_.context "Nesting & overlap.") - ..overlap)))) + ..overlap) + ))) + +(def: #export (spec (^open "_@.") gen-sample) + (All [a] (-> (Interval a) (Random a) Test)) + (<| (_.context (%name (name-of /.Interval))) + (do r.monad + [sample gen-sample] + ($_ _.and + (_.test "No value is bigger than the top." + (_@< _@top sample)) + (_.test "No value is smaller than the bottom." + (_@> _@bottom sample)) + )))) diff --git a/stdlib/source/test/lux/control/monad.lux b/stdlib/source/test/lux/control/monad.lux index 2edcd1705..4382a260d 100644 --- a/stdlib/source/test/lux/control/monad.lux +++ b/stdlib/source/test/lux/control/monad.lux @@ -48,7 +48,7 @@ (|> (injection sample) (_;map increase) _;join (_;map decrease) _;join) (|> (injection sample) (_;map (|>> increase (_;map decrease) _;join)) _;join))))) -(def: #export (laws injection comparison monad) +(def: #export (spec injection comparison monad) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (_.context (%name (name-of /.Monad)) ($_ _.and diff --git a/stdlib/source/test/lux/control/monoid.lux b/stdlib/source/test/lux/control/monoid.lux new file mode 100644 index 000000000..b12262900 --- /dev/null +++ b/stdlib/source/test/lux/control/monoid.lux @@ -0,0 +1,25 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + ["." function] + [control + [monad (#+ do)]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Monoid) + [// + [equivalence (#+ Equivalence)]]]}) + +(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) + (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test)) + (do r.monad + [sample gen-sample] + (<| (_.context (%name (name-of /.Monoid))) + ($_ _.and + (_.test "Left identity." + (/@= sample (/@compose /@identity sample))) + (_.test "Right identity." + (/@= sample (/@compose sample /@identity))) + )))) diff --git a/stdlib/source/test/lux/control/number.lux b/stdlib/source/test/lux/control/number.lux new file mode 100644 index 000000000..c1ffb0075 --- /dev/null +++ b/stdlib/source/test/lux/control/number.lux @@ -0,0 +1,47 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [control + [monad (#+ do)]] + [data + [text + format]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Number) + [// + [order (#+ Order)]]]}) + +(def: #export (spec (^open "_@.") (^open "_@.") gen-sample) + (All [a] (-> (Order a) (Number a) (Random a) Test)) + (do r.monad + [#let [non-zero (r.filter (function (_ sample) + (|> sample (_@+ sample) (_@= sample) not)) + gen-sample)] + parameter non-zero + subject non-zero] + (<| (_.context (%name (name-of /.Number))) + ($_ _.and + (_.test "Addition and subtraction are inverse functions." + (|> subject (_@+ parameter) (_@- parameter) (_@= subject))) + (_.test "Multiplication and division are inverse functions." + (|> subject (_@* parameter) (_@/ parameter) (_@= subject))) + (_.test "Modulus fills all the information division misses." + (let [modulus (_@% parameter subject) + multiple (_@- modulus subject) + times (_@/ modulus multiple)] + (|> parameter (_@* times) (_@+ modulus) (_@= subject)))) + (_.test "Negation flips the sign of a number and mimics subtraction." + (let [unsigned? (_@= (_@signum parameter) + (_@signum (_@negate parameter)))] + (or unsigned? + (_@= (_@+ (_@negate parameter) subject) + (_@- parameter subject))))) + (_.test "The absolute value is always positive." + (let [unsigned? (_@= (_@abs parameter) + (_@abs (_@negate parameter)))] + (if unsigned? + (_@= subject (_@abs subject)) + (_@>= subject (_@abs subject))))) + )))) diff --git a/stdlib/source/test/lux/control/order.lux b/stdlib/source/test/lux/control/order.lux new file mode 100644 index 000000000..b57489b0f --- /dev/null +++ b/stdlib/source/test/lux/control/order.lux @@ -0,0 +1,27 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [control + [monad (#+ do)]] + [data + [text + format]] + [math + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Order)]}) + +(def: #export (spec (^open "_@.") generator) + (All [a] (-> (Order a) (Random a) Test)) + (do r.monad + [left generator + right generator] + (<| (_.context (%name (name-of /.Order))) + ($_ _.and + (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." + (if (_@= left right) + (not (or (_@< left right) + (_@> left right))) + (if (_@< left right) + (not (_@> left right)) + (_@> left right)))))))) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 58c2a98d0..a5d8fb0c2 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -6,9 +6,9 @@ [equivalence (#+ Equivalence)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data ["." error (#+ Error)] [number @@ -225,6 +225,10 @@ [assertion (r.ascii 1)] (<| (_.context (%name (name-of /.Parser))) ($_ _.and + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Can make assertions while parsing." (and (|> (/.assert assertion #1) (/.run (list (code.bit #1) (code.int +123))) @@ -234,7 +238,4 @@ fails?))) ..combinators-0 ..combinators-1 - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) )))) diff --git a/stdlib/source/test/lux/control/reader.lux b/stdlib/source/test/lux/control/reader.lux index 4e57131f5..59763c0e8 100644 --- a/stdlib/source/test/lux/control/reader.lux +++ b/stdlib/source/test/lux/control/reader.lux @@ -6,9 +6,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data [text format]] @@ -34,16 +34,16 @@ [sample r.nat factor r.nat] ($_ _.and + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Can query the environment." (n/= sample (/.run sample /.ask))) (_.test "Can modify an environment locally." (n/= (n/* factor sample) (/.run sample (/.local (n/* factor) /.ask)))) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) - (let [(^open "io@.") io.monad] (_.test "Can add reader functionality to any monad." (|> (: (/.Reader Any (IO Nat)) diff --git a/stdlib/source/test/lux/control/security/integrity.lux b/stdlib/source/test/lux/control/security/integrity.lux index c57d9fde5..ad9b67f4f 100644 --- a/stdlib/source/test/lux/control/security/integrity.lux +++ b/stdlib/source/test/lux/control/security/integrity.lux @@ -6,9 +6,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data ["." error] ["." text ("#;." equivalence) @@ -35,6 +35,10 @@ [raw (r.ascii 10) #let [dirty (/.taint raw)]] ($_ _.and + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Can clean a dirty value by trusting it." (text;= raw (/.trust dirty))) (_.test "Can validate a dirty value." @@ -48,7 +52,4 @@ (#error.Failure error) false)) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) )))) diff --git a/stdlib/source/test/lux/control/security/privacy.lux b/stdlib/source/test/lux/control/security/privacy.lux index e624ace99..3bc41e6a9 100644 --- a/stdlib/source/test/lux/control/security/privacy.lux +++ b/stdlib/source/test/lux/control/security/privacy.lux @@ -8,9 +8,9 @@ ["!" capability]] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data ["." text ("#;." equivalence) format]] @@ -73,6 +73,10 @@ raw-password (r.ascii 10) #let [password (:: policy-0 password raw-password)]] ($_ _.and + ($functor.spec (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.functor) + ($apply.spec (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.apply) + ($monad.spec (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.monad) + (_.test "Can work with private values under the same label." (and (:: policy-0 = password password) (n/= (:: text.hash hash raw-password) @@ -81,7 +85,4 @@ delegate (/.delegation (:: policy-0 can-reveal) (:: policy-1 can-conceal))] (_.test "Can use delegation to share private values between policies." (:: policy-1 = (delegate password) (delegate password)))) - (functorT.laws (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.functor) - (applyT.laws (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.apply) - (monadT.laws (..injection (:: policy-0 can-conceal)) (..comparison (:: policy-0 can-reveal)) /.monad) )))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 75dd43212..8bae5e472 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -7,9 +7,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data ["." product] [text @@ -69,9 +69,9 @@ [state r.nat value r.nat] ($_ _.and - (functorT.laws ..injection (..comparison state) /.functor) - (applyT.laws ..injection (..comparison state) /.apply) - (monadT.laws ..injection (..comparison state) /.monad) + ($functor.spec ..injection (..comparison state) /.functor) + ($apply.spec ..injection (..comparison state) /.apply) + ($monad.spec ..injection (..comparison state) /.monad) ))) (def: loops diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index 61b7524cc..a6f28e428 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -5,9 +5,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data [text format]] @@ -32,13 +32,15 @@ factor r.nat] (<| (_.context (%name (name-of /.Thread))) ($_ _.and - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Can safely do mutation." (n/= (n/* factor original) (/.run (: (All [!] (Thread ! Nat)) (do /.monad [box (/.box original) old (/.update (n/* factor) box)] - (/.read box)))))))))) + (/.read box)))))) + )))) diff --git a/stdlib/source/test/lux/control/writer.lux b/stdlib/source/test/lux/control/writer.lux index 49610dafe..dfd3b4a10 100644 --- a/stdlib/source/test/lux/control/writer.lux +++ b/stdlib/source/test/lux/control/writer.lux @@ -8,9 +8,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data ["." product] ["." text ("#;." equivalence) @@ -37,14 +37,13 @@ right r.nat] (<| (_.context (%name (name-of /.Writer))) ($_ _.and + ($functor.spec (..injection text.monoid) ..comparison /.functor) + ($apply.spec (..injection text.monoid) ..comparison (/.apply text.monoid)) + ($monad.spec (..injection text.monoid) ..comparison (/.monad text.monoid)) + (_.test "Can write any value." (text;= log (product.left (/.write log)))) - - (functorT.laws (..injection text.monoid) ..comparison /.functor) - (applyT.laws (..injection text.monoid) ..comparison (/.apply text.monoid)) - (monadT.laws (..injection text.monoid) ..comparison (/.monad text.monoid)) - (let [lift (/.lift text.monoid io.monad) (^open "io;.") io.monad] (_.test "Can add writer functionality to any monad." diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index ec1cdf702..2f733d1d2 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -9,8 +9,28 @@ ["#." lazy] ["#." maybe] ["#." name] + [number + ["#." i64] + ["#." nat] + ["#." int] + ["#." rev] + ["#." frac] + ["#." ratio] + ["#." complex]] ]) +(def: #export number + Test + ($_ _.and + /i64.test + /nat.test + /int.test + /rev.test + /frac.test + /ratio.test + /complex.test + )) + (def: #export test Test ($_ _.and @@ -21,4 +41,5 @@ /lazy.test /maybe.test /name.test + ..number )) diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index 48643c29b..2ae784312 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -6,8 +6,9 @@ [monad (#+ do)] {[0 #test] [/ - ["." equivalence] - ["." codec]]}] + ["$." equivalence] + ["$." monoid] + ["$." codec]]}] data/text/format [math ["r" random]]] @@ -20,6 +21,12 @@ (do r.monad [value r.bit] ($_ _.and + ($equivalence.spec /.equivalence r.bit) + ($codec.spec /.equivalence /.codec r.bit) + (<| (_.context "Disjunction.") + ($monoid.spec /.equivalence /.disjunction r.bit)) + (<| (_.context "Conjunction.") + ($monoid.spec /.equivalence /.conjunction r.bit)) (_.test "A value cannot be true and false at the same time." (not (and value (not value)))) (_.test "A value must be either true or false at any time." @@ -27,12 +34,4 @@ (_.test "Can create the complement of a predicate." (and (not (:: /.equivalence = value ((/.complement function.identity) value))) (:: /.equivalence = value ((/.complement not) value)))) - (equivalence.test /.equivalence r.bit) - (codec.test /.codec /.equivalence r.bit) - (_.test "Or/disjunction monoid." - (and (not (:: /.or-monoid identity)) - (:: /.or-monoid compose value (not value)))) - (_.test "And/conjunction monoid." - (and (:: /.and-monoid identity) - (not (:: /.and-monoid compose value (not value))))) )))) diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux index af16ef76e..f5ac95d90 100644 --- a/stdlib/source/test/lux/data/color.lux +++ b/stdlib/source/test/lux/data/color.lux @@ -5,7 +5,7 @@ [monad (#+ do)] {[0 #test] [/ - ["." equivalence]]}] + ["$." equivalence]]}] [data text/format [number @@ -65,7 +65,7 @@ (f/<= +0.75 saturation))))))) ratio (|> r.frac (r.filter (f/>= +0.5)))] ($_ _.and - (equivalence.test /.equivalence ..color) + ($equivalence.spec /.equivalence ..color) (_.test "Can convert to/from HSL." (|> any /.to-hsl /.from-hsl (distance any) diff --git a/stdlib/source/test/lux/data/error.lux b/stdlib/source/test/lux/data/error.lux index 1dbe1969e..58d37aef7 100644 --- a/stdlib/source/test/lux/data/error.lux +++ b/stdlib/source/test/lux/data/error.lux @@ -7,10 +7,10 @@ [monad (#+ do Monad)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad] - [".T" equivalence]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad] + ["$." equivalence]]}] [data text/format [number @@ -39,10 +39,10 @@ Test (<| (_.context (%name (name-of /.Error))) ($_ _.and - (equivalenceT.test (/.equivalence nat.equivalence) (..error r.nat)) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) + ($equivalence.spec (/.equivalence nat.equivalence) (..error r.nat)) + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) (do r.monad [left r.nat right r.nat diff --git a/stdlib/source/test/lux/data/identity.lux b/stdlib/source/test/lux/data/identity.lux index aced82f84..ef4450c50 100644 --- a/stdlib/source/test/lux/data/identity.lux +++ b/stdlib/source/test/lux/data/identity.lux @@ -6,10 +6,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad] - [".T" equivalence]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [data ["." text ("#@." monoid equivalence) format]]] @@ -29,9 +28,10 @@ Test (<| (_.context (%name (name-of /.Identity))) ($_ _.and - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (let [(^open "/@.") /.comonad] (_.test "CoMonad does not affect values." (and (text@= "yololol" (/@unwrap "yololol")) diff --git a/stdlib/source/test/lux/data/lazy.lux b/stdlib/source/test/lux/data/lazy.lux index 957ce0c34..44c0ff2da 100644 --- a/stdlib/source/test/lux/data/lazy.lux +++ b/stdlib/source/test/lux/data/lazy.lux @@ -5,10 +5,10 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad] - [".T" equivalence]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad] + ["$." equivalence]]}] [data text/format [number @@ -40,6 +40,11 @@ #let [lazy (/.freeze (n/* left right)) expected (n/* left right)]] ($_ _.and + ($equivalence.spec (/.equivalence nat.equivalence) (..lazy r.nat)) + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Freezing does not alter the expected value." (n/= expected (/.thaw lazy))) @@ -48,8 +53,4 @@ (/.thaw lazy))) (is? (/.thaw lazy) (/.thaw lazy)))) - (equivalenceT.test (/.equivalence nat.equivalence) (..lazy r.nat)) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) )))) diff --git a/stdlib/source/test/lux/data/maybe.lux b/stdlib/source/test/lux/data/maybe.lux index e2c0ce3fa..9b3a77ff9 100644 --- a/stdlib/source/test/lux/data/maybe.lux +++ b/stdlib/source/test/lux/data/maybe.lux @@ -6,10 +6,10 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad] - [".T" equivalence]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad] + ["$." equivalence]]}] [data ["." text format] @@ -38,10 +38,11 @@ Test (<| (_.context (%name (name-of .Maybe))) ($_ _.and - (equivalenceT.test (/.equivalence nat.equivalence) (..maybe r.nat)) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad) + ($equivalence.spec (/.equivalence nat.equivalence) (..maybe r.nat)) + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (do r.monad [left r.nat right r.nat diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 6582e68ff..a42684938 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -6,8 +6,8 @@ [monad (#+ do)] {[0 #test] [/ - [".T" equivalence] - [".T" codec]]}] + ["$." equivalence] + ["$." codec]]}] [data ["." text ("#@." equivalence) format]] @@ -38,8 +38,9 @@ sizeS2 (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) (^@ name2 [module2 short2]) (..name sizeM2 sizeS2)] ($_ _.and - (equivalenceT.test /.equivalence (..name sizeM1 sizeS1)) - (codecT.test /.codec /.equivalence (..name sizeM1 sizeS1)) + ($equivalence.spec /.equivalence (..name sizeM1 sizeS1)) + ($codec.spec /.equivalence /.codec (..name sizeM1 sizeS1)) + (_.test "Can get the module / short parts of an name." (and (is? module1 (/.module name1)) (is? short1 (/.short name1)))) diff --git a/stdlib/source/test/lux/data/number.lux b/stdlib/source/test/lux/data/number.lux deleted file mode 100644 index 7b57ffc63..000000000 --- a/stdlib/source/test/lux/data/number.lux +++ /dev/null @@ -1,185 +0,0 @@ -(.module: - [lux #* - [control - ["M" monad (#+ Monad do)] - pipe] - [data - number - ["." text ("#;." equivalence) - format]] - [math - ["r" random]]] - lux/test) - -(do-template [category rand-gen <Equivalence> <Order>] - [(context: (format "[" category "] " "Equivalence & Order") - (<| (times 100) - (do @ - [x rand-gen - y rand-gen] - (test "" (and (:: <Equivalence> = x x) - (or (:: <Equivalence> = x y) - (:: <Order> < y x) - (:: <Order> > y x)))))))] - - ["Nat" r.nat equivalence order] - ["Int" r.int equivalence order] - ["Rev" r.rev equivalence order] - ["Frac" r.frac equivalence order] - ) - -(do-template [category rand-gen <Number> <Order>] - [(context: (format "[" category "] " "Number") - (<| (times 100) - (do @ - [x rand-gen - #let [(^open ".") <Number> - (^open ".") <Order>]] - (test "" (and (>= x (abs x)) - ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0 - (or (text;= "Frac" category) - (not (= x (negate x)))) - (= x (negate (negate x))) - ## There is loss of precision when multiplying - (or (text;= "Rev" category) - (= x (* (signum x) - (abs x)))))))))] - - ["Nat" r.nat number order] - ["Int" r.int number order] - ["Rev" r.rev number order] - ["Frac" r.frac number order] - ) - -(do-template [category rand-gen <Enum> <Number> <Order>] - [(context: (format "[" category "] " "Enum") - (<| (times 100) - (do @ - [x rand-gen] - (test "" (let [(^open ".") <Number> - (^open ".") <Order>] - (and (> x - (:: <Enum> succ x)) - (< x - (:: <Enum> pred x)) - - (= x - (|> x (:: <Enum> pred) (:: <Enum> succ))) - (= x - (|> x (:: <Enum> succ) (:: <Enum> pred))) - ))))))] - - ["Nat" r.nat enum number order] - ["Int" r.int enum number order] - ) - -(do-template [category rand-gen <Number> <Order> <Interval> <test>] - [(context: (format "[" category "] " "Interval") - (<| (times 100) - (do @ - [x (|> rand-gen (r.filter <test>)) - #let [(^open ".") <Number> - (^open ".") <Order>]] - (test "" (and (<= x (:: <Interval> bottom)) - (>= x (:: <Interval> top)))))))] - - ["Nat" r.nat number order interval (function (_ _) #1)] - ["Int" r.int number order interval (function (_ _) #1)] - ## Both min and max values will be positive (thus, greater than zero) - ["Rev" r.rev number order interval (function (_ _) #1)] - ["Frac" r.frac number order interval (f/> +0.0)] - ) - -(do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>] - [(context: (format "[" category "] " "Monoid") - (<| (times 100) - (do @ - [x (|> rand-gen (:: @ map (|>> (:: <Number> abs) <cap>)) (r.filter <test>)) - #let [(^open ".") <Number> - (^open ".") <Order> - (^open ".") <Monoid>]] - (test "Composing with identity doesn't change the value." - (and (= x (compose identity x)) - (= x (compose x identity)) - (= identity (compose identity identity)))))))] - - ["Nat/Add" r.nat number order add@monoid (n/% 1000) (function (_ _) #1)] - ["Nat/Mul" r.nat number order mul@monoid (n/% 1000) (function (_ _) #1)] - ["Nat/Min" r.nat number order min@monoid (n/% 1000) (function (_ _) #1)] - ["Nat/Max" r.nat number order max@monoid (n/% 1000) (function (_ _) #1)] - ["Int/Add" r.int number order add@monoid (i/% +1000) (function (_ _) #1)] - ["Int/Mul" r.int number order mul@monoid (i/% +1000) (function (_ _) #1)] - ["Int/Min" r.int number order min@monoid (i/% +1000) (function (_ _) #1)] - ["Int/Max" r.int number order max@monoid (i/% +1000) (function (_ _) #1)] - ["Rev/Add" r.rev number order add@monoid (r/% .125) (function (_ _) #1)] - ["Rev/Mul" r.rev number order mul@monoid (r/% .125) (function (_ _) #1)] - ["Rev/Min" r.rev number order min@monoid (r/% .125) (function (_ _) #1)] - ["Rev/Max" r.rev number order max@monoid (r/% .125) (function (_ _) #1)] - ["Frac/Add" r.frac number order add@monoid (f/% +1000.0) (f/> +0.0)] - ["Frac/Mul" r.frac number order mul@monoid (f/% +1000.0) (f/> +0.0)] - ["Frac/Min" r.frac number order min@monoid (f/% +1000.0) (f/> +0.0)] - ["Frac/Max" r.frac number order max@monoid (f/% +1000.0) (f/> +0.0)] - ) - -(do-template [<category> <rand-gen> <Equivalence> <Codec>] - [(context: (format "[" <category> "] " "Alternative formats") - (<| (times 100) - (do @ - [x <rand-gen>] - (test "Can encode/decode values." - (|> x - (:: <Codec> encode) - (:: <Codec> decode) - (case> (#.Right x') - (:: <Equivalence> = x x') - - (#.Left _) - #0))))))] - - ["Nat/Binary" r.nat equivalence binary@codec] - ["Nat/Octal" r.nat equivalence octal@codec] - ["Nat/Decimal" r.nat equivalence codec] - ["Nat/Hex" r.nat equivalence hex@codec] - - ["Int/Binary" r.int equivalence binary@codec] - ["Int/Octal" r.int equivalence octal@codec] - ["Int/Decimal" r.int equivalence codec] - ["Int/Hex" r.int equivalence hex@codec] - - ["Rev/Binary" r.rev equivalence binary@codec] - ["Rev/Octal" r.rev equivalence octal@codec] - ["Rev/Decimal" r.rev equivalence codec] - ["Rev/Hex" r.rev equivalence hex@codec] - - ["Frac/Binary" r.frac equivalence binary@codec] - ["Frac/Octal" r.frac equivalence octal@codec] - ["Frac/Decimal" r.frac equivalence codec] - ["Frac/Hex" r.frac equivalence hex@codec] - ) - -(context: "Can convert frac values to/from their bit patterns." - (<| (times 100) - (do @ - [raw r.frac - factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) - #let [sample (|> factor .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)))))) - -(context: "Macros for alternative numeric encodings." - ($_ seq - (test "Binary." - (and (n/= (bin "11001001") (bin "11_00_10_01")) - (i/= (bin "+11001001") (bin "+11_00_10_01")) - (r/= (bin ".11001001") (bin ".11_00_10_01")) - (f/= (bin "+1100.1001") (bin "+11_00.10_01")))) - (test "Octal." - (and (n/= (oct "615243") (oct "615_243")) - (i/= (oct "+615243") (oct "+615_243")) - (r/= (oct ".615243") (oct ".615_243")) - (f/= (oct "+6152.43") (oct "+615_2.43")))) - (test "Hexadecimal." - (and (n/= (hex "deadBEEF") (hex "dead_BEEF")) - (i/= (hex "+deadBEEF") (hex "+dead_BEEF")) - (r/= (hex ".deadBEEF") (hex ".dead_BEEF")) - (f/= (hex "+deadBE.EF") (hex "+dead_BE.EF")))))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 106edf33d..278e8ec58 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -1,202 +1,221 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control - [monad (#+ do Monad)] - pipe] + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." order] + ["$." number] + ["$." codec]]}] [data - ["." number - ["." frac ("#;." number)] - ["&" complex]] + [number + ["." frac ("#@." number)]] [collection - ["." list ("#;." functor)]]] + ["." list ("#@." functor)]]] ["." math - ["r" random]]] - lux/test) + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Complex)]}) (def: margin-of-error Frac +1.0e-9) (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)))] + (-> 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)))) -(def: gen-dim - (r.Random Frac) +(def: dimension + (Random Frac) (do r.monad [factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) measure (|> r.frac (r.filter (f/> +0.0)))] (wrap (f/* (|> factor .int int-to-frac) measure)))) -(def: gen-complex - (r.Random &.Complex) +(def: #export complex + (Random Complex) (do r.monad - [real gen-dim - imaginary gen-dim] - (wrap (&.complex real imaginary)))) - -(context: "Construction" - (<| (times 100) - (do @ - [real gen-dim - imaginary gen-dim] - ($_ seq - (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))))) - - (test "If either the real part or the imaginary part is NaN, the composite is NaN." - (and (&.not-a-number? (&.complex number.not-a-number imaginary)) - (&.not-a-number? (&.complex real number.not-a-number)))) - )))) - -(context: "Absolute value" - (<| (times 100) - (do @ - [real gen-dim - imaginary gen-dim] - ($_ seq - (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)))) - - (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 (&.abs (&.complex number.not-a-number imaginary)))) - (number.not-a-number? (get@ #&.real (&.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 (&.abs (&.complex number.positive-infinity imaginary)))) - (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.positive-infinity)))) - (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex number.negative-infinity imaginary)))) - (f/= number.positive-infinity (get@ #&.real (&.abs (&.complex real number.negative-infinity)))))) - )))) - -(context: "Addidion, substraction, multiplication and division" - (<| (times 100) - (do @ - [x gen-complex - y gen-complex - factor gen-dim] - ($_ seq - (test "Adding 2 complex numbers is the same as adding their parts." - (let [z (&.+ y x)] - (and (&.= 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 (&.- y x)] - (and (&.= 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 (&.+ y) (&.- y) (within? margin-of-error x)) - (|> x (&.- y) (&.+ y) (within? margin-of-error x)))) - - (test "Division is the inverse of multiplication." - (|> x (&.* y) (&./ y) (within? margin-of-error x))) - - (test "Scalar division is the inverse of scalar multiplication." - (|> x (&.*' factor) (&./' factor) (within? margin-of-error x))) - - (test "If you subtract the remainder, all divisions must be exact." - (let [rem (&.% y x) - quotient (|> x (&.- rem) (&./ y)) - floored (|> quotient - (update@ #&.real math.floor) - (update@ #&.imaginary math.floor))] - (within? +0.000000000001 - x - (|> quotient (&.* y) (&.+ rem))))) - )))) - -(context: "Conjugate, reciprocal, signum, negation" - (<| (times 100) - (do @ - [x gen-complex] - ($_ seq - (test "Conjugate has same real part as original, and opposite of imaginary part." - (let [cx (&.conjugate x)] - (and (f/= (get@ #&.real x) - (get@ #&.real cx)) - (f/= (frac;negate (get@ #&.imaginary x)) - (get@ #&.imaginary cx))))) - - (test "The reciprocal functions is its own inverse." - (|> x &.reciprocal &.reciprocal (within? margin-of-error x))) - - (test "x*(x^-1) = 1" - (|> 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)))) - - (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)) - (get@ #&.real (&.abs (&.negate x))))) - )))) + [real ..dimension + imaginary ..dimension] + (wrap (/.complex real imaginary)))) + +(def: construction + Test + (do r.monad + [real ..dimension + imaginary ..dimension] + ($_ _.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))))) + + (_.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)))) + ))) + +(def: absolute-value + Test + (do r.monad + [real ..dimension + imaginary ..dimension] + ($_ _.and + (_.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)))) + + (_.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)))))) + + (_.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)))))) + ))) + +(def: number + Test + (do r.monad + [x ..complex + y ..complex + factor ..dimension] + ($_ _.and + (_.test "Adding 2 complex numbers is the same as adding their parts." + (let [z (/.+ y x)] + (and (/.= 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 (/.- y x)] + (and (/.= 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 (/.+ y) (/.- y) (within? margin-of-error x)) + (|> x (/.- y) (/.+ y) (within? margin-of-error x)))) + + (_.test "Division is the inverse of multiplication." + (|> x (/.* y) (/./ y) (within? margin-of-error x))) + + (_.test "Scalar division is the inverse of scalar multiplication." + (|> x (/.*' factor) (/./' factor) (within? margin-of-error x))) + + (_.test "If you subtract the remainder, all divisions must be exact." + (let [rem (/.% y x) + quotient (|> x (/.- rem) (/./ y)) + floored (|> quotient + (update@ #/.real math.floor) + (update@ #/.imaginary math.floor))] + (within? +0.000000000001 + x + (|> quotient (/.* y) (/.+ rem))))) + ))) + +(def: conjugate&reciprocal&signum&negation + Test + (do r.monad + [x ..complex] + ($_ _.and + (_.test "Conjugate has same real part as original, and opposite of imaginary part." + (let [cx (/.conjugate x)] + (and (f/= (get@ #/.real x) + (get@ #/.real cx)) + (f/= (frac@negate (get@ #/.imaginary x)) + (get@ #/.imaginary cx))))) + + (_.test "The reciprocal functions is its own inverse." + (|> x /.reciprocal /.reciprocal (within? margin-of-error x))) + + (_.test "x*(x^-1) = 1" + (|> 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)))) + + (_.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)) + (get@ #/.real (/.abs (/.negate x))))) + ))) (def: (trigonometric-symmetry forward backward angle) - (-> (-> &.Complex &.Complex) (-> &.Complex &.Complex) &.Complex Bit) + (-> (-> Complex Complex) (-> Complex Complex) Complex Bit) (let [normal (|> angle forward backward)] (|> normal forward backward (within? margin-of-error normal)))) -(context: "Trigonometry" - (<| (seed 17274883666004960943) - ## (times 100) - (do @ - [angle (|> gen-complex (:: @ map (|>> (update@ #&.real (f/% +1.0)) - (update@ #&.imaginary (f/% +1.0)))))] - ($_ seq - (test "Arc-sine is the inverse of sine." - (trigonometric-symmetry &.sin &.asin angle)) - - (test "Arc-cosine is the inverse of cosine." - (trigonometric-symmetry &.cos &.acos angle)) - - (test "Arc-tangent is the inverse of tangent." - (trigonometric-symmetry &.tan &.atan angle)))))) - -(context: "Power 2 and exponential/logarithm" - (<| (times 100) - (do @ - [x gen-complex] - ($_ seq - (test "Root 2 is inverse of power 2." - (|> x (&.pow' +2.0) (&.pow' +0.5) (within? margin-of-error x))) - - (test "Logarithm is inverse of exponentiation." - (|> x &.log &.exp (within? margin-of-error x))) - )))) - -(context: "Complex roots" - (<| (times 100) - (do @ - [sample gen-complex - degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))] - (test "Can calculate the N roots for any complex number." - (|> sample - (&.roots degree) - (list;map (&.pow' (|> degree .int int-to-frac))) - (list.every? (within? margin-of-error sample))))))) +(def: trigonometry + Test + (<| (_.seed 17274883666004960943) + (do r.monad + [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)) + + (_.test "Arc-cosine is the inverse of cosine." + (trigonometric-symmetry /.cos /.acos angle)) + + (_.test "Arc-tangent is the inverse of tangent." + (trigonometric-symmetry /.tan /.atan angle)))))) + +(def: exponentiation&logarithm + Test + (do r.monad + [x ..complex] + ($_ _.and + (_.test "Root 2 is inverse of power 2." + (|> x (/.pow' +2.0) (/.pow' +0.5) (within? margin-of-error x))) + + (_.test "Logarithm is inverse of exponentiation." + (|> x /.log /.exp (within? margin-of-error x))) + ))) + +(def: root + Test + (do r.monad + [sample ..complex + degree (|> r.nat (:: @ map (|>> (n/max 1) (n/% 5))))] + (_.test "Can calculate the N roots for any complex number." + (|> sample + (/.roots degree) + (list@map (/.pow' (|> degree .int int-to-frac))) + (list.every? (within? margin-of-error sample)))))) + +(def: #export test + Test + ($_ _.and + ..construction + ..absolute-value + ..number + ..conjugate&reciprocal&signum&negation + ..trigonometry + ..exponentiation&logarithm + ..root + )) diff --git a/stdlib/source/test/lux/data/number/frac.lux b/stdlib/source/test/lux/data/number/frac.lux new file mode 100644 index 000000000..319debddd --- /dev/null +++ b/stdlib/source/test/lux/data/number/frac.lux @@ -0,0 +1,60 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [control + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." order] + ["$." number] + ["$." enum] + ["$." interval] + ["$." monoid] + ["$." codec]]}] + [math + ["r" random]]] + {1 + ["." / + //]}) + +(def: #export test + Test + (<| (_.context (%name (name-of .Frac))) + ($_ _.and + ($equivalence.spec /.equivalence r.frac) + ($order.spec /.order r.frac) + ($number.spec /.order /.number r.frac) + ($enum.spec /.enum r.frac) + ($interval.spec /.interval r.frac) + (<| (_.context "Addition.") + ($monoid.spec /.equivalence /.addition r.frac)) + (<| (_.context "Multiplication.") + ($monoid.spec /.equivalence /.multiplication r.frac)) + (<| (_.context "Minimum.") + ($monoid.spec /.equivalence /.minimum r.frac)) + (<| (_.context "Maximum.") + ($monoid.spec /.equivalence /.multiplication r.frac)) + ## TODO: Uncomment ASAP + ## (<| (_.context "Binary.") + ## ($codec.spec /.equivalence /.binary r.frac)) + ## (<| (_.context "Octal.") + ## ($codec.spec /.equivalence /.octal r.frac)) + ## (<| (_.context "Decimal.") + ## ($codec.spec /.equivalence /.decimal r.frac)) + ## (<| (_.context "Hexadecimal.") + ## ($codec.spec /.equivalence /.hex r.frac)) + + (_.test "Alternate notations." + (and (f/= (bin "+1100.1001") + (bin "+11,00.10,01")) + (f/= (oct "-6152.43") + (oct "-615,2.43")) + (f/= (hex "+deadBE.EF") + (hex "+dead,BE.EF")))) + (do r.monad + [sample r.frac] + (_.test "Can convert frac values to/from their bit patterns." + (|> sample /.frac-to-bits /.bits-to-frac (f/= sample)))) + ))) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 62de5e56e..1eb207e19 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -1,75 +1,83 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control - ["M" monad (#+ do Monad)]] - [data - [number #* - ["&" i64]]] + [monad (#+ do)] + {[0 #test] + [/ + ["$." monoid]]}] [math ["r" random]]] - lux/test) + {1 + ["." / + ["." // #_ + ["#." nat]]]}) -(context: "Bitwise operations." - (<| (times 100) - (do @ - [pattern r.nat - idx (:: @ map (n/% &.width) r.nat)] - ($_ seq - (test "Clearing and settings bits should alter the count." - (and (n/= (dec (&.count (&.set idx pattern))) - (&.count (&.clear idx pattern))) - (|> (&.count pattern) - (n/- (&.count (&.clear idx pattern))) - (n/<= 1)) - (|> (&.count (&.set idx pattern)) - (n/- (&.count pattern)) - (n/<= 1)))) - (test "Can query whether a bit is set." - (and (or (and (&.set? idx pattern) - (not (&.set? idx (&.clear idx pattern)))) - (and (not (&.set? idx pattern)) - (&.set? idx (&.set idx pattern)))) +(def: #export test + Test + (do r.monad + [pattern r.nat + idx (:: @ map (n/% /.width) r.nat)] + ($_ _.and + ($monoid.spec //nat.equivalence /.disjunction r.nat) + ($monoid.spec //nat.equivalence /.conjunction r.nat) + + (_.test "Clearing and settings bits should alter the count." + (and (n/= (dec (/.count (/.set idx pattern))) + (/.count (/.clear idx pattern))) + (|> (/.count pattern) + (n/- (/.count (/.clear idx pattern))) + (n/<= 1)) + (|> (/.count (/.set idx pattern)) + (n/- (/.count pattern)) + (n/<= 1)))) + (_.test "Can query whether a bit is set." + (and (or (and (/.set? idx pattern) + (not (/.set? idx (/.clear idx pattern)))) + (and (not (/.set? idx pattern)) + (/.set? idx (/.set idx pattern)))) - (or (and (&.set? idx pattern) - (not (&.set? idx (&.flip idx pattern)))) - (and (not (&.set? idx pattern)) - (&.set? idx (&.flip idx pattern)))))) - (test "The negation of a bit pattern should have a complementary bit-count." - (n/= &.width - (n/+ (&.count pattern) - (&.count (&.not pattern))))) - (test "Can do simple binary logic." - (and (n/= 0 - (&.and pattern - (&.not pattern))) - (n/= (&.not 0) - (&.or pattern - (&.not pattern))) - (n/= (&.not 0) - (&.xor pattern - (&.not pattern))) - (n/= 0 - (&.xor pattern - pattern)))) - (test "rotate-left and rotate-right are inverses of one another." - (and (|> pattern - (&.rotate-left idx) - (&.rotate-right idx) - (n/= pattern)) - (|> pattern - (&.rotate-right idx) - (&.rotate-left idx) - (n/= pattern)))) - (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." - (and (|> pattern - (&.rotate-left &.width) - (n/= pattern)) - (|> pattern - (&.rotate-right &.width) - (n/= pattern)))) - (test "Shift right respect the sign of ints." - (let [value (.int pattern)] - (if (i/< +0 value) - (i/< +0 (&.arithmetic-right-shift idx value)) - (i/>= +0 (&.arithmetic-right-shift idx value))))) - )))) + (or (and (/.set? idx pattern) + (not (/.set? idx (/.flip idx pattern)))) + (and (not (/.set? idx pattern)) + (/.set? idx (/.flip idx pattern)))))) + (_.test "The negation of a bit pattern should have a complementary bit-count." + (n/= /.width + (n/+ (/.count pattern) + (/.count (/.not pattern))))) + (_.test "Can do simple binary logic." + (and (n/= 0 + (/.and pattern + (/.not pattern))) + (n/= (/.not 0) + (/.or pattern + (/.not pattern))) + (n/= (/.not 0) + (/.xor pattern + (/.not pattern))) + (n/= 0 + (/.xor pattern + pattern)))) + (_.test "rotate-left and rotate-right are inverses of one another." + (and (|> pattern + (/.rotate-left idx) + (/.rotate-right idx) + (n/= pattern)) + (|> pattern + (/.rotate-right idx) + (/.rotate-left idx) + (n/= pattern)))) + (_.test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged." + (and (|> pattern + (/.rotate-left /.width) + (n/= pattern)) + (|> pattern + (/.rotate-right /.width) + (n/= pattern)))) + (_.test "Shift right respect the sign of ints." + (let [value (.int pattern)] + (if (i/< +0 value) + (i/< +0 (/.arithmetic-right-shift idx value)) + (i/>= +0 (/.arithmetic-right-shift idx value))))) + ))) diff --git a/stdlib/source/test/lux/data/number/int.lux b/stdlib/source/test/lux/data/number/int.lux new file mode 100644 index 000000000..e83571653 --- /dev/null +++ b/stdlib/source/test/lux/data/number/int.lux @@ -0,0 +1,55 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [control + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." order] + ["$." number] + ["$." enum] + ["$." interval] + ["$." monoid] + ["$." codec]]}] + [math + ["r" random]]] + {1 + ["." / + //]}) + +(def: #export test + Test + (<| (_.context (%name (name-of .Int))) + ($_ _.and + ($equivalence.spec /.equivalence r.int) + ($order.spec /.order r.int) + ($number.spec /.order /.number r.int) + ($enum.spec /.enum r.int) + ($interval.spec /.interval r.int) + (<| (_.context "Addition.") + ($monoid.spec /.equivalence /.addition r.int)) + (<| (_.context "Multiplication.") + ($monoid.spec /.equivalence /.multiplication r.int)) + (<| (_.context "Minimum.") + ($monoid.spec /.equivalence /.minimum r.int)) + (<| (_.context "Maximum.") + ($monoid.spec /.equivalence /.multiplication r.int)) + (<| (_.context "Binary.") + ($codec.spec /.equivalence /.binary r.int)) + (<| (_.context "Octal.") + ($codec.spec /.equivalence /.octal r.int)) + (<| (_.context "Decimal.") + ($codec.spec /.equivalence /.decimal r.int)) + (<| (_.context "Hexadecimal.") + ($codec.spec /.equivalence /.hex r.int)) + + (_.test "Alternate notations." + (and (i/= (bin "+11001001") + (bin "+11,00,10,01")) + (i/= (oct "-615243") + (oct "-615,243")) + (i/= (hex "+deadBEEF") + (hex "+dead,BEEF")))) + ))) diff --git a/stdlib/source/test/lux/data/number/nat.lux b/stdlib/source/test/lux/data/number/nat.lux new file mode 100644 index 000000000..e570de094 --- /dev/null +++ b/stdlib/source/test/lux/data/number/nat.lux @@ -0,0 +1,55 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [control + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." order] + ["$." number] + ["$." enum] + ["$." interval] + ["$." monoid] + ["$." codec]]}] + [math + ["r" random]]] + {1 + ["." / + //]}) + +(def: #export test + Test + (<| (_.context (%name (name-of .Nat))) + ($_ _.and + ($equivalence.spec /.equivalence r.nat) + ($order.spec /.order r.nat) + ($number.spec /.order /.number r.nat) + ($enum.spec /.enum r.nat) + ($interval.spec /.interval r.nat) + (<| (_.context "Addition.") + ($monoid.spec /.equivalence /.addition r.nat)) + (<| (_.context "Multiplication.") + ($monoid.spec /.equivalence /.multiplication r.nat)) + (<| (_.context "Minimum.") + ($monoid.spec /.equivalence /.minimum r.nat)) + (<| (_.context "Maximum.") + ($monoid.spec /.equivalence /.multiplication r.nat)) + (<| (_.context "Binary.") + ($codec.spec /.equivalence /.binary r.nat)) + (<| (_.context "Octal.") + ($codec.spec /.equivalence /.octal r.nat)) + (<| (_.context "Decimal.") + ($codec.spec /.equivalence /.decimal r.nat)) + (<| (_.context "Hexadecimal.") + ($codec.spec /.equivalence /.hex r.nat)) + + (_.test "Alternate notations." + (and (n/= (bin "11001001") + (bin "11,00,10,01")) + (n/= (oct "615243") + (oct "615,243")) + (n/= (hex "deadBEEF") + (hex "dead,BEEF")))) + ))) diff --git a/stdlib/source/test/lux/data/number/ratio.lux b/stdlib/source/test/lux/data/number/ratio.lux index a68e5abca..654c489c3 100644 --- a/stdlib/source/test/lux/data/number/ratio.lux +++ b/stdlib/source/test/lux/data/number/ratio.lux @@ -1,116 +1,46 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control - [monad (#+ do Monad)] - pipe] - [data - [number - ["&" ratio ("&;." number)]]] + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." order] + ["$." number] + ["$." codec]]}] [math - ["r" random]]] - lux/test) + ["r" random (#+ Random)]]] + {1 + ["." / (#+ Ratio)]}) -(def: gen-part - (r.Random Nat) +(def: part + (Random Nat) (|> r.nat (:: r.monad map (|>> (n/% 1000) (n/max 1))))) -(def: gen-ratio - (r.Random &.Ratio) +(def: #export ratio + (Random Ratio) (do r.monad - [numerator gen-part - denominator (|> gen-part + [numerator ..part + denominator (|> ..part (r.filter (|>> (n/= 0) not)) (r.filter (|>> (n/= numerator) not)))] - (wrap (&.ratio numerator denominator)))) + (wrap (/.ratio numerator denominator)))) -(context: "Normalization" - (<| (times 100) - (do @ - [denom1 gen-part - denom2 gen-part - sample gen-ratio] - ($_ seq - (test "All zeroes are the same." - (&.= (&.ratio 0 denom1) - (&.ratio 0 denom2))) - - (test "All ratios are built normalized." - (|> sample - &.normalize - ("lux in-module" "lux/data/number/ratio") - (&.= sample))) - )))) - -(context: "Arithmetic" - (<| (times 100) - (do @ - [x gen-ratio - y gen-ratio - #let [min (&.min x y) - max (&.max x y)]] - ($_ seq - (test "Addition and subtraction are opposites." - (and (|> max (&.- min) (&.+ min) (&.= max)) - (|> max (&.+ min) (&.- min) (&.= max)))) - - (test "Multiplication and division are opposites." - (and (|> max (&./ min) (&.* min) (&.= max)) - (|> max (&.* min) (&./ min) (&.= max)))) - - (test "Modulus by a larger ratio doesn't change the value." - (|> min (&.% max) (&.= min))) - - (test "Modulus by a smaller ratio results in a value smaller than the limit." - (|> max (&.% min) (&.< min))) - - (test "Can get the remainder of a division." - (let [remainder (&.% min max) - multiple (&.- remainder max) - factor (&./ min multiple)] - (and (|> factor (get@ #&.denominator) (n/= 1)) - (|> factor (&.* min) (&.+ remainder) (&.= max))))) - )))) - -(context: "Negation, absolute value and signum" - (<| (times 100) - (do @ - [sample gen-ratio] - ($_ seq - (test "Negation is it's own inverse." - (let [there (&;negate sample) - back-again (&;negate there)] - (and (not (&.= there sample)) - (&.= back-again sample)))) - - (test "All ratios are already at their absolute value." - (|> sample &;abs (&.= sample))) - - (test "Signum is the identity." - (|> sample (&.* (&;signum sample)) (&.= sample))) - )))) - -(context: "Order" - (<| (times 100) - (do @ - [x gen-ratio - y gen-ratio] - ($_ seq - (test "Can compare ratios." - (and (or (&.<= y x) - (&.> y x)) - (or (&.>= y x) - (&.< y x)))) - )))) - -(context: "Codec" - (<| (times 100) - (do @ - [sample gen-ratio - #let [(^open "&;.") &.codec]] - (test "Can encode/decode ratios." - (|> sample &;encode &;decode - (case> (#.Right output) - (&.= sample output) - - _ - #0)))))) +(def: #export test + Test + (do r.monad + [denom0 ..part + denom1 ..part] + ($_ _.and + ($equivalence.spec /.equivalence ..ratio) + ($order.spec /.order ..ratio) + ($number.spec /.order /.number ..ratio) + ($codec.spec /.equivalence /.codec ..ratio) + + (_.test "All zeroes are the same." + (let [(^open "/@.") /.equivalence] + (/@= (/.ratio 0 denom0) + (/.ratio 0 denom1)))) + ))) diff --git a/stdlib/source/test/lux/data/number/rev.lux b/stdlib/source/test/lux/data/number/rev.lux new file mode 100644 index 000000000..427ce4edf --- /dev/null +++ b/stdlib/source/test/lux/data/number/rev.lux @@ -0,0 +1,55 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [control + [monad (#+ do)] + {[0 #test] + [/ + ["$." equivalence] + ["$." order] + ["$." number] + ["$." enum] + ["$." interval] + ["$." monoid] + ["$." codec]]}] + [math + ["r" random]]] + {1 + ["." / + //]}) + +(def: #export test + Test + (<| (_.context (%name (name-of .Rev))) + ($_ _.and + ($equivalence.spec /.equivalence r.rev) + ($order.spec /.order r.rev) + ($number.spec /.order /.number r.rev) + ($enum.spec /.enum r.rev) + ($interval.spec /.interval r.rev) + (<| (_.context "Addition.") + ($monoid.spec /.equivalence /.addition r.rev)) + (<| (_.context "Multiplication.") + ($monoid.spec /.equivalence /.multiplication r.rev)) + (<| (_.context "Minimum.") + ($monoid.spec /.equivalence /.minimum r.rev)) + (<| (_.context "Maximum.") + ($monoid.spec /.equivalence /.multiplication r.rev)) + (<| (_.context "Binary.") + ($codec.spec /.equivalence /.binary r.rev)) + (<| (_.context "Octal.") + ($codec.spec /.equivalence /.octal r.rev)) + (<| (_.context "Decimal.") + ($codec.spec /.equivalence /.decimal r.rev)) + (<| (_.context "Hexadecimal.") + ($codec.spec /.equivalence /.hex r.rev)) + + (_.test "Alternate notations." + (and (r/= (bin ".11001001") + (bin ".11,00,10,01")) + (r/= (oct ".615243") + (oct ".615,243")) + (r/= (hex ".deadBEEF") + (hex ".dead,BEEF")))) + ))) diff --git a/stdlib/source/test/lux/io.lux b/stdlib/source/test/lux/io.lux index bd9b67306..5dd4bfe8d 100644 --- a/stdlib/source/test/lux/io.lux +++ b/stdlib/source/test/lux/io.lux @@ -4,9 +4,9 @@ [monad (#+ do)] {[0 #test] [/ - [".T" functor (#+ Injection Comparison)] - [".T" apply] - [".T" monad]]}] + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] ["." function] [math ["r" random]] @@ -29,11 +29,12 @@ [sample r.nat exit-code r.int] ($_ _.and + ($functor.spec ..injection ..comparison /.functor) + ($apply.spec ..injection ..comparison /.apply) + ($monad.spec ..injection ..comparison /.monad) + (_.test "Can execute computations designated as I/O computations." (n/= sample (/.run (/.io sample)))) (_.test "I/O operations won't execute unless they are explicitly run." (exec (/.exit exit-code) - true)) - (functorT.laws ..injection ..comparison /.functor) - (applyT.laws ..injection ..comparison /.apply) - (monadT.laws ..injection ..comparison /.monad)))) + true))))) |