From 6095c8149a4f0c47333d50186f0758d286d30dec Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Mon, 12 Dec 2016 20:15:49 -0400
Subject: - Small fixes, refactorings and expansions.

---
 stdlib/source/lux/math/simple.lux | 89 +++++++++++++++++++++++++++++++++++++--
 1 file changed, 86 insertions(+), 3 deletions(-)

(limited to 'stdlib/source/lux/math/simple.lux')

diff --git a/stdlib/source/lux/math/simple.lux b/stdlib/source/lux/math/simple.lux
index 9b6e70fbc..bb66e1160 100644
--- a/stdlib/source/lux/math/simple.lux
+++ b/stdlib/source/lux/math/simple.lux
@@ -133,11 +133,94 @@
   [* ;;* n.* i.* r.* f.*]
   [/ ;;/ n./ i./ r./ f./]
   [% ;;% n.% i.% r.% f.%]
+  )
+
+(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;end)})
+     (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)
+       (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? Frac =x)
+                   (wrap (` <frac-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 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? (-> Frac Frac Bool) =e)
+                   (wrap (` <frac-op>))
+
+                   (compiler;fail (format "No operation for type: " (%type =e))))]
+         (wrap (list op)))
+       ))]
 
-  [= ;;= n.= i.= r.= f.=]
-  [< ;;< n.< i.< r.< f.<]
+  [=  ;;=  n.=  i.=  r.=  f.=]
+  [<  ;;<  n.<  i.<  r.<  f.<]
   [<= ;;<= n.<= i.<= r.<= f.<=]
-  [> ;;> n.> i.> r.> f.>]
+  [>  ;;>  n.>  i.>  r.>  f.>]
   [>= ;;>= n.>= i.>= r.>= f.>=]
   )
 
-- 
cgit v1.2.3