diff options
Diffstat (limited to '')
82 files changed, 670 insertions, 668 deletions
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index 0e41a961c..0470be339 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -8,7 +8,7 @@ ["." i64]]] ["." function] ["." math - ["r" random (#+ Random) ("r/." Functor<Random>)]] + ["r" random (#+ Random) ("r/." functor)]] ["_" test (#+ Test)]] [/ ["/." cli] @@ -17,7 +17,7 @@ (def: identity Test - (do r.Monad<Random> + (do r.monad [self (r.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." @@ -32,7 +32,7 @@ (def: increment-and-decrement Test - (do r.Monad<Random> + (do r.monad [value r.i64] ($_ _.and (_.test "'inc' and 'dec' are different." @@ -55,7 +55,7 @@ (def: (even-or-odd rand-gen even? odd?) (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) - (do r.Monad<Random> + (do r.monad [value rand-gen] ($_ _.and (_.test "Every number is either even or odd." @@ -78,7 +78,7 @@ (def: (choice rand-gen = [< choose]) (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test)) - (do r.Monad<Random> + (do r.monad [left rand-gen right rand-gen #let [choice (choose left right)]] @@ -101,7 +101,7 @@ (def: (conversion rand-gen forward backward =) (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) - (do r.Monad<Random> + (do r.monad [value rand-gen] (_.test "Can convert between types in a lossless way." (|> value forward backward (= value))))) @@ -109,12 +109,12 @@ (def: frac-rev (r.Random Rev) (|> r.rev - (:: r.Functor<Random> map (|>> (i64.left-shift 11) (i64.logical-right-shift 11))))) + (:: r.functor map (|>> (i64.left-shift 11) (i64.logical-right-shift 11))))) (def: prelude-macros Test ($_ _.and - (do r.Monad<Random> + (do r.monad [factor (r/map (|>> (n/% 10) (n/max 1)) r.nat) iterations (r/map (n/% 100) r.nat) #let [expected (n/* factor iterations)]] @@ -126,7 +126,7 @@ (recur (inc counter) (n/+ factor value)) value))))) - (do r.Monad<Random> + (do r.monad [first r.nat second r.nat third r.nat] @@ -162,7 +162,7 @@ (def: template Test - (do r.Monad<Random> + (do r.monad [cat0 r.nat cat1 r.nat] (_.test "Template application is a stand-in for the templated code." @@ -171,7 +171,7 @@ (def: cross-platform-support Test - (do r.Monad<Random> + (do r.monad [on-default r.nat on-fake-host r.nat on-valid-host r.nat] diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index 0ee1071e8..e202b3aa7 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -1,13 +1,14 @@ (.module: [lux #* [control - ["M" monad (#+ do Monad)] + ["M" monad (#+ Monad do)] pipe ["p" parser]] [data ["." error] - ["." number] - [text ("text/." Equivalence<Text>) + [number + ["." nat ("nat/." decimal)]] + [text ("text/." equivalence) format] [collection ["." list]]] @@ -19,10 +20,9 @@ (def: #export test Test - (do r.Monad<Random> + (do r.monad [num-args (|> r.nat (:: @ map (n/% 10))) - #let [(^open "Nat/.") number.Codec<Text,Nat> - gen-arg (:: @ map Nat/encode r.nat)] + #let [gen-arg (:: @ map nat/encode r.nat)] yes gen-arg #let [gen-ignore (r.filter (|>> (text/= yes) not) (r.unicode 5))] @@ -51,12 +51,12 @@ (#error.Success _) #0)))) (_.test "Can use custom token parsers." - (|> (/.run (list yes) (/.parse Nat/decode)) + (|> (/.run (list yes) (/.parse nat/decode)) (case> (#error.Failure _) #0 (#error.Success parsed) - (text/= (Nat/encode parsed) + (text/= (nat/encode parsed) yes)))) (_.test "Can query if there are any more inputs." (and (|> (/.run (list) /.end) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux index 2b9cfa914..2bf02bb0e 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/case.lux @@ -6,12 +6,12 @@ [data ["." product] ["." maybe] - ["." text ("text/." Equivalence<Text>)] + ["." text ("text/." equivalence)] [collection - ["." list ("list/." Monad<List>)] + ["." list ("list/." monad)] ["." set]]] [math - ["r" random ("random/." Monad<Random>)]] + ["r" random ("random/." monad)]] ["." type ["." check]] [macro @@ -38,7 +38,7 @@ (list/map (|>> list) head+) (#.Cons head+ tail++) - (do list.Monad<List> + (do list.monad [tail+ (exhaustive-weaving tail++) head head+] (wrap (#.Cons head tail+))))) @@ -52,7 +52,7 @@ (^template [<tag> <gen> <wrapper>] [_ (<tag> _)] (if allow-literals? - (do r.Monad<Random> + (do r.monad [?sample (r.maybe <gen>)] (case ?sample (#.Some sample) @@ -76,14 +76,14 @@ (random/wrap (list (' {}))) [_ (#.Tuple members)] - (do r.Monad<Random> + (do r.monad [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving (list/map code.tuple)))) [_ (#.Record kvs)] - (do r.Monad<Random> + (do r.monad [#let [ks (list/map product.left kvs) vs (list/map product.right kvs)] member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) vs)] @@ -92,7 +92,7 @@ (list/map (|>> (list.zip2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) - (do r.Monad<Random> + (do r.monad [bundles (monad.map @ (function (_ [_tag _code]) (do @ @@ -112,12 +112,12 @@ (function (_ input) ($_ r.either (random/map product.right _primitive.primitive) - (do r.Monad<Random> + (do r.monad [choice (|> r.nat (:: @ map (n/% (list.size variant-tags)))) #let [choiceT (maybe.assume (list.nth choice variant-tags)) choiceC (maybe.assume (list.nth choice primitivesC))]] (wrap (` ((~ choiceT) (~ choiceC))))) - (do r.Monad<Random> + (do r.monad [size (|> r.nat (:: @ map (n/% 3))) elems (r.list size input)] (wrap (code.tuple elems))) @@ -138,8 +138,8 @@ variant-name (r.unicode 5) record-name (|> (r.unicode 5) (r.filter (|>> (text/= variant-name) not))) size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - variant-tags (|> (r.set text.Hash<Text> size (r.unicode 5)) (:: @ map set.to-list)) - record-tags (|> (r.set text.Hash<Text> size (r.unicode 5)) (:: @ map set.to-list)) + variant-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) + record-tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) primitivesTC (r.list size _primitive.primitive) #let [primitivesT (list/map product.left primitivesTC) primitivesC (list/map product.right primitivesTC) @@ -171,7 +171,7 @@ analyse-pm (|>> (/.case _primitive.phase inputC) (typeA.with-type outputT) analysis.with-scope - (do phase.Monad<Operation> + (do phase.monad [_ (module.declare-tags variant-tags #0 (#.Named [module-name variant-name] (type.variant primitivesT))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux index e46f22585..0ec5d4766 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/function.lux @@ -7,10 +7,10 @@ ["." error] ["." maybe] ["." product] - [text ("text/." Equivalence<Text>) + [text ("text/." equivalence) format] [collection - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] [math ["r" random]] ["." type] diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux index a101c5414..de079094b 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/primitive.lux @@ -9,8 +9,8 @@ [text format]] [math - ["r" random ("random/." Monad<Random>)]] - [".L" type ("type/." Equivalence<Type>)] + ["r" random ("random/." monad)]] + [".L" type ("type/." equivalence)] [macro ["." code]] [compiler diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux index 2a1a20005..6576ae90d 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/procedure/common.lux @@ -13,7 +13,7 @@ format]] [math ["r" random]] - [type ("type/." Equivalence<Type>)] + [type ("type/." equivalence)] [macro ["." code]] [compiler diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux index b24d74e1e..18ab58fa9 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/reference.lux @@ -5,11 +5,11 @@ pipe] [data ["." error (#+ Error)] - [name ("name/." Equivalence<Name>)] - [text ("text/." Equivalence<Text>)]] + [name ("name/." equivalence)] + [text ("text/." equivalence)]] [math ["r" random]] - [type ("type/." Equivalence<Type>)] + [type ("type/." equivalence)] [macro ["." code]] [compiler @@ -45,7 +45,7 @@ (def: (reach-test var-name [export? def-module] [import? dependent-module] check!) (-> Text [Bit Text] [Bit Text] Check Bit) - (|> (do phase.Monad<Operation> + (|> (do phase.monad [_ (module.with-module 0 def-module (module.define var-name [Any (if export? @@ -86,7 +86,7 @@ #0))) (test "Can analyse definition (in the same module)." (let [def-name [def-module var-name]] - (|> (do phase.Monad<Operation> + (|> (do phase.monad [_ (module.define var-name [expectedT (' {}) []])] (typeA.with-inference (_primitive.phase (code.identifier def-name)))) diff --git a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux index c5165fca7..63c6da493 100644 --- a/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux +++ b/stdlib/test/test/lux/compiler/default/phase/analysis/structure.lux @@ -4,17 +4,17 @@ [monad (#+ do)] pipe] [data - [bit ("bit/." Equivalence<Bit>)] + [bit ("bit/." equivalence)] ["e" error] ["." product] ["." maybe] ["." text] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["." set]]] [math ["r" random]] - ["." type ("type/." Equivalence<Type>) + ["." type ("type/." equivalence) ["." check]] [macro ["." code]] @@ -69,7 +69,7 @@ (def: (tagged module tags type) (All [a] (-> Text (List module.Tag) Type (Operation a) (Operation [Module a]))) - (|>> (do phase.Monad<Operation> + (|>> (do phase.monad [_ (module.declare-tags tags #0 type)]) (module.with-module 0 module))) @@ -128,7 +128,7 @@ (check-sum variantT size choice (/.sum _primitive.phase choice valueC))) (test "Can analyse sum through bound type-vars." - (|> (do phase.Monad<Operation> + (|> (do phase.monad [[_ varT] (typeA.with-env check.var) _ (typeA.with-env (check.check varT variantT))] @@ -141,7 +141,7 @@ _ #0))) (test "Cannot analyse sum through unbound type-vars." - (|> (do phase.Monad<Operation> + (|> (do phase.monad [[_ varT] (typeA.with-env check.var)] (typeA.with-type varT (/.sum _primitive.phase choice valueC))) @@ -197,7 +197,7 @@ (_primitive.phase (` [(~ singletonC)]))) check-succeeds)) (test "Can analyse product through bound type-vars." - (|> (do phase.Monad<Operation> + (|> (do phase.monad [[_ varT] (typeA.with-env check.var) _ (typeA.with-env (check.check varT (type.tuple (list/map product.left primitives))))] @@ -223,7 +223,7 @@ (<| (times 100) (do @ [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tags (|> (r.set text.Hash<Text> size (r.unicode 5)) (:: @ map set.to-list)) + tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) choice (|> r.nat (:: @ map (n/% size))) other-choice (|> r.nat (:: @ map (n/% size)) (r.filter (|>> (n/= choice) not))) primitives (r.list size _primitive.primitive) @@ -262,7 +262,7 @@ (<| (times 100) (do @ [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2)))) - tags (|> (r.set text.Hash<Text> size (r.unicode 5)) (:: @ map set.to-list)) + tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) primitives (r.list size _primitive.primitive) module-name (r.unicode 5) type-name (r.unicode 5) @@ -289,7 +289,7 @@ (/.record _primitive.phase recordC)) (check-record-inference module-name tags named-polyT size))) (test "Can specialize generic records." - (|> (do phase.Monad<Operation> + (|> (do phase.monad [recordA (typeA.with-type tupleT (/.record _primitive.phase recordC))] (wrap [tupleT recordA])) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux index 2084ee46b..319d4ab57 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/case.lux @@ -4,7 +4,7 @@ [monad (#+ do)] pipe] [data - ["." error ("error/." Functor<Error>)]] + ["." error ("error/." functor)]] [compiler [default ["." reference] diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux index 133048936..f2565dfa0 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/function.lux @@ -11,12 +11,12 @@ [text format] [collection - ["." list ("list/." Functor<List> Fold<List>)] + ["." list ("list/." functor fold)] ["dict" dictionary (#+ Dictionary)] ["." set]]] [compiler [default - ["." reference (#+ Variable) ("variable/." Equivalence<Variable>)] + ["." reference (#+ Variable) ("variable/." equivalence)] ["." phase ["." analysis (#+ Arity Analysis)] ["//" synthesis (#+ Synthesis) @@ -32,7 +32,7 @@ (r.Random [Arity Analysis Analysis]) (r.rec (function (_ constant-function) - (do r.Monad<Random> + (do r.monad [function? r.bit] (if function? (do @ @@ -46,11 +46,11 @@ (def: (pick scope-size) (-> Nat (r.Random Nat)) - (|> r.nat (:: r.Monad<Random> map (n/% scope-size)))) + (|> r.nat (:: r.monad map (n/% scope-size)))) (def: function-with-environment (r.Random [Arity Analysis Variable]) - (do r.Monad<Random> + (do r.monad [num-locals (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) #let [indices (list.n/range 0 (dec num-locals)) local-env (list/map (|>> #reference.Local) indices) @@ -62,14 +62,14 @@ resolver (list/fold (function (_ [idx var] resolver) (dict.put idx var resolver)) (: (Dictionary Nat Variable) - (dict.new number.Hash<Nat>)) + (dict.new number.hash)) (list.enumerate current-env))] (do @ [nest? r.bit] (if nest? (do @ [num-picks (:: @ map (n/max 1) (pick (inc current-env/size))) - picks (|> (r.set number.Hash<Nat> num-picks (pick current-env/size)) + picks (|> (r.set number.hash num-picks (pick current-env/size)) (:: @ map set.to-list)) [arity bodyA predictionA] (recur (inc arity) (list/map (function (_ pick) @@ -93,13 +93,13 @@ (loop [arity 0 nest? #1] (if nest? - (do r.Monad<Random> + (do r.monad [nest?' r.bit [arity' bodyA predictionA] (recur (inc arity) nest?')] (wrap [arity' (#analysis.Function (list) bodyA) predictionA])) - (do r.Monad<Random> + (do r.monad [chosen (|> r.nat (:: @ map (|>> (n/% 100) (n/max 2))))] (wrap [arity (#analysis.Reference (reference.local chosen)) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux index 0a55fbcf6..87dccc9f5 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/primitive.lux @@ -21,7 +21,7 @@ (def: #export primitive (r.Random Analysis) - (do r.Monad<Random> + (do r.monad [primitive (: (r.Random analysis.Primitive) ($_ r.or (wrap []) diff --git a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux index fa93777b2..7f9eae209 100644 --- a/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux +++ b/stdlib/test/test/lux/compiler/default/phase/synthesis/structure.lux @@ -4,7 +4,7 @@ [monad (#+ do)] pipe] [data - [bit ("bit/." Equivalence<Bit>)] + [bit ("bit/." equivalence)] ["." product] ["." error] [collection diff --git a/stdlib/test/test/lux/compiler/default/syntax.lux b/stdlib/test/test/lux/compiler/default/syntax.lux index 74d927975..fb83bda4c 100644 --- a/stdlib/test/test/lux/compiler/default/syntax.lux +++ b/stdlib/test/test/lux/compiler/default/syntax.lux @@ -11,7 +11,7 @@ ["." list] ["." dictionary (#+ Dictionary)]]] [math - ["r" random ("r/." Monad<Random>)]] + ["r" random ("r/." monad)]] [macro ["." code]] [compiler @@ -27,7 +27,7 @@ (def: name-part^ (r.Random Text) - (do r.Monad<Random> + (do r.monad [#let [digits "0123456789" delimiters (format "()[]{}#." &.text-delimiter) space (format " " text.new-line) @@ -55,7 +55,7 @@ (|> r.frac (r/map code.frac)))) textual^ (: (r.Random Code) ($_ r.either - (do r.Monad<Random> + (do r.monad [size (|> r.nat (r/map (n/% 20)))] (|> (r.unicode size) (r/map code.text))) (|> name^ (r/map code.identifier)) @@ -66,14 +66,14 @@ textual^))] (r.rec (function (_ code^) - (let [multi^ (do r.Monad<Random> + (let [multi^ (do r.monad [size (|> r.nat (r/map (n/% 3)))] (r.list size code^)) composite^ (: (r.Random Code) ($_ r.either (|> multi^ (r/map code.form)) (|> multi^ (r/map code.tuple)) - (do r.Monad<Random> + (do r.monad [size (|> r.nat (r/map (n/% 3)))] (|> (r.list size (r.and code^ code^)) (r/map code.record)))))] @@ -88,42 +88,42 @@ ($_ seq (test "Can parse Lux code." (case (let [source-code (%code sample)] - (&.parse "" (dictionary.new text.Hash<Text>) (text.size source-code) + (&.parse "" (dictionary.new text.hash) (text.size source-code) [default-cursor 0 source-code])) (#error.Failure error) #0 (#error.Success [_ parsed]) - (:: code.Equivalence<Code> = parsed sample))) + (:: code.equivalence = parsed sample))) (test "Can parse Lux multiple code nodes." (let [source-code (format (%code sample) " " (%code other)) source-code//size (text.size source-code)] - (case (&.parse "" (dictionary.new text.Hash<Text>) source-code//size + (case (&.parse "" (dictionary.new text.hash) source-code//size [default-cursor 0 source-code]) (#error.Failure error) #0 (#error.Success [remaining =sample]) - (case (&.parse "" (dictionary.new text.Hash<Text>) source-code//size + (case (&.parse "" (dictionary.new text.hash) source-code//size remaining) (#error.Failure error) #0 (#error.Success [_ =other]) - (and (:: code.Equivalence<Code> = sample =sample) - (:: code.Equivalence<Code> = other =other)))))) + (and (:: code.equivalence = sample =sample) + (:: code.equivalence = other =other)))))) )))) (def: comment-text^ (r.Random Text) (let [char-gen (|> r.nat (r.filter (|>> (n/= (`` (char (~~ (static text.new-line))))) not)))] - (do r.Monad<Random> + (do r.monad [size (|> r.nat (r/map (n/% 20)))] (r.text char-gen size)))) (def: comment^ (r.Random Text) - (do r.Monad<Random> + (do r.monad [comment comment-text^] (wrap (format "## " comment text.new-line)))) @@ -137,11 +137,11 @@ (test "Can handle comments." (case (let [source-code (format comment (%code sample)) source-code//size (text.size source-code)] - (&.parse "" (dictionary.new text.Hash<Text>) source-code//size + (&.parse "" (dictionary.new text.hash) source-code//size [default-cursor 0 source-code])) (#error.Failure error) #0 (#error.Success [_ parsed]) - (:: code.Equivalence<Code> = parsed sample))) + (:: code.equivalence = parsed sample))) )))) diff --git a/stdlib/test/test/lux/control/concurrency/actor.lux b/stdlib/test/test/lux/control/concurrency/actor.lux index 59a0f4d76..c035cabe2 100644 --- a/stdlib/test/test/lux/control/concurrency/actor.lux +++ b/stdlib/test/test/lux/control/concurrency/actor.lux @@ -5,7 +5,7 @@ ["M" monad (#+ do Monad)] ["ex" exception] [concurrency - ["P" promise ("promise/." Monad<Promise>)] + ["P" promise ("promise/." monad)] ["T" task] ["&" actor (#+ actor: message:)]]] [data @@ -18,7 +18,7 @@ Nat ((handle message state self) - (do T.Monad<Task> + (do t.monad [#let [_ (log! "BEFORE")] output (message state self) #let [_ (log! "AFTER")]] @@ -37,27 +37,27 @@ (context: "Actors" ($_ seq (test "Can check if an actor is alive." - (io.run (do io.Monad<IO> + (io.run (do io.monad [counter (new@Counter 0)] (wrap (&.alive? counter))))) (test "Can poison actors." - (io.run (do io.Monad<IO> + (io.run (do io.monad [counter (new@Counter 0) poisoned? (&.poison counter)] (wrap (and poisoned? (not (&.alive? counter))))))) (test "Cannot poison an already dead actor." - (io.run (do io.Monad<IO> + (io.run (do io.monad [counter (new@Counter 0) first-time (&.poison counter) second-time (&.poison counter)] (wrap (and first-time (not second-time)))))) - (wrap (do P.Monad<Promise> - [result (do T.Monad<Task> + (wrap (do p.monad + [result (do t.monad [#let [counter (io.run (new@Counter 0))] output-1 (count! 1 counter) output-2 (count! 1 counter) diff --git a/stdlib/test/test/lux/control/concurrency/frp.lux b/stdlib/test/test/lux/control/concurrency/frp.lux index a906ee54b..cfe70ff0e 100644 --- a/stdlib/test/test/lux/control/concurrency/frp.lux +++ b/stdlib/test/test/lux/control/concurrency/frp.lux @@ -4,7 +4,7 @@ [control ["." monad (#+ do Monad)] [concurrency - ["." promise ("promise/." Monad<Promise>)] + ["." promise ("promise/." monad)] ["." frp (#+ Channel)] ["." atom (#+ Atom atom)]]] [data @@ -14,9 +14,9 @@ lux/test) (context: "FRP" - (let [(^open "list/.") (list.Equivalence<List> number.Equivalence<Int>)] + (let [(^open "list/.") (list.equivalence number.equivalence)] ($_ seq - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [output (|> (list +0 +1 +2 +3 +4 +5) (frp.sequential 0) (frp.filter i/even?) @@ -24,26 +24,26 @@ (assert "Can filter a channel's elements." (list/= (list +0 +2 +4) output)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [output (|> (list +0 +1 +2 +3 +4 +5) (frp.sequential 0) - (:: frp.Functor<Channel> map inc) + (:: frp.functor map inc) frp.consume)] (assert "Functor goes over every element in a channel." (list/= (list +1 +2 +3 +4 +5 +6) output)))) - (wrap (do promise.Monad<Promise> - [output (frp.consume (:: frp.Apply<Channel> apply + (wrap (do promise.monad + [output (frp.consume (:: frp.apply apply (frp.sequential 0 (list inc)) (frp.sequential 0 (list +12345))))] (assert "Apply works over all channel values." (list/= (list +12346) output)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [output (frp.consume - (do frp.Monad<Channel> + (do frp.monad [f (frp.from-promise (promise/wrap inc)) a (frp.from-promise (promise/wrap +12345))] (wrap (f a))))] diff --git a/stdlib/test/test/lux/control/concurrency/promise.lux b/stdlib/test/test/lux/control/concurrency/promise.lux index 0ea05c46a..e50320901 100644 --- a/stdlib/test/test/lux/control/concurrency/promise.lux +++ b/stdlib/test/test/lux/control/concurrency/promise.lux @@ -2,33 +2,33 @@ [lux #* ["." io] [control - ["M" monad (#+ do Monad)] + ["M" monad (#+ Monad do)] pipe [concurrency - ["&" promise ("&/." Monad<Promise>)]]] + ["&" promise ("&/." monad)]]] [math ["r" random]]] lux/test) (context: "Promises" ($_ seq - (wrap (do &.Monad<Promise> + (wrap (do &.monad [running? (&.future (io.io #1))] (assert "Can run IO actions in separate threads." running?))) - (wrap (do &.Monad<Promise> + (wrap (do &.monad [_ (&.wait 500)] (assert "Can wait for a specified amount of time." #1))) - (wrap (do &.Monad<Promise> + (wrap (do &.monad [[left right] (&.and (&.future (io.io #1)) (&.future (io.io #0)))] (assert "Can combine promises sequentially." (and left (not right))))) - (wrap (do &.Monad<Promise> + (wrap (do &.monad [?left (&.or (&.delay 100 #1) (&.delay 200 #0)) ?right (&.or (&.delay 200 #1) @@ -41,7 +41,7 @@ _ #0)))) - (wrap (do &.Monad<Promise> + (wrap (do &.monad [?left (&.either (&.delay 100 #1) (&.delay 200 #0)) ?right (&.either (&.delay 200 #1) @@ -55,7 +55,7 @@ (|> (&.poll (&.delay 200 #1)) (case> #.None #1 _ #0)))) - (wrap (do &.Monad<Promise> + (wrap (do &.monad [?none (&.time-out 100 (&.delay 200 #1)) ?some (&.time-out 200 (&.delay 100 #1))] (assert "Can establish maximum waiting times for promises to be fulfilled." diff --git a/stdlib/test/test/lux/control/concurrency/semaphore.lux b/stdlib/test/test/lux/control/concurrency/semaphore.lux index 5c09f4bac..0c4167ee7 100644 --- a/stdlib/test/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/test/test/lux/control/concurrency/semaphore.lux @@ -8,10 +8,10 @@ ["." atom (#+ Atom)]]] [data ["." maybe] - ["." text ("text/." Equivalence<Text> Monoid<Text>) + ["." text ("text/." equivalence monoid) format] [collection - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] ["." io] [math ["r" random]]] @@ -21,10 +21,10 @@ ## (-> Nat /.Semaphore (Promise Any)) ## (loop [steps times] ## (if (n/> 0 steps) -## (do promise.Monad<Promise> +## (do promise.monad ## [_ (/.wait semaphore)] ## (recur (dec steps))) -## (:: promise.Monad<Promise> wrap [])))) +## (:: promise.monad wrap [])))) ## (context: "Semaphore." ## (<| (times 100) @@ -32,12 +32,12 @@ ## [open-positions (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))] ## ($_ seq ## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.Monad<Promise> +## (wrap (do promise.monad ## [_ (wait-many-times open-positions semaphore)] ## (assert "Can wait on a semaphore up to the number of open positions without blocking." ## true)))) ## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.Monad<Promise> +## (wrap (do promise.monad ## [result (<| (promise.time-out 100) ## (wait-many-times (inc open-positions) semaphore))] ## (assert "Waiting on a semaphore more than the number of open positions blocks the process." @@ -48,7 +48,7 @@ ## #.None ## true))))) ## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.Monad<Promise> +## (wrap (do promise.monad ## [_ (: (Promise Any) ## (loop [steps (n/* 2 open-positions)] ## (if (n/> 0 steps) @@ -60,7 +60,7 @@ ## (assert "Signaling a semaphore replenishes its open positions." ## true)))) ## (let [semaphore (/.semaphore open-positions)] -## (wrap (do promise.Monad<Promise> +## (wrap (do promise.monad ## [#let [resource (atom.atom "") ## blocked (do @ ## [_ (wait-many-times open-positions semaphore) @@ -84,14 +84,14 @@ ## [repetitions (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] ## ($_ seq ## (let [mutex (/.mutex [])] -## (wrap (do promise.Monad<Promise> +## (wrap (do promise.monad ## [#let [resource (atom.atom "") ## expected-As (text.join-with "" (list.repeat repetitions "A")) ## expected-Bs (text.join-with "" (list.repeat repetitions "B")) ## processA (<| (/.synchronize mutex) ## io.io ## promise.future -## (do io.Monad<IO> +## (do io.monad ## [_ (<| (monad.seq @) ## (list.repeat repetitions) ## (atom.update (|>> (format "A")) resource))] @@ -99,7 +99,7 @@ ## processB (<| (/.synchronize mutex) ## io.io ## promise.future -## (do io.Monad<IO> +## (do io.monad ## [_ (<| (monad.seq @) ## (list.repeat repetitions) ## (atom.update (|>> (format "B")) resource))] @@ -116,7 +116,7 @@ ## (def: (waiter resource barrier id) ## (-> (Atom Text) /.Barrier Nat (Promise Any)) -## (do promise.Monad<Promise> +## (do promise.monad ## [_ (/.block barrier) ## #let [_ (io.run (atom.update (|>> (format (%n id))) resource))]] ## (wrap []))) @@ -126,7 +126,7 @@ ## barrier (/.barrier (maybe.assume (/.limit limit))) ## resource (atom.atom "")] ## ($_ seq -## (wrap (do promise.Monad<Promise> +## (wrap (do promise.monad ## [#let [ids (list.n/range 0 (dec limit)) ## waiters (list/map (function (_ id) ## (let [process (waiter resource barrier id)] diff --git a/stdlib/test/test/lux/control/concurrency/stm.lux b/stdlib/test/test/lux/control/concurrency/stm.lux index c84ce44cc..966ab6007 100644 --- a/stdlib/test/test/lux/control/concurrency/stm.lux +++ b/stdlib/test/test/lux/control/concurrency/stm.lux @@ -12,14 +12,14 @@ [data ["." number] [collection - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] [math ["r" random]]] lux/test) (def: (read! channel) (All [a] (-> (Channel a) (IO (Atom (List a))))) - (do io.Monad<IO> + (do io.monad [#let [output (atom (list))] _ (frp.listen (function (_ value) ## TODO: Simplify when possible. @@ -33,36 +33,36 @@ (context: "STM" ($_ seq - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [output (&.commit (&.read (&.var 0)))] (assert "Can read STM vars." (n/= 0 output)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [_var (&.var 0)] - output (&.commit (do &.Monad<STM> + output (&.commit (do &.monad [_ (&.write 5 _var)] (&.read _var)))] (assert "Can write STM vars." (n/= 5 output)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [_var (&.var 5)] - output (&.commit (do &.Monad<STM> + output (&.commit (do &.monad [_ (&.update (n/* 3) _var)] (&.read _var)))] (assert "Can update STM vars." (n/= 15 output)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [_var (&.var 0) changes (io.run (read! (io.run (&.follow _var))))] _ (&.commit (&.write 5 _var)) _ (&.commit (&.update (n/* 3) _var)) changes (promise.future (atom.read changes))] (assert "Can follow all the changes to STM vars." - (:: (list.Equivalence<List> number.Equivalence<Nat>) = + (:: (list.equivalence number.equivalence) = (list 5 15) (list.reverse changes))))) (wrap (let [_concurrency-var (&.var 0)] - (do promise.Monad<Promise> + (do promise.monad [_ (|> process.parallelism (list.n/range 1) (list/map (function (_ _) diff --git a/stdlib/test/test/lux/control/continuation.lux b/stdlib/test/test/lux/control/continuation.lux index dfe93023a..0dbbe7dc5 100644 --- a/stdlib/test/test/lux/control/continuation.lux +++ b/stdlib/test/test/lux/control/continuation.lux @@ -14,8 +14,8 @@ (<| (times 100) (do @ [sample r.nat - #let [(^open "&/.") &.Apply<Cont> - (^open "&/.") &.Monad<Cont>] + #let [(^open "&/.") &.apply + (^open "&/.") &.monad] elems (r.list 3 r.nat)] ($_ seq (test "Can run continuations to compute their values." @@ -28,14 +28,14 @@ (n/= (inc sample) (&.run (&/apply (&/wrap inc) (&/wrap sample))))) (test "Can use monad." - (n/= (inc sample) (&.run (do &.Monad<Cont> + (n/= (inc sample) (&.run (do &.monad [func (wrap inc) arg (wrap sample)] (wrap (func arg)))))) (test "Can use the current-continuation as a escape hatch." (n/= (n/* 2 sample) - (&.run (do &.Monad<Cont> + (&.run (do &.monad [value (&.call/cc (function (_ k) (do @ @@ -48,15 +48,15 @@ (test "Can use the current-continuation to build a time machine." (n/= (n/+ 100 sample) - (&.run (do &.Monad<Cont> + (&.run (do &.monad [[restart [output idx]] (&.portal [sample 0])] (if (n/< 10 idx) (restart [(n/+ 10 output) (inc idx)]) (wrap output)))))) (test "Can use delimited continuations with shifting." - (let [(^open "&/.") &.Monad<Cont> - (^open "L/.") (list.Equivalence<List> number.Equivalence<Nat>) + (let [(^open "&/.") &.monad + (^open "L/.") (list.equivalence number.equivalence) visit (: (-> (List Nat) (&.Cont (List Nat) (List Nat))) (function (visit xs) @@ -65,7 +65,7 @@ (&/wrap #.Nil) (#.Cons x xs') - (do &.Monad<Cont> + (do &.monad [output (&.shift (function (_ k) (do @ [tail (k xs')] diff --git a/stdlib/test/test/lux/control/equivalence.lux b/stdlib/test/test/lux/control/equivalence.lux index 7c45e90e0..daa2c81b3 100644 --- a/stdlib/test/test/lux/control/equivalence.lux +++ b/stdlib/test/test/lux/control/equivalence.lux @@ -9,7 +9,7 @@ (def: #export (spec Equivalence<a> generator) (All [a] (-> (/.Equivalence a) (r.Random a) Test)) - (do r.Monad<Random> + (do r.monad [sample generator another generator] ($_ seq diff --git a/stdlib/test/test/lux/control/interval.lux b/stdlib/test/test/lux/control/interval.lux index 9fe01a0a1..6d00a36e9 100644 --- a/stdlib/test/test/lux/control/interval.lux +++ b/stdlib/test/test/lux/control/interval.lux @@ -18,14 +18,14 @@ (do @ [bottom r.int top r.int - #let [(^open "&/.") &.Equivalence<Interval>]] + #let [(^open "&/.") &.equivalence]] ($_ seq (test "Every interval is equal to itself." - (and (let [self (&.between number.Enum<Int> bottom top)] + (and (let [self (&.between number.enum bottom top)] (&/= self self)) - (let [self (&.between number.Enum<Int> top bottom)] + (let [self (&.between number.enum top bottom)] (&/= self self)) - (let [self (&.singleton number.Enum<Int> bottom)] + (let [self (&.singleton number.enum bottom)] (&/= self self)))))))) (context: "Boundaries" @@ -33,7 +33,7 @@ (do @ [bottom r.int top r.int - #let [interval (&.between number.Enum<Int> bottom top)]] + #let [interval (&.between number.enum bottom top)]] ($_ seq (test "Every boundary value belongs to it's interval." (and (&.within? interval bottom) @@ -60,12 +60,12 @@ (do-template [<name> <cmp>] [(def: <name> (r.Random (&.Interval Int)) - (do r.Monad<Random> + (do r.monad [bottom r.int top (|> r.int (r.filter (|>> (i/= bottom) not)))] (if (<cmp> top bottom) - (wrap (&.between number.Enum<Int> bottom top)) - (wrap (&.between number.Enum<Int> top bottom)))))] + (wrap (&.between number.enum bottom top)) + (wrap (&.between number.enum top bottom)))))] [gen-inner i/<] [gen-outer i/>] @@ -73,9 +73,9 @@ (def: gen-singleton (r.Random (&.Interval Int)) - (do r.Monad<Random> + (do r.monad [point r.int] - (wrap (&.singleton number.Enum<Int> point)))) + (wrap (&.singleton number.enum point)))) (def: gen-interval (r.Random (&.Interval Int)) @@ -94,7 +94,7 @@ right-singleton gen-singleton left-outer gen-outer right-outer gen-outer - #let [(^open "&/.") &.Equivalence<Interval>]] + #let [(^open "&/.") &.equivalence]] ($_ seq (test "The union of an interval to itself yields the same interval." (&/= some-interval (&.union some-interval some-interval))) @@ -116,7 +116,7 @@ right-singleton gen-singleton left-outer gen-outer right-outer gen-outer - #let [(^open "&/.") &.Equivalence<Interval>]] + #let [(^open "&/.") &.equivalence]] ($_ seq (test "The intersection of an interval to itself yields the same interval." (&/= some-interval (&.intersection some-interval some-interval))) @@ -132,7 +132,7 @@ (<| (times 100) (do @ [some-interval gen-interval - #let [(^open "&/.") &.Equivalence<Interval>]] + #let [(^open "&/.") &.equivalence]] ($_ seq (test "The complement of a complement is the same as the original." (&/= some-interval (|> some-interval &.complement &.complement))) @@ -143,7 +143,7 @@ (context: "Positioning/location" (<| (times 100) (do @ - [[l m r] (|> (r.set number.Hash<Int> 3 r.int) + [[l m r] (|> (r.set number.hash 3 r.int) (:: @ map (|>> S.to-list (L.sort i/<) (case> (^ (list b t1 t2)) @@ -151,8 +151,8 @@ _ (undefined))))) - #let [left (&.singleton number.Enum<Int> l) - right (&.singleton number.Enum<Int> r)]] + #let [left (&.singleton number.enum l) + right (&.singleton number.enum r)]] ($_ seq (test "'precedes?' and 'succeeds?' are symetric." (and (&.precedes? right left) @@ -165,7 +165,7 @@ (context: "Touching intervals" (<| (times 100) (do @ - [[b t1 t2] (|> (r.set number.Hash<Int> 3 r.int) + [[b t1 t2] (|> (r.set number.hash 3 r.int) (:: @ map (|>> S.to-list (L.sort i/<) (case> (^ (list b t1 t2)) @@ -173,26 +173,26 @@ _ (undefined))))) - #let [int-left (&.between number.Enum<Int> t1 t2) - int-right (&.between number.Enum<Int> b t1)]] + #let [int-left (&.between number.enum t1 t2) + int-right (&.between number.enum b t1)]] ($_ seq (test "An interval meets another if it's top is the other's bottom." (&.meets? int-left int-right)) (test "Two intervals touch one another if any one meets the other." (&.touches? int-left int-right)) (test "Can check if 2 intervals start together." - (&.starts? (&.between number.Enum<Int> b t2) - (&.between number.Enum<Int> b t1))) + (&.starts? (&.between number.enum b t2) + (&.between number.enum b t1))) (test "Can check if 2 intervals finish together." - (&.finishes? (&.between number.Enum<Int> b t2) - (&.between number.Enum<Int> t1 t2))) + (&.finishes? (&.between number.enum b t2) + (&.between number.enum t1 t2))) )))) (context: "Nesting & overlap" (<| (times 100) (do @ [some-interval gen-interval - [x0 x1 x2 x3] (|> (r.set number.Hash<Int> 4 r.int) + [x0 x1 x2 x3] (|> (r.set number.hash 4 r.int) (:: @ map (|>> S.to-list (L.sort i/<) (case> (^ (list x0 x1 x2 x3)) @@ -205,30 +205,30 @@ (&.nested? some-interval some-interval)) (test "No interval overlaps with itself." (not (&.overlaps? some-interval some-interval))) - (let [small-inner (&.between number.Enum<Int> x1 x2) - large-inner (&.between number.Enum<Int> x0 x3)] + (let [small-inner (&.between number.enum x1 x2) + large-inner (&.between number.enum x0 x3)] (test "Inner intervals can be nested inside one another." (and (&.nested? large-inner small-inner) (not (&.nested? small-inner large-inner))))) - (let [left-inner (&.between number.Enum<Int> x0 x2) - right-inner (&.between number.Enum<Int> x1 x3)] + (let [left-inner (&.between number.enum x0 x2) + right-inner (&.between number.enum x1 x3)] (test "Inner intervals can overlap one another." (and (&.overlaps? left-inner right-inner) (&.overlaps? right-inner left-inner)))) - (let [small-outer (&.between number.Enum<Int> x2 x1) - large-outer (&.between number.Enum<Int> x3 x0)] + (let [small-outer (&.between number.enum x2 x1) + large-outer (&.between number.enum x3 x0)] (test "Outer intervals can be nested inside one another." (and (&.nested? small-outer large-outer) (not (&.nested? large-outer small-outer))))) - (let [left-inner (&.between number.Enum<Int> x0 x1) - right-inner (&.between number.Enum<Int> x2 x3) - outer (&.between number.Enum<Int> x0 x3)] + (let [left-inner (&.between number.enum x0 x1) + right-inner (&.between number.enum x2 x3) + outer (&.between number.enum x0 x3)] (test "Inners can be nested inside outers." (and (&.nested? outer left-inner) (&.nested? outer right-inner)))) - (let [left-inner (&.between number.Enum<Int> x0 x2) - right-inner (&.between number.Enum<Int> x1 x3) - outer (&.between number.Enum<Int> x1 x2)] + (let [left-inner (&.between number.enum x0 x2) + right-inner (&.between number.enum x1 x3) + outer (&.between number.enum x1 x2)] (test "Inners can overlap outers." (and (&.overlaps? outer left-inner) (&.overlaps? outer right-inner)))) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux index 37b296357..c9d568495 100644 --- a/stdlib/test/test/lux/control/parser.lux +++ b/stdlib/test/test/lux/control/parser.lux @@ -97,7 +97,7 @@ (test "Can use either parser." (let [positive (: (s.Syntax Int) - (do &.Monad<Parser> + (do &.monad [value s.int _ (&.assert "" (i/> +0 value))] (wrap value)))] diff --git a/stdlib/test/test/lux/control/pipe.lux b/stdlib/test/test/lux/control/pipe.lux index e5ceaeb19..aaaa18616 100644 --- a/stdlib/test/test/lux/control/pipe.lux +++ b/stdlib/test/test/lux/control/pipe.lux @@ -1,11 +1,11 @@ (.module: [lux #* [control - [monad (#+ do Monad)] + [monad (#+ Monad do)] pipe] [data - identity - [text ("text/." Equivalence<Text>) + ["." identity] + [text ("text/." equivalence) format]] [math ["r" random]]] @@ -49,7 +49,7 @@ (test "Can use monads within pipelines." (|> +5 - (do> Monad<Identity> + (do> identity.monad [(i/* +3)] [(i/+ +4)] [inc]) diff --git a/stdlib/test/test/lux/control/reader.lux b/stdlib/test/test/lux/control/reader.lux index 57f487426..638e11519 100644 --- a/stdlib/test/test/lux/control/reader.lux +++ b/stdlib/test/test/lux/control/reader.lux @@ -8,25 +8,25 @@ lux/test) (context: "Readers" - (let [(^open "&/.") &.Apply<Reader> - (^open "&/.") &.Monad<Reader>] + (let [(^open "&/.") &.apply + (^open "&/.") &.monad] ($_ seq (test "" (i/= +123 (&.run +123 &.ask))) (test "" (i/= +246 (&.run +123 (&.local (i/* +2) &.ask)))) (test "" (i/= +134 (&.run +123 (&/map inc (i/+ +10))))) (test "" (i/= +10 (&.run +123 (&/wrap +10)))) (test "" (i/= +30 (&.run +123 (&/apply (&/wrap (i/+ +10)) (&/wrap +20))))) - (test "" (i/= +30 (&.run +123 (do &.Monad<Reader> + (test "" (i/= +30 (&.run +123 (do &.monad [f (wrap i/+) x (wrap +10) y (wrap +20)] (wrap (f x y))))))))) (context: "Monad transformer" - (let [(^open "io/.") io.Monad<IO>] + (let [(^open "io/.") io.monad] (test "Can add reader functionality to any monad." (|> (: (&.Reader Text (io.IO Int)) - (do (&.ReaderT io.Monad<IO>) + (do (&.ReaderT io.monad) [a (&.lift (io/wrap +123)) b (wrap +456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/control/region.lux b/stdlib/test/test/lux/control/region.lux index f639739b4..ff6bdaeaf 100644 --- a/stdlib/test/test/lux/control/region.lux +++ b/stdlib/test/test/lux/control/region.lux @@ -36,7 +36,7 @@ ($_ seq (test "Clean-up functions are always run when region execution is done." (thread.run - (do thread.Monad<Thread> + (do thread.monad [clean-up-counter (thread.box 0) #let [@@ @ count-clean-up (function (_ value) @@ -44,7 +44,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#error.Success []))))] outcome (/.run @ - (do (/.Monad<Region> @) + (do (/.monad @) [_ (monad.map @ (/.acquire @@ count-clean-up) (list.n/range 1 expected-clean-ups))] (wrap []))) @@ -54,7 +54,7 @@ actual-clean-ups)))))) (test "Can clean-up despite errors." (thread.run - (do thread.Monad<Thread> + (do thread.monad [clean-up-counter (thread.box 0) #let [@@ @ count-clean-up (function (_ value) @@ -62,7 +62,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#error.Success []))))] outcome (/.run @ - (do (/.Monad<Region> @) + (do (/.monad @) [_ (monad.map @ (/.acquire @@ count-clean-up) (list.n/range 1 expected-clean-ups)) _ (/.throw @@ oops [])] @@ -73,7 +73,7 @@ actual-clean-ups)))))) (test "Errors can propagate from the cleaners." (thread.run - (do thread.Monad<Thread> + (do thread.monad [clean-up-counter (thread.box 0) #let [@@ @ count-clean-up (function (_ value) @@ -81,7 +81,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (: (Error Any) (ex.throw oops [])))))] outcome (/.run @ - (do (/.Monad<Region> @) + (do (/.monad @) [_ (monad.map @ (/.acquire @@ count-clean-up) (list.n/range 1 expected-clean-ups))] (wrap []))) @@ -92,11 +92,11 @@ actual-clean-ups)))))) (test "Can lift operations." (thread.run - (do thread.Monad<Thread> + (do thread.monad [clean-up-counter (thread.box 0) #let [@@ @] outcome (/.run @ - (do (/.Monad<Region> @) + (do (/.monad @) [_ (/.lift @@ (thread.write expected-clean-ups clean-up-counter))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] diff --git a/stdlib/test/test/lux/control/security/integrity.lux b/stdlib/test/test/lux/control/security/integrity.lux index 8b1da6780..f306cf7e5 100644 --- a/stdlib/test/test/lux/control/security/integrity.lux +++ b/stdlib/test/test/lux/control/security/integrity.lux @@ -7,7 +7,7 @@ ["@" integrity]]] [data ["." error] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format]] [math ["r" random]]] @@ -39,16 +39,16 @@ (function (_ raw) (format raw raw)))] raw (r.ascii 10) #let [check (|>> @.trust (text/= (duplicate raw))) - (^open "@/.") @.Functor<Dirty> - (^open "@/.") @.Apply<Dirty> - (^open "@/.") @.Monad<Dirty>]] + (^open "@/.") @.functor + (^open "@/.") @.apply + (^open "@/.") @.monad]] ($_ seq (test "Can use Functor." (check (@/map duplicate (@.taint raw)))) (test "Can use Apply." (check (@/apply (@/wrap duplicate) (@.taint raw)))) (test "Can use Monad." - (check (do @.Monad<Dirty> + (check (do @.monad [dirty (@.taint raw)] (wrap (duplicate dirty))))) ))) diff --git a/stdlib/test/test/lux/control/security/privacy.lux b/stdlib/test/test/lux/control/security/privacy.lux index 37415bf30..72c23e4c1 100644 --- a/stdlib/test/test/lux/control/security/privacy.lux +++ b/stdlib/test/test/lux/control/security/privacy.lux @@ -6,7 +6,7 @@ [security ["@" privacy (#+ Context Privilege Private with-privacy)]]] [data - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format]] [math ["r" random]]] @@ -38,7 +38,7 @@ (%/reveal sample))))) (def: hash (|>> %/reveal - (:: text.Hash<Text> hash))))) + (:: text.hash hash))))) (def: password %/conceal) @@ -53,7 +53,7 @@ ($_ seq (test "Can work with private values under the same label." (and (:: policy-0 = password password) - (n/= (:: text.Hash<Text> hash raw-password) + (n/= (:: text.hash hash raw-password) (:: policy-0 hash password)))) (let [policy-1 (policy 1) delegate (@.delegation (:: policy-0 reveal) (:: policy-1 conceal))] @@ -70,16 +70,16 @@ #let [password (:: policy-0 password raw-password)] #let [check (:: policy-0 = (:: policy-0 password (duplicate raw-password))) - (^open "@/.") @.Functor<Private> - (^open "@/.") @.Apply<Private> - (^open "@/.") @.Monad<Private>]] + (^open "@/.") @.functor + (^open "@/.") @.apply + (^open "@/.") @.monad]] ($_ seq (test "Can use Functor." (check (@/map duplicate password))) (test "Can use Apply." (check (@/apply (@/wrap duplicate) password))) (test "Can use Monad." - (check (do @.Monad<Private> + (check (do @.monad [raw-password' (:: policy-0 password raw-password)] (wrap (duplicate raw-password'))))) ))) diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux index 45f8675d8..948cbd5bf 100644 --- a/stdlib/test/test/lux/control/state.lux +++ b/stdlib/test/test/lux/control/state.lux @@ -29,12 +29,12 @@ &.get)) (test "Can replace the state." (with-conditions [state value] - (do &.Monad<State> + (do &.monad [_ (&.put value)] &.get))) (test "Can update the state." (with-conditions [state (n/* value state)] - (do &.Monad<State> + (do &.monad [_ (&.update (n/* value))] &.get))) (test "Can use the state." @@ -51,9 +51,9 @@ (do @ [state r.nat value r.nat - #let [(^open "&/.") &.Functor<State> - (^open "&/.") &.Apply<State> - (^open "&/.") &.Monad<State>]] + #let [(^open "&/.") &.functor + (^open "&/.") &.apply + (^open "&/.") &.monad]] ($_ seq (test "Can use functor." (with-conditions [state (inc state)] @@ -67,7 +67,7 @@ (test "Can use monad." (with-conditions [state (n/+ value value)] (: (&.State Nat Nat) - (do &.Monad<State> + (do &.monad [f (wrap n/+) x (wrap value) y (wrap value)] @@ -80,11 +80,11 @@ [state r.nat left r.nat right r.nat] - (let [(^open "io/.") io.Monad<IO>] + (let [(^open "io/.") io.monad] (test "Can add state functionality to any monad." (|> (: (&.State' io.IO Nat Nat) - (do (&.Monad<State'> io.Monad<IO>) - [a (&.lift io.Monad<IO> (io/wrap left)) + (do (&.monad io.monad) + [a (&.lift io.monad (io/wrap left)) b (wrap right)] (wrap (n/+ a b)))) (&.run' state) @@ -98,7 +98,7 @@ (<| (times 100) (do @ [limit (|> r.nat (:: @ map (n/% 10))) - #let [condition (do &.Monad<State> + #let [condition (do &.monad [state &.get] (wrap (n/< limit state)))]] ($_ seq diff --git a/stdlib/test/test/lux/control/thread.lux b/stdlib/test/test/lux/control/thread.lux index d9867f4bc..8f31addbb 100644 --- a/stdlib/test/test/lux/control/thread.lux +++ b/stdlib/test/test/lux/control/thread.lux @@ -6,7 +6,7 @@ (def: _test0_ Nat - (/.run (do /.Monad<Thread> + (/.run (do /.monad [box (/.box 123) old (/.update (n/* 2) box) new (/.read box)] @@ -14,7 +14,7 @@ (def: _test1_ (All [!] (/.Thread ! Nat)) - (do /.Monad<Thread> + (do /.monad [box (/.box 123) old (/.update (n/* 2) box) new (/.read box)] diff --git a/stdlib/test/test/lux/control/writer.lux b/stdlib/test/test/lux/control/writer.lux index de8bdc599..b5fb372d8 100644 --- a/stdlib/test/test/lux/control/writer.lux +++ b/stdlib/test/test/lux/control/writer.lux @@ -2,17 +2,17 @@ [lux #* ["." io] [control - ["M" monad (#+ do Monad)] + ["M" monad (#+ Monad do)] pipe ["&" writer]] [data ["." product] - ["." text ("text/." Equivalence<Text>)]]] + ["." text ("text/." equivalence)]]] lux/test) (context: "Writer." - (let [(^open "&/.") (&.Monad<Writer> text.Monoid<Text>) - (^open "&/.") (&.Apply<Writer> text.Monoid<Text>)] + (let [(^open "&/.") (&.monad text.monoid) + (^open "&/.") (&.apply text.monoid)] ($_ seq (test "Functor respects Writer." (i/= +11 (product.right (&/map inc ["" +10])))) @@ -22,7 +22,7 @@ (i/= +30 (product.right (&/apply (&/wrap (i/+ +10)) (&/wrap +20)))))) (test "Monad respects Writer." - (i/= +30 (product.right (do (&.Monad<Writer> text.Monoid<Text>) + (i/= +30 (product.right (do (&.monad text.monoid) [f (wrap i/+) a (wrap +10) b (wrap +20)] @@ -33,10 +33,10 @@ ))) (context: "Monad transformer" - (let [lift (&.lift text.Monoid<Text> io.Monad<IO>) - (^open "io/.") io.Monad<IO>] + (let [lift (&.lift text.monoid io.monad) + (^open "io/.") io.monad] (test "Can add writer functionality to any monad." - (|> (io.run (do (&.WriterT text.Monoid<Text> io.Monad<IO>) + (|> (io.run (do (&.WriterT text.monoid io.monad) [a (lift (io/wrap +123)) b (wrap +456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index ecb0c90ad..d064a736b 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -1,7 +1,7 @@ (.module: [lux #* [control - ["M" monad (#+ do Monad)]] + ["M" monad (#+ Monad do)]] [data bit] [math @@ -15,22 +15,22 @@ (test "" (and (not (and value (not value))) (or value (not value)) - (not (:: Or@Monoid<Bit> identity)) - (:: Or@Monoid<Bit> compose value (not value)) - (:: And@Monoid<Bit> identity) - (not (:: And@Monoid<Bit> compose value (not value))) + (not (:: disjunction identity)) + (:: disjunction compose value (not value)) + (:: conjunction identity) + (not (:: conjunction compose value (not value))) - (:: Equivalence<Bit> = value (not (not value))) - (not (:: Equivalence<Bit> = value (not value))) + (:: equivalence = value (not (not value))) + (not (:: equivalence = value (not value))) - (not (:: Equivalence<Bit> = value ((complement id) value))) - (:: Equivalence<Bit> = value ((complement not) value)) + (not (:: equivalence = value ((complement id) value))) + (:: equivalence = value ((complement not) value)) (case (|> value - (:: Codec<Text,Bit> encode) - (:: Codec<Text,Bit> decode)) + (:: codec encode) + (:: codec decode)) (#.Right dec-value) - (:: Equivalence<Bit> = value dec-value) + (:: equivalence = value dec-value) (#.Left _) #0) diff --git a/stdlib/test/test/lux/data/collection/array.lux b/stdlib/test/test/lux/data/collection/array.lux index ea3ab69d5..47c384cb7 100644 --- a/stdlib/test/test/lux/data/collection/array.lux +++ b/stdlib/test/test/lux/data/collection/array.lux @@ -16,7 +16,7 @@ (def: bounded-size (r.Random Nat) (|> r.nat - (:: r.Monad<Random> map (|>> (n/% 100) (n/+ 1))))) + (:: r.monad map (|>> (n/% 100) (n/+ 1))))) (context: "Arrays and their copies" (<| (times 100) @@ -32,24 +32,24 @@ (test "Size function must correctly return size of array." (n/= size (@.size original))) (test "Cloning an array should yield and identical array, but not the same one." - (and (:: (@.Equivalence<Array> number.Equivalence<Nat>) = original clone) + (and (:: (@.equivalence number.equivalence) = original clone) (not (is? original clone)))) (test "Full-range manual copies should give the same result as cloning." (exec (@.copy size 0 original 0 copy) - (and (:: (@.Equivalence<Array> number.Equivalence<Nat>) = original copy) + (and (:: (@.equivalence number.equivalence) = original copy) (not (is? original copy))))) (test "Array folding should go over all values." - (exec (:: @.Fold<Array> fold + (exec (:: @.fold fold (function (_ x idx) (exec (@.write idx x manual-copy) (inc idx))) 0 original) - (:: (@.Equivalence<Array> number.Equivalence<Nat>) = original manual-copy))) + (:: (@.equivalence number.equivalence) = original manual-copy))) (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values." (|> original @.to-list @.from-list - (:: (@.Equivalence<Array> number.Equivalence<Nat>) = original))) + (:: (@.equivalence number.equivalence) = original))) )))) (context: "Array mutation" @@ -104,8 +104,8 @@ (do @ [size bounded-size array (r.array size r.nat)] - (let [(^open ".") @.Functor<Array> - (^open ".") (@.Equivalence<Array> number.Equivalence<Nat>)] + (let [(^open ".") @.functor + (^open ".") (@.equivalence number.equivalence)] ($_ seq (test "Functor shouldn't alter original array." (let [copy (map id array)] @@ -124,8 +124,8 @@ sizeR bounded-size left (r.array sizeL r.nat) right (r.array sizeR r.nat) - #let [(^open ".") @.Monoid<Array> - (^open ".") (@.Equivalence<Array> number.Equivalence<Nat>) + #let [(^open ".") @.monoid + (^open ".") (@.equivalence number.equivalence) fusion (compose left right)]] ($_ seq (test "Appending two arrays should produce a new one twice as large." diff --git a/stdlib/test/test/lux/data/collection/bits.lux b/stdlib/test/test/lux/data/collection/bits.lux index 91ab7b828..aeeac1429 100644 --- a/stdlib/test/test/lux/data/collection/bits.lux +++ b/stdlib/test/test/lux/data/collection/bits.lux @@ -17,11 +17,11 @@ (def: (size min max) (-> Nat Nat (r.Random Nat)) (|> r.nat - (:: r.Monad<Random> map (|>> (n/% max) (n/max min))))) + (:: r.monad map (|>> (n/% max) (n/max min))))) (def: bits (r.Random /.Bits) - (do r.Monad<Random> + (do r.monad [size (size 1 1_000) idx (|> r.nat (:: @ map (n/% size)))] (wrap (|> /.empty (/.set idx))))) @@ -64,7 +64,7 @@ (not (/.intersects? sample (/.not sample)))) (test "'and' with oneself changes nothing" - (:: /.Equivalence<Bits> = sample (/.and sample sample))) + (:: /.equivalence = sample (/.and sample sample))) (test "'and' with one's opposite yields the empty bit-set." (is? /.empty (/.and sample (/.not sample)))) @@ -79,9 +79,9 @@ (/.capacity sample))) (test "Double negation results in original bit-set." - (:: /.Equivalence<Bits> = sample (/.not (/.not sample)))) + (:: /.equivalence = sample (/.not (/.not sample)))) (test "Negation does not affect the empty bit-set." (is? /.empty (/.not /.empty))) - (_eq.spec /.Equivalence<Bits> ..bits) + (_eq.spec /.equivalence ..bits) )))) diff --git a/stdlib/test/test/lux/data/collection/dictionary.lux b/stdlib/test/test/lux/data/collection/dictionary.lux index 466cb2872..3ad45704e 100644 --- a/stdlib/test/test/lux/data/collection/dictionary.lux +++ b/stdlib/test/test/lux/data/collection/dictionary.lux @@ -8,7 +8,7 @@ ["." maybe] [collection ["&" dictionary] - ["." list ("list/." Fold<List> Functor<List>)]]] + ["." list ("list/." fold functor)]]] [math ["r" random]]] lux/test) @@ -16,11 +16,11 @@ (context: "Dictionaries." (<| (times 100) (do @ - [#let [capped-nat (:: r.Monad<Random> map (n/% 100) r.nat)] + [#let [capped-nat (:: r.monad map (n/% 100) r.nat)] size capped-nat - dict (r.dictionary number.Hash<Nat> size r.nat capped-nat) + dict (r.dictionary number.hash size r.nat capped-nat) non-key (|> r.nat (r.filter (function (_ key) (not (&.contains? key dict))))) - test-val (|> r.nat (r.filter (function (_ val) (not (list.member? number.Equivalence<Nat> (&.values dict) val)))))] + test-val (|> r.nat (r.filter (function (_ val) (not (list.member? number.equivalence (&.values dict) val)))))] ($_ seq (test "Size function should correctly represent Dictionary size." (n/= size (&.size dict))) @@ -31,7 +31,7 @@ (not (&.empty? dict)))) (test "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list.Equivalence<List> (eq.product number.Equivalence<Nat> number.Equivalence<Nat>)) = + (:: (list.equivalence (eq.product number.equivalence number.equivalence)) = (&.entries dict) (list.zip2 (&.keys dict) (&.values dict)))) @@ -90,19 +90,19 @@ (n/= (dec (&.size plus)) (&.size base))))) (test "A Dictionary should equal itself & going to<->from lists shouldn't change that." - (let [(^open ".") (&.Equivalence<Dictionary> number.Equivalence<Nat>)] + (let [(^open ".") (&.equivalence number.equivalence)] (and (= dict dict) - (|> dict &.entries (&.from-list number.Hash<Nat>) (= dict))))) + (|> dict &.entries (&.from-list number.hash) (= dict))))) (test "Merging a Dictionary to itself changes nothing." - (let [(^open ".") (&.Equivalence<Dictionary> number.Equivalence<Nat>)] + (let [(^open ".") (&.equivalence number.equivalence)] (= dict (&.merge dict dict)))) (test "If you merge, and the second dict has overlapping keys, it should overwrite yours." (let [dict' (|> dict &.entries (list/map (function (_ [k v]) [k (inc v)])) - (&.from-list number.Hash<Nat>)) - (^open ".") (&.Equivalence<Dictionary> number.Equivalence<Nat>)] + (&.from-list number.hash)) + (^open ".") (&.equivalence number.equivalence)] (= dict' (&.merge dict' dict)))) (test "Can merge values in such a way that they become combined." diff --git a/stdlib/test/test/lux/data/collection/dictionary/ordered.lux b/stdlib/test/test/lux/data/collection/dictionary/ordered.lux index a8246887e..6b1f131cb 100644 --- a/stdlib/test/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/test/test/lux/data/collection/dictionary/ordered.lux @@ -10,7 +10,7 @@ ["s" set] ["dict" dictionary ["&" ordered]] - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] [math ["r" random]]] lux/test) @@ -19,18 +19,18 @@ (<| (times 100) (do @ [size (|> r.nat (:: @ map (n/% 100))) - keys (r.set number.Hash<Nat> size r.nat) - values (r.set number.Hash<Nat> size r.nat) + keys (r.set number.nat-hash size r.nat) + values (r.set number.nat-hash size r.nat) extra-key (|> r.nat (r.filter (|>> (s.member? keys) not))) extra-value r.nat #let [pairs (list.zip2 (s.to-list keys) (s.to-list values)) - sample (&.from-list number.Order<Nat> pairs) + sample (&.from-list number.nat-order pairs) sorted-pairs (list.sort (function (_ [left _] [right _]) (n/< left right)) pairs) sorted-values (list/map product.right sorted-pairs) - (^open "&/.") (&.Equivalence<Dictionary> number.Equivalence<Nat>)]] + (^open "&/.") (&.equivalence number.nat-equivalence)]] ($_ seq (test "Can query the size of a dictionary." (n/= size (&.size sample))) @@ -59,14 +59,14 @@ (test "Converting dictionaries to/from lists cannot change their values." (|> sample - &.entries (&.from-list number.Order<Nat>) + &.entries (&.from-list number.nat-order) (&/= sample))) (test "Order is preserved." - (let [(^open "list/.") (list.Equivalence<List> (: (Equivalence [Nat Nat]) - (function (_ [kr vr] [ks vs]) - (and (n/= kr ks) - (n/= vr vs)))))] + (let [(^open "list/.") (list.equivalence (: (Equivalence [Nat Nat]) + (function (_ [kr vr] [ks vs]) + (and (n/= kr ks) + (n/= vr vs)))))] (list/= (&.entries sample) sorted-pairs))) diff --git a/stdlib/test/test/lux/data/collection/list.lux b/stdlib/test/test/lux/data/collection/list.lux index 31d5d6155..9919f3dd1 100644 --- a/stdlib/test/test/lux/data/collection/list.lux +++ b/stdlib/test/test/lux/data/collection/list.lux @@ -18,7 +18,7 @@ (def: bounded-size (r.Random Nat) (|> r.nat - (:: r.Monad<Random> map (|>> (n/% 100) (n/+ 10))))) + (:: r.monad map (|>> (n/% 100) (n/+ 10))))) (context: "Lists: Part 1" (<| (times 100) @@ -29,8 +29,8 @@ other-size bounded-size other-sample (r.list other-size r.nat) separator r.nat - #let [(^open ".") (&.Equivalence<List> number.Equivalence<Nat>) - (^open "&/.") &.Functor<List>]] + #let [(^open ".") (&.equivalence number.equivalence) + (^open "&/.") &.functor]] ($_ seq (test "The size function should correctly portray the size of the list." (n/= size (&.size sample))) @@ -63,7 +63,7 @@ (test "Any element of the list can be considered its member." (let [elem (maybe.assume (&.nth idx sample))] - (&.member? number.Equivalence<Nat> sample elem))) + (&.member? number.equivalence sample elem))) )))) (context: "Lists: Part 2" @@ -75,8 +75,8 @@ other-size bounded-size other-sample (r.list other-size r.nat) separator r.nat - #let [(^open ".") (&.Equivalence<List> number.Equivalence<Nat>) - (^open "&/.") &.Functor<List>]] + #let [(^open ".") (&.equivalence number.equivalence) + (^open "&/.") &.functor]] ($_ seq (test "Appending the head and the tail should yield the original list." (let [head (maybe.assume (&.head sample)) @@ -85,21 +85,21 @@ (#.Cons head tail)))) (test "Appending the inits and the last should yield the original list." - (let [(^open ".") &.Monoid<List> + (let [(^open ".") &.monoid inits (maybe.assume (&.inits sample)) last (maybe.assume (&.last sample))] (= sample (compose inits (list last))))) (test "Functor should go over every element of the list." - (let [(^open ".") &.Functor<List> + (let [(^open ".") &.functor there (map inc sample) back-again (map dec there)] (and (not (= sample there)) (= sample back-again)))) (test "Splitting a list into chunks and re-appending them should yield the original list." - (let [(^open ".") &.Monoid<List> + (let [(^open ".") &.monoid [left right] (&.split idx sample) [left' right'] (&.split-with n/even? sample)] (and (= sample @@ -138,22 +138,22 @@ separator r.nat from (|> r.nat (:: @ map (n/% 10))) to (|> r.nat (:: @ map (n/% 10))) - #let [(^open ".") (&.Equivalence<List> number.Equivalence<Nat>) - (^open "&/.") &.Functor<List>]] + #let [(^open ".") (&.equivalence number.equivalence) + (^open "&/.") &.functor]] ($_ seq (test "If you zip 2 lists, the result's size will be that of the smaller list." (n/= (&.size (&.zip2 sample other-sample)) (n/min (&.size sample) (&.size other-sample)))) (test "I can pair-up elements of a list in order." - (let [(^open ".") &.Functor<List> + (let [(^open ".") &.functor zipped (&.zip2 sample other-sample) num-zipper (&.size zipped)] (and (|> zipped (map product.left) (= (&.take num-zipper sample))) (|> zipped (map product.right) (= (&.take num-zipper other-sample)))))) (test "You can generate indices for any size, and they will be in ascending order." - (let [(^open ".") &.Functor<List> + (let [(^open ".") &.functor indices (&.indices size)] (and (n/= size (&.size indices)) (= indices @@ -165,14 +165,14 @@ ))) (test "The 'interpose' function places a value between every member of a list." - (let [(^open ".") &.Functor<List> + (let [(^open ".") &.functor sample+ (&.interpose separator sample)] (and (n/= (|> size (n/* 2) dec) (&.size sample+)) (|> sample+ &.as-pairs (map product.right) (&.every? (n/= separator)))))) (test "List append is a monoid." - (let [(^open ".") &.Monoid<List>] + (let [(^open ".") &.monoid] (and (= sample (compose identity sample)) (= sample (compose sample identity)) (let [[left right] (&.split size (compose sample other-sample))] @@ -180,15 +180,15 @@ (= other-sample right)))))) (test "Apply allows you to create singleton lists, and apply lists of functions to lists of values." - (let [(^open ".") &.Monad<List> - (^open ".") &.Apply<List>] + (let [(^open ".") &.monad + (^open ".") &.apply] (and (= (list separator) (wrap separator)) (= (map inc sample) (apply (wrap inc) sample))))) (test "List concatenation is a monad." - (let [(^open ".") &.Monad<List> - (^open ".") &.Monoid<List>] + (let [(^open ".") &.monad + (^open ".") &.monoid] (= (compose sample other-sample) (join (list sample other-sample))))) @@ -216,10 +216,10 @@ (&/map product.right enum-sample))))) (test "Ranges can be constructed forward and backwards." - (and (let [(^open "list/.") (&.Equivalence<List> number.Equivalence<Nat>)] + (and (let [(^open "list/.") (&.equivalence number.equivalence)] (list/= (&.n/range from to) (&.reverse (&.n/range to from)))) - (let [(^open "list/.") (&.Equivalence<List> number.Equivalence<Int>) + (let [(^open "list/.") (&.equivalence number.equivalence) from (.int from) to (.int to)] (list/= (&.i/range from to) @@ -228,10 +228,10 @@ ## TODO: Add again once new-luxc becomes the standard compiler. (context: "Monad transformer" - (let [lift (&.lift io.Monad<IO>) - (^open "io/.") io.Monad<IO>] + (let [lift (&.lift io.monad) + (^open "io/.") io.monad] (test "Can add list functionality to any monad." - (|> (io.run (do (&.ListT io.Monad<IO>) + (|> (io.run (do (&.ListT io.monad) [a (lift (io/wrap +123)) b (wrap +456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/data/collection/queue.lux b/stdlib/test/test/lux/data/collection/queue.lux index 9b21411fa..4f4f12ef0 100644 --- a/stdlib/test/test/lux/data/collection/queue.lux +++ b/stdlib/test/test/lux/data/collection/queue.lux @@ -16,7 +16,7 @@ [size (:: @ map (n/% 100) r.nat) sample (r.queue size r.nat) non-member (|> r.nat - (r.filter (|>> (&.member? number.Equivalence<Nat> sample) not)))] + (r.filter (|>> (&.member? number.equivalence sample) not)))] ($_ seq (test "I can query the size of a queue (and empty queues have size 0)." (if (n/= 0 size) @@ -30,7 +30,7 @@ (n/= size (&.size (&.pop (&.push non-member sample)))))) (test "Transforming to/from list can't change the queue." - (let [(^open "&/.") (&.Equivalence<Queue> number.Equivalence<Nat>)] + (let [(^open "&/.") (&.equivalence number.equivalence)] (|> sample &.to-list &.from-list (&/= sample)))) @@ -41,14 +41,14 @@ (#.Some _) #1)) (test "I can query whether an element belongs to a queue." - (and (not (&.member? number.Equivalence<Nat> sample non-member)) - (&.member? number.Equivalence<Nat> (&.push non-member sample) + (and (not (&.member? number.equivalence sample non-member)) + (&.member? number.equivalence (&.push non-member sample) non-member) (case (&.peek sample) #.None (&.empty? sample) (#.Some first) - (and (&.member? number.Equivalence<Nat> sample first) - (not (&.member? number.Equivalence<Nat> (&.pop sample) first)))))) + (and (&.member? number.equivalence sample first) + (not (&.member? number.equivalence (&.pop sample) first)))))) )))) diff --git a/stdlib/test/test/lux/data/collection/queue/priority.lux b/stdlib/test/test/lux/data/collection/queue/priority.lux index 5450b8ad9..3868a01a8 100644 --- a/stdlib/test/test/lux/data/collection/queue/priority.lux +++ b/stdlib/test/test/lux/data/collection/queue/priority.lux @@ -3,7 +3,8 @@ [control ["." monad (#+ do Monad)]] [data - ["." number] + [number + ["." nat]] ["." maybe] [collection [queue @@ -14,7 +15,7 @@ (def: (gen-queue size) (-> Nat (r.Random (&.Queue Nat))) - (do r.Monad<Random> + (do r.monad [inputs (r.list size r.nat)] (monad.fold @ (function (_ head tail) (do @ @@ -29,7 +30,7 @@ [size (|> r.nat (:: @ map (n/% 100))) sample (gen-queue size) non-member-priority r.nat - non-member (|> r.nat (r.filter (|>> (&.member? number.Equivalence<Nat> sample) not)))] + non-member (|> r.nat (r.filter (|>> (&.member? nat.equivalence sample) not)))] ($_ seq (test "I can query the size of a queue (and empty queues have size 0)." (n/= size (&.size sample))) @@ -42,15 +43,15 @@ (&.size (&.pop sample)))))) (test "I can query whether an element belongs to a queue." - (and (and (not (&.member? number.Equivalence<Nat> sample non-member)) - (&.member? number.Equivalence<Nat> + (and (and (not (&.member? nat.equivalence sample non-member)) + (&.member? nat.equivalence (&.push non-member-priority non-member sample) non-member)) (or (n/= 0 (&.size sample)) - (and (&.member? number.Equivalence<Nat> + (and (&.member? nat.equivalence sample (maybe.assume (&.peek sample))) - (not (&.member? number.Equivalence<Nat> + (not (&.member? nat.equivalence (&.pop sample) (maybe.assume (&.peek sample)))))))) )))) diff --git a/stdlib/test/test/lux/data/collection/row.lux b/stdlib/test/test/lux/data/collection/row.lux index 09b443219..2eb342e6e 100644 --- a/stdlib/test/test/lux/data/collection/row.lux +++ b/stdlib/test/test/lux/data/collection/row.lux @@ -1,12 +1,13 @@ (.module: [lux #* [control - [monad (#+ do Monad)]] + [monad (#+ Monad do)]] [data ["." number] ["." maybe] - [collection ["&" row] - [list ("list/." Fold<List>)]]] + [collection + ["&" row] + [list ("list/." fold)]]] [math ["r" random]]] lux/test) @@ -18,12 +19,12 @@ idx (|> r.nat (:: @ map (n/% size))) sample (r.row size r.nat) other-sample (r.row size r.nat) - non-member (|> r.nat (r.filter (|>> (&.member? number.Equivalence<Nat> sample) not))) - #let [(^open "&/.") (&.Equivalence<Row> number.Equivalence<Nat>) - (^open "&/.") &.Apply<Row> - (^open "&/.") &.Monad<Row> - (^open "&/.") &.Fold<Row> - (^open "&/.") &.Monoid<Row>]] + non-member (|> r.nat (r.filter (|>> (&.member? number.equivalence sample) not))) + #let [(^open "&/.") (&.equivalence number.equivalence) + (^open "&/.") &.apply + (^open "&/.") &.monad + (^open "&/.") &.fold + (^open "&/.") &.monoid]] ($_ seq (test "Can query size of row." (if (&.empty? sample) @@ -52,8 +53,8 @@ (|> sample &.to-list &.from-list (&/= sample))) (test "Can identify members of a row." - (and (not (&.member? number.Equivalence<Nat> sample non-member)) - (&.member? number.Equivalence<Nat> (&.add non-member sample) non-member))) + (and (not (&.member? number.equivalence sample non-member)) + (&.member? number.equivalence (&.add non-member sample) non-member))) (test "Can fold over elements of row." (n/= (list/fold n/+ 0 (&.to-list sample)) diff --git a/stdlib/test/test/lux/data/collection/sequence.lux b/stdlib/test/test/lux/data/collection/sequence.lux index ce8ef1b4f..de398e6f6 100644 --- a/stdlib/test/test/lux/data/collection/sequence.lux +++ b/stdlib/test/test/lux/data/collection/sequence.lux @@ -5,8 +5,8 @@ comonad] [data ["." maybe] - ["." number ("nat/." Codec<Text,Nat>)] - ["." text ("text/." Monoid<Text>)] + ["." number ("nat/." codec)] + ["." text ("text/." monoid)] [collection ["." list] ["&" sequence]]] @@ -23,7 +23,7 @@ elem r.nat cycle-seed (r.list size r.nat) cycle-sample-idx (|> r.nat (:: @ map (n/% 1000))) - #let [(^open "List/.") (list.Equivalence<List> number.Equivalence<Nat>) + #let [(^open "List/.") (list.equivalence number.equivalence) sample0 (&.iterate inc 0) sample1 (&.iterate inc offset)]] ($_ seq @@ -68,7 +68,7 @@ (&.nth offset odds)))))) (test "Functor goes over 'all' elements in a sequence." - (let [(^open "&/.") &.Functor<Sequence> + (let [(^open "&/.") &.functor there (&/map (n/* factor) sample0) back-again (&/map (n// factor) there)] (and (not (List/= (&.take size sample0) @@ -77,16 +77,16 @@ (&.take size back-again))))) (test "CoMonad produces a value for every element in a sequence." - (let [(^open "&/.") &.Functor<Sequence>] + (let [(^open "&/.") &.functor] (List/= (&.take size (&/map (n/* factor) sample1)) (&.take size - (be &.CoMonad<Sequence> + (be &.comonad [inputs sample1] (n/* factor (&.head inputs))))))) (test "'unfold' generalizes 'iterate'." - (let [(^open "&/.") &.Functor<Sequence> - (^open "List/.") (list.Equivalence<List> text.Equivalence<Text>)] + (let [(^open "&/.") &.functor + (^open "List/.") (list.equivalence text.equivalence)] (List/= (&.take size (&/map nat/encode (&.iterate inc offset))) (&.take size diff --git a/stdlib/test/test/lux/data/collection/set.lux b/stdlib/test/test/lux/data/collection/set.lux index 1b94aed8c..bbdc945f7 100644 --- a/stdlib/test/test/lux/data/collection/set.lux +++ b/stdlib/test/test/lux/data/collection/set.lux @@ -14,18 +14,18 @@ (def: gen-nat (r.Random Nat) (|> r.nat - (:: r.Monad<Random> map (n/% 100)))) + (:: r.monad map (n/% 100)))) (context: "Sets" (<| (times 100) (do @ [sizeL gen-nat sizeR gen-nat - setL (r.set number.Hash<Nat> sizeL gen-nat) - setR (r.set number.Hash<Nat> sizeR gen-nat) + setL (r.set number.hash sizeL gen-nat) + setR (r.set number.hash sizeR gen-nat) non-member (|> gen-nat (r.filter (|>> (&.member? setL) not))) - #let [(^open "&/.") &.Equivalence<Set>]] + #let [(^open "&/.") &.equivalence]] ($_ seq (test "I can query the size of a set." (and (n/= sizeL (&.size setL)) @@ -33,7 +33,7 @@ (test "Converting sets to/from lists can't change their values." (|> setL - &.to-list (&.from-list number.Hash<Nat>) + &.to-list (&.from-list number.hash) (&/= setL))) (test "Every set is a sub-set of the union of itself with another." @@ -48,11 +48,11 @@ (test "Union with the empty set leaves a set unchanged." (&/= setL - (&.union (&.new number.Hash<Nat>) + (&.union (&.new number.hash) setL))) (test "Intersection with the empty set results in the empty set." - (let [empty-set (&.new number.Hash<Nat>)] + (let [empty-set (&.new number.hash)] (&/= empty-set (&.intersection empty-set setL)))) diff --git a/stdlib/test/test/lux/data/collection/set/ordered.lux b/stdlib/test/test/lux/data/collection/set/ordered.lux index 7eb313c0f..384a0506b 100644 --- a/stdlib/test/test/lux/data/collection/set/ordered.lux +++ b/stdlib/test/test/lux/data/collection/set/ordered.lux @@ -17,18 +17,18 @@ (def: gen-nat (r.Random Nat) (|> r.nat - (:: r.Monad<Random> map (n/% 100)))) + (:: r.monad map (n/% 100)))) (context: "Sets" (<| (times 100) (do @ [sizeL gen-nat sizeR gen-nat - listL (|> (r.set number.Hash<Nat> sizeL gen-nat) (:: @ map set.to-list)) - listR (|> (r.set number.Hash<Nat> sizeR gen-nat) (:: @ map set.to-list)) - #let [(^open "&/.") &.Equivalence<Set> - setL (&.from-list number.Order<Nat> listL) - setR (&.from-list number.Order<Nat> listR) + listL (|> (r.set number.hash sizeL gen-nat) (:: @ map set.to-list)) + listR (|> (r.set number.hash sizeR gen-nat) (:: @ map set.to-list)) + #let [(^open "&/.") &.equivalence + setL (&.from-list number.order listL) + setR (&.from-list number.order listR) sortedL (list.sort n/< listL) minL (list.head sortedL) maxL (list.last sortedL)]] @@ -60,12 +60,12 @@ (test "Converting sets to/from lists can't change their values." (|> setL - &.to-list (&.from-list number.Order<Nat>) + &.to-list (&.from-list number.order) (&/= setL))) (test "Order is preserved." (let [listL (&.to-list setL) - (^open "L/.") (list.Equivalence<List> number.Equivalence<Nat>)] + (^open "L/.") (list.equivalence number.equivalence)] (L/= listL (list.sort n/< listL)))) @@ -81,11 +81,11 @@ (test "Union with the empty set leaves a set unchanged." (&/= setL - (&.union (&.new number.Order<Nat>) + (&.union (&.new number.order) setL))) (test "Intersection with the empty set results in the empty set." - (let [empty-set (&.new number.Order<Nat>)] + (let [empty-set (&.new number.order)] (&/= empty-set (&.intersection empty-set setL)))) diff --git a/stdlib/test/test/lux/data/collection/stack.lux b/stdlib/test/test/lux/data/collection/stack.lux index 954e72e78..d203b4246 100644 --- a/stdlib/test/test/lux/data/collection/stack.lux +++ b/stdlib/test/test/lux/data/collection/stack.lux @@ -13,7 +13,7 @@ (def: gen-nat (r.Random Nat) (|> r.nat - (:: r.Monad<Random> map (n/% 100)))) + (:: r.monad map (n/% 100)))) (context: "Stacks" (<| (times 100) diff --git a/stdlib/test/test/lux/data/collection/tree/rose.lux b/stdlib/test/test/lux/data/collection/tree/rose.lux index 674ac1d47..47dbf94cf 100644 --- a/stdlib/test/test/lux/data/collection/tree/rose.lux +++ b/stdlib/test/test/lux/data/collection/tree/rose.lux @@ -5,10 +5,10 @@ [data ["." product] ["." number] - [text ("text/." Equivalence<Text>) + [text ("text/." equivalence) format] [collection - ["." list ("list/." Functor<List> Fold<List>)] + ["." list ("list/." functor fold)] [tree ["&" rose]]]] [math @@ -19,8 +19,8 @@ (r.Random [Nat (&.Tree Nat)]) (r.rec (function (_ gen-tree) - (r.either (:: r.Monad<Random> map (|>> &.leaf [1]) r.nat) - (do r.Monad<Random> + (r.either (:: r.monad map (|>> &.leaf [1]) r.nat) + (do r.monad [value r.nat num-children (|> r.nat (:: @ map (n/% 3))) children' (r.list num-children gen-tree) @@ -34,8 +34,8 @@ (<| (times 100) (do @ [[size sample] gen-tree - #let [(^open "&/.") (&.Equivalence<Tree> number.Equivalence<Nat>) - (^open "&/.") &.Fold<Tree> + #let [(^open "&/.") (&.equivalence number.equivalence) + (^open "&/.") &.fold concat (function (_ addition partial) (format partial (%n addition)))]] ($_ seq (test "Can compare trees for equivalence." diff --git a/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux b/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux index b1481518b..3abf1dd26 100644 --- a/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux +++ b/stdlib/test/test/lux/data/collection/tree/rose/zipper.lux @@ -20,7 +20,7 @@ (def: gen-tree (r.Random (rose.Tree Nat)) (r.rec (function (_ gen-tree) - (do r.Monad<Random> + (do r.monad ## Each branch can have, at most, 1 child. [size (|> r.nat (:: @ map (n/% 2)))] (r.and r.nat @@ -40,8 +40,8 @@ new-val r.nat pre-val r.nat post-val r.nat - #let [(^open "tree/.") (rose.Equivalence<Tree> number.Equivalence<Nat>) - (^open "list/.") (list.Equivalence<List> number.Equivalence<Nat>)]] + #let [(^open "tree/.") (rose.equivalence number.equivalence) + (^open "list/.") (list.equivalence number.equivalence)]] ($_ seq (test "Trees can be converted to/from zippers." (|> sample diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux index 5ff92e6cd..503421db2 100644 --- a/stdlib/test/test/lux/data/color.lux +++ b/stdlib/test/test/lux/data/color.lux @@ -4,7 +4,7 @@ [monad (#+ do)]] [data ["@" color] - [number ("frac/." Number<Frac>)]] + [number ("frac/." number)]] ["." math ["r" random]]] lux/test) @@ -12,7 +12,7 @@ (def: color (r.Random @.Color) (|> ($_ r.and r.nat r.nat r.nat) - (:: r.Monad<Random> map @.from-rgb))) + (:: r.monad map @.from-rgb))) (def: scale (-> Nat Frac) @@ -59,7 +59,7 @@ ratio (|> r.frac (r.filter (f/>= +0.5)))] ($_ seq (test "Has equivalence." - (:: @.Equivalence<Color> = any any)) + (:: @.equivalence = any any)) (test "Can convert to/from HSL." (|> any @.to-hsl @.from-hsl (distance any) @@ -79,7 +79,7 @@ (distance (@.brighter ratio colorful) white)))) (test "Can calculate complement." (let [~any (@.complement any) - (^open "@/.") @.Equivalence<Color>] + (^open "@/.") @.equivalence] (and (not (@/= any ~any)) (@/= any (@.complement ~any))))) (test "Can saturate color." diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux index 4848443f9..7f491dc2c 100644 --- a/stdlib/test/test/lux/data/error.lux +++ b/stdlib/test/test/lux/data/error.lux @@ -9,8 +9,8 @@ lux/test) (context: "Errors" - (let [(^open "//.") /.Apply<Error> - (^open "//.") /.Monad<Error>] + (let [(^open "//.") /.apply + (^open "//.") /.monad] ($_ seq (test "Functor correctly handles both cases." (and (|> (: (Error Int) (#/.Success +10)) @@ -31,13 +31,13 @@ (case> (#/.Failure "YOLO") #1 _ #0)))) (test "Monad correctly handles both cases." - (and (|> (do /.Monad<Error> + (and (|> (do /.monad [f (wrap i/+) a (wrap +10) b (wrap +20)] (wrap (f a b))) (case> (#/.Success +30) #1 _ #0)) - (|> (do /.Monad<Error> + (|> (do /.monad [f (wrap i/+) a (#/.Failure "YOLO") b (wrap +20)] @@ -47,10 +47,10 @@ ))) (context: "Monad transformer" - (let [lift (/.lift io.Monad<IO>) - (^open "io/.") io.Monad<IO>] + (let [lift (/.lift io.monad) + (^open "io/.") io.monad] (test "Can add error functionality to any monad." - (|> (io.run (do (/.ErrorT io.Monad<IO>) + (|> (io.run (do (/.ErrorT io.monad) [a (lift (io/wrap +123)) b (wrap +456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 9b6b3f9a1..f54b51c3b 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -44,7 +44,7 @@ (def: gen-json (r.Random @.JSON) (r.rec (function (_ gen-json) - (do r.Monad<Random> + (do r.monad [size (:: @ map (n/% 2) r.nat)] ($_ r.or (:: @ wrap []) @@ -52,15 +52,15 @@ (|> r.frac (:: @ map (f/* +1_000_000.0))) (r.unicode size) (r.row size gen-json) - (r.dictionary text.Hash<Text> size (r.unicode size) gen-json) + (r.dictionary text.hash size (r.unicode size) gen-json) ))))) (context: "JSON" (<| (times 100) (do @ [sample gen-json - #let [(^open "@/.") @.Equivalence<JSON> - (^open "@/.") @.Codec<Text,JSON>]] + #let [(^open "@/.") @.equivalence + (^open "@/.") @.codec]] ($_ seq (test "Every JSON is equal to itself." (@/= sample sample)) @@ -109,11 +109,11 @@ (def: qty (All [unit] (r.Random (unit.Qty unit))) - (|> r.int (:: r.Monad<Random> map unit.in))) + (|> r.int (:: r.monad map unit.in))) (def: gen-record (r.Random Record) - (do r.Monad<Random> + (do r.monad [size (:: @ map (n/% 2) r.nat)] ($_ r.and r.bit @@ -121,7 +121,7 @@ (r.unicode size) (r.maybe r.frac) (r.list size r.frac) - (r.dictionary text.Hash<Text> size (r.unicode size) r.frac) + (r.dictionary text.hash size (r.unicode size) r.frac) ## ($_ r.or r.bit (r.unicode size) r.frac) ## ($_ r.and r.bit r.frac (r.unicode size)) gen-recursive @@ -131,40 +131,40 @@ qty ))) -(derived: (poly/json.Codec<JSON,?> Record)) +(derived: (poly/json.codec Record)) (structure: _ (Equivalence Record) (def: (= recL recR) (let [variant/= (function (_ left right) (case [left right] [(#Case0 left') (#Case0 right')] - (:: bit.Equivalence<Bit> = left' right') + (:: bit.equivalence = left' right') [(#Case1 left') (#Case1 right')] - (:: text.Equivalence<Text> = left' right') + (:: text.equivalence = left' right') [(#Case2 left') (#Case2 right')] (f/= left' right') _ #0))] - (and (:: bit.Equivalence<Bit> = (get@ #bit recL) (get@ #bit recR)) + (and (:: bit.equivalence = (get@ #bit recL) (get@ #bit recR)) (f/= (get@ #frac recL) (get@ #frac recR)) - (:: text.Equivalence<Text> = (get@ #text recL) (get@ #text recR)) - (:: (maybe.Equivalence<Maybe> number.Equivalence<Frac>) = (get@ #maybe recL) (get@ #maybe recR)) - (:: (list.Equivalence<List> number.Equivalence<Frac>) = (get@ #list recL) (get@ #list recR)) - (:: (d.Equivalence<Dictionary> number.Equivalence<Frac>) = (get@ #dict recL) (get@ #dict recR)) + (:: text.equivalence = (get@ #text recL) (get@ #text recR)) + (:: (maybe.equivalence number.equivalence) = (get@ #maybe recL) (get@ #maybe recR)) + (:: (list.equivalence number.equivalence) = (get@ #list recL) (get@ #list recR)) + (:: (d.equivalence number.equivalence) = (get@ #dict recL) (get@ #dict recR)) ## (variant/= (get@ #variant recL) (get@ #variant recR)) ## (let [[tL0 tL1 tL2] (get@ #tuple recL) ## [tR0 tR1 tR2] (get@ #tuple recR)] - ## (and (:: bit.Equivalence<Bit> = tL0 tR0) + ## (and (:: bit.equivalence = tL0 tR0) ## (f/= tL1 tR1) - ## (:: text.Equivalence<Text> = tL2 tR2))) - (:: Equivalence<Recursive> = (get@ #recursive recL) (get@ #recursive recR)) - ## (:: ti.Equivalence<Instant> = (get@ #instant recL) (get@ #instant recR)) - ## (:: tdu.Equivalence<Duration> = (get@ #duration recL) (get@ #duration recR)) - (:: tda.Equivalence<Date> = (get@ #date recL) (get@ #date recR)) - (:: unit.Equivalence<Unit> = (get@ #grams recL) (get@ #grams recR)) + ## (:: text.equivalence = tL2 tR2))) + (:: equivalence = (get@ #recursive recL) (get@ #recursive recR)) + ## (:: ti.equivalence = (get@ #instant recL) (get@ #instant recR)) + ## (:: tdu.equivalence = (get@ #duration recL) (get@ #duration recR)) + (:: tda.equivalence = (get@ #date recL) (get@ #date recR)) + (:: unit.equivalence = (get@ #grams recL) (get@ #grams recR)) )))) (context: "Polytypism" @@ -172,8 +172,8 @@ ## (times 100) (do @ [sample gen-record - #let [(^open "@/.") Equivalence<Record> - (^open "@/.") Codec<JSON,Record>]] + #let [(^open "@/.") ..equivalence + (^open "@/.") ..codec]] (test "Can encode/decode arbitrary types." (|> sample @/encode @/decode (case> (#error.Success result) diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index b61ad1a5d..0f86eb63d 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -1,22 +1,22 @@ (.module: [lux #* [control - [monad (#+ do Monad)] + [monad (#+ Monad do)] ["p" parser] pipe] [data ["." name] ["E" error] ["." maybe] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format] [format ["&" xml]] [collection ["dict" dictionary] - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] [math - ["r" random ("r/." Monad<Random>)]]] + ["r" random ("r/." monad)]]] lux/test) (def: char-range @@ -27,7 +27,7 @@ (def: xml-char^ (r.Random Nat) - (do r.Monad<Random> + (do r.monad [idx (|> r.nat (:: @ map (n/% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) @@ -38,7 +38,7 @@ (def: (xml-text^ bottom top) (-> Nat Nat (r.Random Text)) - (do r.Monad<Random> + (do r.monad [size (size^ bottom top)] (r.text xml-char^ size))) @@ -51,19 +51,19 @@ (r.Random &.XML) (r.rec (function (_ gen-xml) (r.or (xml-text^ 1 10) - (do r.Monad<Random> + (do r.monad [size (size^ 0 2)] ($_ r.and xml-identifier^ - (r.dictionary name.Hash<Name> size xml-identifier^ (xml-text^ 0 10)) + (r.dictionary name.hash size xml-identifier^ (xml-text^ 0 10)) (r.list size gen-xml))))))) (context: "XML." (<| (times 100) (do @ [sample gen-xml - #let [(^open "&/.") &.Equivalence<XML> - (^open "&/.") &.Codec<Text,XML>]] + #let [(^open "&/.") &.equivalence + (^open "&/.") &.codec]] ($_ seq (test "Every XML is equal to itself." (&/= sample sample)) @@ -92,30 +92,30 @@ ($_ seq (test "Can parse text." (E.default #0 - (do E.Monad<Error> + (do E.monad [output (&.run (#&.Text text) &.text)] (wrap (text/= text output))))) (test "Can parse attributes." (E.default #0 - (do E.Monad<Error> + (do E.monad [output (|> (&.attr attr) (p.before &.ignore) (&.run node))] (wrap (text/= value output))))) (test "Can parse nodes." (E.default #0 - (do E.Monad<Error> + (do E.monad [_ (|> (&.node tag) (p.before &.ignore) (&.run node))] (wrap #1)))) (test "Can parse children." (E.default #0 - (do E.Monad<Error> + (do E.monad [outputs (|> (&.children (p.some &.text)) (&.run node))] - (wrap (:: (list.Equivalence<List> text.Equivalence<Text>) = + (wrap (:: (list.equivalence text.equivalence) = children outputs))))) )))) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux index c7703f24b..31bf105cd 100644 --- a/stdlib/test/test/lux/data/identity.lux +++ b/stdlib/test/test/lux/data/identity.lux @@ -1,17 +1,17 @@ (.module: [lux #* [control - ["M" monad (#+ do Monad)] + ["M" monad (#+ Monad do)] comonad] [data ["&" identity] - [text ("text/." Monoid<Text> Equivalence<Text>)]]] + [text ("text/." monoid equivalence)]]] lux/test) (context: "Identity" - (let [(^open "&/.") &.Apply<Identity> - (^open "&/.") &.Monad<Identity> - (^open "&/.") &.CoMonad<Identity>] + (let [(^open "&/.") &.apply + (^open "&/.") &.monad + (^open "&/.") &.comonad] ($_ seq (test "Functor does not affect values." (text/= "yololol" (&/map (text/compose "yolo") "lol"))) @@ -21,7 +21,7 @@ (text/= "yololol" (&/apply (&/wrap (text/compose "yolo")) (&/wrap "lol"))))) (test "Monad does not affect values." - (text/= "yololol" (do &.Monad<Identity> + (text/= "yololol" (do &.monad [f (wrap text/compose) a (wrap "yolo") b (wrap "lol")] @@ -29,7 +29,7 @@ (test "CoMonad does not affect values." (and (text/= "yololol" (&/unwrap "yololol")) - (text/= "yololol" (be &.CoMonad<Identity> + (text/= "yololol" (be &.comonad [f text/compose a "yolo" b "lol"] diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux index b5918c281..f00b572ab 100644 --- a/stdlib/test/test/lux/data/lazy.lux +++ b/stdlib/test/test/lux/data/lazy.lux @@ -33,12 +33,12 @@ ($_ seq (test "Functor map." (|> (&.freeze sample) - (:: &.Functor<Lazy> map inc) + (:: &.functor map inc) &.thaw (n/= (inc sample)))) (test "Monad." - (|> (do &.Monad<Lazy> + (|> (do &.monad [f (wrap inc) a (wrap sample)] (wrap (f a))) @@ -46,8 +46,8 @@ (n/= (inc sample)))) (test "Apply apply." - (let [(^open "&/.") &.Monad<Lazy> - (^open "&/.") &.Apply<Lazy>] + (let [(^open "&/.") &.monad + (^open "&/.") &.apply] (|> (&/apply (&/wrap inc) (&/wrap sample)) &.thaw (n/= (inc sample))))) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index d47559d62..eb09491a1 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -1,18 +1,18 @@ (.module: [lux #* - ["." io ("io/." Monad<IO>)] [control - ["M" monad (#+ do Monad)] + ["M" monad (#+ Monad do)] pipe] [data - ["&" maybe ("&/." Monoid<Maybe>)] - ["." text ("text/." Monoid<Text>)]]] + ["&" maybe ("&/." monoid)] + ["." text ("text/." monoid)]] + ["." io ("io/." monad)]] lux/test) (context: "Maybe" - (let [(^open "&/.") &.Apply<Maybe> - (^open "&/.") &.Monad<Maybe> - (^open "&/.") (&.Equivalence<Maybe> text.Equivalence<Text>)] + (let [(^open "&/.") &.apply + (^open "&/.") &.monad + (^open "&/.") (&.equivalence text.equivalence)] ($_ seq (test "Can compare Maybe values." (and (&/= #.None #.None) @@ -38,13 +38,13 @@ (test "Monad respects Maybe." (&/= (#.Some "yololol") - (do &.Monad<Maybe> + (do &.monad [f (wrap text/compose) a (wrap "yolo") b (wrap "lol")] (wrap (f a b))))) - (do r.Monad<Random> + (do r.monad [default r.nat maybe r.nat] (_.test "Can have defaults for Maybe values." @@ -56,9 +56,9 @@ ))) (context: "Monad transformer" - (let [lift (&.lift io.Monad<IO>)] + (let [lift (&.lift io.monad)] (test "Can add maybe functionality to any monad." - (|> (io.run (do (&.MaybeT io.Monad<IO>) + (|> (io.run (do (&.MaybeT io.monad) [a (lift (io/wrap +123)) b (wrap +456)] (wrap (i/+ a b)))) diff --git a/stdlib/test/test/lux/data/name.lux b/stdlib/test/test/lux/data/name.lux index 53751066d..3855fe221 100644 --- a/stdlib/test/test/lux/data/name.lux +++ b/stdlib/test/test/lux/data/name.lux @@ -5,7 +5,7 @@ pipe] [data ["&" name] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format]] [math ["r" random]]] @@ -30,8 +30,8 @@ module2 (gen-part sizeM2) short2 (gen-part sizeN2) #let [name2 [module2 short2]] - #let [(^open "&/.") &.Equivalence<Name> - (^open "&/.") &.Codec<Text,Name>]] + #let [(^open "&/.") &.equivalence + (^open "&/.") &.codec]] ($_ seq (test "Can get the module & short parts of an name." (and (is? module1 (&.module name1)) @@ -58,7 +58,7 @@ )))) (context: "Name-related macros." - (let [(^open "&/.") &.Equivalence<Name>] + (let [(^open "&/.") &.equivalence] ($_ seq (test "Can obtain Name from identifier." (and (&/= ["lux" "yolo"] (name-of .yolo)) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index b5cf8e414..9d870ab08 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -1,11 +1,11 @@ (.module: [lux #* [control - ["M" monad (#+ do Monad)] + ["M" monad (#+ Monad do)] pipe] [data number - [text ("text/." Equivalence<Text>) + [text ("text/." equivalence) format]] [math ["r" random]]] @@ -22,10 +22,10 @@ (:: <Order> < y x) (:: <Order> > y x)))))))] - ["Nat" r.nat Equivalence<Nat> Order<Nat>] - ["Int" r.int Equivalence<Int> Order<Int>] - ["Rev" r.rev Equivalence<Rev> Order<Rev>] - ["Frac" r.frac Equivalence<Frac> Order<Frac>] + ["Nat" r.nat equivalence order] + ["Int" r.int equivalence order] + ["Rev" r.rev equivalence order] + ["Frac" r.frac equivalence order] ) (do-template [category rand-gen <Number> <Order>] @@ -45,10 +45,10 @@ (= x (* (signum x) (abs x)))))))))] - ["Nat" r.nat Number<Nat> Order<Nat>] - ["Int" r.int Number<Int> Order<Int>] - ["Rev" r.rev Number<Rev> Order<Rev>] - ["Frac" r.frac Number<Frac> Order<Frac>] + ["Nat" r.nat number order] + ["Int" r.int number order] + ["Rev" r.rev number order] + ["Frac" r.frac number order] ) (do-template [category rand-gen <Enum> <Number> <Order>] @@ -69,8 +69,8 @@ (|> x (:: <Enum> succ) (:: <Enum> pred))) ))))))] - ["Nat" r.nat Enum<Nat> Number<Nat> Order<Nat>] - ["Int" r.int Enum<Int> Number<Int> Order<Int>] + ["Nat" r.nat enum number order] + ["Int" r.int enum number order] ) (do-template [category rand-gen <Number> <Order> <Interval> <test>] @@ -83,11 +83,11 @@ (test "" (and (<= x (:: <Interval> bottom)) (>= x (:: <Interval> top)))))))] - ["Nat" r.nat Number<Nat> Order<Nat> Interval<Nat> (function (_ _) #1)] - ["Int" r.int Number<Int> Order<Int> Interval<Int> (function (_ _) #1)] + ["Nat" r.nat number order interval (function (_ _) #1)] + ["Int" r.int number order interval (function (_ _) #1)] ## Both min and max values will be positive (thus, greater than zero) - ["Rev" r.rev Number<Rev> Order<Rev> Interval<Rev> (function (_ _) #1)] - ["Frac" r.frac Number<Frac> Order<Frac> Interval<Frac> (f/> +0.0)] + ["Rev" r.rev number order interval (function (_ _) #1)] + ["Frac" r.frac number order interval (f/> +0.0)] ) (do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>] @@ -103,22 +103,22 @@ (= x (compose x identity)) (= identity (compose identity identity)))))))] - ["Nat/Add" r.nat Number<Nat> Order<Nat> Add@Monoid<Nat> (n/% 1000) (function (_ _) #1)] - ["Nat/Mul" r.nat Number<Nat> Order<Nat> Mul@Monoid<Nat> (n/% 1000) (function (_ _) #1)] - ["Nat/Min" r.nat Number<Nat> Order<Nat> Min@Monoid<Nat> (n/% 1000) (function (_ _) #1)] - ["Nat/Max" r.nat Number<Nat> Order<Nat> Max@Monoid<Nat> (n/% 1000) (function (_ _) #1)] - ["Int/Add" r.int Number<Int> Order<Int> Add@Monoid<Int> (i/% +1000) (function (_ _) #1)] - ["Int/Mul" r.int Number<Int> Order<Int> Mul@Monoid<Int> (i/% +1000) (function (_ _) #1)] - ["Int/Min" r.int Number<Int> Order<Int> Min@Monoid<Int> (i/% +1000) (function (_ _) #1)] - ["Int/Max" r.int Number<Int> Order<Int> Max@Monoid<Int> (i/% +1000) (function (_ _) #1)] - ["Rev/Add" r.rev Number<Rev> Order<Rev> Add@Monoid<Rev> (r/% .125) (function (_ _) #1)] - ["Rev/Mul" r.rev Number<Rev> Order<Rev> Mul@Monoid<Rev> (r/% .125) (function (_ _) #1)] - ["Rev/Min" r.rev Number<Rev> Order<Rev> Min@Monoid<Rev> (r/% .125) (function (_ _) #1)] - ["Rev/Max" r.rev Number<Rev> Order<Rev> Max@Monoid<Rev> (r/% .125) (function (_ _) #1)] - ["Frac/Add" r.frac Number<Frac> Order<Frac> Add@Monoid<Frac> (f/% +1000.0) (f/> +0.0)] - ["Frac/Mul" r.frac Number<Frac> Order<Frac> Mul@Monoid<Frac> (f/% +1000.0) (f/> +0.0)] - ["Frac/Min" r.frac Number<Frac> Order<Frac> Min@Monoid<Frac> (f/% +1000.0) (f/> +0.0)] - ["Frac/Max" r.frac Number<Frac> Order<Frac> Max@Monoid<Frac> (f/% +1000.0) (f/> +0.0)] + ["Nat/Add" r.nat number order add@monoid (n/% 1000) (function (_ _) #1)] + ["Nat/Mul" r.nat number order mul@monoid (n/% 1000) (function (_ _) #1)] + ["Nat/Min" r.nat number order min@monoid (n/% 1000) (function (_ _) #1)] + ["Nat/Max" r.nat number order max@monoid (n/% 1000) (function (_ _) #1)] + ["Int/Add" r.int number order add@monoid (i/% +1000) (function (_ _) #1)] + ["Int/Mul" r.int number order mul@monoid (i/% +1000) (function (_ _) #1)] + ["Int/Min" r.int number order min@monoid (i/% +1000) (function (_ _) #1)] + ["Int/Max" r.int number order max@monoid (i/% +1000) (function (_ _) #1)] + ["Rev/Add" r.rev number order add@monoid (r/% .125) (function (_ _) #1)] + ["Rev/Mul" r.rev number order mul@monoid (r/% .125) (function (_ _) #1)] + ["Rev/Min" r.rev number order min@monoid (r/% .125) (function (_ _) #1)] + ["Rev/Max" r.rev number order max@monoid (r/% .125) (function (_ _) #1)] + ["Frac/Add" r.frac number order add@monoid (f/% +1000.0) (f/> +0.0)] + ["Frac/Mul" r.frac number order mul@monoid (f/% +1000.0) (f/> +0.0)] + ["Frac/Min" r.frac number order min@monoid (f/% +1000.0) (f/> +0.0)] + ["Frac/Max" r.frac number order max@monoid (f/% +1000.0) (f/> +0.0)] ) (do-template [<category> <rand-gen> <Equivalence> <Codec>] @@ -136,25 +136,25 @@ (#.Left _) #0))))))] - ["Nat/Binary" r.nat Equivalence<Nat> Binary@Codec<Text,Nat>] - ["Nat/Octal" r.nat Equivalence<Nat> Octal@Codec<Text,Nat>] - ["Nat/Decimal" r.nat Equivalence<Nat> Codec<Text,Nat>] - ["Nat/Hex" r.nat Equivalence<Nat> Hex@Codec<Text,Nat>] - - ["Int/Binary" r.int Equivalence<Int> Binary@Codec<Text,Int>] - ["Int/Octal" r.int Equivalence<Int> Octal@Codec<Text,Int>] - ["Int/Decimal" r.int Equivalence<Int> Codec<Text,Int>] - ["Int/Hex" r.int Equivalence<Int> Hex@Codec<Text,Int>] - - ["Rev/Binary" r.rev Equivalence<Rev> Binary@Codec<Text,Rev>] - ["Rev/Octal" r.rev Equivalence<Rev> Octal@Codec<Text,Rev>] - ["Rev/Decimal" r.rev Equivalence<Rev> Codec<Text,Rev>] - ["Rev/Hex" r.rev Equivalence<Rev> Hex@Codec<Text,Rev>] - - ["Frac/Binary" r.frac Equivalence<Frac> Binary@Codec<Text,Frac>] - ["Frac/Octal" r.frac Equivalence<Frac> Octal@Codec<Text,Frac>] - ["Frac/Decimal" r.frac Equivalence<Frac> Codec<Text,Frac>] - ["Frac/Hex" r.frac Equivalence<Frac> Hex@Codec<Text,Frac>] + ["Nat/Binary" r.nat equivalence binary@codec] + ["Nat/Octal" r.nat equivalence octal@codec] + ["Nat/Decimal" r.nat equivalence codec] + ["Nat/Hex" r.nat equivalence hex@codec] + + ["Int/Binary" r.int equivalence binary@codec] + ["Int/Octal" r.int equivalence octal@codec] + ["Int/Decimal" r.int equivalence codec] + ["Int/Hex" r.int equivalence hex@codec] + + ["Rev/Binary" r.rev equivalence binary@codec] + ["Rev/Octal" r.rev equivalence octal@codec] + ["Rev/Decimal" r.rev equivalence codec] + ["Rev/Hex" r.rev equivalence hex@codec] + + ["Frac/Binary" r.frac equivalence binary@codec] + ["Frac/Octal" r.frac equivalence octal@codec] + ["Frac/Decimal" r.frac equivalence codec] + ["Frac/Hex" r.frac equivalence hex@codec] ) (context: "Can convert frac values to/from their bit patterns." diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index 537027710..850845296 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -4,10 +4,10 @@ [monad (#+ do Monad)] pipe] [data - ["." number ("frac/." Number<Frac>) + ["." number ("frac/." number) ["&" complex]] [collection - ["." list ("list/." Functor<List>)]]] + ["." list ("list/." functor)]]] ["." math ["r" random]]] lux/test) @@ -25,7 +25,7 @@ (def: gen-dim (r.Random Frac) - (do r.Monad<Random> + (do r.monad [factor (|> r.nat (:: @ map (|>> (n/% 1000) (n/max 1)))) measure (|> r.frac (r.filter (f/> +0.0)))] (wrap (f/* (|> factor .int int-to-frac) @@ -33,7 +33,7 @@ (def: gen-complex (r.Random &.Complex) - (do r.Monad<Random> + (do r.monad [real gen-dim imaginary gen-dim] (wrap (&.complex real imaginary)))) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index aa931d688..63d1e5fc8 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -5,18 +5,18 @@ pipe] [data [number - ["&" ratio ("&/." Number<Ratio>)]]] + ["&" ratio ("&/." number)]]] [math ["r" random]]] lux/test) (def: gen-part (r.Random Nat) - (|> r.nat (:: r.Monad<Random> map (|>> (n/% 1000) (n/max 1))))) + (|> r.nat (:: r.monad map (|>> (n/% 1000) (n/max 1))))) (def: gen-ratio (r.Random &.Ratio) - (do r.Monad<Random> + (do r.monad [numerator gen-part denominator (|> gen-part (r.filter (|>> (n/= 0) not)) @@ -106,7 +106,7 @@ (<| (times 100) (do @ [sample gen-ratio - #let [(^open "&/.") &.Codec<Text,Ratio>]] + #let [(^open "&/.") &.codec]] (test "Can encode/decode ratios." (|> sample &/encode &/decode (case> (#.Right output) diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index 96c0518c0..d47922304 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -10,7 +10,7 @@ lux/test) (context: "Sum operations" - (let [(^open "List/.") (list.Equivalence<List> text.Equivalence<Text>)] + (let [(^open "List/.") (list.equivalence text.equivalence)] ($_ seq (test "Can inject values into Either." (and (|> (left "Hello") (case> (0 "Hello") #1 _ #0)) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index a98eb92e6..01cd2220d 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -24,7 +24,7 @@ (def: bounded-size (r.Random Nat) (|> r.nat - (:: r.Monad<Random> map (|>> (n/% 20) (n/+ 1))))) + (:: r.monad map (|>> (n/% 20) (n/+ 1))))) (context: "Locations" (<| (times 100) @@ -66,7 +66,7 @@ fake-sample (&.join-with " " (list sampleL sampleR)) dup-sample (&.join-with "" (list sampleL sampleR)) enclosed-sample (&.enclose [sampleR sampleR] sampleL) - (^open ".") &.Equivalence<Text>]] + (^open ".") &.equivalence]] (test "" (and (not (= sample fake-sample)) (= sample dup-sample) (&.starts-with? sampleL sample) @@ -114,7 +114,7 @@ parts (r.list sizeL part-gen) #let [sample1 (&.concat (list.interpose sep1 parts)) sample2 (&.concat (list.interpose sep2 parts)) - (^open "&/.") &.Equivalence<Text>]] + (^open "&/.") &.equivalence]] ($_ seq (test "Can split text through a separator." (n/= (list.size parts) @@ -126,7 +126,7 @@ )))) (context: "Structures" - (let [(^open "&/.") &.Order<Text>] + (let [(^open "&/.") &.order] ($_ seq (test "" (&/< "bcd" "abc")) (test "" (not (&/< "abc" "abc"))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index 48cf24306..d3bbafe7e 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -1,14 +1,14 @@ (.module: [lux #* [control - [monad (#+ do Monad)]] + [monad (#+ Monad do)]] [data ["." text format]]] lux/test) (context: "Formatters" - (let [(^open "&/.") text.Equivalence<Text>] + (let [(^open "&/.") text.equivalence] ($_ seq (test "Can format common values simply." (and (&/= "#1" (%b #1)) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index a08c49ef7..a1e52b64c 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -6,7 +6,7 @@ ["p" parser]] [data ["." error (#+ Error)] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format ["&" lexer]] [collection @@ -33,7 +33,7 @@ (def: (should-passL test input) (-> (List Text) (Error (List Text)) Bit) - (let [(^open "list/.") (list.Equivalence<List> text.Equivalence<Text>)] + (let [(^open "list/.") (list.equivalence text.equivalence)] (case input (#.Right output) (list/= test output) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index 3398f4685..f6bc7d098 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -6,7 +6,7 @@ ["p" parser]] [data [number (#+ hex)] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format ["." lexer (#+ Lexer)] ["&" regex]]] diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index 3e184c7b9..3de5e28d7 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -4,7 +4,7 @@ [monad (#+ Monad do)] pipe] [data - [text ("text/." Equivalence<Text>)]] + [text ("text/." equivalence)]] [math ["r" random]] ["_" test (#+ Test)]] @@ -61,7 +61,7 @@ (def: conversions Test - (do r.Monad<Random> + (do r.monad [sample r.int] (`` ($_ _.and (~~ (do-template [<to> <from> <message>] @@ -81,7 +81,7 @@ (def: miscellaneous Test - (do r.Monad<Random> + (do r.monad [sample (r.ascii 1)] ($_ _.and (_.test "Can check if an object is of a certain class." @@ -111,7 +111,7 @@ (def: arrays Test - (do r.Monad<Random> + (do r.monad [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 1)))) idx (|> r.nat (:: @ map (n/% size))) value r.int] diff --git a/stdlib/test/test/lux/host/jvm.jvm.lux b/stdlib/test/test/lux/host/jvm.jvm.lux index 70a8c3da5..d8224d214 100644 --- a/stdlib/test/test/lux/host/jvm.jvm.lux +++ b/stdlib/test/test/lux/host/jvm.jvm.lux @@ -36,10 +36,10 @@ (def: (write-class! name bytecode) (-> Text Binary (IO Text)) (let [file-path (format name ".class")] - (do io.Monad<IO> - [outcome (do (error.ErrorT @) + (do io.monad + [outcome (do (error.with-error @) [file (: (IO (Error (File IO))) - (file.get-file io.Monad<IO> file.System<IO> file-path))] + (file.get-file io.monad file.system file-path))] (!.use (:: file over-write) bytecode))] (wrap (case outcome (#error.Success definition) @@ -50,7 +50,7 @@ (def: class Test - (do r.Monad<Random> + (do r.monad [_ (wrap []) #let [package "my.package" name "MyClass" @@ -70,7 +70,7 @@ (_.test "Can read a generated class." (case (binary.read /class.format bytecode) (#error.Success output) - (:: /class.Equivalence<Class> = input output) + (:: /class.equivalence = input output) (#error.Failure error) false)) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index 66cd4a730..86143fe27 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -5,19 +5,19 @@ ["M" monad (#+ do Monad)]] [data [number] - [text ("text/." Equivalence<Text>) + [text ("text/." equivalence) format]]] lux/test) (context: "I/O" ($_ seq (test "" (text/= "YOLO" (&.run (&.io "YOLO")))) - (test "" (i/= +11 (&.run (:: &.Functor<IO> map inc (&.io +10))))) - (test "" (i/= +10 (&.run (:: &.Monad<IO> wrap +10)))) - (test "" (i/= +30 (&.run (let [(^open "&/.") &.Apply<IO> - (^open "&/.") &.Monad<IO>] + (test "" (i/= +11 (&.run (:: &.functor map inc (&.io +10))))) + (test "" (i/= +10 (&.run (:: &.monad wrap +10)))) + (test "" (i/= +30 (&.run (let [(^open "&/.") &.apply + (^open "&/.") &.monad] (&/apply (&/wrap (i/+ +10)) (&/wrap +20)))))) - (test "" (i/= +30 (&.run (do &.Monad<IO> + (test "" (i/= +30 (&.run (do &.monad [f (wrap i/+) x (wrap +10) y (wrap +20)] diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index be53adfad..02baf04a5 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -5,10 +5,12 @@ [monad (#+ do Monad)]] [data [number] - ["." text ("text/." Equivalence<Text>) + ["." text ("text/." equivalence) format]] - [math ["r" random]] - [macro ["&" code]]] + [math + ["r" random]] + [macro + ["&" code]]] lux/test) (context: "Code" @@ -16,7 +18,7 @@ [<tests> (do-template [<expr> <text>] [(test (format "Can produce Code node: " <text>) (and (text/= <text> (&.to-text <expr>)) - (:: &.Equivalence<Code> = <expr> <expr>)))] + (:: &.equivalence = <expr> <expr>)))] [(&.bit #1) "#1"] [(&.bit #0) "#0"] diff --git a/stdlib/test/test/lux/macro/poly/equivalence.lux b/stdlib/test/test/lux/macro/poly/equivalence.lux index 8b10dc738..3d943f6e6 100644 --- a/stdlib/test/test/lux/macro/poly/equivalence.lux +++ b/stdlib/test/test/lux/macro/poly/equivalence.lux @@ -6,7 +6,7 @@ [data ["." bit] ["." maybe] - [number ("int/." Number<Int>)] + [number ("int/." int-number)] ["." text format] [collection @@ -18,7 +18,6 @@ ["&" equivalence]]]] lux/test) -## [Utils] (type: Variant (#Case0 Bit) (#Case1 Int) @@ -47,7 +46,7 @@ (def: gen-record (r.Random Record) - (do r.Monad<Random> + (do r.monad [size (:: @ map (n/% 2) r.nat) #let [gen-int (|> r.int (:: @ map (|>> int/abs (i/% +1_000_000))))]] ($_ r.and @@ -63,11 +62,10 @@ (derived: (&.Equivalence<?> Record)) -## [Tests] (context: "Equivalence polytypism" (<| (times 100) (do @ [sample gen-record - #let [(^open "&/.") Equivalence<Record>]] + #let [(^open "&/.") ..equivalence]] (test "Every instance equals itself." (&/= sample sample))))) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 5fe3a6118..ff8c1c433 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -72,14 +72,14 @@ (found? (s.this? (<ctor> <value>)) (list (<ctor> <value>))) (enforced? (s.this (<ctor> <value>)) (list (<ctor> <value>)))))] - ["Can parse Bit syntax." #1 code.bit bit.Equivalence<Bit> s.bit] - ["Can parse Nat syntax." 123 code.nat number.Equivalence<Nat> s.nat] - ["Can parse Int syntax." +123 code.int number.Equivalence<Int> s.int] - ["Can parse Rev syntax." .123 code.rev number.Equivalence<Rev> s.rev] - ["Can parse Frac syntax." +123.0 code.frac number.Equivalence<Frac> s.frac] - ["Can parse Text syntax." text.new-line code.text text.Equivalence<Text> s.text] - ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.Equivalence<Name> s.identifier] - ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.Equivalence<Name> s.tag] + ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit] + ["Can parse Nat syntax." 123 code.nat number.equivalence s.nat] + ["Can parse Int syntax." +123 code.int number.equivalence s.int] + ["Can parse Rev syntax." .123 code.rev number.equivalence s.rev] + ["Can parse Frac syntax." +123.0 code.frac number.equivalence s.frac] + ["Can parse Text syntax." text.new-line code.text text.equivalence s.text] + ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier] + ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag] )] ($_ seq <simple-tests> diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 059f19c4c..002cdaa41 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -1,10 +1,10 @@ (.module: [lux #* [control - [monad (#+ do Monad)]] + [monad (#+ Monad do)]] [data - [bit ("bit/." Equivalence<Bit>)] - [number ("frac/." Number<Frac>)]] + [bit ("bit/." equivalence)] + [number ("frac/." number)]] ["&" math infix ["r" random]]] diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux index 38f1cc75a..60223e8a3 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -3,7 +3,7 @@ [control [monad (#+ do Monad)]] [data - [bit ("bit/." Equivalence<Bit>)] + [bit ("bit/." equivalence)] ["." number] [text format] @@ -55,7 +55,7 @@ (<gte> top sample)))) ))))] - ["Rev" number.Hash<Rev> r.rev &.triangle r/< r/<= r/> r/>=] + ["Rev" number.hash r.rev &.triangle r/< r/<= r/> r/>=] ) (do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] @@ -102,12 +102,12 @@ (<gte> top sample)))) ))))] - ["Rev" number.Hash<Rev> r.rev &.trapezoid r/< r/<= r/> r/>=] + ["Rev" number.hash r.rev &.trapezoid r/< r/<= r/> r/>=] ) (def: gen-triangle (r.Random (&.Fuzzy Rev)) - (do r.Monad<Random> + (do r.monad [x r.rev y r.rev z r.rev] @@ -150,7 +150,7 @@ (context: "From predicates and sets" (<| (times 100) (do @ - [#let [set-10 (set.from-list number.Hash<Nat> (list.n/range 0 10))] + [#let [set-10 (set.from-list number.hash (list.n/range 0 10))] sample (|> r.nat (:: @ map (n/% 20)))] ($_ seq (test (format "Values that satisfy a predicate have membership = 1." diff --git a/stdlib/test/test/lux/math/modular.lux b/stdlib/test/test/lux/math/modular.lux index f2a3bdef6..b5ff0e40b 100644 --- a/stdlib/test/test/lux/math/modular.lux +++ b/stdlib/test/test/lux/math/modular.lux @@ -4,14 +4,14 @@ [monad (#+ do)]] [data ["." product] - [bit ("bit/." Equivalence<Bit>)] + [bit ("bit/." equivalence)] ["." error] [text format]] [math ["r" random] ["/" modular]] - [type ("type/." Equivalence<Type>)]] + [type ("type/." equivalence)]] lux/test) (def: %3 (/.modulus +3)) @@ -20,16 +20,16 @@ (def: modulusR (r.Random Int) (|> r.int - (:: r.Monad<Random> map (i/% +1000)) + (:: r.monad map (i/% +1000)) (r.filter (|>> (i/= +0) not)))) (def: valueR (r.Random Int) - (|> r.int (:: r.Monad<Random> map (i/% +1000)))) + (|> r.int (:: r.monad map (i/% +1000)))) (def: (modR modulus) (All [m] (-> (/.Modulus m) (r.Random [Int (/.Mod m)]))) - (do r.Monad<Random> + (do r.monad [raw valueR] (wrap [raw (/.mod modulus raw)]))) @@ -115,7 +115,7 @@ #1)) (test "Can encode/decode to text." - (let [(^open "mod/.") (/.Codec<Text,Mod> normalM)] + (let [(^open "mod/.") (/.codec normalM)] (case (|> subject mod/encode mod/decode) (#error.Success output) (/.m/= subject output) diff --git a/stdlib/test/test/lux/math/random.lux b/stdlib/test/test/lux/math/random.lux index a7f126ef3..acc161cc4 100644 --- a/stdlib/test/test/lux/math/random.lux +++ b/stdlib/test/test/lux/math/random.lux @@ -25,8 +25,8 @@ _array (r.array size r.nat) _queue (r.queue size r.nat) _stack (r.stack size r.nat) - _set (r.set number.Hash<Nat> size r.nat) - _dict (r.dictionary number.Hash<Nat> size r.nat r.nat) + _set (r.set number.hash size r.nat) + _dict (r.dictionary number.hash size r.nat r.nat) top r.nat filtered (|> r.nat (r.filter (n/<= top)))] ($_ seq diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux index 87734f22f..d89ccccc8 100644 --- a/stdlib/test/test/lux/time/date.lux +++ b/stdlib/test/test/lux/time/date.lux @@ -1,12 +1,12 @@ (.module: [lux #* [control - [monad (#+ do Monad)] + [monad (#+ Monad do)] pipe] [data ["." error]] [math - ["r" random ("random/." Monad<Random>)]] + ["r" random ("random/." monad)]] [time ["@." instant] ["@" date]]] @@ -33,7 +33,7 @@ (<| (times 100) (do @ [sample month - #let [(^open "@/.") @.Equivalence<Month>]] + #let [(^open "@/.") @.equivalence]] (test "Every value equals itself." (@/= sample sample))))) @@ -42,7 +42,7 @@ (do @ [reference month sample month - #let [(^open "@/.") @.Order<Month>]] + #let [(^open "@/.") @.order]] (test "Valid Order." (and (or (@/< reference sample) (@/>= reference sample)) @@ -53,7 +53,7 @@ (<| (times 100) (do @ [sample month - #let [(^open "@/.") @.Enum<Month>]] + #let [(^open "@/.") @.enum]] (test "Valid Enum." (and (not (@/= (@/succ sample) sample)) @@ -76,7 +76,7 @@ (<| (times 100) (do @ [sample day - #let [(^open "@/.") @.Equivalence<Day>]] + #let [(^open "@/.") @.equivalence]] (test "Every value equals itself." (@/= sample sample))))) @@ -85,7 +85,7 @@ (do @ [reference day sample day - #let [(^open "@/.") @.Order<Day>]] + #let [(^open "@/.") @.order]] (test "Valid Order." (and (or (@/< reference sample) (@/>= reference sample)) @@ -96,7 +96,7 @@ (<| (times 100) (do @ [sample day - #let [(^open "@/.") @.Enum<Day>]] + #let [(^open "@/.") @.enum]] (test "Valid Enum." (and (not (@/= (@/succ sample) sample)) @@ -107,13 +107,13 @@ (def: #export date (r.Random @.Date) - (|> _instant.instant (:: r.Monad<Random> map @instant.date))) + (|> _instant.instant (:: r.monad map @instant.date))) (context: "(Date) Equivalence." (<| (times 100) (do @ [sample date - #let [(^open "@/.") @.Equivalence<Date>]] + #let [(^open "@/.") @.equivalence]] (test "Every value equals itself." (@/= sample sample))))) @@ -122,7 +122,7 @@ (do @ [reference date sample date - #let [(^open "@/.") @.Order<Date>]] + #let [(^open "@/.") @.order]] (test "Valid Order." (and (or (@/< reference sample) (@/>= reference sample)) @@ -134,8 +134,8 @@ ## (times 100) (do @ [sample date - #let [(^open "@/.") @.Equivalence<Date> - (^open "@/.") @.Codec<Text,Date>]] + #let [(^open "@/.") @.equivalence + (^open "@/.") @.codec]] (test "Can encode/decode dates." (|> sample @/encode diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux index 8bf00b88b..3aba23203 100644 --- a/stdlib/test/test/lux/time/duration.lux +++ b/stdlib/test/test/lux/time/duration.lux @@ -13,7 +13,7 @@ (def: #export duration (r.Random @.Duration) - (|> r.int (:: r.Monad<Random> map @.from-millis))) + (|> r.int (:: r.monad map @.from-millis))) (context: "Conversion." (<| (times 100) @@ -26,7 +26,7 @@ (<| (times 100) (do @ [sample duration - #let [(^open "@/.") @.Equivalence<Duration>]] + #let [(^open "@/.") @.equivalence]] (test "Every duration equals itself." (@/= sample sample))))) @@ -35,7 +35,7 @@ (do @ [reference duration sample duration - #let [(^open "@/.") @.Order<Duration>]] + #let [(^open "@/.") @.order]] (test "Can compare times." (and (or (@/< reference sample) (@/>= reference sample)) @@ -48,7 +48,7 @@ [sample (|> duration (:: @ map (@.frame @.day))) frame duration factor (|> r.int (:: @ map (|>> (i/% +10) (i/max +1)))) - #let [(^open "@/.") @.Order<Duration>]] + #let [(^open "@/.") @.order]] ($_ seq (test "Can scale a duration." (|> sample (@.scale-up factor) (@.query sample) (i/= factor))) diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux index 975c72558..c9d7aad55 100644 --- a/stdlib/test/test/lux/time/instant.lux +++ b/stdlib/test/test/lux/time/instant.lux @@ -22,7 +22,7 @@ (def: #export instant (r.Random @.Instant) - (|> r.int (:: r.Monad<Random> map (|>> (i/% boundary) @.from-millis)))) + (|> r.int (:: r.monad map (|>> (i/% boundary) @.from-millis)))) (context: "Conversion." (<| (times 100) @@ -35,7 +35,7 @@ (<| (times 100) (do @ [sample instant - #let [(^open "@/.") @.Equivalence<Instant>]] + #let [(^open "@/.") @.equivalence]] (test "Every instant equals itself." (@/= sample sample))))) @@ -44,7 +44,7 @@ (do @ [reference instant sample instant - #let [(^open "@/.") @.Order<Instant>]] + #let [(^open "@/.") @.order]] (test "Can compare instants." (and (or (@/< reference sample) (@/>= reference sample)) @@ -55,7 +55,7 @@ (<| (times 100) (do @ [sample instant - #let [(^open "@/.") @.Enum<Instant>]] + #let [(^open "@/.") @.enum]] (test "Valid Enum." (and (not (@/= (@/succ sample) sample)) @@ -69,8 +69,8 @@ (do @ [sample instant span _duration.duration - #let [(^open "@/.") @.Equivalence<Instant> - (^open "@d/.") @d.Equivalence<Duration>]] + #let [(^open "@/.") @.equivalence + (^open "@d/.") @d.equivalence]] ($_ seq (test "The span of a instant and itself has an empty duration." (|> sample (@.span sample) (@d/= @d.empty))) @@ -86,8 +86,8 @@ ## ## (times 100) ## (do @ ## [sample instant -## #let [(^open "@/.") @.Equivalence<Instant> -## (^open "@/.") @.Codec<Text,Instant>]] +## #let [(^open "@/.") @.equivalence +## (^open "@/.") @.codec]] ## (test "Can encode/decode instants." ## (|> sample ## @/encode diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index e8de83c56..b4796911a 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -17,7 +17,7 @@ ## [Utils] (def: #export gen-short (r.Random Text) - (do r.Monad<Random> + (do r.monad [size (|> r.nat (:: @ map (n/% 10)))] (r.unicode size))) @@ -27,7 +27,7 @@ (def: #export gen-type (r.Random Type) - (let [(^open "R/.") r.Monad<Random>] + (let [(^open "R/.") r.monad] (r.rec (function (_ gen-type) (let [pairG (r.and gen-type gen-type) idG r.nat @@ -52,15 +52,15 @@ (do @ [sample gen-type] (test "Every type is equal to itself." - (:: &.Equivalence<Type> = sample sample))))) + (:: &.equivalence = sample sample))))) (context: "Type application" (test "Can apply quantified types (universal and existential quantification)." (and (maybe.default #0 - (do maybe.Monad<Maybe> + (do maybe.monad [partial (&.apply (list Bit) Ann) full (&.apply (list Int) partial)] - (wrap (:: &.Equivalence<Type> = full (#.Product Bit Int))))) + (wrap (:: &.equivalence = full (#.Product Bit Int))))) (|> (&.apply (list Bit) Text) (case> #.None #1 _ #0))))) @@ -71,15 +71,15 @@ base))] ($_ seq (test "Can remove aliases from an already-named type." - (:: &.Equivalence<Type> = + (:: &.equivalence = base (&.un-alias aliased))) (test "Can remove all names from a type." - (and (not (:: &.Equivalence<Type> = + (and (not (:: &.equivalence = base (&.un-name aliased))) - (:: &.Equivalence<Type> = + (:: &.equivalence = (&.un-name base) (&.un-name aliased))))))) @@ -97,8 +97,8 @@ #1))) (list.repeat size) (M.seq @)) - #let [(^open "&/.") &.Equivalence<Type> - (^open "L/.") (list.Equivalence<List> &.Equivalence<Type>)]] + #let [(^open "&/.") &.equivalence + (^open "L/.") (list.equivalence &.equivalence)]] (with-expansions [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>] [(test (format "Can build and tear-down " <desc> " types.") @@ -127,8 +127,8 @@ _ #1)))) - #let [(^open "&/.") &.Equivalence<Type> - (^open "L/.") (list.Equivalence<List> &.Equivalence<Type>)]] + #let [(^open "&/.") &.equivalence + (^open "L/.") (list.equivalence &.equivalence)]] ($_ seq (test "Can build and tear-down function types." (let [[inputs output] (|> (&.function members extra) &.flatten-function)] @@ -152,7 +152,7 @@ _ #1)))) - #let [(^open "&/.") &.Equivalence<Type>]] + #let [(^open "&/.") &.equivalence]] (with-expansions [<quant-tests> (do-template [<desc> <ctor> <dtor>] [(test (format "Can build and tear-down " <desc> " types.") diff --git a/stdlib/test/test/lux/type/check.lux b/stdlib/test/test/lux/type/check.lux index c5700f8cb..426127fb6 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -7,13 +7,13 @@ ["." product] ["." maybe] ["." number] - [text ("text/." Equivalence<Text>)] + [text ("text/." equivalence)] [collection - ["." list ("list/." Functor<List>)] + ["." list ("list/." functor)] ["." set]]] [math ["r" random]] - ["." type ("type/." Equivalence<Type>) + ["." type ("type/." equivalence) ["@" check]]] lux/test ["." //]) @@ -68,24 +68,24 @@ (@.checks? Any Any))) (test "Existential types only match with themselves." - (and (type-checks? (do @.Monad<Check> + (and (type-checks? (do @.monad [[_ exT] @.existential] (@.check exT exT))) - (not (type-checks? (do @.Monad<Check> + (not (type-checks? (do @.monad [[_ exTL] @.existential [_ exTR] @.existential] (@.check exTL exTR)))))) (test "Names do not affect type-checking." - (and (type-checks? (do @.Monad<Check> + (and (type-checks? (do @.monad [[_ exT] @.existential] (@.check (#.Named ["module" "name"] exT) exT))) - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[_ exT] @.existential] (@.check exT (#.Named ["module" "name"] exT)))) - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[_ exT] @.existential] (@.check (#.Named ["module" "name"] exT) (#.Named ["module" "name"] exT)))))) @@ -132,32 +132,32 @@ (context: "Type variables." ($_ seq (test "Type-vars check against themselves." - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[id var] @.var] (@.check var var)))) (test "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (do @.Monad<Check> + (and (type-checks? (do @.monad [[id var] @.var] (@.check var .Any))) - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[id var] @.var] (@.check .Any var))))) (test "Cannot rebind already bound type-vars." - (not (type-checks? (do @.Monad<Check> + (not (type-checks? (do @.monad [[id var] @.var _ (@.check var .Bit)] (@.check var .Nat))))) (test "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[id var] @.var _ (@.check var Any)] (@.check var .Bit)))) (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[id var] @.var _ (@.check var Nothing)] (@.check .Bit var)))) @@ -165,7 +165,7 @@ (def: (build-ring num-connections) (-> Nat (@.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do @.Monad<Check> + (do @.monad [[head-id head-type] @.var ids+types (monad.seq @ (list.repeat num-connections @.var)) [tail-id tail-type] (monad.fold @ (function (_ [tail-id tail-type] [_head-id _head-type]) @@ -184,22 +184,22 @@ pick-pcg (r.and r.nat r.nat)] ($_ seq (test "Can create rings of variables." - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[[head-id head-type] ids+types [tail-id tail-type]] (build-ring num-connections) #let [ids (list/map product.left ids+types)] headR (@.ring head-id) tailR (@.ring tail-id)] (@.assert "" - (let [same-rings? (:: set.Equivalence<Set> = headR tailR) + (let [same-rings? (:: set.equivalence = headR tailR) expected-size? (n/= (inc num-connections) (set.size headR)) same-vars? (|> (set.to-list headR) (list.sort n/<) - (:: (list.Equivalence<List> number.Equivalence<Nat>) = (list.sort n/< (#.Cons head-id ids))))] + (:: (list.equivalence number.equivalence) = (list.sort n/< (#.Cons head-id ids))))] (and same-rings? expected-size? same-vars?)))))) (test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[[head-id headT] ids+types tailT] (build-ring num-connections) #let [ids (list/map product.left ids+types)] _ (@.check headT boundT) @@ -217,7 +217,7 @@ (and rings-were-erased? same-types?)))))) (test "Can merge multiple rings of variables." - (type-checks? (do @.Monad<Check> + (type-checks? (do @.monad [[[head-idL headTL] ids+typesL [tail-idL tailTL]] (build-ring num-connections) [[head-idR headTR] ids+typesR [tail-idR tailTR]] (build-ring num-connections) headRL-pre (@.ring head-idL) @@ -226,10 +226,10 @@ headRL-post (@.ring head-idL) headRR-post (@.ring head-idR)] (@.assert "" - (let [same-rings? (:: set.Equivalence<Set> = headRL-post headRR-post) + (let [same-rings? (:: set.equivalence = headRL-post headRR-post) expected-size? (n/= (n/* 2 (inc num-connections)) (set.size headRL-post)) - union? (:: set.Equivalence<Set> = headRL-post (set.union headRL-pre headRR-pre))] + union? (:: set.equivalence = headRL-post (set.union headRL-pre headRR-pre))] (and same-rings? expected-size? union?)))))) diff --git a/stdlib/test/test/lux/type/implicit.lux b/stdlib/test/test/lux/type/implicit.lux index 669d720c2..98b647bf1 100644 --- a/stdlib/test/test/lux/type/implicit.lux +++ b/stdlib/test/test/lux/type/implicit.lux @@ -4,9 +4,9 @@ [control [equivalence] [functor] - [monad (#+ do Monad)]] + [monad (#+ Monad do)]] [data - [bit ("bit/." Equivalence<Bit>)] + [bit ("bit/." equivalence)] [number] [collection [list]]] [math @@ -21,8 +21,8 @@ y r.nat] ($_ seq (test "Can automatically select first-order structures." - (let [(^open "list/.") (list.Equivalence<List> number.Equivalence<Nat>)] - (and (bit/= (:: number.Equivalence<Nat> = x y) + (let [(^open "list/.") (list.equivalence number.equivalence)] + (and (bit/= (:: number.equivalence = x y) (::: = x y)) (list/= (list.n/range 1 10) (::: map inc (list.n/range 0 9))) diff --git a/stdlib/test/test/lux/type/resource.lux b/stdlib/test/test/lux/type/resource.lux index cf6d49b17..b04321cc2 100644 --- a/stdlib/test/test/lux/type/resource.lux +++ b/stdlib/test/test/lux/type/resource.lux @@ -14,7 +14,7 @@ (<| (n/= (n/+ 123 456)) io.run resource.run-sync - (do resource.IxMonad<Sync> + (do resource.sync [res|left (resource.ordered-sync 123) res|right (resource.ordered-sync 456) right (resource.read-sync res|right) @@ -25,7 +25,7 @@ (<| (n/= (n/+ 123 456)) io.run resource.run-sync - (do resource.IxMonad<Sync> + (do resource.sync [res|left (resource.commutative-sync 123) res|right (resource.commutative-sync 456) _ (resource.exchange-sync [1 0]) @@ -37,7 +37,7 @@ (<| (n/= (n/+ 123 456)) io.run resource.run-sync - (do resource.IxMonad<Sync> + (do resource.sync [res|left (resource.commutative-sync 123) res|right (resource.commutative-sync 456) _ (resource.group-sync 2) diff --git a/stdlib/test/test/lux/world/binary.lux b/stdlib/test/test/lux/world/binary.lux index c2f09abd8..ec4da0d11 100644 --- a/stdlib/test/test/lux/world/binary.lux +++ b/stdlib/test/test/lux/world/binary.lux @@ -32,11 +32,11 @@ (let [output (/.create size)] (loop [idx 0] (if (n/< size idx) - (do r.Monad<Random> + (do r.monad [byte r.nat] (exec (error.assume (/.write/8 idx byte output)) (recur (inc idx)))) - (:: r.Monad<Random> wrap output))))) + (:: r.monad wrap output))))) (def: (bits-io bytes read write value) (-> Nat (-> Nat /.Binary (Error Nat)) (-> Nat Nat /.Binary (Error Any)) Nat Bit) @@ -44,7 +44,7 @@ bits (n/* 8 bytes) capped-value (|> 1 (i64.left-shift bits) dec (i64.and value))] (succeed - (do error.Monad<Error> + (do error.monad [_ (write 0 value binary) output (read 0 binary)] (wrap (n/= capped-value output)))))) @@ -61,7 +61,7 @@ #let [[from to] [(n/min from to) (n/max from to)]]] ($_ seq ## TODO: De-comment... - ## (_eq.spec /.Equivalence<Binary> (:: @ map binary gen-size)) + ## (_eq.spec /.equivalence (:: @ map binary gen-size)) (test "Can get size of binary." (|> random-binary /.size (n/= binary-size))) (test "Can read/write 8-bit values." @@ -78,10 +78,10 @@ idxs (list.n/range 0 (dec slice-size)) reader (function (_ binary idx) (/.read/8 idx binary))] (and (n/= slice-size (/.size random-slice)) - (case [(monad.map error.Monad<Error> (reader random-slice) idxs) - (monad.map error.Monad<Error> (|>> (n/+ from) (reader random-binary)) idxs)] + (case [(monad.map error.monad (reader random-slice) idxs) + (monad.map error.monad (|>> (n/+ from) (reader random-binary)) idxs)] [(#error.Success slice-vals) (#error.Success binary-vals)] - (:: (list.Equivalence<List> number.Equivalence<Nat>) = slice-vals binary-vals) + (:: (list.equivalence number.nat-equivalence) = slice-vals binary-vals) _ #0)))) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index ab1406475..b3693f207 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -21,7 +21,7 @@ ["@" file (#+ Path File)] ["." binary (#+ Binary)]] [math - ["r" random ("r/." Monad<Random>)]]] + ["r" random ("r/." monad)]]] lux/test [// ["_." binary]]) @@ -31,14 +31,14 @@ (def: (creation-and-deletion number) (-> Nat Test) - (r/wrap (do promise.Monad<Promise> + (r/wrap (do promise.monad [#let [path (format "temp_file_" (%n number))] result (promise.future - (do (error.ErrorT io.Monad<IO>) + (do (error.ErrorT io.monad) [#let [check-existence! (: (IO (Error Bit)) - (io.from-io (@.exists? io.Monad<IO> @.System<IO> path)))] + (io.from-io (@.exists? io.monad @.system path)))] pre! check-existence! - file (:: @.System<IO> create-file path) + file (:: @.system create-file path) post! check-existence! _ (:: file delete []) remains? check-existence!] @@ -50,15 +50,15 @@ (def: (read-and-write number data) (-> Nat Binary Test) - (r/wrap (do promise.Monad<Promise> + (r/wrap (do promise.monad [#let [path (format "temp_file_" (%n number))] result (promise.future - (do (error.ErrorT io.Monad<IO>) - [file (:: @.System<IO> create-file path) + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) _ (:: file over-write data) content (:: file content []) _ (:: file delete [])] - (wrap (:: binary.Equivalence<Binary> = data (integrity.trust content)))))] + (wrap (:: binary.equivalence = data (integrity.trust content)))))] (assert "Can write/read files." (error.default #0 result))))) @@ -67,53 +67,53 @@ [file-size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) dataL (_binary.binary file-size) dataR (_binary.binary file-size) - new-modified (|> r.int (:: @ map (|>> (:: number.Number<Int> abs) + new-modified (|> r.int (:: @ map (|>> (:: number.number abs) truncate-millis duration.from-millis instant.absolute)))] ($_ seq (creation-and-deletion 0) (read-and-write 1 dataL) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [path "temp_file_2"] result (promise.future - (do (error.ErrorT io.Monad<IO>) - [file (:: @.System<IO> create-file path) + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) _ (:: file over-write dataL) read-size (:: file size []) _ (:: file delete [])] (wrap (n/= file-size read-size))))] (assert "Can read file size." (error.default #0 result)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [path "temp_file_3"] result (promise.future - (do (error.ErrorT io.Monad<IO>) - [file (:: @.System<IO> create-file path) + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) _ (:: file over-write dataL) _ (:: file append dataR) content (:: file content []) read-size (:: file size []) _ (:: file delete [])] (wrap (and (n/= (n/* 2 file-size) read-size) - (:: binary.Equivalence<Binary> = + (:: binary.equivalence = dataL (error.assume (binary.slice 0 (dec file-size) (integrity.trust content)))) - (:: binary.Equivalence<Binary> = + (:: binary.equivalence = dataR (error.assume (binary.slice file-size (dec read-size) (integrity.trust content))))))))] (assert "Can append to files." (error.default #0 result)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [path "temp_dir_4"] result (promise.future - (do (error.ErrorT io.Monad<IO>) + (do (error.ErrorT io.monad) [#let [check-existence! (: (IO (Error Bit)) - (io.from-io (@.exists? io.Monad<IO> @.System<IO> path)))] + (io.from-io (@.exists? io.monad @.system path)))] pre! check-existence! - dir (:: @.System<IO> create-directory path) + dir (:: @.system create-directory path) post! check-existence! _ (:: dir discard []) remains? check-existence!] @@ -122,13 +122,13 @@ (not remains?)))))] (assert "Can create/delete directories." (error.default #0 result)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [file-path "temp_file_5" dir-path "temp_dir_5"] result (promise.future - (do (error.ErrorT io.Monad<IO>) - [dir (:: @.System<IO> create-directory dir-path) - file (:: @.System<IO> create-file (format dir-path "/" file-path)) + (do (error.ErrorT io.monad) + [dir (:: @.system create-directory dir-path) + file (:: @.system create-file (format dir-path "/" file-path)) _ (:: file over-write dataL) read-size (:: file size []) _ (:: file delete []) @@ -136,18 +136,18 @@ (wrap (n/= file-size read-size))))] (assert "Can create files inside of directories." (error.default #0 result)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [file-path "temp_file_6" dir-path "temp_dir_6" inner-dir-path "inner_temp_dir_6"] result (promise.future - (do (error.ErrorT io.Monad<IO>) - [dir (:: @.System<IO> create-directory dir-path) + (do (error.ErrorT io.monad) + [dir (:: @.system create-directory dir-path) pre-files (:: dir files []) pre-directories (:: dir directories []) - file (:: @.System<IO> create-file (format dir-path "/" file-path)) - inner-dir (:: @.System<IO> create-directory (format dir-path "/" inner-dir-path)) + file (:: @.system create-file (format dir-path "/" file-path)) + inner-dir (:: @.system create-directory (format dir-path "/" inner-dir-path)) post-files (:: dir files []) post-directories (:: dir directories []) @@ -160,26 +160,26 @@ (n/= 1 (list.size post-directories)))))))] (assert "Can list files/directories inside a directory." (error.default #0 result)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [path "temp_file_7"] result (promise.future - (do (error.ErrorT io.Monad<IO>) - [file (:: @.System<IO> create-file path) + (do (error.ErrorT io.monad) + [file (:: @.system create-file path) _ (:: file over-write dataL) _ (:: file modify new-modified) old-modified (:: file last-modified []) _ (:: file delete [])] - (wrap (:: instant.Equivalence<Instant> = new-modified old-modified))))] + (wrap (:: instant.equivalence = new-modified old-modified))))] (assert "Can change the time of last modification." (error.default #0 result)))) - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [path0 (format "temp_file_8+0") path1 (format "temp_file_8+1")] result (promise.future - (do (error.ErrorT io.Monad<IO>) + (do (error.ErrorT io.monad) [#let [check-existence! (: (-> Path (IO (Error Bit))) - (|>> (@.exists? io.Monad<IO> @.System<IO>) io.from-io))] - file0 (:: @.System<IO> create-file path0) + (|>> (@.exists? io.monad @.system) io.from-io))] + file0 (:: @.system create-file path0) _ (:: file0 over-write dataL) pre! (check-existence! path0) file1 (: (IO (Error (File IO))) ## TODO: Remove : diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux index ecae405d7..fae5ac05d 100644 --- a/stdlib/test/test/lux/world/net/tcp.lux +++ b/stdlib/test/test/lux/world/net/tcp.lux @@ -8,7 +8,7 @@ ["." taint]]] [concurrency ["." promise (#+ Promise promise)] - [frp ("frp/." Functor<Channel>)]] + [frp ("frp/." functor)]] [data ["." error] ["." text @@ -28,7 +28,7 @@ (def: port (r.Random net.Port) (|> r.nat - (:: r.Monad<Random> map + (:: r.monad map (|>> (n/% 1000) (n/+ 8000))))) @@ -39,18 +39,18 @@ from (_binary.binary size) to (_binary.binary size)] ($_ seq - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [#let [from-worked? (: (Promise Bit) (promise #.Nil))] result (promise.future - (do io.Monad<Process> + (do io.monad [[server-close server] (@.server port) #let [_ (frp/map (function (_ client) (promise.future (do @ [[trasmission-size transmission] (:: client read size) #let [_ (io.run (promise.resolve (and (n/= size trasmission-size) - (:: binary.Equivalence<Binary> = from (taint.trust transmission))) + (:: binary.equivalence = from (taint.trust transmission))) from-worked?))]] (:: client write to)))) server)] @@ -59,7 +59,7 @@ #################### [trasmission-size transmission] (:: client read size) #let [to-worked? (and (n/= size trasmission-size) - (:: binary.Equivalence<Binary> = to (taint.trust transmission)))] + (:: binary.equivalence = to (taint.trust transmission)))] #################### _ (:: client close []) _ (io.from-io (promise.resolve [] server-close))] diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux index 9e0079211..2b85958fa 100644 --- a/stdlib/test/test/lux/world/net/udp.lux +++ b/stdlib/test/test/lux/world/net/udp.lux @@ -25,7 +25,7 @@ (def: port (r.Random net.Port) (|> r.nat - (:: r.Monad<Random> map + (:: r.monad map (|>> (n/% 1000) (n/+ 8000))))) @@ -36,21 +36,21 @@ from (_binary.binary size) to (_binary.binary size)] ($_ seq - (wrap (do promise.Monad<Promise> + (wrap (do promise.monad [result (promise.future - (do io.Monad<Process> + (do io.monad [server (@.server port) client @.client #################### _ (:: client write [[localhost port] from]) [bytes-from [from-address from-port] temp] (:: server read size) #let [from-worked? (and (n/= size bytes-from) - (:: binary.Equivalence<Binary> = from (integrity.trust temp)))] + (:: binary.equivalence = from (integrity.trust temp)))] #################### _ (:: server write [[from-address from-port] to]) [bytes-to [to-address to-port] temp] (:: client read size) #let [to-worked? (and (n/= size bytes-to) - (:: binary.Equivalence<Binary> = to (integrity.trust temp)) + (:: binary.equivalence = to (integrity.trust temp)) (n/= port to-port))] #################### _ (:: client close []) |