aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
authorEduardo Julian2019-04-17 20:56:46 -0400
committerEduardo Julian2019-04-17 20:56:46 -0400
commit319f5d120a88eb9e9a75e5ca0c03f5fd555cab14 (patch)
tree789b20fcbe76c2c598eb45db1c9473604b9f02b6 /stdlib/source
parent31d7f09f2c410951948134bb3045b2ca0147327d (diff)
Simplified the "Order" signature.
Diffstat (limited to '')
-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
-rw-r--r--stdlib/source/lux/data/collection/dictionary/ordered.lux14
-rw-r--r--stdlib/source/lux/data/name.lux22
-rw-r--r--stdlib/source/lux/data/number/frac.lux5
-rw-r--r--stdlib/source/lux/data/number/int.lux5
-rw-r--r--stdlib/source/lux/data/number/nat.lux5
-rw-r--r--stdlib/source/lux/data/number/ratio.lux34
-rw-r--r--stdlib/source/lux/data/number/rev.lux5
-rw-r--r--stdlib/source/lux/data/text.lux14
-rw-r--r--stdlib/source/lux/time/date.lux37
-rw-r--r--stdlib/source/lux/time/day.lux15
-rw-r--r--stdlib/source/lux/time/duration.lux28
-rw-r--r--stdlib/source/lux/time/instant.lux24
-rw-r--r--stdlib/source/lux/time/month.lux15
-rw-r--r--stdlib/source/lux/type/unit.lux24
-rw-r--r--stdlib/source/test/lux/abstract/interval.lux15
-rw-r--r--stdlib/source/test/lux/abstract/number.lux6
-rw-r--r--stdlib/source/test/lux/abstract/order.lux19
20 files changed, 191 insertions, 296 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))))))
diff --git a/stdlib/source/lux/data/collection/dictionary/ordered.lux b/stdlib/source/lux/data/collection/dictionary/ordered.lux
index 58026984f..d8cf01121 100644
--- a/stdlib/source/lux/data/collection/dictionary/ordered.lux
+++ b/stdlib/source/lux/data/collection/dictionary/ordered.lux
@@ -1,14 +1,14 @@
(.module:
[lux #*
[abstract
- [monad (#+ Monad do)]
equivalence
- [order (#+ Order)]]
+ [monad (#+ Monad do)]
+ ["." order (#+ Order)]]
[data
["p" product]
["." maybe]
[collection
- ["." list ("#;." monoid fold)]]]
+ ["." list ("#@." monoid fold)]]]
["." macro
["." code]
["s" syntax (#+ syntax: Syntax)]]])
@@ -265,8 +265,8 @@
(#.Some (<add> (maybe.assume outcome)
root))))]
- [T/< #left add-left]
- [T/> #right add-right]
+ [T/< #left add-left]
+ [(order.> (get@ #&order dict)) #right add-right]
))
## (T/= reference key)
@@ -532,7 +532,7 @@
(def: #export (from-list Order<l> list)
(All [k v] (-> (Order k) (List [k v]) (Dictionary k v)))
- (list;fold (function (_ [key value] dict)
+ (list@fold (function (_ [key value] dict)
(put key value dict))
(new Order<l>)
list))
@@ -546,7 +546,7 @@
(list)
(#.Some node')
- ($_ list;compose
+ ($_ list@compose
(recur (get@ #left node'))
(list <output>)
(recur (get@ #right node'))))))]
diff --git a/stdlib/source/lux/data/name.lux b/stdlib/source/lux/data/name.lux
index 20aa73d28..557ecf1ec 100644
--- a/stdlib/source/lux/data/name.lux
+++ b/stdlib/source/lux/data/name.lux
@@ -25,23 +25,13 @@
(and (text@= xmodule ymodule)
(text@= xname yname))))
-(def: (name@< [moduleP shortP] [moduleS shortS])
- (-> Name Name Bit)
- (if (text@= moduleP moduleS)
- (:: text.order < shortP shortS)
- (:: text.order < moduleP moduleS)))
-
-(structure: #export order (Order Name)
+(structure: #export order
+ (Order Name)
(def: &equivalence ..equivalence)
- (def: < name@<)
- (def: (<= parameter subject)
- (or (:: ..equivalence = parameter subject)
- (name@< parameter subject)))
- (def: (> parameter subject)
- (name@< subject parameter))
- (def: (>= parameter subject)
- (or (:: ..equivalence = subject parameter)
- (name@< subject parameter))))
+ (def: (< [moduleP shortP] [moduleS shortS])
+ (if (text@= moduleP moduleS)
+ (:: text.order < shortP shortS)
+ (:: text.order < moduleP moduleS))))
(structure: #export codec (Codec Text Name)
(def: (encode [module short])
diff --git a/stdlib/source/lux/data/number/frac.lux b/stdlib/source/lux/data/number/frac.lux
index 790aee05b..7c5f52b7f 100644
--- a/stdlib/source/lux/data/number/frac.lux
+++ b/stdlib/source/lux/data/number/frac.lux
@@ -22,10 +22,7 @@
(structure: #export order (Order Frac)
(def: &equivalence ..equivalence)
- (def: < f/<)
- (def: <= f/<=)
- (def: > f/>)
- (def: >= f/>=))
+ (def: < f/<))
(structure: #export number (Number Frac)
(def: + f/+)
diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux
index 22b7aff23..464575700 100644
--- a/stdlib/source/lux/data/number/int.lux
+++ b/stdlib/source/lux/data/number/int.lux
@@ -21,10 +21,7 @@
(structure: #export order (Order Int)
(def: &equivalence ..equivalence)
- (def: < i/<)
- (def: <= i/<=)
- (def: > i/>)
- (def: >= i/>=))
+ (def: < i/<))
(structure: #export enum (Enum Int)
(def: &order ..order)
diff --git a/stdlib/source/lux/data/number/nat.lux b/stdlib/source/lux/data/number/nat.lux
index 9212e0ad5..fd671641f 100644
--- a/stdlib/source/lux/data/number/nat.lux
+++ b/stdlib/source/lux/data/number/nat.lux
@@ -21,10 +21,7 @@
(structure: #export order (Order Nat)
(def: &equivalence ..equivalence)
- (def: < n/<)
- (def: <= n/<=)
- (def: > n/>)
- (def: >= n/>=))
+ (def: < n/<))
(structure: #export enum (Enum Nat)
(def: &order ..order)
diff --git a/stdlib/source/lux/data/number/ratio.lux b/stdlib/source/lux/data/number/ratio.lux
index 7542a56ff..e91c9ea97 100644
--- a/stdlib/source/lux/data/number/ratio.lux
+++ b/stdlib/source/lux/data/number/ratio.lux
@@ -46,30 +46,12 @@
(n/= (get@ #denominator parameter)
(get@ #denominator subject)))))
-(`` (structure: #export order (Order Ratio)
- (def: &equivalence ..equivalence)
-
- (~~ (template [<name> <op>]
- [(def: (<name> parameter subject)
- (let [[parameter' subject'] (..equalize parameter subject)]
- (<op> parameter' subject')))]
-
- [< n/<]
- [<= n/<=]
- [> n/>]
- [>= n/>=]
- ))
- ))
-
-(template [<name> <comp>]
- [(def: #export (<name> left right)
- (-> Ratio Ratio Ratio)
- (if (:: ..order <comp> left right)
- right
- left))]
-
- [min <]
- [max >]
+(structure: #export order (Order Ratio)
+ (def: &equivalence ..equivalence)
+
+ (def: (< parameter subject)
+ (let [[parameter' subject'] (..equalize parameter subject)]
+ (n/< parameter' subject')))
)
(def: (- parameter subject)
@@ -120,10 +102,10 @@
(structure: #export codec (Codec Text Ratio)
(def: (encode (^slots [#numerator #denominator]))
- ($_ text@compose (nat@encode numerator) separator (nat@encode denominator)))
+ ($_ text@compose (nat@encode numerator) ..separator (nat@encode denominator)))
(def: (decode input)
- (case (text.split-with separator input)
+ (case (text.split-with ..separator input)
(#.Some [num denom])
(do error.monad
[numerator (nat@decode num)
diff --git a/stdlib/source/lux/data/number/rev.lux b/stdlib/source/lux/data/number/rev.lux
index 3dbfeb6fc..746347ca8 100644
--- a/stdlib/source/lux/data/number/rev.lux
+++ b/stdlib/source/lux/data/number/rev.lux
@@ -26,10 +26,7 @@
(structure: #export order (Order Rev)
(def: &equivalence ..equivalence)
- (def: < r/<)
- (def: <= r/<=)
- (def: > r/>)
- (def: >= r/>=))
+ (def: < r/<))
(structure: #export enum (Enum Rev)
(def: &order ..order)
diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux
index 3174c9b8f..a91beccef 100644
--- a/stdlib/source/lux/data/text.lux
+++ b/stdlib/source/lux/data/text.lux
@@ -176,19 +176,7 @@
(def: &equivalence ..equivalence)
(def: (< reference sample)
- ("lux text <" reference sample))
-
- (def: (<= reference sample)
- (or ("lux text <" reference sample)
- ("lux text =" reference sample)))
-
- (def: (> reference sample)
- ("lux text <" sample reference))
-
- (def: (>= reference sample)
- (or ("lux text <" sample reference)
- ("lux text =" reference sample)))
- )
+ ("lux text <" reference sample)))
(structure: #export monoid (Monoid Text)
(def: identity "")
diff --git a/stdlib/source/lux/time/date.lux b/stdlib/source/lux/time/date.lux
index 994b95dbe..fa7a40676 100644
--- a/stdlib/source/lux/time/date.lux
+++ b/stdlib/source/lux/time/date.lux
@@ -38,32 +38,21 @@
(n/= (get@ #day reference)
(get@ #day sample)))))
-(def: (date/< reference sample)
- (-> Date Date Bit)
- (or (i/< (get@ #year reference)
- (get@ #year sample))
- (and (i/= (get@ #year reference)
- (get@ #year sample))
- (or (:: //month.order <
- (get@ #month reference)
- (get@ #month sample))
- (and (:: //month.order =
- (get@ #month reference)
- (get@ #month sample))
- (n/< (get@ #day reference)
- (get@ #day sample)))))))
-
(structure: #export order (Order Date)
(def: &equivalence ..equivalence)
- (def: < date/<)
- (def: (> reference sample)
- (date/< sample reference))
- (def: (<= reference sample)
- (or (date/< reference sample)
- (:: ..equivalence = reference sample)))
- (def: (>= reference sample)
- (or (date/< sample reference)
- (:: ..equivalence = sample reference))))
+ (def: (< reference sample)
+ (or (i/< (get@ #year reference)
+ (get@ #year sample))
+ (and (i/= (get@ #year reference)
+ (get@ #year sample))
+ (or (:: //month.order <
+ (get@ #month reference)
+ (get@ #month sample))
+ (and (:: //month.order =
+ (get@ #month reference)
+ (get@ #month sample))
+ (n/< (get@ #day reference)
+ (get@ #day sample))))))))
## Based on this: https://stackoverflow.com/a/42936293/6823464
(def: (pad value)
diff --git a/stdlib/source/lux/time/day.lux b/stdlib/source/lux/time/day.lux
index 87c603937..a3f3fb3f2 100644
--- a/stdlib/source/lux/time/day.lux
+++ b/stdlib/source/lux/time/day.lux
@@ -42,17 +42,10 @@
#Friday 5
#Saturday 6))
-(`` (structure: #export order (Order Day)
- (def: &equivalence ..equivalence)
- (~~ (template [<name> <comp>]
- [(def: (<name> reference sample)
- (<comp> (day-to-nat reference) (day-to-nat sample)))]
-
- [< n/<]
- [<= n/<=]
- [> n/>]
- [>= n/>=]
- ))))
+(structure: #export order (Order Day)
+ (def: &equivalence ..equivalence)
+ (def: (< reference sample)
+ (n/< (day-to-nat reference) (day-to-nat sample))))
(structure: #export enum (Enum Day)
(def: &order ..order)
diff --git a/stdlib/source/lux/time/duration.lux b/stdlib/source/lux/time/duration.lux
index 2ec2de13d..d420cfa0d 100644
--- a/stdlib/source/lux/time/duration.lux
+++ b/stdlib/source/lux/time/duration.lux
@@ -64,30 +64,10 @@
(def: (= param subject)
(i/= (:representation param) (:representation subject))))
- (`` (structure: #export order (Order Duration)
- (def: &equivalence ..equivalence)
- (~~ (template [<name> <op>]
- [(def: (<name> param subject)
- (<op> (:representation param) (:representation subject)))]
-
- [< i/<]
- [<= i/<=]
- [> i/>]
- [>= i/>=]
- ))))
-
- (open: "duration@." ..order)
-
- (template [<name> <op>]
- [(def: #export (<name> left right)
- (-> Duration Duration Duration)
- (if (<op> left right)
- right
- left))]
-
- [max duration@>]
- [min duration@<]
- )
+ (structure: #export order (Order Duration)
+ (def: &equivalence ..equivalence)
+ (def: (< param subject)
+ (i/< (:representation param) (:representation subject))))
(template [<name> <op>]
[(def: #export <name>
diff --git a/stdlib/source/lux/time/instant.lux b/stdlib/source/lux/time/instant.lux
index 9dce5f8b3..51087e4fc 100644
--- a/stdlib/source/lux/time/instant.lux
+++ b/stdlib/source/lux/time/instant.lux
@@ -2,7 +2,7 @@
[lux #*
[abstract
[equivalence (#+ Equivalence)]
- [order (#+ Order)]
+ ["." order (#+ Order)]
[enum (#+ Enum)]
codec
[monad (#+ do Monad)]]
@@ -22,7 +22,7 @@
[type
abstract]]
[//
- ["." duration ("#@." order)]
+ ["." duration]
["." date (#+ Date)]
["." month (#+ Month)]
["." day (#+ Day)]])
@@ -59,14 +59,10 @@
(def: (= param subject)
(:: int.equivalence = (:representation param) (:representation subject))))
- (`` (structure: #export order (Order Instant)
- (def: &equivalence ..equivalence)
- (~~ (template [<name>]
- [(def: (<name> param subject)
- (:: int.order <name> (:representation param) (:representation subject)))]
-
- [<] [<=] [>] [>=]
- ))))
+ (structure: #export order (Order Instant)
+ (def: &equivalence ..equivalence)
+ (def: (< param subject)
+ (:: int.order < (:representation param) (:representation subject))))
(`` (structure: #export enum (Enum Instant)
(def: &order ..order)
@@ -105,7 +101,7 @@
duration.normal-year)]
(if (i/= +0 (duration.query year time-left))
[reference time-left]
- (if (duration@>= duration.empty time-left)
+ (if (order.>= duration.order duration.empty time-left)
(recur (inc reference) (duration.merge (duration.inverse year) time-left))
(recur (dec reference) (duration.merge year time-left)))
))))
@@ -123,7 +119,7 @@
(def: (find-month months time)
(-> (Row Nat) duration.Duration [Nat duration.Duration])
- (if (duration@>= duration.empty time)
+ (if (order.>= duration.order duration.empty time)
(row@fold (function (_ month-days [current-month time-left])
(let [month-duration (duration.scale-up month-days duration.day)]
(if (i/= +0 (duration.query month-duration time-left))
@@ -183,7 +179,7 @@
(i/+ (i// +4 years-of-era))
(i/- (i// +100 years-of-era)))))
day-time (duration.frame duration.day offset)
- days-of-year (if (duration@>= duration.empty day-time)
+ days-of-year (if (order.>= duration.order duration.empty day-time)
days-of-year
(dec days-of-year))
mp (|> days-of-year (i/* +5) (i/+ +2) (i// +153))
@@ -204,7 +200,7 @@
(def: #export (to-text instant)
(-> Instant Text)
(let [[[year month day] day-time] (extract-date instant)
- day-time (if (duration@>= duration.empty day-time)
+ day-time (if (order.>= duration.order duration.empty day-time)
day-time
(duration.merge duration.day day-time))
[hours day-time] [(duration.query duration.hour day-time) (duration.frame duration.hour day-time)]
diff --git a/stdlib/source/lux/time/month.lux b/stdlib/source/lux/time/month.lux
index 3911d7849..e2e248ce5 100644
--- a/stdlib/source/lux/time/month.lux
+++ b/stdlib/source/lux/time/month.lux
@@ -57,17 +57,10 @@
#November 10
#December 11))
-(`` (structure: #export order (Order Month)
- (def: &equivalence ..equivalence)
- (~~ (template [<name> <comp>]
- [(def: (<name> reference sample)
- (<comp> (number reference) (number sample)))]
-
- [< n/<]
- [<= n/<=]
- [> n/>]
- [>= n/>=]
- ))))
+(structure: #export order (Order Month)
+ (def: &equivalence ..equivalence)
+ (def: (< reference sample)
+ (n/< (number reference) (number sample))))
(structure: #export enum (Enum Month)
(def: &order ..order)
diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux
index a05b7c85c..1437f862c 100644
--- a/stdlib/source/lux/type/unit.lux
+++ b/stdlib/source/lux/type/unit.lux
@@ -10,12 +10,12 @@
["p" parser]]
[data
[number
- ["r" ratio]]
+ ["r" ratio (#+ Ratio)]]
[text
format]]
["." macro
["." code]
- ["s" syntax (#+ syntax:)]
+ ["s" syntax (#+ Syntax syntax:)]
[syntax
["cs" common
["csr" reader]
@@ -40,7 +40,7 @@
scale)
(: (All [u] (-> (Qty (s u)) (Qty u)))
de-scale)
- (: r.Ratio
+ (: Ratio
ratio))
(type: #export Pure
@@ -82,7 +82,7 @@
)))
(def: ratio^
- (s.Syntax r.Ratio)
+ (Syntax Ratio)
(s.tuple (do p.monad
[numerator s.int
_ (p.assert (format "Numerator must be positive: " (%i numerator))
@@ -170,17 +170,11 @@
(def: (= reference sample)
(i/= (out reference) (out sample))))
-(`` (structure: #export order (All [unit] (Order (Qty unit)))
- (def: &equivalence ..equivalence)
-
- (~~ (template [<name> <func>]
- [(def: (<name> reference sample)
- (<func> (out reference) (out sample)))]
-
- [< i/<]
- [<= i/<=]
- [> i/>]
- [>= i/>=]))))
+(structure: #export order (All [unit] (Order (Qty unit)))
+ (def: &equivalence ..equivalence)
+
+ (def: (< reference sample)
+ (i/< (out reference) (out sample))))
(structure: #export enum (All [unit] (Enum (Qty unit)))
(def: &order ..order)
diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux
index cfc19f6a9..62b56a5fb 100644
--- a/stdlib/source/test/lux/abstract/interval.lux
+++ b/stdlib/source/test/lux/abstract/interval.lux
@@ -3,6 +3,7 @@
["_" test (#+ Test)]
[abstract/monad (#+ do)]
[abstract
+ ["." order]
{[0 #test]
[/
["$." equivalence]]}]
@@ -19,7 +20,7 @@
[math
["r" random (#+ Random)]]]
{1
- ["." / (#+ Interval) ("_@." equivalence)]})
+ ["." / (#+ Interval) (",@." equivalence)]})
(template [<name> <cmp>]
[(def: #export <name>
@@ -79,7 +80,7 @@
right-outer ..outer]
($_ _.and
(_.test "The union of an interval to itself yields the same interval."
- (_@= some-interval (/.union some-interval some-interval)))
+ (,@= some-interval (/.union some-interval some-interval)))
(_.test "The union of 2 inner intervals is another inner interval."
(/.inner? (/.union left-inner right-inner)))
(_.test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do."
@@ -100,7 +101,7 @@
right-outer ..outer]
($_ _.and
(_.test "The intersection of an interval to itself yields the same interval."
- (_@= some-interval (/.intersection some-interval some-interval)))
+ (,@= some-interval (/.intersection some-interval some-interval)))
(_.test "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))
@@ -115,7 +116,7 @@
[some-interval ..interval]
($_ _.and
(_.test "The complement of a complement is the same as the original."
- (_@= some-interval (|> some-interval /.complement /.complement)))
+ (,@= some-interval (|> some-interval /.complement /.complement)))
(_.test "The complement of an interval does not overlap it."
(not (/.overlaps? some-interval (/.complement some-interval))))
)))
@@ -235,14 +236,14 @@
..overlap)
)))
-(def: #export (spec (^open "_@.") gen-sample)
+(def: #export (spec (^open ",@.") gen-sample)
(All [a] (-> (Interval a) (Random a) Test))
(<| (_.context (%name (name-of /.Interval)))
(do r.monad
[sample gen-sample]
($_ _.and
(_.test "No value is bigger than the top."
- (_@< _@top sample))
+ (,@< ,@top sample))
(_.test "No value is smaller than the bottom."
- (_@> _@bottom sample))
+ (order.> ,@&order ,@bottom sample))
))))
diff --git a/stdlib/source/test/lux/abstract/number.lux b/stdlib/source/test/lux/abstract/number.lux
index 2d726dfed..363621791 100644
--- a/stdlib/source/test/lux/abstract/number.lux
+++ b/stdlib/source/test/lux/abstract/number.lux
@@ -10,9 +10,9 @@
{1
["." / (#+ Number)
[//
- [order (#+ Order)]]]})
+ ["." order (#+ Order)]]]})
-(def: #export (spec (^open "/@.") (^open "/@.") gen-sample)
+(def: #export (spec (^@ order (^open "/@.")) (^open "/@.") gen-sample)
(All [a] (-> (Order a) (Number a) (Random a) Test))
(do r.monad
[#let [non-zero (r.filter (function (_ sample)
@@ -42,5 +42,5 @@
(/@negate parameter))]
(if unsigned?
(/@= subject (/@abs subject))
- (/@>= subject (/@abs subject)))))
+ (order.>= order subject (/@abs subject)))))
))))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index 535d774a7..5406a490c 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -13,14 +13,17 @@
(def: #export (spec (^open ",@.") generator)
(All [a] (-> (Order a) (Random a) Test))
(do r.monad
- [left generator
- right generator]
+ [parameter generator
+ subject generator]
(<| (_.context (%name (name-of /.Order)))
($_ _.and
(_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
- (if (,@= left right)
- (not (or (,@< left right)
- (,@> left right)))
- (if (,@< left right)
- (not (,@> left right))
- (,@> left right))))))))
+ (cond (,@< parameter subject)
+ (not (or (,@< subject parameter)
+ (,@= parameter subject)))
+
+ (,@< subject parameter)
+ (not (,@= parameter subject))
+
+ ## else
+ (,@= parameter subject)))))))