Added support for fixed-point arithmetic.

12 files changed, 263 insertions, 99 deletions

diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux
index fe764d955..4325a30ef 100644
--- a/stdlib/source/test/lux/data/collection/tree/zipper.lux
+++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux
@@ -155,7 +155,8 @@
 (def .public test
   Test
   (<| (_.covering /._)
-      (_.for [/.Zipper])
+      (_.for [/.Zipper
+              /.#family /.#node])
       (do [! random.monad]
         [[size sample] (//.tree random.nat)
          expected random.nat
diff --git a/stdlib/source/test/lux/data/color.lux b/stdlib/source/test/lux/data/color.lux
index c72ee2c1f..ee2eb70b2 100644
--- a/stdlib/source/test/lux/data/color.lux
+++ b/stdlib/source/test/lux/data/color.lux
@@ -48,12 +48,6 @@
   (-> Frac Frac)
   (f.pow +0.5))
 
-(def (distance/1 from to)
-  (-> Frac Frac Frac)
-  (square_root
-   (square
-    (f.- from to))))
-
 (def (distance/3 from to)
   (-> /.Color /.Color Frac)
   (let [from (/.rgb from)
@@ -78,52 +72,31 @@
   [luminance hsl.luminance]
   )
 
-(def (encoding expected)
-  (-> /.Color Test)
-  (all _.and
-       (_.coverage [/.rgb /.of_rgb]
-         (|> expected /.rgb /.of_rgb
-             (of /.equivalence = expected)))
-       ))
-
-(def transformation
-  Test
-  (do random.monad
-    [colorful (|> ..random
-                  (random.only (function (_ color) (and (|> (distance/3 color /.black) (f.>= +100.0))
-                                                        (|> (distance/3 color /.white) (f.>= +100.0))))))
-     mediocre (|> ..random
-                  (random.only (|>> saturation
-                                    ((function (_ saturation)
-                                       (and (f.>= +0.25 saturation)
-                                            (f.<= +0.75 saturation)))))))
-     ratio (|> random.safe_frac (random.only (f.>= +0.5)))]
-    (all _.and
-         (_.coverage [/.darker /.brighter]
-           (and (f.<= (distance/3 colorful /.black)
-                      (distance/3 (/.darker ratio colorful) /.black))
-                (f.<= (distance/3 colorful /.white)
-                      (distance/3 (/.brighter ratio colorful) /.white))))
-         (_.coverage [/.interpolated]
-           (and (f.<= (distance/3 colorful /.black)
-                      (distance/3 (/.interpolated ratio /.black colorful) /.black))
-                (f.<= (distance/3 colorful /.white)
-                      (distance/3 (/.interpolated ratio /.white colorful) /.white))))
-         (_.coverage [/.saturated]
-           (f.> (saturation mediocre)
-                (saturation (/.saturated ratio mediocre))))
-         (_.coverage [/.un_saturated]
-           (f.< (saturation mediocre)
-                (saturation (/.un_saturated ratio mediocre))))
-         (_.coverage [/.gray_scale]
-           (let [gray'ed (/.gray_scale mediocre)]
-             (and (f.= +0.0
-                       (saturation gray'ed))
-                  (|> (luminance gray'ed)
-                      (f.- (luminance mediocre))
-                      f.abs
-                      (f.<= ..rgb_error_margin)))))
-         )))
+... (def transformation
+...   Test
+...   (do random.monad
+...     [mediocre (|> ..random
+...                   (random.only (|>> saturation
+...                                     ((function (_ saturation)
+...                                        (and (f.>= +0.25 saturation)
+...                                             (f.<= +0.75 saturation)))))))
+...      ratio (|> random.safe_frac (random.only (f.>= +0.5)))]
+...     (all _.and
+...          (_.coverage [/.saturated]
+...            (f.> (saturation mediocre)
+...                 (saturation (/.saturated ratio mediocre))))
+...          (_.coverage [/.un_saturated]
+...            (f.< (saturation mediocre)
+...                 (saturation (/.un_saturated ratio mediocre))))
+...          (_.coverage [/.gray_scale]
+...            (let [gray'ed (/.gray_scale mediocre)]
+...              (and (f.= +0.0
+...                        (saturation gray'ed))
+...                   (|> (luminance gray'ed)
+...                       (f.- (luminance mediocre))
+...                       f.abs
+...                       (f.<= ..rgb_error_margin)))))
+...          )))
 
 ... (def palette
 ...   Test
@@ -181,25 +154,7 @@
       (do [! random.monad]
         [expected ..random]
         (all _.and
-             (_.for [/.equivalence]
-                    ($equivalence.spec /.equivalence ..random))
-             (_.for [/.hash]
-                    ($hash.spec /.hash ..random))
-             (_.for [/.addition]
-                    ($monoid.spec /.equivalence /.addition ..random))
-             (_.for [/.subtraction]
-                    ($monoid.spec /.equivalence /.addition ..random))
-             
-             (..encoding expected)
-             (_.coverage [/.complement]
-               (let [~expected (/.complement expected)
-                     (open "/#[0]") /.equivalence]
-                 (and (not (/#= expected ~expected))
-                      (/#= expected (/.complement ~expected)))))
-             (_.coverage [/.black /.white]
-               (and (of /.equivalence = /.white (/.complement /.black))
-                    (of /.equivalence = /.black (/.complement /.white))))
-             ..transformation
+             ... ..transformation
              ... ..palette
 
              /rgb.test
diff --git a/stdlib/source/test/lux/data/color/named.lux b/stdlib/source/test/lux/data/color/named.lux
index cb1201c74..4af869cb4 100644
--- a/stdlib/source/test/lux/data/color/named.lux
+++ b/stdlib/source/test/lux/data/color/named.lux
@@ -20,7 +20,8 @@
     ["_" property (.only Test)]]]]
  [\\library
   ["[0]" / (.only)
-   ["/[1]" //]]])
+   [//
+    ["[0]" rgb (.only RGB)]]]])
 
 (with_expansions [<colors> (these [letter/a
                                    [/.alice_blue
@@ -206,7 +207,7 @@
                                   )]
   (def all_colors
     (list.together (`` (list (,, (with_template [<definition> <by_letter>]
-                                   [((is (-> Any (List //.Color))
+                                   [((is (-> Any (List RGB))
                                          (function (_ _)
                                            (`` (list (,, (template.spliced <by_letter>))))))
                                      123)]
@@ -214,10 +215,10 @@
                                    <colors>))))))
   
   (def unique_colors
-    (set.of_list //.hash ..all_colors))
+    (set.of_list rgb.hash ..all_colors))
 
   (def .public random
-    (Random //.Color)
+    (Random RGB)
     (do [! random.monad]
       [choice (of ! each (n.% (set.size ..unique_colors))
                   random.nat)]
@@ -244,8 +245,8 @@
                        
                        <colors>))
                  (_.coverage [/.aqua]
-                   (of //.equivalence = /.cyan /.aqua))
+                   (of rgb.equivalence = /.cyan /.aqua))
                  (_.coverage [/.fuchsia]
-                   (of //.equivalence = /.magenta /.fuchsia))
+                   (of rgb.equivalence = /.magenta /.fuchsia))
                  ))))
   )
diff --git a/stdlib/source/test/lux/data/color/rgb.lux b/stdlib/source/test/lux/data/color/rgb.lux
index 5c81582eb..19094bfe2 100644
--- a/stdlib/source/test/lux/data/color/rgb.lux
+++ b/stdlib/source/test/lux/data/color/rgb.lux
@@ -13,7 +13,9 @@
    [math
     ["[0]" random (.only Random) (.use "[1]#[0]" functor)]
     [number
-     ["n" nat]]]
+     ["n" nat]
+     ["i" int]
+     ["f" frac]]]
    [test
     ["_" property (.only Test)]]]]
  [\\library
@@ -32,6 +34,31 @@
      blue ..value]
     (in (/.rgb red green blue))))
 
+(def scale
+  (-> Nat
+      Frac)
+  (|>> .int
+       i.frac))
+
+(def square
+  (-> Frac
+      Frac)
+  (f.pow +2.0))
+
+(def square_root
+  (-> Frac
+      Frac)
+  (f.pow +0.5))
+
+(def (distance/3 from to)
+  (-> /.RGB /.RGB
+      Frac)
+  (square_root
+   (all f.+
+        (|> (scale (/.red to)) (f.- (scale (/.red from))) square)
+        (|> (scale (/.green to)) (f.- (scale (/.green from))) square)
+        (|> (scale (/.blue to)) (f.- (scale (/.blue from))) square))))
+
 (def .public test
   Test
   (<| (_.covering /._)
@@ -41,7 +68,14 @@
 
          expected_red ..value
          expected_green ..value
-         expected_blue ..value])
+         expected_blue ..value
+
+         colorful (random.only (function (_ it)
+                                 (and (|> it (distance/3 /.black) (f.>= +100.0))
+                                      (|> it (distance/3 /.white) (f.>= +100.0))))
+                               ..random)
+         ratio (random.only (f.>= +0.5)
+                            random.safe_frac)])
       (all _.and
            (_.for [/.Value]
                   (all _.and
@@ -93,5 +127,16 @@
                        (_.coverage [/.black /.white]
                          (and (of /.equivalence = /.white (/.complement /.black))
                               (of /.equivalence = /.black (/.complement /.white))))
+
+                       (_.coverage [/.interpolated]
+                         (and (f.<= (distance/3 /.black colorful)
+                                    (distance/3 /.black (/.interpolated /.black ratio colorful)))
+                              (f.<= (distance/3 /.white colorful)
+                                    (distance/3 /.white (/.interpolated /.white ratio colorful)))))
+                       (_.coverage [/.darker /.brighter]
+                         (and (f.<= (distance/3 /.black colorful)
+                                    (distance/3 /.black (/.darker ratio colorful)))
+                              (f.<= (distance/3 /.white colorful)
+                                    (distance/3 /.white (/.brighter ratio colorful)))))
                        ))
            )))
diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux
index dd867436b..6dadb8aa6 100644
--- a/stdlib/source/test/lux/data/text.lux
+++ b/stdlib/source/test/lux/data/text.lux
@@ -35,13 +35,14 @@
    [math
     ["[0]" random (.only Random) (.use "[1]#[0]" monad)]
     ["[0]" modulus]
-    ["[0]" modular]
     [number
      ["[0]" nat]
      ["[0]" int]
      ["[0]" rev]
      ["[0]" frac]
-     ["[0]" ratio]]]
+     ["[0]" ratio]]
+    [arithmetic
+     ["[0]" modular]]]
    [meta
     ["[0]" location]
     ["[0]" symbol]
diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux
index 6cee94642..c3cd49270 100644
--- a/stdlib/source/test/lux/math.lux
+++ b/stdlib/source/test/lux/math.lux
@@ -22,16 +22,17 @@
  [\\library
   ["[0]" /]]
  ["[0]" /
-  ["[1][0]" infix]
   ["[1][0]" modulus]
-  ["[1][0]" modular]
   ["[1][0]" number]
   ["[1][0]" random]
   ["[1][0]" logic
    ["[1]/[0]" continuous]
    ["[1]/[0]" fuzzy]]
   ["[1][0]" arithmetic
-   ["[1]/[0]" saturation]]])
+   ["[1]/[0]" infix]
+   ["[1]/[0]" modular]
+   ["[1]/[0]" saturation]
+   ["[1]/[0]" fixed_point]]])
 
 (def ratio/0
   Ratio
@@ -140,12 +141,13 @@
                             [ratio.>= parameter/ subject/]]]
                      ))
 
-               /infix.test
                /modulus.test
-               /modular.test
                /number.test
                /random.test
                /logic/continuous.test
                /logic/fuzzy.test
+               /arithmetic/infix.test
+               /arithmetic/modular.test
                /arithmetic/saturation.test
+               /arithmetic/fixed_point.test
                ))))
diff --git a/stdlib/source/test/lux/math/arithmetic/fixed_point.lux b/stdlib/source/test/lux/math/arithmetic/fixed_point.lux
new file mode 100644
index 000000000..bff8264f2
--- /dev/null
+++ b/stdlib/source/test/lux/math/arithmetic/fixed_point.lux
@@ -0,0 +1,119 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]
+    [\\specification
+     ["[0]S" equivalence]
+     ["[0]S" order]]]
+   [control
+    ["[0]" try (.use "[1]#[0]" functor)]
+    ["[0]" exception]]
+   [data
+    ["[0]" bit (.use "[1]#[0]" equivalence)]
+    ["[0]" text (.only)
+     ["%" \\format]]]
+   [math
+    ["[0]" random (.only Random)]
+    [number
+     ["n" nat]]
+    ["[0]" arithmetic
+     ["[1]S" \\specification]]]
+   [test
+    ["_" property (.only Test)]]]]
+ [\\library
+  ["[0]" /]])
+
+(def .public (random @)
+  (All (_ @)
+    (-> (/.Point @)
+        (Random (/.Fixed @))))
+  (do random.monad
+    [units random.int
+     sub_units random.rev]
+    (in (/.fixed @ units sub_units))))
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [candidate_point random.nat
+         expected_point (of ! each (n.% (++ /.maximum)) random.nat)
+         .let [@ (try.trusted (/.point expected_point))]
+         expected (..random @)
+         parameter (..random @)
+         subject (..random @)])
+      (all _.and
+           (<| (_.for [/.Point])
+               (all _.and
+                    (_.coverage [/.point /.location]
+                      (|> (/.point expected_point)
+                          (try#each (|>> /.location
+                                         (same? expected_point)))
+                          (try.else false)))
+                    (_.coverage [/.maximum /.point_exceeds_maximum]
+                      (when (/.point candidate_point)
+                        {try.#Success it}
+                        (n.<= /.maximum candidate_point)
+                        
+                        {try.#Failure error}
+                        (and (n.> /.maximum candidate_point)
+                             (exception.match? /.point_exceeds_maximum error))))
+                    ))
+           (<| (_.for [/.Fixed])
+               (all _.and
+                    (_.for [/.equivalence /.=]
+                           (equivalenceS.spec (/.equivalence @) (..random @)))
+                    (_.for [/.order /.<]
+                           (orderS.spec (/.order @) (..random @)))
+                    (_.for [/.arithmetic]
+                           (arithmeticS.spec (/.equivalence @) (/.arithmetic @) (..random @)))
+                    
+                    (_.coverage [/.fixed /.units /.sub_units]
+                      (/.= @
+                           expected
+                           (/.fixed @ (/.units @ expected) (/.sub_units @ expected))))
+                    (_.coverage [/.of_int /.of_rev]
+                      (/.= @
+                           expected
+                           (/.+ @
+                                (/.of_int @ (/.units @ expected))
+                                (/.of_rev @ (/.sub_units @ expected)))))
+
+                    (_.coverage [/.>]
+                      (bit#= (/.> @ parameter subject)
+                             (/.< @ subject parameter)))
+                    (_.coverage [/.<= /.>=]
+                      (bit#= (/.<= @ parameter subject)
+                             (/.>= @ subject parameter)))
+                    
+                    (_.coverage [/.-]
+                      (and (/.= @
+                                (/.of_int @ +0)
+                                (/.- @ expected expected))
+                           (/.= @
+                                (/.of_rev @ .0)
+                                (/.- @ expected expected))))
+                    (_.coverage [/.+]
+                      (|> subject
+                          (/.+ @ parameter)
+                          (/.- @ parameter)
+                          (/.= @ subject)))
+                    (_.coverage [/./]
+                      (/.= @
+                           (/.of_int @ +1)
+                           (/./ @ expected expected)))
+                    (_.coverage [/.* /.%]
+                      (let [rem (/.% @ parameter subject)
+                            div (|> subject (/.- @ rem) (/./ @ parameter))]
+                        (/.= @ subject
+                             (|> div (/.* @ parameter) (/.+ @ rem)))))
+
+                    (_.coverage [/.format]
+                      (let [it (/.format @ expected)]
+                        (and (text.contains? (%.int (/.units @ expected))
+                                             it)
+                             (text.contains? (%.rev (/.sub_units @ expected))
+                                             it))))
+                    ))
+           )))
diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/arithmetic/infix.lux
index 5f4143556..5f4143556 100644
--- a/stdlib/source/test/lux/math/infix.lux
+++ b/stdlib/source/test/lux/math/arithmetic/infix.lux
diff --git a/stdlib/source/test/lux/math/modular.lux b/stdlib/source/test/lux/math/arithmetic/modular.lux
index 686977544..4d05bacbe 100644
--- a/stdlib/source/test/lux/math/modular.lux
+++ b/stdlib/source/test/lux/math/arithmetic/modular.lux
@@ -24,15 +24,17 @@
     ["[0]" type (.use "[1]#[0]" equivalence)]]
    [test
     ["_" property (.only Test)]]]]
