diff options
author | Eduardo Julian | 2017-07-22 18:26:19 -0400 |
---|---|---|
committer | Eduardo Julian | 2017-07-22 18:26:19 -0400 |
commit | be51cd8fdbcb7a71bdb451ea5c67ff93da84eb76 (patch) | |
tree | 533655cc90463efa55558ce58b97e8ab1a828a02 | |
parent | 1550dcf419662e19eb4c1dd21ce316060d03e52b (diff) |
- Eliminated lux/math/simple. If you want simple math, use lux/type/auto with the relevant signatures.
-rw-r--r-- | stdlib/source/lux/math/simple.lux | 306 | ||||
-rw-r--r-- | stdlib/test/test/lux/math/simple.lux | 100 | ||||
-rw-r--r-- | stdlib/test/tests.lux | 3 |
3 files changed, 1 insertions, 408 deletions
diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux deleted file mode 100644 index 752f5a5b5..000000000 --- a/stdlib/source/lux/math/simple.lux +++ /dev/null @@ -1,306 +0,0 @@ -(;module: {#;doc "Polymorphic arithmetic operators that work with all primitive numeric types, without requiring any prefixes."} - lux - (lux (control monad - ["p" parser]) - (data text/format - [product] - (coll [list])) - [macro] - (macro [code] - ["s" syntax #+ syntax: Syntax]) - [type] - (type [check]))) - -(def: (find-type-var id env) - (-> Nat Type-Context (Lux Type)) - (case (list;find (|>. product;left (n.= id)) - (get@ #;var-bindings env)) - (#;Some [_ (#;Some type)]) - (case type - (#;Var id') - (find-type-var id' env) - - _ - (:: macro;Monad<Lux> wrap type)) - - (#;Some [_ #;None]) - (macro;fail (format "Unbound type-var " (%n id))) - - #;None - (macro;fail (format "Unknown type-var " (%n id))) - )) - -(def: (resolve-type var-name) - (-> Ident (Lux Type)) - (do macro;Monad<Lux> - [raw-type (macro;find-type var-name) - compiler macro;get-compiler] - (case raw-type - (#;Var id) - (find-type-var id (get@ #;type-context compiler)) - - _ - (wrap raw-type)))) - -(do-template [<name> <rec> <nat-op> <int-op> <real-op> <deg-op>] - [(syntax: #export (<name> [args ($_ p;alt - (p;seq (p;alt s;symbol s;any) - (p;some s;any)) - s;end!)]) - ## {#;doc (doc (= (<name> +1 +2) - ## (<nat-op> +1 +2)) - ## (= (<name> 1 2) - ## (<int-op> 1 2)) - ## (= (<name> 1.0 2.0) - ## (<real-op> 1.0 2.0)) - ## (= (<name> .1 .2) - ## (<deg-op> .1 .2)))} - (case args - (+0 [(#;Left x) ys]) - (do @ - [=x (resolve-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>)) - - (check;checks? Deg =x) - (wrap (` <deg-op>)) - - (macro;fail (format "No operation for types: " (%type =x))))] - (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys)))))) - - (+0 [(#;Right x) ys]) - (do @ - [g!x (macro;gensym "g!x")] - (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x) (~@ ys))))))) - - (+1 []) - (do @ - [=e macro;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>)) - - (check;checks? (-> Deg Deg Deg) =e) - (wrap (` <deg-op>)) - - (macro;fail (format "No operation for type: " (%type =e))))] - (wrap (list op))) - ))] - - [+ ;;+ n.+ i.+ r.+ d.+] - [- ;;- n.- i.- r.- d.-] - [* ;;* n.* i.* r.* d.*] - [/ ;;/ n./ i./ r./ d./] - [% ;;% n.% i.% r.% d.%] - ) - -(do-template [<name> <rec> <nat-op> <int-op> <real-op> <deg-op>] - [(syntax: #export (<name> [args ($_ p;alt - (p;seq (p;alt s;symbol s;any) - (p;some s;any)) - s;end!)]) - ## {#;doc (doc (= (<name> +1 +2) - ## (<nat-op> +1 +2)) - ## (= (<name> 1 2) - ## (<int-op> 1 2)) - ## (= (<name> 1.0 2.0) - ## (<real-op> 1.0 2.0)) - ## (= (<name> .1 .2) - ## (<deg-op> .1 .2)))} - (case args - (+0 [(#;Left x) ys]) - (do @ - [=x (resolve-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>)) - - (check;checks? Deg =x) - (wrap (` <deg-op>)) - - (macro;fail (format "No operation for types: " (%type =x))))] - (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys)))))) - - (+0 [(#;Right x) ys]) - (do @ - [g!x (macro;gensym "g!x")] - (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x) (~@ ys))))))) - - (+1 []) - (do @ - [=e macro;expected-type - op (cond (check;checks? (-> Nat Nat Bool) =e) - (wrap (` <nat-op>)) - - (check;checks? (-> Int Int Bool) =e) - (wrap (` <int-op>)) - - (check;checks? (-> Real Real Bool) =e) - (wrap (` <real-op>)) - - (check;checks? (-> Deg Deg Bool) =e) - (wrap (` <deg-op>)) - - (macro;fail (format "No operation for type: " (%type =e))))] - (wrap (list op))) - ))] - - [= ;;= n.= i.= r.= d.=] - [< ;;< n.< i.< r.< d.<] - [<= ;;<= n.<= i.<= r.<= d.<=] - [> ;;> n.> i.> r.> d.>] - [>= ;;>= n.>= i.>= r.>= d.>=] - ) - -(do-template [<name> <rec> <nat-op> <int-op>] - [(syntax: #export (<name> [args ($_ p;alt - (p;seq (p;alt s;symbol s;any) - (p;some s;any)) - s;end!)]) - ## {#;doc (doc (= (<name> +1 +2) - ## (<nat-op> +1 +2)) - ## (= (<name> 1 2) - ## (<int-op> 1 2)))} - (case args - (+0 [(#;Left x) ys]) - (do @ - [=x (resolve-type x) - op (cond (check;checks? Nat =x) - (wrap (` <nat-op>)) - - (check;checks? Int =x) - (wrap (` <int-op>)) - - (macro;fail (format "No operation for types: " (%type =x))))] - (wrap (list (` ($_ (~ op) (~ (code;symbol x)) (~@ ys)))))) - - (+0 [(#;Right x) ys]) - (do @ - [g!x (macro;gensym "g!x")] - (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x) (~@ ys))))))) - - (+1 []) - (do @ - [=e macro;expected-type - op (cond (check;checks? (-> Nat Nat Nat) =e) - (wrap (` <nat-op>)) - - (check;checks? (-> Int Int Int) =e) - (wrap (` <int-op>)) - - (macro;fail (format "No operation for type: " (%type =e))))] - (wrap (list op))) - ))] - - [min ;;min n.min i.min] - [max ;;max n.max i.max] - ) - -(do-template [<name> <rec> <nat-op> <int-op>] - [(syntax: #export (<name> [args ($_ p;alt - s;symbol - s;any - s;end!)]) - ## {#;doc (doc (= (<name> +1 +2) - ## (<nat-op> +1 +2)) - ## (= (<name> 1 2) - ## (<int-op> 1 2)))} - (case args - (+0 x) - (do @ - [=x (resolve-type x) - op (cond (check;checks? Nat =x) - (wrap (` <nat-op>)) - - (check;checks? Int =x) - (wrap (` <int-op>)) - - (macro;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (code;symbol x))))))) - - (+1 x) - (do @ - [g!x (macro;gensym "g!x")] - (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x))))))) - - (+2 []) - (do @ - [=e macro;expected-type - op (cond (check;checks? (-> Nat Nat) =e) - (wrap (` <nat-op>)) - - (check;checks? (-> Int Int) =e) - (wrap (` <int-op>)) - - (macro;fail (format "No operation for type: " (%type =e))))] - (wrap (list op))) - ))] - - [inc ;;inc n.inc i.inc] - [dec ;;dec n.dec i.dec] - ) - -(do-template [<name> <rec> <nat-op> <int-op>] - [(syntax: #export (<name> [args ($_ p;alt - s;symbol - s;any - s;end!)]) - ## {#;doc (doc (= (<name> +1 +2) - ## (<nat-op> +1 +2)) - ## (= (<name> 1 2) - ## (<int-op> 1 2)))} - (case args - (+0 x) - (do @ - [=x (resolve-type x) - op (cond (check;checks? Nat =x) - (wrap (` <nat-op>)) - - (check;checks? Int =x) - (wrap (` <int-op>)) - - (macro;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (code;symbol x))))))) - - (+1 x) - (do @ - [g!x (macro;gensym "g!x")] - (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x))))))) - - (+2 []) - (do @ - [=e macro;expected-type - op (cond (check;checks? (-> Nat Bool) =e) - (wrap (` <nat-op>)) - - (check;checks? (-> Int Bool) =e) - (wrap (` <int-op>)) - - (macro;fail (format "No operation for type: " (%type =e))))] - (wrap (list op))) - ))] - - [even? ;;even? n.even? i.even?] - [odd? ;;odd? n.odd? i.odd?] - ) diff --git a/stdlib/test/test/lux/math/simple.lux b/stdlib/test/test/lux/math/simple.lux deleted file mode 100644 index 1b35c4069..000000000 --- a/stdlib/test/test/lux/math/simple.lux +++ /dev/null @@ -1,100 +0,0 @@ -(;module: - lux - (lux [io] - (control monad) - (data [text "Text/" Monoid<Text>] - text/format - [bool "b/" Eq<Bool>] - [number "r/" Number<Real>] - (coll [list "List/" Fold<List> Functor<List>]) - [product]) - ["R" math/random] - ["&" math/simple]) - lux/test) - -(do-template [<category> <generator> <=> <+> <-> <*> </> <%> <0>] - [(context: (format <category> " arihtmetic") - [x <generator> - y (|> <generator> (R;filter (. not (<=> <0>))))] - ($_ seq - (test "Can add." - (<=> (<+> y x) (&;+ y x))) - (test "Can subtract." - (<=> (<-> y x) (&;- y x))) - (test "Can multiply." - (<=> (<*> y x) (&;* y x))) - (test "Can divide." - (<=> (</> y x) (&;/ y x))) - (test "Can get remainder." - (<=> (<%> y x) (&;% y x))) - ))] - - ["Nat" R;nat n.= n.+ n.- n.* n./ n.% +0] - ["Int" R;int i.= i.+ i.- i.* i./ i.% 0] - ["Real" R;real r.= r.+ r.- r.* r./ r.% 0.0] - ["Deg" R;deg d.= d.+ d.- d.* d./ d.% .0] - ) - -(do-template [<category> <generator> <lt> <lte> <gt> <gte>] - [(context: (format <category> " comparisons") - [x <generator> - y <generator>] - ($_ seq - (test "<" - (b/= (<lt> y x) (&;< y x))) - (test "<=" - (b/= (<lte> y x) (&;<= y x))) - (test ">" - (b/= (<gt> y x) (&;> y x))) - (test ">=" - (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.>=] - ["Deg" R;deg d.< d.<= d.> d.>=] - ) - -(do-template [<category> <generator> <=> <min> <max>] - [(context: (format <category> " min & max") - [x <generator> - y <generator>] - ($_ seq - (test "Min." - (<=> (<min> y x) (&;min y x))) - (test "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>] - [(context: (format <category> " inc & dec") - [x <generator>] - ($_ seq - (test "Inc." - (<=> (<inc> x) (&;inc x))) - (test "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?>] - [(context: (format <category> " even & odd") - [x <generator>] - ($_ seq - (test "Even." - (b/= (<even?> x) (&;even? x))) - (test "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 be26d43fb..34c5c9be2 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -55,8 +55,7 @@ ["_;" lexer] ["_;" regex])) ["_;" math] - (math ["_;" simple] - (logic ["_;" continuous] + (math (logic ["_;" continuous] ["_;" fuzzy])) (macro ["_;" code] ["_;" syntax] |