aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/compiler.lux7
-rw-r--r--stdlib/source/lux/concurrency/actor.lux4
-rw-r--r--stdlib/source/lux/data/error.lux4
-rw-r--r--stdlib/source/lux/data/error/exception.lux2
-rw-r--r--stdlib/source/lux/data/format/json.lux2
-rw-r--r--stdlib/source/lux/lexer.lux2
-rw-r--r--stdlib/source/lux/macro/syntax.lux2
-rw-r--r--stdlib/source/lux/math/random.lux2
-rw-r--r--stdlib/source/lux/math/ratio.lux103
-rw-r--r--stdlib/source/lux/math/simple.lux134
-rw-r--r--stdlib/source/lux/test.lux2
-rw-r--r--stdlib/source/lux/type/check.lux2
-rw-r--r--stdlib/test/test/lux/concurrency/actor.lux2
-rw-r--r--stdlib/test/test/lux/concurrency/frp.lux2
-rw-r--r--stdlib/test/test/lux/concurrency/promise.lux2
-rw-r--r--stdlib/test/test/lux/data/format/json.lux2
-rw-r--r--stdlib/test/test/lux/math/ratio.lux106
-rw-r--r--stdlib/test/test/lux/math/simple.lux107
-rw-r--r--stdlib/test/tests.lux9
19 files changed, 349 insertions, 147 deletions
diff --git a/stdlib/source/lux/compiler.lux b/stdlib/source/lux/compiler.lux
index d1f71a6c3..fd438b1a3 100644
--- a/stdlib/source/lux/compiler.lux
+++ b/stdlib/source/lux/compiler.lux
@@ -15,7 +15,7 @@
[product]
[ident "Ident/" Codec<Text,Ident>]
maybe
- error)))
+ [error #- fail])))
## (type: (Lux a)
## (-> Compiler (Error [Compiler a])))
@@ -557,3 +557,8 @@
_
(wrap def-name))))
+
+(def: #export get-compiler
+ (Lux Compiler)
+ (lambda [compiler]
+ (#;Right [compiler compiler])))
diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux
index b195a8d6c..a10691b66 100644
--- a/stdlib/source/lux/concurrency/actor.lux
+++ b/stdlib/source/lux/concurrency/actor.lux
@@ -8,7 +8,7 @@
(lux (control monad)
(codata [io #- run]
function)
- (data error
+ (data [error #- fail]
text/format
(struct [list "List/" Monoid<List> Monad<List>])
[product]
@@ -126,7 +126,7 @@
(wrap (#;Right new-server))))
))))
#end (lambda [_ server] (exec (io;run (poison server))
- (:: Monad<Promise> wrap [])))})))]
+ (:: Monad<Promise> wrap [])))})))]
(update@ #obituary (: (-> (promise;Promise [(Maybe Text) (Actor ($ +0) ($ +1)) (List ($ +1))])
(promise;Promise [(Maybe Text) ($ +0) (List ($ +1))]))
(lambda [process]
diff --git a/stdlib/source/lux/data/error.lux b/stdlib/source/lux/data/error.lux
index ce2f529b9..235eee147 100644
--- a/stdlib/source/lux/data/error.lux
+++ b/stdlib/source/lux/data/error.lux
@@ -64,3 +64,7 @@
(def: #export (lift-error Monad<M>)
(All [M a] (-> (Monad M) (-> (M a) (M (Error a)))))
(liftM Monad<M> (:: Monad<Error> wrap)))
+
+(def: #export (fail message)
+ (All [a] (-> Text (Error a)))
+ (#;Left message))
diff --git a/stdlib/source/lux/data/error/exception.lux b/stdlib/source/lux/data/error/exception.lux
index c3e9143e2..e476357ca 100644
--- a/stdlib/source/lux/data/error/exception.lux
+++ b/stdlib/source/lux/data/error/exception.lux
@@ -6,7 +6,7 @@
(;module:
lux
(lux (control monad)
- (data error
+ (data [error #- fail]
[text])
[compiler]
(macro [ast]
diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux
index 675aabfde..aa469beb5 100644
--- a/stdlib/source/lux/data/format/json.lux
+++ b/stdlib/source/lux/data/format/json.lux
@@ -16,7 +16,7 @@
[number #* "Real/" Codec<Text,Real>]
maybe
[char "Char/" Eq<Char> Codec<Text,Char>]
- error
+ [error #- fail]
[sum]
[product]
(struct [list "" Fold<List> "List/" Monad<List>]
diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux
index ee364d819..6d54f2614 100644
--- a/stdlib/source/lux/lexer.lux
+++ b/stdlib/source/lux/lexer.lux
@@ -15,7 +15,7 @@
[product]
[char "Char/" Ord<Char>]
maybe
- error
+ [error #- fail]
(struct [list "" Functor<List>]))
host))
diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux
index bd8c755d3..e2689aeb5 100644
--- a/stdlib/source/lux/macro/syntax.lux
+++ b/stdlib/source/lux/macro/syntax.lux
@@ -17,7 +17,7 @@
[ident]
(struct [list #* "" Functor<List> Fold<List> "List/" Monoid<List>])
[product]
- error))
+ [error #- fail]))
(.. [ast]))
## [Utils]
diff --git a/stdlib/source/lux/math/random.lux b/stdlib/source/lux/math/random.lux
index 9fe4f4fd6..0a76f3365 100644
--- a/stdlib/source/lux/math/random.lux
+++ b/stdlib/source/lux/math/random.lux
@@ -129,7 +129,7 @@
right <gen>]
(wrap (<ctor> left right))))]
- [ratio r;Ratio r;ratio int]
+ [ratio r;Ratio r;ratio nat]
[complex c;Complex c;complex real]
)
diff --git a/stdlib/source/lux/math/ratio.lux b/stdlib/source/lux/math/ratio.lux
index c2c9e7183..1baa9a206 100644
--- a/stdlib/source/lux/math/ratio.lux
+++ b/stdlib/source/lux/math/ratio.lux
@@ -11,89 +11,95 @@
number
codec
monad)
- (data [number "i:" Number<Int> Codec<Text,Int>]
+ (data [number "n/" Number<Nat> Codec<Text,Nat>]
[text "Text/" Monoid<Text>]
- error)
+ error
+ [product])
[compiler]
(macro [ast]
["s" syntax #+ syntax: Syntax])))
(type: #export Ratio
- {#numerator Int
- #denominator Int})
+ {#numerator Nat
+ #denominator Nat})
(def: #hidden (normalize (^slots [#numerator #denominator]))
(-> Ratio Ratio)
- (let [common (nat-to-int (math;gcd (int-to-nat (i:abs numerator))
- (int-to-nat (i:abs denominator))))
- numerator (i./ common numerator)
- denominator (i./ common denominator)]
- {#numerator (if (and (i.< 0 numerator)
- (i.< 0 denominator))
- (i:abs numerator)
- numerator)
- #denominator (i:abs denominator)}))
+ (let [common (math;gcd numerator denominator)]
+ {#numerator (n./ common numerator)
+ #denominator (n./ common denominator)}))
(def: #export (q.* param input)
(-> Ratio Ratio Ratio)
- (normalize [(i.* (get@ #numerator param)
+ (normalize [(n.* (get@ #numerator param)
(get@ #numerator input))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #denominator input))]))
(def: #export (q./ param input)
(-> Ratio Ratio Ratio)
- (normalize [(i.* (get@ #denominator param)
+ (normalize [(n.* (get@ #denominator param)
(get@ #numerator input))
- (i.* (get@ #numerator param)
+ (n.* (get@ #numerator param)
(get@ #denominator input))]))
(def: #export (q.+ param input)
(-> Ratio Ratio Ratio)
- (normalize [(i.+ (i.* (get@ #denominator input)
+ (normalize [(n.+ (n.* (get@ #denominator input)
(get@ #numerator param))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #numerator input)))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #denominator input))]))
(def: #export (q.- param input)
(-> Ratio Ratio Ratio)
- (normalize [(i.- (i.* (get@ #denominator input)
+ (normalize [(n.- (n.* (get@ #denominator input)
(get@ #numerator param))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #numerator input)))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #denominator input))]))
(def: #export (q.% param input)
(-> Ratio Ratio Ratio)
- (let [quot (i./ (i.* (get@ #denominator input)
+ (let [quot (n./ (n.* (get@ #denominator input)
(get@ #numerator param))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #numerator input)))]
- (q.- (update@ #numerator (i.* quot) param)
+ (q.- (update@ #numerator (n.* quot) param)
input)))
(def: #export (q.= param input)
(-> Ratio Ratio Bool)
- (and (i.= (get@ #numerator param)
+ (and (n.= (get@ #numerator param)
(get@ #numerator input))
- (i.= (get@ #denominator param)
+ (n.= (get@ #denominator param)
(get@ #denominator input))))
(do-template [<name> <op>]
[(def: #export (<name> param input)
(-> Ratio Ratio Bool)
- (and (<op> (i.* (get@ #denominator input)
+ (and (<op> (n.* (get@ #denominator input)
(get@ #numerator param))
- (i.* (get@ #denominator param)
+ (n.* (get@ #denominator param)
(get@ #numerator input)))))]
- [q.< i.<]
- [q.<= i.<=]
- [q.> i.>]
- [q.>= i.>=]
+ [q.< n.<]
+ [q.<= n.<=]
+ [q.> n.>]
+ [q.>= n.>=]
+ )
+
+(do-template [<name> <comp>]
+ [(def: #export (<name> left right)
+ (-> Ratio Ratio Ratio)
+ (if (<comp> left right)
+ right
+ left))]
+
+ [q.min q.<]
+ [q.max q.>]
)
(struct: #export _ (Eq Ratio)
@@ -113,24 +119,39 @@
(def: * q.*)
(def: / q./)
(def: % q.%)
- (def: negate (|>. (update@ #numerator i:negate) normalize))
- (def: abs (|>. (update@ #numerator i:abs) (update@ #denominator i:abs)))
+ (def: (negate (^slots [#numerator #denominator]))
+ {#numerator denominator
+ #denominator numerator})
+ (def: abs id)
(def: (signum x)
- {#numerator (i:signum (get@ #numerator x))
- #denominator 1}))
+ {#numerator +1
+ #denominator +1}))
(def: separator Text ":")
+(def: part-encode
+ (-> Nat Text)
+ (|>. n/encode (text;split +1) (default (undefined)) product;right))
+
+(def: (part-decode part)
+ (-> Text (Error Nat))
+ (case (text;split-with "+" part)
+ (#;Some [_ part])
+ (n/decode part)
+
+ _
+ (fail "Invalid format for ratio part.")))
+
(struct: #export _ (Codec Text Ratio)
(def: (encode (^slots [#numerator #denominator]))
- ($_ Text/append (i:encode numerator) separator (i:encode denominator)))
+ ($_ Text/append (part-encode numerator) separator (part-encode denominator)))
(def: (decode input)
(case (text;split-with separator input)
(#;Some [num denom])
(do Monad<Error>
- [numerator (i:decode num)
- denominator (i:decode denom)]
+ [numerator (part-decode num)
+ denominator (part-decode denom)]
(wrap (normalize {#numerator numerator
#denominator denominator})))
diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux
index f6adbc162..9b6e70fbc 100644
--- a/stdlib/source/lux/math/simple.lux
+++ b/stdlib/source/lux/math/simple.lux
@@ -6,13 +6,46 @@
(;module:
lux
(lux (control monad)
- (data text/format)
+ (data text/format
+ [product]
+ (struct [list]))
[compiler]
(macro [ast]
["s" syntax #+ syntax: Syntax])
[type]
(type [check])))
+(def: (find-type-var id env)
+ (-> Nat (Bindings Nat (Maybe Type)) (Lux Type))
+ (case (list;find (|>. product;left (n.= id))
+ (get@ #;mappings env))
+ (#;Some [_ (#;Some type)])
+ (case type
+ (#;VarT id')
+ (find-type-var id' env)
+
+ _
+ (:: compiler;Monad<Lux> wrap type))
+
+ (#;Some [_ #;None])
+ (compiler;fail (format "Unbound type-var " (%n id)))
+
+ #;None
+ (compiler;fail (format "Unknown type-var " (%n id)))
+ ))
+
+(def: (resolve-type var-name)
+ (-> Ident (Lux Type))
+ (do compiler;Monad<Lux>
+ [raw-type (compiler;find-type var-name)
+ compiler compiler;get-compiler]
+ (case raw-type
+ (#;VarT id)
+ (find-type-var id (get@ #;type-vars compiler))
+
+ _
+ (wrap raw-type))))
+
(do-template [<name> <rec> <nat-op> <int-op> <real-op> <frac-op>]
[(syntax: #export (<name> {args ($_ s;alt
(s;seq s;symbol s;symbol)
@@ -23,8 +56,8 @@
(case args
(+0 [x y])
(do @
- [=x (compiler;find-type x)
- =y (compiler;find-type y)
+ [=x (resolve-type x)
+ =y (resolve-type y)
op (cond (and (check;checks? Nat =x)
(check;checks? Nat =y))
(wrap (` <nat-op>))
@@ -54,7 +87,7 @@
(+2 x)
(do @
- [=x (compiler;find-type x)
+ [=x (resolve-type x)
op (cond (check;checks? Nat =x)
(wrap (` <nat-op>))
@@ -100,85 +133,12 @@
[* ;;* n.* i.* r.* f.*]
[/ ;;/ n./ i./ r./ f./]
[% ;;% n.% i.% r.% f.%]
- )
-
-(do-template [<name> <rec> <nat-op> <int-op> <real-op>]
- [(syntax: #export (<name> {args ($_ s;alt
- (s;seq s;symbol s;symbol)
- (s;seq s;any s;any)
- s;symbol
- s;any
- s;end)})
- (case args
- (+0 [x y])
- (do @
- [=x (compiler;find-type x)
- =y (compiler;find-type y)
- op (cond (and (check;checks? Nat =x)
- (check;checks? Nat =y))
- (wrap (` <nat-op>))
-
- (and (check;checks? Int =x)
- (check;checks? Int =y))
- (wrap (` <int-op>))
-
- (and (check;checks? Real =x)
- (check;checks? Real =y))
- (wrap (` <real-op>))
-
- (compiler;fail (format "No operation for types: " (%type =x) " and " (%type =y))))]
- (wrap (list (` ((~ op) (~ (ast;symbol x)) (~ (ast;symbol y)))))))
-
- (+1 [x y])
- (do @
- [g!x (compiler;gensym "g!x")
- g!y (compiler;gensym "g!y")]
- (wrap (list (` (let [(~ g!x) (~ x)
- (~ g!y) (~ y)]
- (<rec> (~ g!x) (~ g!y)))))))
-
- (+2 x)
- (do @
- [=x (compiler;find-type x)
- op (cond (check;checks? Nat =x)
- (wrap (` <nat-op>))
-
- (check;checks? Int =x)
- (wrap (` <int-op>))
-
- (check;checks? Real =x)
- (wrap (` <real-op>))
-
- (compiler;fail (format "No operation for type: " (%type =x))))]
- (wrap (list (` ((~ op) (~ (ast;symbol x)))))))
-
- (+3 x)
- (do @
- [g!x (compiler;gensym "g!x")]
- (wrap (list (` (let [(~ g!x) (~ x)]
- (<rec> (~ g!x)))))))
-
- (+4 [])
- (do @
- [=e compiler;expected-type
- op (cond (check;checks? (-> Nat Nat Nat) =e)
- (wrap (` <nat-op>))
-
- (check;checks? (-> Int Int Int) =e)
- (wrap (` <int-op>))
-
- (check;checks? (-> Real Real Real) =e)
- (wrap (` <real-op>))
-
- (compiler;fail (format "No operation for type: " (%type =e))))]
- (wrap (list op)))
- ))]
- [= ;;= n.= i.= r.=]
- [< ;;< n.< i.< r.<]
- [<= ;;<= n.<= i.<= r.<=]
- [> ;;> n.> i.> r.>]
- [>= ;;>= n.>= i.>= r.>=]
+ [= ;;= n.= i.= r.= f.=]
+ [< ;;< n.< i.< r.< f.<]
+ [<= ;;<= n.<= i.<= r.<= f.<=]
+ [> ;;> n.> i.> r.> f.>]
+ [>= ;;>= n.>= i.>= r.>= f.>=]
)
(do-template [<name> <rec> <nat-op> <int-op>]
@@ -191,8 +151,8 @@
(case args
(+0 [x y])
(do @
- [=x (compiler;find-type x)
- =y (compiler;find-type y)
+ [=x (resolve-type x)
+ =y (resolve-type y)
op (cond (and (check;checks? Nat =x)
(check;checks? Nat =y))
(wrap (` <nat-op>))
@@ -214,7 +174,7 @@
(+2 x)
(do @
- [=x (compiler;find-type x)
+ [=x (resolve-type x)
op (cond (check;checks? Nat =x)
(wrap (` <nat-op>))
@@ -255,7 +215,7 @@
(case args
(+0 x)
(do @
- [=x (compiler;find-type x)
+ [=x (resolve-type x)
op (cond (check;checks? Nat =x)
(wrap (` <nat-op>))
@@ -296,7 +256,7 @@
(case args
(+0 x)
(do @
- [=x (compiler;find-type x)
+ [=x (resolve-type x)
op (cond (check;checks? Nat =x)
(wrap (` <nat-op>))
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index 161019d91..0d3deb7b9 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -16,7 +16,7 @@
[product]
[text]
text/format
- [error #* "Error/" Monad<Error>])
+ [error #- fail "Error/" Monad<Error>])
(codata [io #- run])
(math ["R" random])
[host #- try]))
diff --git a/stdlib/source/lux/type/check.lux b/stdlib/source/lux/type/check.lux
index 16bfc9e2c..88f165cb3 100644
--- a/stdlib/source/lux/type/check.lux
+++ b/stdlib/source/lux/type/check.lux
@@ -15,7 +15,7 @@
[product]
(struct [list]
[dict])
- error)
+ [error #- fail])
[type "Type/" Eq<Type>]
))
diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux
index ff1d831b6..7940cb22d 100644
--- a/stdlib/test/test/lux/concurrency/actor.lux
+++ b/stdlib/test/test/lux/concurrency/actor.lux
@@ -8,7 +8,7 @@
(lux (control monad)
(data [number]
text/format
- error)
+ [error #- fail])
(concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>]
["&" actor #+ actor:])
(codata function
diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux
index 65d38b9c2..6bec2ea37 100644
--- a/stdlib/test/test/lux/concurrency/frp.lux
+++ b/stdlib/test/test/lux/concurrency/frp.lux
@@ -8,7 +8,7 @@
(lux (control monad)
(data [number]
text/format
- error)
+ [error #- fail])
(concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>]
["&" frp])
(codata function
diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux
index c8e8acad7..51a62df7f 100644
--- a/stdlib/test/test/lux/concurrency/promise.lux
+++ b/stdlib/test/test/lux/concurrency/promise.lux
@@ -8,7 +8,7 @@
(lux (control monad)
(data [number]
text/format
- error)
+ [error #- fail])
(concurrency ["&" promise])
(codata function
[io #- run])
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
index 270a42358..39f039717 100644
--- a/stdlib/test/test/lux/data/format/json.lux
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -11,7 +11,7 @@
eq)
(data [text "Text/" Monoid<Text>]
text/format
- error
+ [error #- fail]
[bool]
[char]
[maybe]
diff --git a/stdlib/test/test/lux/math/ratio.lux b/stdlib/test/test/lux/math/ratio.lux
new file mode 100644
index 000000000..9c7eacd77
--- /dev/null
+++ b/stdlib/test/test/lux/math/ratio.lux
@@ -0,0 +1,106 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (lux (codata [io])
+ (control monad)
+ (data [text "Text/" Monoid<Text>]
+ text/format
+ [bool "b/" Eq<Bool>]
+ [number "r/" Number<Real>]
+ (struct [list "List/" Fold<List> Functor<List>])
+ [product])
+ (codata function)
+ (math ["R" random])
+ pipe
+ ["&" math/ratio "&/" Number<Ratio>])
+ lux/test)
+
+(def: gen-ratio
+ (R;Random &;Ratio)
+ (do R;Monad<Random>
+ [numerator R;nat
+ denominator (|> R;nat (R;filter (|>. (n.= +0) not)))]
+ (wrap (&;ratio numerator denominator))))
+
+(test: "Normalization"
+ [denom1 R;nat
+ denom2 R;nat
+ sample gen-ratio]
+ ($_ seq
+ (assert "All zeroes are the same."
+ (&;q.= (&;ratio +0 denom1)
+ (&;ratio +0 denom2)))
+
+ (assert "All ratios are built normalized."
+ (|> sample &;normalize (&;q.= sample)))
+ ))
+
+(test: "Arithmetic"
+ [x gen-ratio
+ y gen-ratio
+ #let [min (&;q.min x y)
+ max (&;q.max x y)]]
+ ($_ seq
+ (assert "Addition and subtraction are opposites."
+ (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max))
+ (|> max (&;q.+ min) (&;q.- min) (&;q.= max))))
+
+ (assert "Multiplication and division are opposites."
+ (and (|> max (&;q./ min) (&;q.* min) (&;q.= max))
+ (|> max (&;q.* min) (&;q./ min) (&;q.= max))))
+
+ (assert "Modulus by a larger ratio doesn't change the value."
+ (|> min (&;q.% max) (&;q.= min)))
+
+ (assert "Modulus by a smaller ratio results in a value smaller than the limit."
+ (|> max (&;q.% min) (&;q.< min)))
+
+ (assert "Can get the remainder of a division."
+ (let [remainder (&;q.% min max)
+ multiple (&;q.- remainder max)
+ factor (&;q./ min multiple)]
+ (and (|> factor (get@ #&;denominator) (n.= +1))
+ (|> factor (&;q.* min) (&;q.+ remainder) (&;q.= max)))))
+ ))
+
+(test: "Negation, absolute value and signum"
+ [sample gen-ratio]
+ ($_ seq
+ (assert "Negation is it's own inverse."
+ (let [there (&/negate sample)
+ back-again (&/negate there)]
+ (and (not (&;q.= there sample))
+ (&;q.= back-again sample))))
+
+ (assert "All ratios are already at their absolute value."
+ (|> sample &/abs (&;q.= sample)))
+
+ (assert "Signum is the identity."
+ (|> sample (&;q.* (&/signum sample)) (&;q.= sample)))
+ ))
+
+(test: "Order"
+ [x gen-ratio
+ y gen-ratio]
+ ($_ seq
+ (assert "Can compare ratios."
+ (and (or (&;q.<= y x)
+ (&;q.> y x))
+ (or (&;q.>= y x)
+ (&;q.< y x))))
+ ))
+
+(test: "Codec"
+ [sample gen-ratio
+ #let [(^open "&/") &;Codec<Text,Ratio>]]
+ (assert "Can encode/decode ratios."
+ (|> sample &/encode &/decode
+ (case> (#;Right output)
+ (&;q.= sample output)
+
+ _
+ false))))
diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux
new file mode 100644
index 000000000..9e3af0c59
--- /dev/null
+++ b/stdlib/test/test/lux/math/simple.lux
@@ -0,0 +1,107 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (lux (codata [io])
+ (control monad)
+ (data [text "Text/" Monoid<Text>]
+ text/format
+ [bool "b/" Eq<Bool>]
+ [number "r/" Number<Real>]
+ (struct [list "List/" Fold<List> Functor<List>])
+ [product])
+ (codata function)
+ (math ["R" random])
+ pipe
+ ["&" math/simple])
+ lux/test)
+
+(do-template [<category> <generator> <=> <+> <-> <*> </> <%>]
+ [(test: (format <category> " aritmetic")
+ [x <generator>
+ y <generator>]
+ ($_ seq
+ (assert "Can add."
+ (<=> (<+> y x) (&;+ y x)))
+ (assert "Can subtract."
+ (<=> (<-> y x) (&;- y x)))
+ (assert "Can multiply."
+ (<=> (<*> y x) (&;* y x)))
+ (assert "Can divide."
+ (<=> (</> y x) (&;/ y x)))
+ (assert "Can get remainder."
+ (<=> (<%> y x) (&;% y x)))
+ ))]
+
+ ["Nat" R;nat n.= n.+ n.- n.* n./ n.%]
+ ["Int" R;int i.= i.+ i.- i.* i./ i.%]
+ ["Real" R;real r.= r.+ r.- r.* r./ r.%]
+ ["Frac" R;frac f.= f.+ f.- f.* f./ f.%]
+ )
+
+(do-template [<category> <generator> <lt> <lte> <gt> <gte>]
+ [(test: (format <category> " comparisons")
+ [x <generator>
+ y <generator>]
+ ($_ seq
+ (assert "<"
+ (b/= (<lt> y x) (&;< y x)))
+ (assert "<="
+ (b/= (<lte> y x) (&;<= y x)))
+ (assert ">"
+ (b/= (<gt> y x) (&;> y x)))
+ (assert ">="
+ (b/= (<gte> y x) (&;>= y x)))
+ ))]
+
+ ["Nat" R;nat n.< n.<= n.> n.>=]
+ ["Int" R;int i.< i.<= i.> i.>=]
+ ["Real" R;real r.< r.<= r.> r.>=]
+ ["Frac" R;frac f.< f.<= f.> f.>=]
+ )
+
+(do-template [<category> <generator> <=> <min> <max>]
+ [(test: (format <category> " min & max")
+ [x <generator>
+ y <generator>]
+ ($_ seq
+ (assert "Min."
+ (<=> (<min> y x) (&;min y x)))
+ (assert "Max."
+ (<=> (<max> y x) (&;max y x)))
+ ))]
+
+ ["Nat" R;nat n.= n.min n.max]
+ ["Int" R;int i.= i.min i.max]
+ )
+
+(do-template [<category> <generator> <=> <inc> <dec>]
+ [(test: (format <category> " inc & dec")
+ [x <generator>]
+ ($_ seq
+ (assert "Inc."
+ (<=> (<inc> x) (&;inc x)))
+ (assert "Dec."
+ (<=> (<dec> x) (&;dec x)))
+ ))]
+
+ ["Nat" R;nat n.= n.inc n.dec]
+ ["Int" R;int i.= i.inc i.dec]
+ )
+
+(do-template [<category> <generator> <even?> <odd?>]
+ [(test: (format <category> " even & odd")
+ [x <generator>]
+ ($_ seq
+ (assert "Even."
+ (b/= (<even?> x) (&;even? x)))
+ (assert "Odd."
+ (b/= (<odd?> x) (&;odd? x)))
+ ))]
+
+ ["Nat" R;nat n.even? n.odd?]
+ ["Int" R;int i.even? i.odd?]
+ )
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 86de3d341..4b46a7cd5 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -47,10 +47,10 @@
[zipper])
(text [format]))
["_;" math]
- (math ## ["_;" ratio]
+ (math ["_;" ratio]
["_;" complex]
## ["_;" random]
- ## ["_;" simple]
+ ["_;" simple]
)
## ["_;" pipe]
## ["_;" lexer]
@@ -59,6 +59,7 @@
## (macro [ast]
## [syntax])
## [type]
+ ## (control ...)
)
)
## (lux (codata [cont])
@@ -69,9 +70,7 @@
## ["poly_;" text-encoder]
## ["poly_;" functor]))
## (type [check] [auto])
- ## (control [effect])
- ## ["_;" lexer]
- ## ["_;" regex])
+ ## (control [effect]))
)
## [Program]
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-22 06:13:09 +0000