aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/control/interval.lux1
-rw-r--r--stdlib/source/lux/data/bit.lux4
-rw-r--r--stdlib/source/lux/data/number/frac.lux2
-rw-r--r--stdlib/source/lux/data/number/i64.lux29
-rw-r--r--stdlib/source/lux/data/number/nat.lux2
-rw-r--r--stdlib/source/lux/data/number/ratio.lux142
-rw-r--r--stdlib/source/test/lux.lux10
-rw-r--r--stdlib/source/test/lux/control/apply.lux2
-rw-r--r--stdlib/source/test/lux/control/codec.lux4
-rw-r--r--stdlib/source/test/lux/control/continuation.lux14
-rw-r--r--stdlib/source/test/lux/control/enum.lux28
-rw-r--r--stdlib/source/test/lux/control/equivalence.lux10
-rw-r--r--stdlib/source/test/lux/control/functor.lux2
-rw-r--r--stdlib/source/test/lux/control/interval.lux27
-rw-r--r--stdlib/source/test/lux/control/monad.lux2
-rw-r--r--stdlib/source/test/lux/control/monoid.lux25
-rw-r--r--stdlib/source/test/lux/control/number.lux47
-rw-r--r--stdlib/source/test/lux/control/order.lux27
-rw-r--r--stdlib/source/test/lux/control/parser.lux13
-rw-r--r--stdlib/source/test/lux/control/reader.lux14
-rw-r--r--stdlib/source/test/lux/control/security/integrity.lux13
-rw-r--r--stdlib/source/test/lux/control/security/privacy.lux13
-rw-r--r--stdlib/source/test/lux/control/state.lux12
-rw-r--r--stdlib/source/test/lux/control/thread.lux16
-rw-r--r--stdlib/source/test/lux/control/writer.lux15
-rw-r--r--stdlib/source/test/lux/data.lux21
-rw-r--r--stdlib/source/test/lux/data/bit.lux19
-rw-r--r--stdlib/source/test/lux/data/color.lux4
-rw-r--r--stdlib/source/test/lux/data/error.lux16
-rw-r--r--stdlib/source/test/lux/data/identity.lux14
-rw-r--r--stdlib/source/test/lux/data/lazy.lux17
-rw-r--r--stdlib/source/test/lux/data/maybe.lux17
-rw-r--r--stdlib/source/test/lux/data/name.lux9
-rw-r--r--stdlib/source/test/lux/data/number.lux185
-rw-r--r--stdlib/source/test/lux/data/number/complex.lux373
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux60
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux144
-rw-r--r--stdlib/source/test/lux/data/number/int.lux55
-rw-r--r--stdlib/source/test/lux/data/number/nat.lux55
-rw-r--r--stdlib/source/test/lux/data/number/ratio.lux140
-rw-r--r--stdlib/source/test/lux/data/number/rev.lux55
-rw-r--r--stdlib/source/test/lux/io.lux15
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)))))