diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/math/simple.lux | 139 |
1 files changed, 24 insertions, 115 deletions
diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux index 9de6a54b0..111e5cc8c 100644 --- a/stdlib/source/lux/math/simple.lux +++ b/stdlib/source/lux/math/simple.lux @@ -48,10 +48,8 @@ (do-template [<name> <rec> <nat-op> <int-op> <real-op> <frac-op>] [(syntax: #export (<name> [args ($_ s;alt - (s;seq s;symbol s;symbol) - (s;seq s;any s;any) - s;symbol - s;any + (s;seq (s;alt s;symbol s;any) + (s;some s;any)) s;end)]) ## {#;doc (doc (= (<name> +1 +2) ## (<nat-op> +1 +2)) @@ -62,38 +60,7 @@ ## (= (<name> .1 .2) ## (<frac-op> .1 .2)))} (case args - (+0 [x y]) - (do @ - [=x (resolve-type x) - =y (resolve-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>)) - - (and (check;checks? Frac =x) - (check;checks? Frac =y)) - (wrap (` <frac-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) + (+0 [(#;Left x) ys]) (do @ [=x (resolve-type x) op (cond (check;checks? Nat =x) @@ -108,16 +75,16 @@ (check;checks? Frac =x) (wrap (` <frac-op>)) - (compiler;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (ast;symbol x))))))) + (compiler;fail (format "No operation for types: " (%type =x))))] + (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) - (+3 x) + (+0 [(#;Right x) ys]) (do @ [g!x (compiler;gensym "g!x")] (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x))))))) + (<rec> (~ g!x) (~@ ys))))))) - (+4 []) + (+1 []) (do @ [=e compiler;expected-type op (cond (check;checks? (-> Nat Nat Nat) =e) @@ -145,10 +112,8 @@ (do-template [<name> <rec> <nat-op> <int-op> <real-op> <frac-op>] [(syntax: #export (<name> [args ($_ s;alt - (s;seq s;symbol s;symbol) - (s;seq s;any s;any) - s;symbol - s;any + (s;seq (s;alt s;symbol s;any) + (s;some s;any)) s;end)]) ## {#;doc (doc (= (<name> +1 +2) ## (<nat-op> +1 +2)) @@ -159,38 +124,7 @@ ## (= (<name> .1 .2) ## (<frac-op> .1 .2)))} (case args - (+0 [x y]) - (do @ - [=x (resolve-type x) - =y (resolve-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>)) - - (and (check;checks? Frac =x) - (check;checks? Frac =y)) - (wrap (` <frac-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) + (+0 [(#;Left x) ys]) (do @ [=x (resolve-type x) op (cond (check;checks? Nat =x) @@ -205,16 +139,16 @@ (check;checks? Frac =x) (wrap (` <frac-op>)) - (compiler;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (ast;symbol x))))))) + (compiler;fail (format "No operation for types: " (%type =x))))] + (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) - (+3 x) + (+0 [(#;Right x) ys]) (do @ [g!x (compiler;gensym "g!x")] (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x))))))) + (<rec> (~ g!x) (~@ ys))))))) - (+4 []) + (+1 []) (do @ [=e compiler;expected-type op (cond (check;checks? (-> Nat Nat Bool) =e) @@ -242,40 +176,15 @@ (do-template [<name> <rec> <nat-op> <int-op>] [(syntax: #export (<name> [args ($_ s;alt - (s;seq s;symbol s;symbol) - (s;seq s;any s;any) - s;symbol - s;any + (s;seq (s;alt s;symbol s;any) + (s;some s;any)) s;end)]) ## {#;doc (doc (= (<name> +1 +2) ## (<nat-op> +1 +2)) ## (= (<name> 1 2) ## (<int-op> 1 2)))} (case args - (+0 [x y]) - (do @ - [=x (resolve-type x) - =y (resolve-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>)) - - (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) + (+0 [(#;Left x) ys]) (do @ [=x (resolve-type x) op (cond (check;checks? Nat =x) @@ -284,16 +193,16 @@ (check;checks? Int =x) (wrap (` <int-op>)) - (compiler;fail (format "No operation for type: " (%type =x))))] - (wrap (list (` ((~ op) (~ (ast;symbol x))))))) + (compiler;fail (format "No operation for types: " (%type =x))))] + (wrap (list (` ($_ (~ op) (~ (ast;symbol x)) (~@ ys)))))) - (+3 x) + (+0 [(#;Right x) ys]) (do @ [g!x (compiler;gensym "g!x")] (wrap (list (` (let [(~ g!x) (~ x)] - (<rec> (~ g!x))))))) + (<rec> (~ g!x) (~@ ys))))))) - (+4 []) + (+1 []) (do @ [=e compiler;expected-type op (cond (check;checks? (-> Nat Nat Nat) =e) |