Created the "lux/abstract" branch and moved some modules into it.

1 files changed, 184 insertions, 0 deletions

diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux
new file mode 100644
index 000000000..efb131843
--- /dev/null
+++ b/stdlib/source/lux/abstract/interval.lux
@@ -0,0 +1,184 @@
+(.module:
+  [lux #*]
+  [//
+   [equivalence (#+ Equivalence)]
+   ["." order]
+   [enum (#+ Enum)]])
+
+(signature: #export (Interval a)
+  {#.doc "A representation of top and bottom boundaries for an ordered type."}
+  (: (Enum a)
+     &enum)
+
+  (: a
+     bottom)
+
+  (: a
+     top))
+
+(def: #export (between enum bottom top)
+  (All [a] (-> (Enum a) a a (Interval a)))
+  (structure (def: &enum enum)
+             (def: bottom bottom)
+             (def: top top)))
+
+(def: #export (singleton enum elem)
+  (All [a] (-> (Enum a) a (Interval a)))
+  (structure (def: &enum enum)
+             (def: bottom elem)
+             (def: top elem)))
+
+(template [<name> <comp>]
+  [(def: #export (<name> interval)
+     (All [a] (-> (Interval a) Bit))
+     (let [(^open ".") interval]
+       (<comp> bottom top)))]
+
+  [inner?     >]
+  [outer?     <]
+  [singleton? =]
+  )
+
+(def: #export (within? interval elem)
+  (All [a] (-> (Interval a) a Bit))
+  (let [(^open ".") interval]
+    (cond (inner? interval)
+          (and (>= bottom elem)
+               (<= top elem))
+          
+          (outer? interval)
+          (or (>= bottom elem)
+              (<= top elem))
+          
+          ## singleton
+          (and (= bottom elem)
+               (= top elem)))))
+
+(template [<name> <limit>]
+  [(def: #export (<name> elem interval)
+     (All [a] (-> a (Interval a) Bit))
+     (let [(^open ".") interval]
+       (= <limit> elem)))]
+
+  [starts-with? bottom]
+  [ends-with?   top]
+  )
+
+(def: #export (borders? interval elem)
+  (All [a] (-> (Interval a) a Bit))
+  (or (starts-with? elem interval)
+      (ends-with? elem interval)))
+
+(def: #export (union left right)
+  (All [a] (-> (Interval a) (Interval a) (Interval a)))
+  (structure (def: &enum (get@ #&enum right))
+             (def: bottom (order.min (:: right &order) (:: left bottom) (:: right bottom)))
+             (def: top (order.max (:: right &order) (:: left top) (:: right top)))))
+
+(def: #export (intersection left right)
+  (All [a] (-> (Interval a) (Interval a) (Interval a)))
+  (structure (def: &enum (get@ #&enum right))
+             (def: bottom (order.max (:: right &order) (:: left bottom) (:: right bottom)))
+             (def: top (order.min (:: right &order) (:: left top) (:: right top)))))
+
+(def: #export (complement interval)
+  (All [a] (-> (Interval a) (Interval a)))
+  (let [(^open ".") interval]
+    (structure (def: &enum (get@ #&enum interval))
+               (def: bottom (succ top))
+               (def: top (pred bottom)))))
+
+(def: #export (precedes? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bit))
+  (let [(^open ".") reference
+        limit (:: reference bottom)]
+    (and (< limit (:: sample bottom))
+         (< limit (:: sample top)))))
+
+(def: #export (succeeds? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bit))
+  (precedes? sample reference))
+
+(def: #export (meets? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bit))
+  (let [(^open ".") reference
+        limit (:: reference bottom)]
+    (and (<= limit (:: sample bottom))
+         (= limit (:: sample top)))))
+
+(def: #export (touches? reference sample)
+  (All [a] (-> (Interval a) (Interval a) Bit))
+  (or (meets? reference sample)
+      (meets? sample reference)))
+
+(template [<name> <eq-side> <ineq> <ineq-side>]
+  [(def: #export (<name> reference sample)
+     (All [a] (-> (Interval a) (Interval a) Bit))
+     (let [(^open ".") reference]
+       (and (=      (:: reference <eq-side>)   (:: sample <eq-side>))
+            (<ineq> (:: reference <ineq-side>) (:: sample <ineq-side>)))))]
+
+  [starts?   bottom <= top]
+  [finishes? top    >= bottom]
+  )
+
+(template [<name> <comp>]
+  [(def: #export (<name> reference sample)
+     (All [a] (-> a (Interval a) Bit))
+     (let [(^open ".") sample]
+       (and (<comp> reference bottom)
+            (<comp> reference top))))]
+
+  [before? <]
+  [after?  >]
+  )
+
+(structure: #export equivalence (All [a] (Equivalence (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) Bit))
+  (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)))
+        #0
+
+        ## (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) Bit))
+  (let [(^open ".") reference]
+    (and (not (:: ..equivalence = reference sample))
+         (cond (singleton? sample)
+               #0
+
+               (singleton? reference)
+               (nested? sample reference)
+
+               (or (and (inner? sample) (outer? reference))
+                   (and (outer? sample) (inner? reference)))
+               (or (>= (:: reference bottom) (:: sample top))
+                   (<= (:: reference top) (:: sample bottom)))
+
+               ## both inner
+               (inner? sample)
+               (inner? (intersection reference sample))
+
+               ## both outer
+               (not (nested? reference sample))
+               ))))