aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/abstract
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/abstract')
-rw-r--r--stdlib/source/lux/abstract/enum.lux8
-rw-r--r--stdlib/source/lux/abstract/interval.lux99
-rw-r--r--stdlib/source/lux/abstract/order.lux93
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))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-18 03:36:39 +0000