- Added tests for lux/math/ratio and lux/math/simple.

- Some minor refactorings.
- Ratios now work with nats instead of ints.

12 files changed, 128 insertions, 138 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>]
        ))