diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/abstract/fold.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/lux/abstract/interval.lux | 28 | ||||
| -rw-r--r-- | stdlib/source/lux/abstract/order.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/interval.lux | 60 | ||||
| -rw-r--r-- | stdlib/source/test/lux/abstract/order.lux | 42 |
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)))))) |