Simplified the "Order" signature.

3 files changed, 99 insertions, 101 deletions

diff --git a/stdlib/source/lux/abstract/enum.lux b/stdlib/source/lux/abstract/enum.lux
index 5bbb7df38..27690b286 100644
--- a/stdlib/source/lux/abstract/enum.lux
+++ b/stdlib/source/lux/abstract/enum.lux
@@ -1,11 +1,11 @@
 (.module:
   [lux #*]
   [//
-   ["." order]])
+   ["." order (#+ Order)]])
 
 (signature: #export (Enum e)
   {#.doc "Enumerable types, with a notion of moving forward and backwards through a type's instances."}
-  (: (order.Order e) &order)
+  (: (Order e) &order)
   (: (-> e e) succ)
   (: (-> e e) pred))
 
@@ -15,7 +15,7 @@
     (#.Cons from (range' <= succ (succ from) to))
     #.Nil))
 
-(def: #export (range (^open ".") from to)
+(def: #export (range (^open ",@.") from to)
   {#.doc "An inclusive [from, to] range of values."}
   (All [a] (-> (Enum a) a a (List a)))
-  (range' <= succ from to))
+  (range' (order.<= ,@&order) ,@succ from to))
diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux
index efb131843..f5c3ce656 100644
--- a/stdlib/source/lux/abstract/interval.lux
+++ b/stdlib/source/lux/abstract/interval.lux
@@ -18,41 +18,43 @@
 
 (def: #export (between enum bottom top)
   (All [a] (-> (Enum a) a a (Interval a)))
-  (structure (def: &enum enum)
-             (def: bottom bottom)
-             (def: top top)))
+  (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)))
+  (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)))]
+     (let [(^open ",@.") interval]
+       (<comp> ,@bottom ,@top)))]
 
-  [inner?     >]
-  [outer?     <]
-  [singleton? =]
+  [inner?     (order.> ,@&order)]
+  [outer?     ,@<]
+  [singleton? ,@=]
   )
 
 (def: #export (within? interval elem)
   (All [a] (-> (Interval a) a Bit))
-  (let [(^open ".") interval]
+  (let [(^open ",@.") interval]
     (cond (inner? interval)
-          (and (>= bottom elem)
-               (<= top elem))
+          (and (order.>= ,@&order ,@bottom elem)
+               (order.<= ,@&order ,@top elem))
           
           (outer? interval)
-          (or (>= bottom elem)
-              (<= top elem))
+          (or (order.>= ,@&order ,@bottom elem)
+              (order.<= ,@&order ,@top elem))
           
           ## singleton
-          (and (= bottom elem)
-               (= top elem)))))
+          (and (,@= ,@bottom elem)
+               (,@= ,@top elem)))))
 
 (template [<name> <limit>]
   [(def: #export (<name> elem interval)
@@ -101,10 +103,10 @@
 
 (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)))))
+  (let [(^open ",@.") reference
+        limit (:: reference ,@bottom)]
+    (and (order.<= ,@&order limit (:: sample ,@bottom))
+         (,@= limit (:: sample ,@top)))))
 
 (def: #export (touches? reference sample)
   (All [a] (-> (Interval a) (Interval a) Bit))
@@ -114,55 +116,58 @@
 (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]
+     (let [(^open ",@.") reference]
+       (and (,@= (:: reference <eq-side>)
+                 (:: sample <eq-side>))
+            (<ineq> ,@&order
+                    (:: reference <ineq-side>)
+                    (:: sample <ineq-side>)))))]
+
+  [starts?   ,@bottom order.<= ,@top]
+  [finishes? ,@top    order.>= ,@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))))]
+     (let [(^open ",@.") sample]
+       (and (<comp> reference ,@bottom)
+            (<comp> reference ,@top))))]
 
