From 2e5852abb1ac0ae5abdd8709238aca447f62520e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 7 Nov 2020 00:29:40 -0400 Subject: Pure-Lux implementation for biggest and smallest Frac values. --- stdlib/source/spec/lux/abstract/apply.lux | 20 ++++----- stdlib/source/spec/lux/abstract/codec.lux | 6 +-- stdlib/source/spec/lux/abstract/comonad.lux | 20 ++++----- stdlib/source/spec/lux/abstract/enum.lux | 18 ++++---- stdlib/source/spec/lux/abstract/equivalence.lux | 10 ++--- stdlib/source/spec/lux/abstract/fold.lux | 4 +- stdlib/source/spec/lux/abstract/functor.lux | 14 +++---- .../spec/lux/abstract/functor/contravariant.lux | 4 +- stdlib/source/spec/lux/abstract/interval.lux | 6 +-- stdlib/source/spec/lux/abstract/monad.lux | 20 ++++----- stdlib/source/spec/lux/abstract/monoid.lux | 14 +++---- stdlib/source/spec/lux/abstract/order.lux | 48 +++++++++++----------- stdlib/source/spec/lux/world/shell.lux | 4 +- 13 files changed, 94 insertions(+), 94 deletions(-) (limited to 'stdlib/source/spec') diff --git a/stdlib/source/spec/lux/abstract/apply.lux b/stdlib/source/spec/lux/abstract/apply.lux index a9925b928..399e69e9e 100644 --- a/stdlib/source/spec/lux/abstract/apply.lux +++ b/stdlib/source/spec/lux/abstract/apply.lux @@ -15,36 +15,36 @@ [// [functor (#+ Injection Comparison)]]) -(def: (identity injection comparison (^open "_@.")) +(def: (identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample (:: ! map injection random.nat)] (_.test "Identity." ((comparison n.=) - (_@apply (injection function.identity) sample) + (_//apply (injection function.identity) sample) sample)))) -(def: (homomorphism injection comparison (^open "_@.")) +(def: (homomorphism injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (_@apply (injection increase) (injection sample)) + (_//apply (injection increase) (injection sample)) (injection (increase sample)))))) -(def: (interchange injection comparison (^open "_@.")) +(def: (interchange injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map n.+ random.nat)] (_.test "Interchange." ((comparison n.=) - (_@apply (injection increase) (injection sample)) - (_@apply (injection (function (_ f) (f sample))) (injection increase)))))) + (_//apply (injection increase) (injection sample)) + (_//apply (injection (function (_ f) (f sample))) (injection increase)))))) -(def: (composition injection comparison (^open "_@.")) +(def: (composition injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) (do {! random.monad} [sample random.nat @@ -52,12 +52,12 @@ decrease (:: ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) - (_$ _@apply + (_$ _//apply (injection function.compose) (injection increase) (injection decrease) (injection sample)) - ($_ _@apply + ($_ _//apply (injection increase) (injection decrease) (injection sample)))))) diff --git a/stdlib/source/spec/lux/abstract/codec.lux b/stdlib/source/spec/lux/abstract/codec.lux index ece213c31..e5740cf53 100644 --- a/stdlib/source/spec/lux/abstract/codec.lux +++ b/stdlib/source/spec/lux/abstract/codec.lux @@ -12,15 +12,15 @@ [// [equivalence (#+ Equivalence)]]]}) -(def: #export (spec (^open "/@.") (^open "/@.") generator) +(def: #export (spec (^open "@//.") (^open "@//.") generator) (All [m a] (-> (Equivalence a) (/.Codec m a) (Random a) Test)) (do random.monad [expected generator] (_.with-cover [/.Codec] (_.test "Isomorphism." - (case (|> expected /@encode /@decode) + (case (|> expected @//encode @//decode) (#try.Success actual) - (/@= expected actual) + (@//= expected actual) (#try.Failure _) false))))) diff --git a/stdlib/source/spec/lux/abstract/comonad.lux b/stdlib/source/spec/lux/abstract/comonad.lux index b69581037..a45c89e26 100644 --- a/stdlib/source/spec/lux/abstract/comonad.lux +++ b/stdlib/source/spec/lux/abstract/comonad.lux @@ -13,19 +13,19 @@ [// [functor (#+ Injection Comparison)]]) -(def: (left-identity injection (^open "_@.")) +(def: (left-identity injection (^open "_//.")) (All [f] (-> (Injection f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat morphism (:: ! map (function (_ diff) - (|>> _@unwrap (n.+ diff))) + (|>> _//unwrap (n.+ diff))) random.nat) #let [start (injection sample)]] (_.test "Left identity." (n.= (morphism start) - (|> start _@split (_@map morphism) _@unwrap))))) + (|> start _//split (_//map morphism) _//unwrap))))) -(def: (right-identity injection comparison (^open "_@.")) +(def: (right-identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) (do random.monad [sample random.nat @@ -33,23 +33,23 @@ == (comparison n.=)]] (_.test "Right identity." (== start - (|> start _@split (_@map _@unwrap)))))) + (|> start _//split (_//map _//unwrap)))))) -(def: (associativity injection comparison (^open "_@.")) +(def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map (function (_ diff) - (|>> _@unwrap (n.+ diff))) + (|>> _//unwrap (n.+ diff))) random.nat) decrease (:: ! map (function (_ diff) - (|>> _@unwrap(n.- diff))) + (|>> _//unwrap(n.- diff))) random.nat) #let [start (injection sample) == (comparison n.=)]] (_.test "Associativity." - (== (|> start _@split (_@map (|>> _@split (_@map increase) decrease))) - (|> start _@split (_@map increase) _@split (_@map decrease)))))) + (== (|> start _//split (_//map (|>> _//split (_//map increase) decrease))) + (|> start _//split (_//map increase) _//split (_//map decrease)))))) (def: #export (spec injection comparison subject) (All [f] (-> (Injection f) (Comparison f) (CoMonad f) Test)) diff --git a/stdlib/source/spec/lux/abstract/enum.lux b/stdlib/source/spec/lux/abstract/enum.lux index 198d3da50..7f541b0e9 100644 --- a/stdlib/source/spec/lux/abstract/enum.lux +++ b/stdlib/source/spec/lux/abstract/enum.lux @@ -8,19 +8,19 @@ {1 ["." /]}) -(def: #export (spec (^open "/@.") gen-sample) +(def: #export (spec (^open "@//.") gen-sample) (All [a] (-> (/.Enum a) (Random a) Test)) (do random.monad [sample gen-sample] (<| (_.with-cover [/.Enum]) ($_ _.and (_.test "Successor and predecessor are inverse functions." - (and (/@= (|> sample /@succ /@pred) - sample) - (/@= (|> sample /@pred /@succ) - sample) - (not (/@= (/@succ sample) - sample)) - (not (/@= (/@pred sample) - sample)))) + (and (@//= (|> sample @//succ @//pred) + sample) + (@//= (|> sample @//pred @//succ) + sample) + (not (@//= (@//succ sample) + sample)) + (not (@//= (@//pred sample) + sample)))) )))) diff --git a/stdlib/source/spec/lux/abstract/equivalence.lux b/stdlib/source/spec/lux/abstract/equivalence.lux index b511ba176..1d8db459c 100644 --- a/stdlib/source/spec/lux/abstract/equivalence.lux +++ b/stdlib/source/spec/lux/abstract/equivalence.lux @@ -8,7 +8,7 @@ {1 ["." / (#+ Equivalence)]}) -(def: #export (spec (^open "_@.") generator) +(def: #export (spec (^open "_//.") generator) (All [a] (-> (Equivalence a) (Random a) Test)) (do random.monad [left generator @@ -16,8 +16,8 @@ (<| (_.with-cover [/.Equivalence]) ($_ _.and (_.test "Reflexivity." - (_@= left left)) + (_//= left left)) (_.test "Symmetry." - (if (_@= left right) - (_@= right left) - (not (_@= right left)))))))) + (if (_//= left right) + (_//= right left) + (not (_//= right left)))))))) diff --git a/stdlib/source/spec/lux/abstract/fold.lux b/stdlib/source/spec/lux/abstract/fold.lux index 71377f991..c1d87dba1 100644 --- a/stdlib/source/spec/lux/abstract/fold.lux +++ b/stdlib/source/spec/lux/abstract/fold.lux @@ -12,11 +12,11 @@ [functor (#+ Injection Comparison)]] {1 ["." /]}) -(def: #export (spec injection comparison (^open "/@.")) +(def: #export (spec injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (/.Fold f) Test)) (do random.monad [subject random.nat parameter random.nat] (_.cover [/.Fold] - (n.= (/@fold n.+ parameter (injection subject)) + (n.= (@//fold n.+ parameter (injection subject)) (n.+ parameter subject))))) diff --git a/stdlib/source/spec/lux/abstract/functor.lux b/stdlib/source/spec/lux/abstract/functor.lux index d40ded1a2..b237a388e 100644 --- a/stdlib/source/spec/lux/abstract/functor.lux +++ b/stdlib/source/spec/lux/abstract/functor.lux @@ -22,26 +22,26 @@ (-> (Equivalence a) (Equivalence (f a))))) -(def: (identity injection comparison (^open "/@.")) +(def: (identity injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample (:: ! map injection random.nat)] (_.test "Identity." ((comparison n.=) - (/@map function.identity sample) + (@//map function.identity sample) sample)))) -(def: (homomorphism injection comparison (^open "/@.")) +(def: (homomorphism injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (/@map increase (injection sample)) + (@//map increase (injection sample)) (injection (increase sample)))))) -(def: (composition injection comparison (^open "/@.")) +(def: (composition injection comparison (^open "@//.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) (do {! random.monad} [sample (:: ! map injection random.nat) @@ -49,8 +49,8 @@ decrease (:: ! map n.- random.nat)] (_.test "Composition." ((comparison n.=) - (|> sample (/@map increase) (/@map decrease)) - (|> sample (/@map (|>> increase decrease))))))) + (|> sample (@//map increase) (@//map decrease)) + (|> sample (@//map (|>> increase decrease))))))) (def: #export (spec injection comparison functor) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) diff --git a/stdlib/source/spec/lux/abstract/functor/contravariant.lux b/stdlib/source/spec/lux/abstract/functor/contravariant.lux index b21e28e68..8adf0139d 100644 --- a/stdlib/source/spec/lux/abstract/functor/contravariant.lux +++ b/stdlib/source/spec/lux/abstract/functor/contravariant.lux @@ -14,11 +14,11 @@ {1 ["." / (#+ Functor)]}) -(def: (identity equivalence value (^open "/@.")) +(def: (identity equivalence value (^open "@//.")) (All [f a] (-> (Equivalence (f a)) (f a) (Functor f) Test)) (_.test "Law of identity." (equivalence - (/@map function.identity value) + (@//map function.identity value) value))) (def: #export (spec equivalence value functor) diff --git a/stdlib/source/spec/lux/abstract/interval.lux b/stdlib/source/spec/lux/abstract/interval.lux index 1541f1cee..0cd255eb2 100644 --- a/stdlib/source/spec/lux/abstract/interval.lux +++ b/stdlib/source/spec/lux/abstract/interval.lux @@ -9,14 +9,14 @@ {1 ["." /]}) -(def: #export (spec (^open "/@.") gen-sample) +(def: #export (spec (^open "@//.") gen-sample) (All [a] (-> (/.Interval a) (Random a) Test)) (<| (_.with-cover [/.Interval]) (do random.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/spec/lux/abstract/monad.lux b/stdlib/source/spec/lux/abstract/monad.lux index c9abf9b25..21ccafe75 100644 --- a/stdlib/source/spec/lux/abstract/monad.lux +++ b/stdlib/source/spec/lux/abstract/monad.lux @@ -11,41 +11,41 @@ [// [functor (#+ Injection Comparison)]]) -(def: (left-identity injection comparison (^open "_@.")) +(def: (left-identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (do {! random.monad} [sample random.nat morphism (:: ! map (function (_ diff) - (|>> (n.+ diff) _@wrap)) + (|>> (n.+ diff) _//wrap)) random.nat)] (_.test "Left identity." ((comparison n.=) - (|> (injection sample) (_@map morphism) _@join) + (|> (injection sample) (_//map morphism) _//join) (morphism sample))))) -(def: (right-identity injection comparison (^open "_@.")) +(def: (right-identity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (do random.monad [sample random.nat] (_.test "Right identity." ((comparison n.=) - (|> (injection sample) (_@map _@wrap) _@join) + (|> (injection sample) (_//map _//wrap) _//join) (injection sample))))) -(def: (associativity injection comparison (^open "_@.")) +(def: (associativity injection comparison (^open "_//.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) (do {! random.monad} [sample random.nat increase (:: ! map (function (_ diff) - (|>> (n.+ diff) _@wrap)) + (|>> (n.+ diff) _//wrap)) random.nat) decrease (:: ! map (function (_ diff) - (|>> (n.- diff) _@wrap)) + (|>> (n.- diff) _//wrap)) random.nat)] (_.test "Associativity." ((comparison n.=) - (|> (injection sample) (_@map increase) _@join (_@map decrease) _@join) - (|> (injection sample) (_@map (|>> increase (_@map decrease) _@join)) _@join))))) + (|> (injection sample) (_//map increase) _//join (_//map decrease) _//join) + (|> (injection sample) (_//map (|>> increase (_//map decrease) _//join)) _//join))))) (def: #export (spec injection comparison monad) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) diff --git a/stdlib/source/spec/lux/abstract/monoid.lux b/stdlib/source/spec/lux/abstract/monoid.lux index eca057360..23e35d0db 100644 --- a/stdlib/source/spec/lux/abstract/monoid.lux +++ b/stdlib/source/spec/lux/abstract/monoid.lux @@ -10,7 +10,7 @@ [// [equivalence (#+ Equivalence)]]]}) -(def: #export (spec (^open "/@.") (^open "/@.") gen-sample) +(def: #export (spec (^open "@//.") (^open "@//.") gen-sample) (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test)) (do random.monad [sample gen-sample @@ -20,12 +20,12 @@ (<| (_.with-cover [/.Monoid]) ($_ _.and (_.test "Left identity." - (/@= sample - (/@compose /@identity sample))) + (@//= sample + (@//compose @//identity sample))) (_.test "Right identity." - (/@= sample - (/@compose sample /@identity))) + (@//= sample + (@//compose sample @//identity))) (_.test "Associativity." - (/@= (/@compose left (/@compose mid right)) - (/@compose (/@compose left mid) right))) + (@//= (@//compose left (@//compose mid right)) + (@//compose (@//compose left mid) right))) )))) diff --git a/stdlib/source/spec/lux/abstract/order.lux b/stdlib/source/spec/lux/abstract/order.lux index 35aef0c9d..7fa8c618c 100644 --- a/stdlib/source/spec/lux/abstract/order.lux +++ b/stdlib/source/spec/lux/abstract/order.lux @@ -8,7 +8,7 @@ {1 ["." /]}) -(def: #export (spec (^open "/@.") generator) +(def: #export (spec (^open "@//.") generator) (All [a] (-> (/.Order a) (Random a) Test)) (<| (_.with-cover [/.Order]) ($_ _.and @@ -16,41 +16,41 @@ [parameter generator subject generator] (_.test "Values are either ordered, or they are equal. All options are mutually exclusive." - (cond (/@< parameter subject) - (not (or (/@< subject parameter) - (/@= parameter subject))) + (cond (@//< parameter subject) + (not (or (@//< subject parameter) + (@//= parameter subject))) - (/@< subject parameter) - (not (/@= parameter subject)) + (@//< subject parameter) + (not (@//= parameter subject)) ## else - (/@= parameter subject)))) + (@//= parameter subject)))) (do random.monad [parameter generator - subject (random.filter (|>> (/@= parameter) not) + subject (random.filter (|>> (@//= parameter) not) generator) extra (random.filter (function (_ value) - (not (or (/@= parameter value) - (/@= subject value)))) + (not (or (@//= parameter value) + (@//= subject value)))) generator)] (_.test "Transitive property." - (if (/@< parameter subject) - (let [greater? (and (/@< subject extra) - (/@< parameter extra)) - lesser? (and (/@< extra parameter) - (/@< extra subject)) - in-between? (and (/@< parameter extra) - (/@< extra subject))] + (if (@//< parameter subject) + (let [greater? (and (@//< subject extra) + (@//< parameter extra)) + lesser? (and (@//< extra parameter) + (@//< extra subject)) + in-between? (and (@//< parameter extra) + (@//< extra subject))] (or greater? lesser? in-between?)) - ## (/@< subject parameter) - (let [greater? (and (/@< extra subject) - (/@< extra parameter)) - lesser? (and (/@< parameter extra) - (/@< subject extra)) - in-between? (and (/@< subject extra) - (/@< extra parameter))] + ## (@//< subject parameter) + (let [greater? (and (@//< extra subject) + (@//< extra parameter)) + lesser? (and (@//< parameter extra) + (@//< subject extra)) + in-between? (and (@//< subject extra) + (@//< extra parameter))] (or greater? lesser? in-between?))))) diff --git a/stdlib/source/spec/lux/world/shell.lux b/stdlib/source/spec/lux/world/shell.lux index 286cc7ce2..d0b62ddc6 100644 --- a/stdlib/source/spec/lux/world/shell.lux +++ b/stdlib/source/spec/lux/world/shell.lux @@ -11,7 +11,7 @@ ["." promise (#+ Promise)]]] [data ["." product] - ["." text ("#@." equivalence) + ["." text ("#//." equivalence) ["%" format (#+ format)]] [number ["n" nat] @@ -41,7 +41,7 @@ (_.claim [/.Can-Read] (case ?read (#try.Success actual) - (text@= expected actual) + (text//= expected actual) (#try.Failure error) false)) -- cgit v1.2.3