- Small fixes, refactorings and expansions.

5 files changed, 104 insertions, 15 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index bff74ff0c..dd8e70ab6 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2074,7 +2074,7 @@
   [ Nat "nat"  n.= "="   n.< n.<= "<"   n.> n.>=
    "Natural equality." "Natural less-than." "Natural less-than-equal." "Natural greater-than." "Natural greater-than-equal."]
 
-  [ Int "jvm"  i.= "leq" i.< i.<= "llt" i.>  i.>=
+  [ Int "jvm"  i.= "leq" i.< i.<= "llt" i.> i.>=
    "Integer equality." "Integer less-than." "Integer less-than-equal." "Integer greater-than." "Integer greater-than-equal."]
   
   [Frac "frac" f.= "="   f.< f.<= "<"   f.> f.>=
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 8c3d08dbf..046e681b8 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -109,7 +109,8 @@
 
   [ Nat (_lux_proc ["nat" "max-value"] [])                            (_lux_proc ["nat" "min-value"] [])]
   [ Int (_lux_proc ["jvm" "getstatic:java.lang.Long:MAX_VALUE"] [])   (_lux_proc ["jvm" "getstatic:java.lang.Long:MIN_VALUE"] [])]
-  [Real (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])])
+  [Real (_lux_proc ["jvm" "getstatic:java.lang.Double:MAX_VALUE"] []) (_lux_proc ["jvm" "getstatic:java.lang.Double:MIN_VALUE"] [])]
+  [Frac (_lux_proc ["frac" "max-value"] [])                           (_lux_proc ["frac" "max-value"] [])])
 
 (do-template [<name> <type> <unit> <append>]
   [(struct: #export <name> (Monoid <type>)
@@ -128,6 +129,10 @@
   [Mul@Monoid<Real> Real 1.0                       r.*]
   [Max@Monoid<Real> Real (:: Bounded<Real> bottom) r.max]
   [Min@Monoid<Real> Real (:: Bounded<Real> top)    r.min]
+  [Add@Monoid<Frac> Frac (:: Bounded<Frac> bottom) f.+]
+  [Mul@Monoid<Frac> Frac (:: Bounded<Frac> top)    f.*]
+  [Max@Monoid<Frac> Frac (:: Bounded<Frac> bottom) f.max]
+  [Min@Monoid<Frac> Frac (:: Bounded<Frac> top)    f.min]
   )
 
 (def: (text.replace pattern value template)
@@ -197,7 +202,7 @@
 
      (def: (decode repr)
        (_lux_proc ["jvm" "try"]
-                  [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:valueOf:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])])))
+                  [(#;Right (int-to-nat (_lux_proc ["jvm" "invokestatic:java.lang.Long:parseUnsignedLong:java.lang.String,int"] [repr (_lux_proc ["jvm" "l2i"] [<radix>])])))
                    (lambda [ex] (#;Left <error>))])))
 
    (macro: #export (<macro> tokens state)
@@ -233,3 +238,7 @@
   [+inf "getstatic:java.lang.Double:POSITIVE_INFINITY"]
   [-inf "getstatic:java.lang.Double:NEGATIVE_INFINITY"]
   )
+
+(def: #export (nan? number)
+  (-> Real Bool)
+  (not (r.= number number)))
diff --git a/stdlib/source/lux/math/complex.lux b/stdlib/source/lux/math/complex.lux
index 6fac976b8..9a2c7c164 100644
--- a/stdlib/source/lux/math/complex.lux
+++ b/stdlib/source/lux/math/complex.lux
@@ -13,6 +13,7 @@
                 monad)
        (data [number "r/" Number<Real> Codec<Text,Real>]
              [text "Text/" Monoid<Text>]
+             text/format
              error
              maybe
              (struct [list "List/" Monad<List>]))
@@ -39,8 +40,8 @@
 (def: #export zero Complex (complex 0.0 0.0))
 
 (def: #export (nan? complex)
-  (or (r.= number;nan (get@ #real complex))
-      (r.= number;nan (get@ #imaginary complex))))
+  (or (number;nan? (get@ #real complex))
+      (number;nan? (get@ #imaginary complex))))
 
 (def: #export (c.= param input)
   (-> Complex Complex Bool)
diff --git a/stdlib/source/lux/math/ratio.lux b/stdlib/source/lux/math/ratio.lux
index 1baa9a206..c0e077c8a 100644
--- a/stdlib/source/lux/math/ratio.lux
+++ b/stdlib/source/lux/math/ratio.lux
@@ -13,6 +13,7 @@
                 monad)
        (data [number "n/" Number<Nat> Codec<Text,Nat>]
              [text "Text/" Monoid<Text>]
+             text/format
              error
              [product])
        [compiler]
@@ -133,14 +134,9 @@
   (-> Nat Text)
   (|>. n/encode (text;split +1) (default (undefined)) product;right))
 
-(def: (part-decode part)
+(def: part-decode
   (-> Text (Error Nat))
-  (case (text;split-with "+" part)
-    (#;Some [_ part])
-    (n/decode part)
-
-    _
-    (fail "Invalid format for ratio part.")))
+  (|>. (format "+") n/decode))
 
 (struct: #export _ (Codec Text Ratio)
   (def: (encode (^slots [#numerator #denominator]))
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.>=]
   )