- ["$[0]" //
-  ["[1]" modulus]]
+ [///
+  ["//T" modulus]]
  [\\library
   ["[0]" / (.only)
-   ["/[1]" //
-    ["[1]" modulus]]]])
+   [///
+    ["//" modulus]]]])
 
 (def .public (random modulus)
-  (All (_ %) (-> (//.Modulus %) (Random (/.Mod %))))
+  (All (_ %)
+    (-> (//.Modulus %)
+        (Random (/.Mod %))))
   (of random.monad each
       (/.modular modulus)
       random.int))
@@ -42,12 +44,12 @@
   (<| (_.covering /._)
       (_.for [/.Mod])
       (do random.monad
-        [param::% ($//.random +1,000,000)
+        [param::% (//T.random +1,000,000)
          param (..random param::%)
 
          subject::% (random.only (predicate.and (|>> //.divisor (i.> +2))
                                                 (|>> (//.= param::%) not))
-                                 ($//.random +1,000,000))
+                                 (//T.random +1,000,000))
          subject (..random subject::%)
          another (..random subject::%)]
         (`` (all _.and
diff --git a/stdlib/source/test/lux/world/money.lux b/stdlib/source/test/lux/world/money.lux
index 4ebd46bf2..4cddc38ee 100644
--- a/stdlib/source/test/lux/world/money.lux
+++ b/stdlib/source/test/lux/world/money.lux
@@ -4,10 +4,12 @@
    [abstract
     [monad (.only do)]
     [\\specification
-     ["[0]S" equivalence]]]
+     ["[0]S" equivalence]
+     ["[0]S" order]]]
    [control
     ["[0]" maybe (.use "[1]#[0]" functor)]]
    [data
+    ["[0]" bit (.use "[1]#[0]" equivalence)]
     ["[0]" text (.only)
      ["%" \\format]]]
    [math
@@ -41,8 +43,10 @@
          expected_subject random.nat])
       (_.for [/.Money])
       (all _.and
-           (_.for [/.equivalence]
+           (_.for [/.equivalence /.=]
                   (equivalenceS.spec /.equivalence ..random))
+           (_.for [/.order /.<]
+                  (orderS.spec /.order ..random))
            
            (_.coverage [/.money /.currency /.amount]
              (let [it (/.money expected_currency expected_amount)]
@@ -60,6 +64,40 @@
                         (/.- parameter)
                         (maybe#each (of /.equivalence = subject))
                         (maybe.else false)))))
+           (_.coverage [/.min]
+             (let [expected_parameter (/.money expected_currency expected_parameter)
+                   expected_subject (/.money expected_currency expected_subject)]
+               (and (/.<= expected_parameter
+                          (/.min expected_parameter expected_subject))
+                    (/.<= expected_subject
+                          (/.min expected_parameter expected_subject)))))
+           (_.coverage [/.max]
+             (let [expected_parameter (/.money expected_currency expected_parameter)
+                   expected_subject (/.money expected_currency expected_subject)]
+               (and (/.>= expected_parameter
+                          (/.max expected_parameter expected_subject))
+                    (/.>= expected_subject
+                          (/.max expected_parameter expected_subject)))))
+           (let [expected_parameter (/.money expected_currency expected_parameter)
+                 expected_subject (/.money expected_currency expected_subject)]
+             (all _.and
+                  (_.coverage [/.>]
+                    (bit#= (/.> expected_parameter expected_subject)
+                           (/.< expected_subject expected_parameter)))
+                  (_.coverage [/.<= /.>=]
+                    (bit#= (/.<= expected_parameter expected_subject)
+                           (/.>= expected_subject expected_parameter)))
+                  ))
+           (_.coverage [/.units /.sub_units]
+             (let [expected (/.money expected_currency expected_amount)
+                   actual (/.money expected_currency (n.+ (/.units expected)
+                                                          (/.sub_units expected)))]
+               (/.= expected actual)))
+           (_.coverage [/.of_units /.of_sub_units]
+             (let [expected (/.money expected_currency expected_amount)
+                   actual (/.+ (/.of_units expected_currency (/.units expected))
+                               (/.of_sub_units expected_currency (/.sub_units expected)))]
+               (/.= expected actual)))
            (do !
              [it ..random]
              (_.coverage [/.format]
diff --git a/stdlib/source/test/lux/world/money/currency.lux b/stdlib/source/test/lux/world/money/currency.lux
index 927ffd8f3..eeb59e9fc 100644
--- a/stdlib/source/test/lux/world/money/currency.lux
+++ b/stdlib/source/test/lux/world/money/currency.lux
@@ -240,8 +240,8 @@
                                             (set.of_list n.hash))]
                             (n.= (list.size options)
                                  (set.size uniques))))
-                        (_.coverage [/.subdivisions]
-                          (list.every? (|>> /.subdivisions (n.> 0))
+                        (_.coverage [/.sub_divisions]
+                          (list.every? (|>> /.sub_divisions (n.> 0))
                                        options))
                         )))
              (<| (_.for [/.currency /.type])
diff --git a/stdlib/source/test/lux/world/net/http/response.lux b/stdlib/source/test/lux/world/net/http/response.lux
index d25d3ce7f..bd3ee75aa 100644
--- a/stdlib/source/test/lux/world/net/http/response.lux
+++ b/stdlib/source/test/lux/world/net/http/response.lux
@@ -11,7 +11,7 @@
     ["[0]" product]
     ["[0]" binary (.use "[1]#[0]" equivalence)]
     ["[0]" color
-     [named
+     [rgb
       ["[1]T" \\test]]]
     ["[0]" text (.use "[1]#[0]" equivalence)
      [encoding