- Expanded the lux/control/interval module.

- Implemented Enum<Real>.

4 files changed, 399 insertions, 21 deletions

diff --git a/stdlib/source/lux/control/interval.lux b/stdlib/source/lux/control/interval.lux
index 7071c49ef..1b197840b 100644
--- a/stdlib/source/lux/control/interval.lux
+++ b/stdlib/source/lux/control/interval.lux
@@ -1,27 +1,184 @@
 (;module:
   lux
-  (lux (control ord)))
+  (lux (control eq
+                [ord]
+                [enum #+ Enum])))
 
 ## Signatures
 (sig: #export (Interval a)
   {#;doc "A representation of top and bottom boundaries for an ordered type."}
-  (: (Ord a)
-     ord)
+  (: (Enum a)
+     enum)
 
   (: a
-     top)
+     bottom)
 
   (: a
-     bottom))
+     top))
 
-(def: #export (within? Interval<a> elem)
+(def: #export (between Enum<a> bottom top)
+  (All [a] (-> (Enum a) a a (Interval a)))
+  (struct (def: enum Enum<a>)
+          (def: bottom bottom)
+          (def: top top)))
+
+(def: #export (singleton Enum<a> elem)
+  (All [a] (-> (Enum a) a (Interval a)))
+  (struct (def: enum Enum<a>)
+          (def: bottom elem)
+          (def: top elem)))
+
+(do-template [<name> <comp>]
+  [(def: #export (<name> interval)
+     (All [a] (-> (Interval a) Bool))
+     (let [(^open) interval]
+       (<comp> bottom top)))]
+
+  [inner?     >]
+  [outer?     <]
+  [singleton? =]
+  )
+
+(def: #export (within? interval elem)
+  (All [a] (-> (Interval a) a Bool))
+  (let [(^open) interval]
+    (cond (inner? interval)
+          (and (>= bottom elem)
+               (<= top elem))
+          
+          (outer? interval)
+          (or (>= bottom elem)
+              (<= top elem))
+          
+          ## singleton
+          (and (= bottom elem)
+               (= top elem)))))
+
+(do-template [<name> <limit>]
+  [(def: #export (<name> elem interval)
+     (All [a] (-> a (Interval a) Bool))
+     (let [(^open) interval]
+       (= <limit> elem)))]
+
+  [starts-with? bottom]
+  [ends-with?   top]
+  )
+
+(def: #export (borders? interval elem)
   (All [a] (-> (Interval a) a Bool))
-  (let [(^open) Interval<a>]
-    (if (>= bottom top)
-      ## Inside order
-      (and (>= bottom elem)
-           (<= top elem))
-      ## Outside order
-      (and (<= bottom elem)
-           (>= top elem))
-      )))
+  (or (starts-with? elem interval)
+      (ends-with? elem interval)))
+
+(def: #export (union left right)
+  (All [a] (-> (Interval a) (Interval a) (Interval a)))
+  (struct (def: enum (get@ #enum right))
+          (def: bottom (ord;min (get@ [#enum #enum;ord] right) (:: left bottom) (:: right bottom)))
+          (def: top (ord;max (get@ [#enum #enum;ord] right) (:: left top) (:: right top)))))
+
+(def: #export (intersection left right)
+  (All [a] (-> (Interval a) (Interval a) (Interval a)))
+  (struct (def: enum (get@ #enum right))
+          (def: bottom (ord;max (get@ [#enum #enum;ord] right) (:: left bottom) (:: right bottom)))
+          (def: top (ord;min (get@ [#enum #enum;ord] right) (:: left top) (:: right top)))))
+
+(def: #export (complement interval)
+  (All [a] (-> (Interval a) (Interval a)))
+  (let [(^open) interval]
+    (struct (def: enum (get@ #enum interval))
+            (def: bottom (succ top))
+            (def: top (pred bottom)))))
+
+(def: #export (precedes? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bool))
+  (let [(^open) reference
+        limit (:: reference bottom)]
+    (and (< limit (:: sample bottom))
+         (< limit (:: sample top)))))
+
+(def: #export (succeeds? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bool))
+  (precedes? sample reference))
+
+(def: #export (meets? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bool))
+  (let [(^open) reference
+        limit (:: reference bottom)]
+    (and (<= limit (:: sample bottom))
+         (= limit (:: sample top)))))
+
+(def: #export (touches? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bool))
+  (or (meets? reference sample)
+      (meets? sample reference)))
+
+(do-template [<name> <eq-side> <ineq> <ineq-side>]
+  [(def: #export (<name> reference sample)
+     (All [a] (-> (Interval a) (Interval a) Bool))
+     (let [(^open) reference]
+       (and (=      (:: reference <eq-side>)   (:: sample <eq-side>))
+            (<ineq> (:: reference <ineq-side>) (:: sample <ineq-side>)))))]
+
+  [starts?   bottom <= top]
+  [finishes? top    >= bottom]
+  )
+
+(do-template [<name> <comp>]
+  [(def: #export (<name> reference sample)
+     (All [a] (-> a (Interval a) Bool))
+     (let [(^open) sample]
+       (and (<comp> reference bottom)
+            (<comp> reference top))))]
+
+  [before? <]
+  [after?  >]
+  )
+
+(struct: #export Eq<Interval> (All [a] (Eq (Interval a)))
+  (def: (= reference sample)
+    (let [(^open) reference]
+      (and (= bottom (:: sample bottom))
+           (= top (:: sample top))))))
+
+(def: #export (nested? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bool))
+  (cond (or (singleton? sample)
+            (and (inner? reference) (inner? sample))
+            (and (outer? reference) (outer? sample)))
+        (let [(^open) reference]
+          (and (>= (:: reference bottom) (:: sample bottom))
+               (<= (:: reference top) (:: sample top))))
+
+        (or (singleton? reference)
+            (and (inner? reference) (outer? sample)))
+        false
+
+        ## (and (outer? reference) (inner? sample))
+        (let [(^open) reference]
+          (or (and (>= (:: reference bottom) (:: sample bottom))
+                   (> (:: reference bottom) (:: sample top)))
+              (and (< (:: reference top) (:: sample bottom))
+                   (<= (:: reference top) (:: sample top)))))
+        ))
+
+(def: #export (overlaps? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bool))
+  (let [(^open) reference]
+    (cond (singleton? sample)
+          false
+
+          (singleton? reference)
+          (and (>= (:: sample bottom) (:: reference bottom))
+               (<= (:: sample top) (:: reference top)))
+
+          (or (and (inner? sample) (outer? reference))
+              (and (outer? sample) (inner? reference)))
+          (or (>= (:: reference bottom) (:: sample top))
+              (<= (:: reference top) (:: sample bottom)))
+          
+          (inner? sample)
+          (and (not (:: Eq<Interval> = reference sample))
+               (inner? (intersection reference sample)))
+
+          ## (outer? sample)
+          (not (:: Eq<Interval> = reference sample))
+          )))
diff --git a/stdlib/source/lux/data/number.lux b/stdlib/source/lux/data/number.lux
index 1a29fc5b6..8c1c021b4 100644
--- a/stdlib/source/lux/data/number.lux
+++ b/stdlib/source/lux/data/number.lux
@@ -92,18 +92,21 @@
 
   [Nat Ord<Nat> n.inc n.dec]
   [Int Ord<Int> i.inc i.dec]
+  [Real Ord<Real> (r.+ (_lux_proc [ "real" "smallest-value"] [])) (r.- (_lux_proc [ "real" "smallest-value"] []))]
+  [Deg Ord<Deg> (d.+ (_lux_proc [ "deg" "min-value"] [])) (d.- (_lux_proc [ "deg" "min-value"] []))]
   )
 
-(do-template [<type> <ord> <top> <bottom>]
+(do-template [<type> <enum> <top> <bottom>]
   [(struct: #export _ (Interval <type>)
-     (def: ord <ord>)
+     (def: enum <enum>)
      (def: top <top>)
      (def: bottom <bottom>))]
 
-  [ Nat Ord<Nat>  (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])]
-  [ Int Ord<Int>  (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])]
-  [Real Ord<Real> (_lux_proc ["real" "max-value"] []) (_lux_proc ["real" "min-value"] [])]
-  [ Deg Ord<Deg>  (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])])
+  [ Nat Enum<Nat>  (_lux_proc [ "nat" "max-value"] []) (_lux_proc [ "nat" "min-value"] [])]
+  [ Int Enum<Int>  (_lux_proc [ "int" "max-value"] []) (_lux_proc [ "int" "min-value"] [])]
+  [Real Enum<Real> (_lux_proc ["real" "max-value"] []) (_lux_proc ["real" "min-value"] [])]
+  [ Deg Enum<Deg>  (_lux_proc [ "deg" "max-value"] []) (_lux_proc [ "deg" "min-value"] [])]
+  )
 
 (do-template [<name> <type> <unit> <append>]
   [(struct: #export <name> (Monoid <type>)
diff --git a/stdlib/test/test/lux/control/interval.lux b/stdlib/test/test/lux/control/interval.lux
new file mode 100644
index 000000000..2127ff6df
--- /dev/null
+++ b/stdlib/test/test/lux/control/interval.lux
@@ -0,0 +1,217 @@
+(;module:
+  lux
+  lux/test
+  (lux (control monad
+                ["&" interval])
+       [io]
+       ["R" math/random]
+       (data text/format
+             [number]
+             ["S" coll/set]
+             ["L" coll/list])
+       pipe))
+
+(test: "Equality."
+  [bottom R;int
+   top R;int
+   #let [(^open "&/") &;Eq<Interval>]]
+  ($_ seq
+      (assert "Every interval is equal to itself."
+              (and (let [self (&;between number;Enum<Int> bottom top)]
+                     (&/= self self))
+                   (let [self (&;between number;Enum<Int> top bottom)]
+                     (&/= self self))
+                   (let [self (&;singleton number;Enum<Int> bottom)]
+                     (&/= self self))))))
+
+(test: "Boundaries"
+  [bottom R;int
+   top R;int
+   #let [interval (&;between number;Enum<Int> bottom top)]]
+  ($_ seq
+      (assert "Every boundary value belongs to it's interval."
+              (and (&;within? interval bottom)
+                   (&;within? interval top)))
+      (assert "Every interval starts with its bottom."
+              (&;starts-with? bottom interval))
+      (assert "Every interval ends with its top."
+              (&;ends-with? top interval))
+      (assert "The boundary values border the interval."
+              (and (&;borders? interval bottom)
+                   (&;borders? interval top)))
+      ))
+
+(def: (list-to-4tuple list)
+  (-> (List Int) [Int Int Int Int])
+  (case list
+    (^ (list x0 x1 x2 x3))
+    [x0 x1 x2 x3]
+
+    _
+    (undefined)))
+
+
+(do-template [<name> <cmp>]
+  [(def: <name>
+     (R;Random (&;Interval Int))
+     (do R;Monad<Random>
+       [bottom R;int
+        top (|> R;int (R;filter (|>. (i.= bottom) not)))]
+       (if (<cmp> top bottom)
+         (wrap (&;between number;Enum<Int> bottom top))
+         (wrap (&;between number;Enum<Int> top bottom)))))]
+
+  [gen-inner i.<]
+  [gen-outer i.>]
+  )
+
+(def: gen-singleton
+  (R;Random (&;Interval Int))
+  (do R;Monad<Random>
+    [point R;int]
+    (wrap (&;singleton number;Enum<Int> point))))
+
+(def: gen-interval
+  (R;Random (&;Interval Int))
+  ($_ R;either
+      gen-inner
+      gen-outer
+      gen-singleton))
+
+(test: "Unions"
+  [some-interval gen-interval
+   left-inner gen-inner
+   right-inner gen-inner
+   left-singleton gen-singleton
+   right-singleton gen-singleton
+   left-outer gen-outer
+   right-outer gen-outer
+   #let [(^open "&/") &;Eq<Interval>]]
+  ($_ seq
+      (assert "The union of an interval to itself yields the same interval."
+              (&/= some-interval (&;union some-interval some-interval)))
+      (assert "The union of 2 inner intervals is another inner interval."
+              (&;inner? (&;union left-inner right-inner)))
+      (assert "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do."
+              (if (&;overlaps? (&;complement left-outer) (&;complement right-outer))
+                (&;outer? (&;union left-outer right-outer))
+                (&;inner? (&;union left-outer right-outer))))
+      ))
+
+(test: "Intersections"
+  [some-interval gen-interval
+   left-inner gen-inner
+   right-inner gen-inner
+   left-singleton gen-singleton
+   right-singleton gen-singleton
+   left-outer gen-outer
+   right-outer gen-outer
+   #let [(^open "&/") &;Eq<Interval>]]
+  ($_ seq
+      (assert "The intersection of an interval to itself yields the same interval."
+              (&/= some-interval (&;intersection some-interval some-interval)))
+      (assert "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't."
+              (if (&;overlaps? left-inner right-inner)
+                (&;inner? (&;intersection left-inner right-inner))
+                (&;outer? (&;intersection left-inner right-inner))))
+      (assert "The intersection of 2 outer intervals is another outer interval."
+              (&;outer? (&;intersection left-outer right-outer)))
+      ))
+
+(test: "Complement"
+  [some-interval gen-interval
+   #let [(^open "&/") &;Eq<Interval>]]
+  ($_ seq
+      (assert "The complement of a complement is the same as the original."
+              (&/= some-interval (|> some-interval &;complement &;complement)))
+      (assert "The complement of an interval does not overlap it."
+              (not (&;overlaps? some-interval (&;complement some-interval))))
+      ))
+
+(test: "Positioning/location"
+  [[l m r] (|> (R;set number;Hash<Int> +3 R;int)
+               (:: @ map (|>. S;to-list
+                              (L;sort i.<)
+                              (case> (^ (list b t1 t2))
+                                     [b t1 t2]
+
+                                     _
+                                     (undefined)))))
+   #let [left (&;singleton number;Enum<Int> l)
+         right (&;singleton number;Enum<Int> r)]]
+  ($_ seq
+      (assert "'precedes?' and 'succeeds?' are symetric."
+              (and (&;precedes? right left)
+                   (&;succeeds? left right)))
+      (assert "Can check if an interval is before or after some element."
+              (and (&;before? m left)
+                   (&;after? m right)))
+      ))
+
+(test: "Touching intervals"
+  [[b t1 t2] (|> (R;set number;Hash<Int> +3 R;int)
+                 (:: @ map (|>. S;to-list
+                                (L;sort i.<)
+                                (case> (^ (list b t1 t2))
+                                       [b t1 t2]
+
+                                       _
+                                       (undefined)))))
+   #let [int-left (&;between number;Enum<Int> t1 t2)
+         int-right (&;between number;Enum<Int> b t1)]]
+  ($_ seq
+      (assert "An interval meets another if it's top is the other's bottom."
+              (&;meets? int-left int-right))
+      (assert "Two intervals touch one another if any one meets the other."
+              (&;touches? int-left int-right))
+      (assert "Can check if 2 intervals start together."
+              (&;starts? (&;between number;Enum<Int> b t2)
+                         (&;between number;Enum<Int> b t1)))
+      (assert "Can check if 2 intervals finish together."
+              (&;finishes? (&;between number;Enum<Int> b t2)
+                           (&;between number;Enum<Int> t1 t2)))
+      ))
+
+(test: "Nesting & overlap"
+  [some-interval gen-interval
+   [x0 x1 x2 x3] (|> (R;set number;Hash<Int> +4 R;int)
+                     (:: @ map (|>. S;to-list
+                                    (L;sort i.<)
+                                    (case> (^ (list x0 x1 x2 x3))
+                                           [x0 x1 x2 x3]
+
+                                           _
+                                           (undefined)))))]
+  ($_ seq
+      (assert "Every interval is nested into itself."
+              (&;nested? some-interval some-interval))
+      (assert "No interval overlaps with itself."
+              (not (&;overlaps? some-interval some-interval)))
+      (let [small-inner (&;between number;Enum<Int> x1 x2)
+            large-inner (&;between number;Enum<Int> x0 x3)]
+        (assert "Inner intervals can be nested inside one another."
+                (and (&;nested? large-inner small-inner)
+                     (not (&;nested? small-inner large-inner)))))
+      (let [left-inner (&;between number;Enum<Int> x0 x2)
+            right-inner (&;between number;Enum<Int> x1 x3)]
+        (assert "Inner intervals can overlap one another."
+                (and (&;overlaps? left-inner right-inner)
+                     (&;overlaps? right-inner left-inner))))
+      (let [small-outer (&;between number;Enum<Int> x2 x1)
+            large-outer (&;between number;Enum<Int> x3 x0)]
+        (assert "Outer intervals can be nested inside one another."
+                (and (&;nested? small-outer large-outer)
+                     (not (&;nested? large-outer small-outer)))))
+      (let [left-inner (&;between number;Enum<Int> x0 x1)
+            right-inner (&;between number;Enum<Int> x2 x3)
+            outer (&;between number;Enum<Int> x0 x3)]
+        (assert "Inners can be nested inside outers."
+                (and (&;nested? outer left-inner)
+                     (&;nested? outer right-inner))))
+      (let [left-inner (&;between number;Enum<Int> x0 x2)
+            right-inner (&;between number;Enum<Int> x1 x3)
+            outer (&;between number;Enum<Int> x1 x2)]
+        (assert "Inners can overlap outers."
+                (and (&;overlaps? outer left-inner)
+                     (&;overlaps? outer right-inner))))
+      ))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index ce01da97e..d92595424 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -22,6 +22,7 @@
                           ["_;" frp]
                           ["_;" promise]
                           ["_;" stm])
+             (control ["_;" interval])
              ["_;" effect]
              (data [bit]
                    [bool]