aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/lux.lux6
-rw-r--r--stdlib/source/lux/data/collection/row.lux133
-rw-r--r--stdlib/source/lux/data/number/frac.lux16
-rw-r--r--stdlib/source/lux/data/number/nat.lux10
-rw-r--r--stdlib/source/lux/data/number/ratio.lux119
-rw-r--r--stdlib/source/lux/data/number/rev.lux59
-rw-r--r--stdlib/source/lux/data/text/format.lux4
-rw-r--r--stdlib/source/test/lux.lux140
-rw-r--r--stdlib/source/test/lux/control/enum.lux10
-rw-r--r--stdlib/source/test/lux/control/number.lux32
-rw-r--r--stdlib/source/test/lux/data/collection/row.lux26
-rw-r--r--stdlib/source/test/lux/data/collection/stack.lux13
-rw-r--r--stdlib/source/test/lux/data/number/complex.lux35
-rw-r--r--stdlib/source/test/lux/data/number/frac.lux69
-rw-r--r--stdlib/source/test/lux/data/number/i64.lux129
-rw-r--r--stdlib/source/test/lux/data/number/int.lux58
-rw-r--r--stdlib/source/test/lux/data/number/nat.lux58
-rw-r--r--stdlib/source/test/lux/data/number/ratio.lux40
-rw-r--r--stdlib/source/test/lux/data/number/rev.lux60
19 files changed, 484 insertions, 533 deletions
diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index 2add33e57..ebdf57efb 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2464,7 +2464,7 @@
high-bits
("lux i64 +" top))))
-(def:''' least-significant-bit-mask (list) Nat 1)
+(def:''' least-significant-bit-mask (list) ($' I64 Any) 1)
(def:''' (without-trailing-zeroes count remaining)
(list)
@@ -2502,8 +2502,8 @@
(text$ "Rev(olution) remainder.")])
(-> Rev Rev Rev)
("lux coerce" Rev
- (n/% ("lux coerce" Nat subject)
- ("lux coerce" Nat param))))
+ (n/% ("lux coerce" Nat param)
+ ("lux coerce" Nat subject))))
(def:''' #export (r/scale param subject)
(list [(tag$ ["lux" "doc"])
diff --git a/stdlib/source/lux/data/collection/row.lux b/stdlib/source/lux/data/collection/row.lux
index dff272a91..16ad5b51a 100644
--- a/stdlib/source/lux/data/collection/row.lux
+++ b/stdlib/source/lux/data/collection/row.lux
@@ -15,13 +15,12 @@
[number
["." i64]]
[collection
- ["." list ("#;." fold functor monoid)]
- ["." array (#+ Array) ("#;." functor fold)]]]
+ ["." list ("#@." fold functor monoid)]
+ ["." array (#+ Array) ("#@." functor fold)]]]
[macro (#+ with-gensyms)
["." code]
["s" syntax (#+ syntax: Syntax)]]])
-## [Utils]
(type: (Node a)
(#Base (Array a))
(#Hierarchy (Array (Node a))))
@@ -66,11 +65,11 @@
(All [a] (-> Any (Hierarchy a)))
(array.new full-node-size))
-(def: (tail-off vec-size)
+(def: (tail-off row-size)
(-> Nat Nat)
- (if (n/< full-node-size vec-size)
+ (if (n/< full-node-size row-size)
0
- (|> (dec vec-size)
+ (|> (dec row-size)
(i64.logic-right-shift branching-exponent)
(i64.left-shift branching-exponent))))
@@ -169,17 +168,15 @@
(|> hierarchy
array.to-list
list.reverse
- (list;fold (function (_ sub acc) (list;compose (to-list' sub) acc))
+ (list@fold (function (_ sub acc) (list@compose (to-list' sub) acc))
#.Nil))))
-## [Types]
(type: #export (Row a)
{#level Level
#size Nat
#root (Hierarchy a)
#tail (Base a)})
-## [Exports]
(def: #export empty
Row
{#level (level-up root-level)
@@ -191,48 +188,48 @@
(All [a] (-> (Row a) Nat))
(get@ #size row))
-(def: #export (add val vec)
+(def: #export (add val row)
(All [a] (-> a (Row a) (Row a)))
## Check if there is room in the tail.
- (let [vec-size (get@ #size vec)]
- (if (|> vec-size (n/- (tail-off vec-size)) (n/< full-node-size))
+ (let [row-size (get@ #size row)]
+ (if (|> row-size (n/- (tail-off row-size)) (n/< full-node-size))
## If so, append to it.
- (|> vec
+ (|> row
(update@ #size inc)
(update@ #tail (expand-tail val)))
## Otherwise, push tail into the tree
## --------------------------------------------------------
## Will the root experience an overflow with this addition?
- (|> (if (n/> (i64.left-shift (get@ #level vec) 1)
- (i64.logic-right-shift branching-exponent vec-size))
+ (|> (if (n/> (i64.left-shift (get@ #level row) 1)
+ (i64.logic-right-shift branching-exponent row-size))
## If so, a brand-new root must be established, that is
## 1-level taller.
- (|> vec
+ (|> row
(set@ #root (|> (: (Hierarchy ($ 0))
(new-hierarchy []))
## TODO: Remove version above once new-luxc becomes the standard compiler.
## (new-hierarchy [])
- (array.write 0 (#Hierarchy (get@ #root vec)))
- (array.write 1 (new-path (get@ #level vec) (get@ #tail vec)))))
+ (array.write 0 (#Hierarchy (get@ #root row)))
+ (array.write 1 (new-path (get@ #level row) (get@ #tail row)))))
(update@ #level level-up))
## Otherwise, just push the current tail onto the root.
- (|> vec
- (update@ #root (push-tail vec-size (get@ #level vec) (get@ #tail vec)))))
+ (|> row
+ (update@ #root (push-tail row-size (get@ #level row) (get@ #tail row)))))
## Finally, update the size of the row and grow a new
## tail with the new element as it's sole member.
(update@ #size inc)
(set@ #tail (new-tail val)))
)))
-(def: (base-for idx vec)
+(def: (base-for idx row)
(All [a] (-> Index (Row a) (Maybe (Base a))))
- (let [vec-size (get@ #size vec)]
+ (let [row-size (get@ #size row)]
(if (and (n/>= 0 idx)
- (n/< vec-size idx))
- (if (n/>= (tail-off vec-size) idx)
- (#.Some (get@ #tail vec))
- (loop [level (get@ #level vec)
- hierarchy (get@ #root vec)]
+ (n/< row-size idx))
+ (if (n/>= (tail-off row-size) idx)
+ (#.Some (get@ #tail row))
+ (loop [level (get@ #level row)
+ hierarchy (get@ #root row)]
(case [(n/> branching-exponent level)
(array.read (branch-idx (i64.logic-right-shift level idx)) hierarchy)]
[#1 (#.Some (#Hierarchy sub))]
@@ -248,61 +245,61 @@
(error! "Incorrect row structure."))))
#.None)))
-(def: #export (nth idx vec)
+(def: #export (nth idx row)
(All [a] (-> Nat (Row a) (Maybe a)))
(do maybe.monad
- [base (base-for idx vec)]
+ [base (base-for idx row)]
(array.read (branch-idx idx) base)))
-(def: #export (put idx val vec)
+(def: #export (put idx val row)
(All [a] (-> Nat a (Row a) (Row a)))
- (let [vec-size (get@ #size vec)]
+ (let [row-size (get@ #size row)]
(if (and (n/>= 0 idx)
- (n/< vec-size idx))
- (if (n/>= (tail-off vec-size) idx)
- (|> vec
+ (n/< row-size idx))
+ (if (n/>= (tail-off row-size) idx)
+ (|> row
## (update@ #tail (|>> array.clone (array.write (branch-idx idx) val)))
## TODO: Remove once new-luxc becomes the standard compiler.
(update@ #tail (: (-> (Base ($ 0)) (Base ($ 0)))
(|>> array.clone (array.write (branch-idx idx) val))))
)
- (|> vec
- (update@ #root (put' (get@ #level vec) idx val))))
- vec)))
+ (|> row
+ (update@ #root (put' (get@ #level row) idx val))))
+ row)))
-(def: #export (update idx f vec)
+(def: #export (update idx f row)
(All [a] (-> Nat (-> a a) (Row a) (Row a)))
- (case (nth idx vec)
+ (case (nth idx row)
(#.Some val)
- (put idx (f val) vec)
+ (put idx (f val) row)
#.None
- vec))
+ row))
-(def: #export (pop vec)
+(def: #export (pop row)
(All [a] (-> (Row a) (Row a)))
- (case (get@ #size vec)
+ (case (get@ #size row)
0
empty
1
empty
- vec-size
- (if (|> vec-size (n/- (tail-off vec-size)) (n/> 1))
- (let [old-tail (get@ #tail vec)
+ row-size
+ (if (|> row-size (n/- (tail-off row-size)) (n/> 1))
+ (let [old-tail (get@ #tail row)
new-tail-size (dec (array.size old-tail))]
- (|> vec
+ (|> row
(update@ #size dec)
(set@ #tail (|> (array.new new-tail-size)
(array.copy new-tail-size 0 old-tail 0)))))
(maybe.assume
(do maybe.monad
- [new-tail (base-for (n/- 2 vec-size) vec)
- #let [[level' root'] (let [init-level (get@ #level vec)]
+ [new-tail (base-for (n/- 2 row-size) row)
+ #let [[level' root'] (let [init-level (get@ #level row)]
(loop [level init-level
root (maybe.default (new-hierarchy [])
- (pop-tail vec-size init-level (get@ #root vec)))]
+ (pop-tail row-size init-level (get@ #root row)))]
(if (n/> branching-exponent level)
(case [(array.read 1 root) (array.read 0 root)]
[#.None (#.Some (#Hierarchy sub-node))]
@@ -314,37 +311,35 @@
_
[level root])
[level root])))]]
- (wrap (|> vec
+ (wrap (|> row
(update@ #size dec)
(set@ #level level')
(set@ #root root')
(set@ #tail new-tail))))))
))
-(def: #export (to-list vec)
+(def: #export (to-list row)
(All [a] (-> (Row a) (List a)))
- (list;compose (to-list' (#Hierarchy (get@ #root vec)))
- (to-list' (#Base (get@ #tail vec)))))
+ (list@compose (to-list' (#Hierarchy (get@ #root row)))
+ (to-list' (#Base (get@ #tail row)))))
(def: #export from-list
(All [a] (-> (List a) (Row a)))
- (list;fold ..add ..empty))
+ (list@fold ..add ..empty))
-(def: #export (member? a/Equivalence vec val)
+(def: #export (member? a/Equivalence row val)
(All [a] (-> (Equivalence a) (Row a) a Bit))
- (list.member? a/Equivalence (to-list vec) val))
+ (list.member? a/Equivalence (to-list row) val))
(def: #export empty?
(All [a] (-> (Row a) Bit))
(|>> (get@ #size) (n/= 0)))
-## [Syntax]
(syntax: #export (row {elems (p.some s.any)})
{#.doc (doc "Row literals."
(row +10 +20 +30 +40))}
(wrap (list (` (from-list (list (~+ elems)))))))
-## [Structures]
(structure: #export (node-equivalence Equivalence<a>) (All [a] (-> (Equivalence a) (Equivalence (Node a))))
(def: (= v1 v2)
(case [v1 v2]
@@ -370,10 +365,10 @@
(def: (fold f init xs)
(case xs
(#Base base)
- (array;fold f init base)
+ (array@fold f init base)
(#Hierarchy hierarchy)
- (array;fold (function (_ node init') (fold f init' node))
+ (array@fold (function (_ node init') (fold f init' node))
init
hierarchy))))
@@ -390,23 +385,23 @@
(def: identity ..empty)
(def: (compose xs ys)
- (list;fold add xs (..to-list ys))))
+ (list@fold add xs (..to-list ys))))
(structure: node-functor (Functor Node)
(def: (map f xs)
(case xs
(#Base base)
- (#Base (array;map f base))
+ (#Base (array@map f base))
(#Hierarchy hierarchy)
- (#Hierarchy (array;map (map f) hierarchy)))))
+ (#Hierarchy (array@map (map f) hierarchy)))))
(structure: #export functor (Functor Row)
(def: (map f xs)
{#level (get@ #level xs)
#size (get@ #size xs)
- #root (|> xs (get@ #root) (array;map (:: node-functor map f)))
- #tail (|> xs (get@ #tail) (array;map f))}))
+ #root (|> xs (get@ #root) (array@map (:: node-functor map f)))
+ #tail (|> xs (get@ #tail) (array@map f))}))
(structure: #export apply (Apply Row)
(def: &functor ..functor)
@@ -429,13 +424,9 @@
(^open ".") ..monoid]
(fold (function (_ post pre) (compose pre post)) identity))))
-## TODO: This definition of 'reverse' shouldn't work correctly.
-## Investigate if/why it does.
(def: #export reverse
(All [a] (-> (Row a) (Row a)))
- (let [(^open ".") ..fold
- (^open ".") ..monoid]
- (fold add identity)))
+ (|>> ..to-list list.reverse (list@fold add ..empty)))
(do-template [<name> <array> <init> <op>]
[(def: #export <name>
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index d67d582f6..02f7b4d88 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -3,8 +3,6 @@
[control
[hash (#+ Hash)]
[number (#+ Number)]
- [enum (#+ Enum)]
- [interval (#+ Interval)]
[monoid (#+ Monoid)]
[equivalence (#+ Equivalence)]
["." order (#+ Order)]
@@ -29,16 +27,6 @@
(def: > f/>)
(def: >= f/>=))
-(structure: #export enum (Enum Frac)
- (def: &order ..order)
- (def: succ (f/+ ("lux frac smallest")))
- (def: pred (f/- ("lux frac smallest"))))
-
-(structure: #export interval (Interval Frac)
- (def: &enum ..enum)
- (def: top ("lux frac max"))
- (def: bottom ("lux frac min")))
-
(structure: #export number (Number Frac)
(def: + f/+)
(def: - f/-)
@@ -64,8 +52,8 @@
[addition f/+ +0.0]
[multiplication f/* +1.0]
- [maximum f/max (:: ..interval bottom)]
- [minimum f/min (:: ..interval top)]
+ [maximum f/max ("lux frac min")]
+ [minimum f/min ("lux frac max")]
)
(do-template [<name> <numerator> <doc>]
diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux
index 8126bc0c3..70f8df0bd 100644
--- a/stdlib/source/lux/data/number/nat.lux
+++ b/stdlib/source/lux/data/number/nat.lux
@@ -177,10 +177,12 @@
(loop [input value
output ""]
(let [digit (maybe.assume (<to-character> (n/% <base> input)))
- output' ("lux text concat" digit output)
- input' (n// <base> input)]
- (if (n/= 0 input')
+ output' ("lux text concat" digit output)]
+ (case (n// <base> input)
+ 0
output'
+
+ input'
(recur input' output')))))
(def: (decode repr)
@@ -201,7 +203,7 @@
[binary 2 binary-character binary-value "Invalid binary syntax for Nat: "]
[octal 8 octal-character octal-value "Invalid octal syntax for Nat: "]
- [decimal 10 decimal-character decimal-value "Invalid syntax for Nat: "]
+ [decimal 10 decimal-character decimal-value "Invalid decimal syntax for Nat: "]
[hex 16 hexadecimal-character hexadecimal-value "Invalid hexadecimal syntax for Nat: "]
)
diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index 21176e998..9c7baaab8 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -3,6 +3,7 @@
[control
[equivalence (#+ Equivalence)]
[order (#+ Order)]
+ [monoid (#+ Monoid)]
number
codec
monad
@@ -12,9 +13,8 @@
["." product]
["." maybe]
[number
- ["." nat ("#;." decimal)]]
- ["." text ("#;." monoid)
- format]]
+ ["." nat ("#@." decimal)]]
+ ["." text ("#@." monoid)]]
["." function]
["." math]
["." macro
@@ -25,6 +25,13 @@
{#numerator Nat
#denominator Nat})
+(def: (equalize parameter subject)
+ (-> Ratio Ratio [Nat Nat])
+ [(n/* (get@ #denominator subject)
+ (get@ #numerator parameter))
+ (n/* (get@ #denominator parameter)
+ (get@ #numerator subject))])
+
(def: (normalize (^slots [#numerator #denominator]))
(-> Ratio Ratio)
(let [common (math.n/gcd numerator denominator)]
@@ -32,21 +39,19 @@
#denominator (n// common denominator)}))
(structure: #export equivalence (Equivalence Ratio)
- (def: (= param input)
- (and (n/= (get@ #numerator param)
- (get@ #numerator input))
- (n/= (get@ #denominator param)
- (get@ #denominator input)))))
+ (def: (= parameter subject)
+ (and (n/= (get@ #numerator parameter)
+ (get@ #numerator subject))
+ (n/= (get@ #denominator parameter)
+ (get@ #denominator subject)))))
(`` (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)))))]
+ [(def: (<name> parameter subject)
+ (let [[parameter' subject'] (..equalize parameter subject)]
+ (<op> parameter' subject')))]
[< n/<]
[<= n/<=]
@@ -66,46 +71,38 @@
[max >]
)
-(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))]))
+(def: (- parameter subject)
+ (let [[parameter' subject'] (..equalize parameter subject)]
+ (normalize [(n/- parameter' subject')
+ (n/* (get@ #denominator parameter)
+ (get@ #denominator subject))])))
(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))]))
+ (def: (+ parameter subject)
+ (let [[parameter' subject'] (..equalize parameter subject)]
+ (normalize [(n/+ parameter' subject')
+ (n/* (get@ #denominator parameter)
+ (get@ #denominator subject))])))
(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: (* parameter subject)
+ (normalize [(n/* (get@ #numerator parameter)
+ (get@ #numerator subject))
+ (n/* (get@ #denominator parameter)
+ (get@ #denominator subject))]))
+
+ (def: (/ parameter subject)
+ (let [[parameter' subject'] (..equalize parameter subject)]
+ (normalize [subject' parameter'])))
+
+ (def: (% parameter subject)
+ (let [[parameter' subject'] (..equalize parameter subject)
+ quot (n// parameter' subject')]
+ (..- (update@ #numerator (n/* quot) parameter)
+ subject)))
(def: (negate (^slots [#numerator #denominator]))
{#numerator denominator
@@ -120,31 +117,39 @@
(def: separator Text ":")
-(def: part-encode
- (-> Nat Text)
- (|>> nat;encode (text.split 1) maybe.assume product.right))
-
(structure: #export codec (Codec Text Ratio)
(def: (encode (^slots [#numerator #denominator]))
- ($_ text;compose (part-encode numerator) separator (part-encode denominator)))
+ ($_ text@compose (nat@encode numerator) separator (nat@encode denominator)))
(def: (decode input)
(case (text.split-with separator input)
(#.Some [num denom])
(do error.monad
- [numerator (nat;decode num)
- denominator (nat;decode denom)]
+ [numerator (nat@decode num)
+ denominator (nat@decode denom)]
(wrap (normalize {#numerator numerator
#denominator denominator})))
#.None
- (#.Left (text;compose "Invalid syntax for ratio: " input)))))
+ (#.Left (text@compose "Invalid syntax for ratio: " input)))))
(syntax: #export (ratio numerator {?denominator (p.maybe s.any)})
{#.doc (doc "Rational literals."
(ratio numerator denominator)
"The denominator can be omitted if it's 1."
(ratio numerator))}
- (wrap (list (` ((~! normalize) {#..numerator (~ numerator)
- #..denominator (~ (maybe.default (' 1)
- ?denominator))})))))
+ (wrap (list (` ((~! ..normalize) {#..numerator (~ numerator)
+ #..denominator (~ (maybe.default (' 1)
+ ?denominator))})))))
+
+(do-template [<identity> <compose> <name>]
+ [(structure: #export <name>
+ (Monoid Ratio)
+
+ (def: identity (..ratio <identity>))
+ (def: compose (:: ..number <compose>))
+ )]
+
+ [0 + addition]
+ [1 * multiplication]
+ )
diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux
index 798844ba7..fcd2e223c 100644
--- a/stdlib/source/lux/data/number/rev.lux
+++ b/stdlib/source/lux/data/number/rev.lux
@@ -40,37 +40,25 @@
(def: top (.rev -1))
(def: bottom (.rev 0)))
-(structure: #export number (Number Rev)
- (def: + r/+)
- (def: - r/-)
- (def: * r/*)
- (def: / r//)
- (def: % r/%)
- (def: (negate x) (r/- x (:coerce Rev -1)))
- (def: abs function.identity)
- (def: (signum x)
- (:coerce Rev -1)))
-
(do-template [<name> <compose> <identity>]
[(structure: #export <name> (Monoid Rev)
- (def: identity <identity>)
+ (def: identity (:: interval <identity>))
(def: compose <compose>))]
- [addition r/+ (:: interval bottom)]
- [multiplication r/* (:: interval top)]
- [maximum r/max (:: interval bottom)]
- [minimum r/min (:: interval top)]
+ [addition r/+ bottom]
+ [maximum r/max bottom]
+ [minimum r/min top]
)
(def: (de-prefix input)
(-> Text Text)
("lux text clip" input 1 ("lux text size" input)))
-(do-template [<struct> <nat> <char-bit-size> <error>]
+(do-template [<struct> <codec> <char-bit-size> <error>]
[(with-expansions [<error-output> (as-is (#error.Failure ("lux text concat" <error> repr)))]
(structure: #export <struct> (Codec Text Rev)
(def: (encode value)
- (let [raw-output (de-prefix (:: <nat> encode (:coerce Nat value)))
+ (let [raw-output (:: <codec> encode (:coerce Nat value))
max-num-chars (n// <char-bit-size> 64)
raw-size ("lux text size" raw-output)
zero-padding (loop [zeroes-left (n/- raw-size max-num-chars)
@@ -78,16 +66,17 @@
(if (n/= 0 zeroes-left)
output
(recur (dec zeroes-left)
- ("lux text concat" "0" output))))
- padded-output ("lux text concat" zero-padding raw-output)]
- ("lux text concat" "." padded-output)))
+ ("lux text concat" "0" output))))]
+ (|> raw-output
+ ("lux text concat" zero-padding)
+ ("lux text concat" "."))))
(def: (decode repr)
(let [repr-size ("lux text size" repr)]
- (if (n/>= 2 repr-size)
+ (if (n/> 1 repr-size)
(case ("lux text char" repr 0)
(^ (char "."))
- (case (:: <nat> decode (de-prefix repr))
+ (case (:: <codec> decode (de-prefix repr))
(#error.Success output)
(#error.Success (:coerce Rev output))
@@ -196,7 +185,7 @@
(loop [idx 0
output (make-digits [])]
(if (n/< length idx)
- (case ("lux text index" "+0123456789" ("lux text clip" input idx (inc idx)) 0)
+ (case ("lux text index" "0123456789" ("lux text clip" input idx (inc idx)) 0)
#.None
#.None
@@ -239,10 +228,12 @@
(structure: #export decimal (Codec Text Rev)
(def: (encode input)
- (let [input (:coerce Nat input)
- last-idx (dec //i64.width)]
- (if (n/= 0 input)
- ".0"
+ (case (:coerce Nat input)
+ 0
+ ".0"
+
+ input
+ (let [last-idx (dec //i64.width)]
(loop [idx last-idx
digits (make-digits [])]
(if (i/>= +0 (.int idx))
@@ -257,16 +248,16 @@
)))))
(def: (decode input)
- (let [length ("lux text size" input)
- dotted? (case ("lux text index" input "." 0)
+ (let [dotted? (case ("lux text index" input "." 0)
(#.Some 0)
#1
_
- #0)]
- (if (and dotted?
- (n/<= (inc //i64.width) length))
- (case (text-to-digits ("lux text clip" input 1 length))
+ #0)
+ within-limits? (n/<= (inc //i64.width)
+ ("lux text size" input))]
+ (if (and dotted? within-limits?)
+ (case (text-to-digits (de-prefix input))
(#.Some digits)
(loop [digits digits
idx 0
diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux
index f6a53358d..b96606cdc 100644
--- a/stdlib/source/lux/data/text/format.lux
+++ b/stdlib/source/lux/data/text/format.lux
@@ -10,7 +10,8 @@
["." nat]
["." int]
["." rev]
- ["." frac]]
+ ["." frac]
+ ["." ratio]]
["." text]
[format
["." xml]
@@ -49,6 +50,7 @@
[%i Int (:: int.decimal encode)]
[%r Rev (:: rev.decimal encode)]
[%f Frac (:: frac.decimal encode)]
+ [%ratio ratio.Ratio (:: ratio.codec encode)]
[%t Text text.encode]
[%name Name (:: name.codec encode)]
[%code Code code.to-text]
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index 30abe1b37..a52c70fd4 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -9,7 +9,7 @@
[common (#+)]
[host (#+)]])]
(.module:
- [lux #*
+ ["/" lux #*
[cli (#+ program:)]
["." io (#+ io)]
[control
@@ -19,8 +19,7 @@
[number
["." i64]]]
["." function]
- ["." math
- ["r" random (#+ Random) ("#@." functor)]]
+ ["." math]
["_" test (#+ Test)]
## These modules do not need to be tested.
[type
@@ -28,11 +27,8 @@
[locale (#+)
[language (#+)]
[territory (#+)]]
- [data
- [text
- [format (#+)]]]
- ## [math
- ## [random (#+)]]
+ data/text/format
+ ["r" math/random (#+ Random) ("#@." functor)]
## TODO: Test these modules
[data
[format
@@ -235,8 +231,8 @@
(def: frac-rev
(r.Random Rev)
- (|> r.rev
- (:: r.functor map (|>> (i64.left-shift 11) (i64.logic-right-shift 11)))))
+ (let [bits-to-ignore 11]
+ (:: r.functor map (i64.left-shift bits-to-ignore) r.rev)))
(def: prelude-macros
Test
@@ -314,73 +310,71 @@
on-default))))))
(def: test
- ($_ _.and
- (<| (_.context "Identity.")
- ..identity)
- (<| (_.context "Increment & decrement.")
- ..increment-and-decrement)
- (<| (_.context "Even or odd.")
- ($_ _.and
- (<| (_.context "Natural numbers.")
- (..even-or-odd r.nat n/even? n/odd?))
- (<| (_.context "Integers.")
- (..even-or-odd r.int i/even? i/odd?))))
- (<| (_.context "Minimum and maximum.")
- (`` ($_ _.and
- (~~ (do-template [<=> <lt> <min> <gt> <max> <gen> <context>]
- [(<| (_.context <context>)
- (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.and
+ (<| (_.context "Identity.")
+ ..identity)
+ (<| (_.context "Increment & decrement.")
+ ..increment-and-decrement)
+ (<| (_.context "Even or odd.")
+ ($_ _.and
+ (<| (_.context "Natural numbers.")
+ (..even-or-odd r.nat n/even? n/odd?))
+ (<| (_.context "Integers.")
+ (..even-or-odd r.int i/even? i/odd?))))
+ (<| (_.context "Minimum and maximum.")
+ (`` ($_ _.and
+ (~~ (do-template [<=> <lt> <min> <gt> <max> <gen> <context>]
+ [(<| (_.context <context>)
+ (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]
- [i/= i/< i/min i/> i/max r.int "Integers."]
- [n/= n/< n/min n/> n/max r.nat "Natural numbers."]
- [r/= r/< r/min r/> r/max r.rev "Revolutions."]
- [f/= f/< f/min f/> f/max r.frac "Fractions."]
- )))))
- (<| (_.context "Conversion.")
- (`` ($_ _.and
- (~~ (do-template [<context> <=> <forward> <backward> <gen>]
- [(<| (_.context <context>)
- (..conversion <gen> <forward> <backward> <=>))]
+ [i/= i/< i/min i/> i/max r.int "Integers."]
+ [n/= n/< n/min n/> n/max r.nat "Natural numbers."]
+ [r/= r/< r/min r/> r/max r.rev "Revolutions."]
+ [f/= f/< f/min f/> f/max r.frac "Fractions."]
+ )))))
+ (<| (_.context "Conversion.")
+ (`` ($_ _.and
+ (~~ (do-template [<=> <forward> <backward> <gen>]
+ [(<| (_.context (format (%name (name-of <forward>))
+ " " (%name (name-of <backward>))))
+ (..conversion <gen> <forward> <backward> <=>))]
- ["Int -> Nat"
- i/= .nat .int (r@map (i/% +1,000,000) r.int)]
- ["Nat -> Int"
- 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)]
- ["Frac -> Int"
- f/= frac-to-int int-to-frac (r@map math.floor r.frac)]
- ["Rev -> Frac"
- r/= rev-to-frac frac-to-rev frac-rev]
- )))))
- (<| (_.context "Prelude macros.")
- ..prelude-macros)
- (<| (_.context "Templates.")
- ..template)
- (<| (_.context "Cross-platform support.")
- ..cross-platform-support)
- /cli.test
- /io.test
- (<| (_.context "/control")
- /control.test)
- (<| (_.context "/data")
- /data.test)
- /macro.test
- (<| (_.context "/math")
- /math.test)
- (<| (_.context "/time")
- /time.test)
- /type.test
- /world.test
- (<| (_.context "/host Host-platform interoperation")
- ($_ _.and
- /host.test
- (<| (_.context "/jvm JVM (Java Virtual Machine)")
- /host/jvm.test)))
- ))
+ [i/= .nat .int (r@map (i/% +1,000,000) r.int)]
+ [n/= .int .nat (r@map (n/% 1,000,000) r.nat)]
+ [i/= .int-to-frac .frac-to-int (r@map (i/% +1,000,000) r.int)]
+ [f/= .frac-to-int .int-to-frac (r@map (|>> (i/% +1,000,000) .int-to-frac) r.int)]
+ [r/= .rev-to-frac .frac-to-rev frac-rev]
+ )))))
+ (<| (_.context "Prelude macros.")
+ ..prelude-macros)
+ (<| (_.context "Templates.")
+ ..template)
+ (<| (_.context "Cross-platform support.")
+ ..cross-platform-support)
+ /cli.test
+ /io.test
+ (<| (_.context "/control")
+ /control.test)
+ (<| (_.context "/data")
+ /data.test)
+ /macro.test
+ (<| (_.context "/math")
+ /math.test)
+ (<| (_.context "/time")
+ /time.test)
+ /type.test
+ /world.test
+ (<| (_.context "/host Host-platform interoperation")
+ ($_ _.and
+ /host.test
+ (<| (_.context "/jvm JVM (Java Virtual Machine)")
+ /host/jvm.test)))
+ )))
(program: args
(<| io
_.run!
- (_.times 100)
+ ## (_.times 100)
+ (_.seed 4035274984803317370)
..test))
diff --git a/stdlib/source/test/lux/control/enum.lux b/stdlib/source/test/lux/control/enum.lux
index 030dee037..5c7832260 100644
--- a/stdlib/source/test/lux/control/enum.lux
+++ b/stdlib/source/test/lux/control/enum.lux
@@ -10,19 +10,19 @@
{1
["." / (#+ Enum)]})
-(def: #export (spec (^open "_@.") gen-sample)
+(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)
+ (and (/@= (|> sample /@succ /@pred)
(function.identity sample))
- (_@= (|> sample _@pred _@succ)
+ (/@= (|> sample /@pred /@succ)
(function.identity sample))
- (not (_@= (|> sample _@succ)
+ (not (/@= (|> sample /@succ)
(function.identity sample)))
- (not (_@= (|> sample _@pred)
+ (not (/@= (|> sample /@pred)
(function.identity sample)))))
))))
diff --git a/stdlib/source/test/lux/control/number.lux b/stdlib/source/test/lux/control/number.lux
index c1ffb0075..57bee6ee3 100644
--- a/stdlib/source/test/lux/control/number.lux
+++ b/stdlib/source/test/lux/control/number.lux
@@ -13,35 +13,35 @@
[//
[order (#+ Order)]]]})
-(def: #export (spec (^open "_@.") (^open "_@.") gen-sample)
+(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))
+ (|> 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)))
+ (|> subject (/@+ parameter) (/@- parameter) (/@= subject)))
(_.test "Multiplication and division are inverse functions."
- (|> subject (_@* parameter) (_@/ parameter) (_@= subject)))
+ (|> 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))))
+ (let [modulus (/@% parameter subject)
+ multiple (/@- modulus subject)
+ factor (/@/ parameter multiple)]
+ (|> parameter (/@* factor) (/@+ modulus) (/@= subject))))
(_.test "Negation flips the sign of a number and mimics subtraction."
- (let [unsigned? (_@= (_@signum parameter)
- (_@signum (_@negate parameter)))]
+ (let [unsigned? (/@= (/@signum parameter)
+ (/@signum (/@negate parameter)))]
(or unsigned?
- (_@= (_@+ (_@negate parameter) subject)
- (_@- parameter subject)))))
+ (/@= (/@+ (/@negate parameter) subject)
+ (/@- parameter subject)))))
(_.test "The absolute value is always positive."
- (let [unsigned? (_@= (_@abs parameter)
- (_@abs (_@negate parameter)))]
+ (let [unsigned? (/@= parameter
+ (/@negate parameter))]
(if unsigned?
- (_@= subject (_@abs subject))
- (_@>= subject (_@abs subject)))))
+ (/@= subject (/@abs subject))
+ (/@>= subject (/@abs subject)))))
))))
diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux
index cf678e0b4..1fa55e135 100644
--- a/stdlib/source/test/lux/data/collection/row.lux
+++ b/stdlib/source/test/lux/data/collection/row.lux
@@ -25,9 +25,9 @@
(def: #export test
Test
- (<| (_.context (%name (name-of /.Row)))
+ (<| (_.context (%name (name-of /._)))
(do r.monad
- [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1))))]
+ [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))]
($_ _.and
($equivalence.spec (/.equivalence nat.equivalence) (r.row size r.nat))
($monoid.spec (/.equivalence nat.equivalence) /.monoid (r.row size r.nat))
@@ -43,34 +43,38 @@
non-member (|> r.nat (r.filter (|>> (/.member? nat.equivalence sample) not)))
#let [(^open "/@.") (/.equivalence nat.equivalence)]]
($_ _.and
- (_.test "Can query size of row."
+ (_.test (format (%name (name-of /.size))
+ " " (%name (name-of /.empty?)))
(if (/.empty? sample)
(and (n/= 0 size)
(n/= 0 (/.size sample)))
(n/= size (/.size sample))))
- (_.test "Can add and remove elements to rows."
+ (_.test (format (%name (name-of /.add))
+ " " (%name (name-of /.pop)))
(and (n/= (inc size) (/.size (/.add non-member sample)))
(n/= (dec size) (/.size (/.pop sample)))))
- (_.test "Can put and get elements into rows."
+ (_.test (format (%name (name-of /.put))
+ " " (%name (name-of /.nth)))
(|> sample
(/.put idx non-member)
(/.nth idx)
maybe.assume
(is? non-member)))
- (_.test "Can update elements of rows."
+ (_.test (%name (name-of /.update))
(|> sample
(/.put idx non-member) (/.update idx inc)
(/.nth idx) maybe.assume
(n/= (inc non-member))))
- (_.test "Can safely transform to/from lists."
+ (_.test (format (%name (name-of /.to-list))
+ " " (%name (name-of /.from-list)))
(|> sample /.to-list /.from-list (/@= sample)))
- (_.test "Can identify members of a row."
+ (_.test (%name (name-of /.member?))
(and (not (/.member? nat.equivalence sample non-member))
(/.member? nat.equivalence (/.add non-member sample) non-member)))
- (_.test "Can reverse."
+ (_.test (%name (name-of /.reverse))
(and (not (/@= sample
(/.reverse sample)))
- (not (/@= sample
- (/.reverse (/.reverse sample))))))
+ (/@= sample
+ (/.reverse (/.reverse sample)))))
))
))))
diff --git a/stdlib/source/test/lux/data/collection/stack.lux b/stdlib/source/test/lux/data/collection/stack.lux
index 0a6fcf698..2886fa815 100644
--- a/stdlib/source/test/lux/data/collection/stack.lux
+++ b/stdlib/source/test/lux/data/collection/stack.lux
@@ -28,7 +28,7 @@
(def: #export test
Test
- (<| (_.context (%name (name-of /.Stack)))
+ (<| (_.context (%name (name-of /._)))
(do r.monad
[size gen-nat
sample (r.stack size gen-nat)
@@ -37,14 +37,13 @@
($equivalence.spec (/.equivalence nat.equivalence) (r.stack size r.nat))
($functor.spec ..injection /.equivalence /.functor)
- (_.test "Can query the size of a stack."
+ (_.test (%name (name-of /.size))
(n/= size (/.size sample)))
- (_.test "Can peek inside non-empty stacks."
+ (_.test (%name (name-of /.peek))
(case (/.peek sample)
#.None (/.empty? sample)
(#.Some _) (not (/.empty? sample))))
- (_.test (format "Popping empty stacks doesn't change anything."
- "But, if they're non-empty, the top of the stack is removed.")
+ (_.test (%name (name-of /.pop))
(case (/.size sample)
0 (case (/.pop sample)
#.None
@@ -54,12 +53,12 @@
false)
expected (case (/.pop sample)
(#.Some sample')
- (and (n/= expected (/.size sample'))
+ (and (n/= (dec expected) (/.size sample'))
(not (/.empty? sample)))
#.None
false)))
- (_.test "Pushing onto a stack always increases it by 1, adding a new value at the top."
+ (_.test (%name (name-of /.push))
(and (is? sample
(|> sample (/.push new-top) /.pop maybe.assume))
(n/= (inc (/.size sample))
diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux
index 278e8ec58..19db6081d 100644
--- a/stdlib/source/test/lux/data/number/complex.lux
+++ b/stdlib/source/test/lux/data/number/complex.lux
@@ -56,7 +56,6 @@
(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))))
@@ -73,11 +72,9 @@
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))))
@@ -99,7 +96,6 @@
(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
@@ -107,17 +103,13 @@
(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))
@@ -140,25 +132,20 @@
(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)))))
@@ -178,10 +165,8 @@
($_ _.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))))))
@@ -192,7 +177,6 @@
($_ _.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)))
)))
@@ -210,12 +194,13 @@
(def: #export test
Test
- ($_ _.and
- ..construction
- ..absolute-value
- ..number
- ..conjugate&reciprocal&signum&negation
- ..trigonometry
- ..exponentiation&logarithm
- ..root
- ))
+ (<| (_.context (%name (name-of /._)))
+ ($_ _.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
index 319debddd..87b937a93 100644
--- a/stdlib/source/test/lux/data/number/frac.lux
+++ b/stdlib/source/test/lux/data/number/frac.lux
@@ -9,8 +9,6 @@
["$." equivalence]
["$." order]
["$." number]
- ["$." enum]
- ["$." interval]
["$." monoid]
["$." codec]]}]
[math
@@ -21,40 +19,35 @@
(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))
+ (let [gen-frac (:: r.monad map (|>> (i/% +100) .int-to-frac) r.int)]
+ (<| (_.context (%name (name-of /._)))
+ (`` ($_ _.and
+ ($equivalence.spec /.equivalence gen-frac)
+ ($order.spec /.order gen-frac)
+ ($number.spec /.order /.number gen-frac)
+ (~~ (do-template [<monoid>]
+ [(<| (_.context (%name (name-of <monoid>)))
+ ($monoid.spec /.equivalence <monoid> gen-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))))
- )))
+ [/.addition] [/.multiplication] [/.minimum] [/.maximum]
+ ))
+ ## TODO: Uncomment ASAP
+ ## (~~ (do-template [<codec>]
+ ## [(<| (_.context (%name (name-of /.binary)))
+ ## ($codec.spec /.equivalence <codec> gen-frac))]
+
+ ## [/.binary] [/.octal] [/.decimal] [/.hex]
+ ## ))
+
+ (_.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 gen-frac]
+ (_.test (format (%name (name-of /.frac-to-bits)) " " (%name (name-of /.bits-to-frac)))
+ (|> 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 1eb207e19..3e251d1e6 100644
--- a/stdlib/source/test/lux/data/number/i64.lux
+++ b/stdlib/source/test/lux/data/number/i64.lux
@@ -16,68 +16,69 @@
(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))))
+ (<| (_.context (%name (name-of /._)))
+ (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
index e83571653..b9ed4f856 100644
--- a/stdlib/source/test/lux/data/number/int.lux
+++ b/stdlib/source/test/lux/data/number/int.lux
@@ -21,35 +21,31 @@
(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))
+ (<| (_.context (%name (name-of /._)))
+ (`` ($_ _.and
+ ($equivalence.spec /.equivalence r.int)
+ ($order.spec /.order r.int)
+ ($number.spec /.order /.number (:: r.monad map (i/% +1,000,000) r.int))
+ ($enum.spec /.enum r.int)
+ ($interval.spec /.interval r.int)
+ (~~ (do-template [<monoid>]
+ [(<| (_.context (%name (name-of <monoid>)))
+ ($monoid.spec /.equivalence <monoid> 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"))))
- )))
+ [/.addition] [/.multiplication] [/.minimum] [/.maximum]
+ ))
+ (~~ (do-template [<codec>]
+ [(<| (_.context (%name (name-of /.binary)))
+ ($codec.spec /.equivalence <codec> r.int))]
+
+ [/.binary] [/.octal] [/.decimal] [/.hex]
+ ))
+
+ (_.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
index e570de094..17ee0503b 100644
--- a/stdlib/source/test/lux/data/number/nat.lux
+++ b/stdlib/source/test/lux/data/number/nat.lux
@@ -21,35 +21,31 @@
(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))
+ (<| (_.context (%name (name-of /._)))
+ (`` ($_ _.and
+ ($equivalence.spec /.equivalence r.nat)
+ ($order.spec /.order r.nat)
+ ($number.spec /.order /.number (:: r.monad map (n/% 1,000,000) r.nat))
+ ($enum.spec /.enum r.nat)
+ ($interval.spec /.interval r.nat)
+ (~~ (do-template [<monoid>]
+ [(<| (_.context (%name (name-of <monoid>)))
+ ($monoid.spec /.equivalence <monoid> 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"))))
- )))
+ [/.addition] [/.multiplication] [/.minimum] [/.maximum]
+ ))
+ (~~ (do-template [<codec>]
+ [(<| (_.context (%name (name-of /.binary)))
+ ($codec.spec /.equivalence <codec> r.nat))]
+
+ [/.binary] [/.octal] [/.decimal] [/.hex]
+ ))
+
+ (_.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 654c489c3..5b74956c4 100644
--- a/stdlib/source/test/lux/data/number/ratio.lux
+++ b/stdlib/source/test/lux/data/number/ratio.lux
@@ -9,6 +9,7 @@
["$." equivalence]
["$." order]
["$." number]
+ ["$." monoid]
["$." codec]]}]
[math
["r" random (#+ Random)]]]
@@ -17,30 +18,35 @@
(def: part
(Random Nat)
- (|> r.nat (:: r.monad map (|>> (n/% 1000) (n/max 1)))))
+ (|> r.nat (:: r.monad map (|>> (n/% 1,000,000) (n/max 1)))))
(def: #export ratio
(Random Ratio)
(do r.monad
[numerator ..part
- denominator (|> ..part
- (r.filter (|>> (n/= 0) not))
- (r.filter (|>> (n/= numerator) not)))]
+ denominator (r.filter (|>> (n/= 0) not) ..part)]
(wrap (/.ratio numerator denominator))))
(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)
+ (<| (_.context (%name (name-of /._)))
+ (`` ($_ _.and
+ ($equivalence.spec /.equivalence ..ratio)
+ ($order.spec /.order ..ratio)
+ ($number.spec /.order /.number ..ratio)
+ (~~ (do-template [<monoid>]
+ [(<| (_.context (%name (name-of <monoid>)))
+ ($monoid.spec /.equivalence <monoid> ..ratio))]
+
+ [/.addition] [/.multiplication]
+ ))
+ ($codec.spec /.equivalence /.codec ..ratio)
- (_.test "All zeroes are the same."
- (let [(^open "/@.") /.equivalence]
- (/@= (/.ratio 0 denom0)
- (/.ratio 0 denom1))))
- )))
+ (do r.monad
+ [denom0 ..part
+ denom1 ..part]
+ (_.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
index 427ce4edf..dba639ae9 100644
--- a/stdlib/source/test/lux/data/number/rev.lux
+++ b/stdlib/source/test/lux/data/number/rev.lux
@@ -13,6 +13,10 @@
["$." interval]
["$." monoid]
["$." codec]]}]
+ [data
+ ["." error]
+ [number
+ ["." i64]]]
[math
["r" random]]]
{1
@@ -21,35 +25,29 @@
(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))
+ (<| (_.context (%name (name-of /._)))
+ (`` ($_ _.and
+ ($equivalence.spec /.equivalence r.rev)
+ ($order.spec /.order r.rev)
+ ($enum.spec /.enum r.rev)
+ ($interval.spec /.interval r.rev)
+ (~~ (do-template [<monoid>]
+ [(<| (_.context (%name (name-of <monoid>)))
+ ($monoid.spec /.equivalence <monoid> 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"))))
- )))
+ [/.addition] [/.minimum] [/.maximum]
+ ))
+ (~~ (do-template [<codec>]
+ [(<| (_.context (%name (name-of /.binary)))
+ ($codec.spec /.equivalence <codec> r.rev))]
+
+ [/.binary] [/.octal] [/.decimal] [/.hex]
+ ))
+ (_.test "Alternate notations."
+ (and (r/= (bin ".11001001")
+ (bin ".11,00,10,01"))
+ (r/= (oct ".615243")
+ (oct ".615,243"))
+ (r/= (hex ".deadBEEF")
+ (hex ".dead,BEEF"))))
+ ))))