-  [before? <]
-  [after?  >]
+  [before? ,@<]
+  [after?  (order.> ,@&order)]
   )
 
 (structure: #export equivalence (All [a] (Equivalence (Interval a)))
   (def: (= reference sample)
-    (let [(^open "_;.") reference]
-      (and (_;= _;bottom (:: sample bottom))
-           (_;= _;top (:: sample top))))))
+    (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))))
+        (let [(^open ",@.") reference]
+          (and (order.>= ,@&order (:: reference bottom) (:: sample bottom))
+               (order.<= ,@&order (:: 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)))))
+        (let [(^open ",@.") reference]
+          (or (and (order.>= ,@&order (:: reference bottom) (:: sample bottom))
+                   (order.> ,@&order (:: reference bottom) (:: sample top)))
+              (and (,@< (:: reference top) (:: sample bottom))
+                   (order.<= ,@&order (:: reference top) (:: sample top)))))
         ))
 
 (def: #export (overlaps? reference sample)
   (All [a] (-> (Interval a) (Interval a) Bit))
-  (let [(^open ".") reference]
+  (let [(^open ",@.") reference]
     (and (not (:: ..equivalence = reference sample))
          (cond (singleton? sample)
                #0
@@ -172,8 +177,8 @@
 
                (or (and (inner? sample) (outer? reference))
                    (and (outer? sample) (inner? reference)))
-               (or (>= (:: reference bottom) (:: sample top))
-                   (<= (:: reference top) (:: sample bottom)))
+               (or (order.>= ,@&order (:: reference bottom) (:: sample top))
+                   (order.<= ,@&order (:: reference top) (:: sample bottom)))
 
                ## both inner
                (inner? sample)
diff --git a/stdlib/source/lux/abstract/order.lux b/stdlib/source/lux/abstract/order.lux
index 32df7d1af..6f992695a 100644
--- a/stdlib/source/lux/abstract/order.lux
+++ b/stdlib/source/lux/abstract/order.lux
@@ -6,55 +6,48 @@
    [functor (#+ Contravariant)]
    ["." equivalence (#+ Equivalence)]])
 
-(`` (signature: #export (Order a)
-      {#.doc "A signature for types that possess some sense of ordering among their elements."}
-      
-      (: (Equivalence a)
-         &equivalence)
-      
-      (~~ (template [<name>]
-            [(: (-> a a Bit) <name>)]
-
-            [<] [<=] [>] [>=]
-            ))
-      ))
-
-(def: #export (order equivalence <)
-  (All [a]
-    (-> (Equivalence a) (-> a a Bit) (Order a)))
-  (let [> (function.flip <)]
-    (structure (def: &equivalence equivalence)
-               
-               (def: < <)
-               
-               (def: (<= test subject)
-                 (or (< test subject)
-                     (:: equivalence = test subject)))
-               
-               (def: > >)
-               
-               (def: (>= test subject)
-                 (or (> test subject)
-                     (:: equivalence = test subject))))))
-
-(template [<name> <op>]
-  [(def: #export (<name> order x y)
-     (All [a]
-       (-> (Order a) a a a))
-     (if (:: order <op> y x) x y))]
-
-  [min <]
-  [max >]
+(signature: #export (Order a)
+  {#.doc "A signature for types that possess some sense of ordering among their elements."}
+  
+  (: (Equivalence a)
+     &equivalence)
+
+  (: (-> a a Bit)
+     <)
   )
 
-(`` (structure: #export contravariant (Contravariant Order)
-      (def: (map-1 f order)
-        (structure
-         (def: &equivalence (:: equivalence.contravariant map-1 f (:: order &equivalence)))
-         
-         (~~ (template [<name>]
-               [(def: (<name> reference sample)
-                  (:: order <name> (f reference) (f sample)))]
-
-               [<] [<=] [>] [>=]
-               ))))))
+(type: (Comparison a)
+  (-> (Order a) a a Bit))
+
+(def: #export (<= order parameter subject)
+  Comparison
+  (or (:: order < parameter subject)
+      (:: order = parameter subject)))
+
+(def: #export (> order parameter subject)
+  Comparison
+  (:: order < subject parameter))
+
+(def: #export (>= order parameter subject)
+  Comparison
+  (or (:: order < subject parameter)
+      (:: order = subject parameter)))
+
+(type: (Choice a)
+  (-> (Order a) a a a))
+
+(def: #export (min order x y)
+  Choice
+  (if (:: order < y x) x y))
+
+(def: #export (max order x y)
+  Choice
+  (if (:: order < y x) y x))
+
+(structure: #export contravariant (Contravariant Order)
+  (def: (map-1 f order)
+    (structure
+     (def: &equivalence (:: equivalence.contravariant map-1 f (:: order &equivalence)))
+     
+     (def: (< reference sample)
+       (:: order < (f reference) (f sample))))))