aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/abstract/fold.lux6
-rw-r--r--stdlib/source/lux/abstract/interval.lux28
-rw-r--r--stdlib/source/lux/abstract/order.lux4
-rw-r--r--stdlib/source/test/lux/abstract.lux6
-rw-r--r--stdlib/source/test/lux/abstract/interval.lux60
-rw-r--r--stdlib/source/test/lux/abstract/order.lux42
6 files changed, 89 insertions, 57 deletions
diff --git a/stdlib/source/lux/abstract/fold.lux b/stdlib/source/lux/abstract/fold.lux
index 504f41f58..a63dc8e20 100644
--- a/stdlib/source/lux/abstract/fold.lux
+++ b/stdlib/source/lux/abstract/fold.lux
@@ -12,7 +12,5 @@
(def: #export (with-monoid monoid fold value)
(All [F a]
(-> (Monoid a) (Fold F) (F a) a))
- (let [(^open "monoid;.") monoid]
- (fold monoid;compose
- monoid;identity
- value)))
+ (let [(^open "/@.") monoid]
+ (fold /@compose /@identity value)))
diff --git a/stdlib/source/lux/abstract/interval.lux b/stdlib/source/lux/abstract/interval.lux
index 17e749804..46fe020e1 100644
--- a/stdlib/source/lux/abstract/interval.lux
+++ b/stdlib/source/lux/abstract/interval.lux
@@ -102,12 +102,23 @@
(All [a] (-> (Interval a) (Interval a) Bit))
(precedes? sample reference))
+(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? (order.> ,@&order)]
+ )
+
(def: #export (meets? reference sample)
(All [a] (-> (Interval a) (Interval a) Bit))
(let [(^open ",@.") reference
- limit (:: reference ,@bottom)]
- (and (order.<= ,@&order limit (:: sample ,@bottom))
- (,@= limit (:: sample ,@top)))))
+ limit (:: reference bottom)]
+ (and (,@= limit (:: sample top))
+ (order.<= ,@&order limit (:: sample bottom)))))
(def: #export (touches? reference sample)
(All [a] (-> (Interval a) (Interval a) Bit))
@@ -128,17 +139,6 @@
[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))))]
-
- [before? ,@<]
- [after? (order.> ,@&order)]
- )
-
(structure: #export equivalence (All [a] (Equivalence (Interval a)))
(def: (= reference sample)
(let [(^open ",@.") reference]
diff --git a/stdlib/source/lux/abstract/order.lux b/stdlib/source/lux/abstract/order.lux
index 6f992695a..5634aac80 100644
--- a/stdlib/source/lux/abstract/order.lux
+++ b/stdlib/source/lux/abstract/order.lux
@@ -16,7 +16,7 @@
<)
)
-(type: (Comparison a)
+(type: #export (Comparison a)
(-> (Order a) a a Bit))
(def: #export (<= order parameter subject)
@@ -33,7 +33,7 @@
(or (:: order < subject parameter)
(:: order = subject parameter)))
-(type: (Choice a)
+(type: #export (Choice a)
(-> (Order a) a a a))
(def: #export (min order x y)
diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux
index b18d1c61b..c0ad0b823 100644
--- a/stdlib/source/test/lux/abstract.lux
+++ b/stdlib/source/test/lux/abstract.lux
@@ -5,7 +5,8 @@
["#." codec]
["#." enum]
["#." equivalence]
- ["#." interval]])
+ ["#." interval]
+ ["#." order]])
(def: #export test
Test
@@ -13,4 +14,5 @@
/codec.test
/enum.test
/equivalence.test
- /interval.test))
+ /interval.test
+ /order.test))
diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux
index 92f2a6faf..1a15336f5 100644
--- a/stdlib/source/test/lux/abstract/interval.lux
+++ b/stdlib/source/test/lux/abstract/interval.lux
@@ -20,14 +20,15 @@
[math
["r" random (#+ Random)]]]
{1
- ["." / (#+ Interval) (",@." equivalence)]})
+ ["." / (#+ Interval) ("#@." equivalence)]})
(template [<name> <cmp>]
[(def: #export <name>
(Random (Interval Nat))
(do r.monad
[bottom r.nat
- top (|> r.nat (r.filter (|>> (n.= bottom) not)))]
+ top (r.filter (|>> (n.= bottom) not)
+ r.nat)]
(if (<cmp> top bottom)
(wrap (/.between n.enum bottom top))
(wrap (/.between n.enum top bottom)))))]
@@ -49,6 +50,21 @@
..outer
..singleton))
+(def: types
+ Test
+ (do r.monad
+ [inner ..inner
+ outer ..outer
+ singleton ..singleton]
+ ($_ _.and
+ (_.test (%.name (name-of /.inner?))
+ (/.inner? inner))
+ (_.test (%.name (name-of /.outer?))
+ (/.outer? outer))
+ (_.test (%.name (name-of /.singleton?))
+ (/.singleton? singleton))
+ )))
+
(def: boundaries
Test
(do r.monad
@@ -56,14 +72,14 @@
top r.nat
#let [interval (/.between n.enum bottom top)]]
($_ _.and
- (_.test "A boundary value belongs to its interval."
+ (_.test (%.name (name-of /.within?))
(and (/.within? interval bottom)
(/.within? interval top)))
- (_.test "An interval starts with its bottom."
+ (_.test (%.name (name-of /.starts-with?))
(/.starts-with? bottom interval))
- (_.test "An interval ends with its top."
+ (_.test (%.name (name-of /.ends-with?))
(/.ends-with? top interval))
- (_.test "The boundary values border the interval."
+ (_.test (%.name (name-of /.borders?))
(and (/.borders? interval bottom)
(/.borders? interval top)))
)))
@@ -80,7 +96,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."
@@ -101,7 +117,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))
@@ -116,7 +132,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))))
)))
@@ -135,10 +151,10 @@
#let [left (/.singleton n.enum l)
right (/.singleton n.enum r)]]
($_ _.and
- (_.test "'precedes?' and 'succeeds?' are symetric."
+ (_.test (format (%.name (name-of /.precedes?)) " &&& " (%.name (name-of /.succeeds?)))
(and (/.precedes? right left)
(/.succeeds? left right)))
- (_.test "Can check if an interval is before or after some element."
+ (_.test (format (%.name (name-of /.before?)) " &&& " (%.name (name-of /.after?)))
(and (/.before? m left)
(/.after? m right)))
)))
@@ -157,14 +173,14 @@
#let [int-left (/.between n.enum t1 t2)
int-right (/.between n.enum b t1)]]
($_ _.and
- (_.test "An interval meets another if its top is the other's bottom."
+ (_.test (%.name (name-of /.meets?))
(/.meets? int-left int-right))
- (_.test "Two intervals touch one another if any one meets the other."
+ (_.test (%.name (name-of /.touches?))
(/.touches? int-left int-right))
- (_.test "Can check if 2 intervals start together."
+ (_.test (%.name (name-of /.starts?))
(/.starts? (/.between n.enum b t2)
(/.between n.enum b t1)))
- (_.test "Can check if 2 intervals finish together."
+ (_.test (%.name (name-of /.finishes?))
(/.finishes? (/.between n.enum b t2)
(/.between n.enum t1 t2)))
)))
@@ -220,13 +236,15 @@
(<| (_.context (%.name (name-of /.Interval)))
($_ _.and
($equivalence.spec /.equivalence ..interval)
+ (<| (_.context "Types.")
+ ..types)
(<| (_.context "Boundaries.")
..boundaries)
- (<| (_.context "Union.")
+ (<| (_.context (%.name (name-of /.union)))
..union)
- (<| (_.context "Intersection.")
+ (<| (_.context (%.name (name-of /.intersection)))
..intersection)
- (<| (_.context "Complement.")
+ (<| (_.context (%.name (name-of /.complement)))
..complement)
(<| (_.context "Positioning/location.")
..location)
@@ -236,14 +254,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."
- (order.> ,@&order ,@bottom sample))
+ (order.> /@&order /@bottom sample))
))))
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index c31ab31e1..a4bff03e9 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -4,26 +4,40 @@
[abstract/monad (#+ do)]
[data
[text
- ["%" format (#+ format)]]]
+ ["%" format (#+ format)]]
+ [number
+ ["n" nat]]]
[math
["r" random (#+ Random)]]]
{1
["." / (#+ Order)]})
+(def: #export test
+ Test
+ (<| (_.context (%.name (name-of /.Codec)))
+ (do r.monad
+ [left r.nat
+ right (|> r.nat (r.filter (|>> (n.= left) not)))])
+ ($_ _.and
+ (_.test (format (%.name (name-of /.min)) " &&& " (%.name (name-of /.max)))
+ (n.< (/.max n.order left right)
+ (/.min n.order left right)))
+ )))
+
(def: #export (spec (^open ",@.") generator)
(All [a] (-> (Order a) (Random a) Test))
- (do r.monad
- [parameter generator
- subject generator]
- (<| (_.context (%.name (name-of /.Order)))
- ($_ _.and
- (_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
- (cond (,@< parameter subject)
- (not (or (,@< subject parameter)
- (,@= parameter subject)))
+ (<| (_.context (%.name (name-of /.Order)))
+ (do r.monad
+ [parameter generator
+ subject generator])
+ ($_ _.and
+ (_.test "Values are either ordered, or they are equal. All options are mutually exclusive."
+ (cond (,@< parameter subject)
+ (not (or (,@< subject parameter)
+ (,@= parameter subject)))
- (,@< subject parameter)
- (not (,@= parameter subject))
+ (,@< subject parameter)
+ (not (,@= parameter subject))
- ## else
- (,@= parameter subject)))))))
+ ## else
+ (,@= parameter subject))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 16:54:57 +0000