From d97f92842981501a8e0d95a1b4f1ba3d9e72f0d5 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 17 May 2020 20:10:42 -0400 Subject: Local binding names for (co|indexed-)?monads are now explicitly set. --- stdlib/source/test/licentia.lux | 4 ++-- stdlib/source/test/lux.lux | 5 ++--- stdlib/source/test/lux/abstract/apply.lux | 8 ++++---- stdlib/source/test/lux/abstract/functor.lux | 6 +++--- stdlib/source/test/lux/abstract/interval.lux | 8 ++++---- stdlib/source/test/lux/abstract/monad.lux | 4 ++-- stdlib/source/test/lux/abstract/predicate.lux | 2 +- stdlib/source/test/lux/control/concurrency/frp.lux | 2 +- .../test/lux/control/concurrency/process.lux | 2 +- .../test/lux/control/concurrency/promise.lux | 2 +- .../test/lux/control/concurrency/semaphore.lux | 22 +++++++++++----------- stdlib/source/test/lux/control/concurrency/stm.lux | 5 ++--- stdlib/source/test/lux/control/continuation.lux | 4 ++-- stdlib/source/test/lux/control/exception.lux | 2 +- stdlib/source/test/lux/control/function.lux | 2 +- stdlib/source/test/lux/control/parser.lux | 4 ++-- stdlib/source/test/lux/control/parser/cli.lux | 2 +- stdlib/source/test/lux/control/parser/text.lux | 2 +- stdlib/source/test/lux/control/pipe.lux | 2 +- stdlib/source/test/lux/control/region.lux | 20 ++++++++++---------- stdlib/source/test/lux/control/remember.lux | 2 +- stdlib/source/test/lux/control/state.lux | 2 +- stdlib/source/test/lux/data/binary.lux | 2 +- stdlib/source/test/lux/data/collection/array.lux | 8 ++++---- stdlib/source/test/lux/data/collection/bits.lux | 4 ++-- .../lux/data/collection/dictionary/ordered.lux | 2 +- stdlib/source/test/lux/data/collection/list.lux | 6 +++--- stdlib/source/test/lux/data/collection/queue.lux | 2 +- .../test/lux/data/collection/queue/priority.lux | 4 ++-- stdlib/source/test/lux/data/collection/row.lux | 2 +- .../source/test/lux/data/collection/sequence.lux | 2 +- .../test/lux/data/collection/set/ordered.lux | 2 +- stdlib/source/test/lux/data/collection/tree.lux | 2 +- .../test/lux/data/collection/tree/zipper.lux | 2 +- stdlib/source/test/lux/data/format/json.lux | 2 +- stdlib/source/test/lux/data/format/xml.lux | 4 ++-- stdlib/source/test/lux/data/name.lux | 2 +- stdlib/source/test/lux/data/number/complex.lux | 6 +++--- stdlib/source/test/lux/data/number/i16.lux | 2 +- stdlib/source/test/lux/data/number/i32.lux | 2 +- stdlib/source/test/lux/data/number/i64.lux | 2 +- stdlib/source/test/lux/data/number/i8.lux | 2 +- stdlib/source/test/lux/data/text.lux | 6 +++--- stdlib/source/test/lux/extension.lux | 9 +++++---- stdlib/source/test/lux/host.jvm.lux | 6 +++--- stdlib/source/test/lux/host.old.lux | 2 +- stdlib/source/test/lux/macro/code.lux | 2 +- stdlib/source/test/lux/macro/poly/equivalence.lux | 2 +- stdlib/source/test/lux/macro/poly/json.lux | 2 +- stdlib/source/test/lux/math.lux | 8 ++++---- stdlib/source/test/lux/math/logic/fuzzy.lux | 2 +- stdlib/source/test/lux/target/jvm.lux | 20 ++++++++++---------- stdlib/source/test/lux/time/duration.lux | 2 +- .../test/lux/tool/compiler/default/syntax.lux | 4 ++-- .../test/lux/tool/compiler/phase/analysis/case.lux | 14 +++++++------- .../lux/tool/compiler/phase/analysis/function.lux | 2 +- .../lux/tool/compiler/phase/analysis/reference.lux | 2 +- .../lux/tool/compiler/phase/analysis/structure.lux | 8 ++++---- .../tool/compiler/phase/extension/analysis/lux.lux | 10 +++++----- .../lux/tool/compiler/phase/synthesis/case.lux | 2 +- .../lux/tool/compiler/phase/synthesis/function.lux | 8 ++++---- .../tool/compiler/phase/synthesis/structure.lux | 4 ++-- stdlib/source/test/lux/type.lux | 8 ++++---- stdlib/source/test/lux/type/check.lux | 6 +++--- stdlib/source/test/lux/world/file.lux | 2 +- 65 files changed, 151 insertions(+), 152 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux index 61bdbb0b2..619d9c711 100644 --- a/stdlib/source/test/licentia.lux +++ b/stdlib/source/test/licentia.lux @@ -42,7 +42,7 @@ (def: period (Random (Period Nat)) - (do r.monad + (do {@ r.monad} [start (r.filter (|>> (n.= n@top) not) r.nat) #let [wiggle-room (n.- start n@top)] @@ -104,7 +104,7 @@ (def: (variable-list max-size gen-element) (All [a] (-> Nat (Random a) (Random (List a)))) - (do r.monad + (do {@ r.monad} [amount (:: @ map (n.% (n.max 1 max-size)) r.nat)] (r.list amount gen-element))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index c43c2abf4..14360da93 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -158,7 +158,7 @@ (def: identity Test - (do random.monad + (do {@ random.monad} [self (random.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." @@ -375,8 +375,7 @@ /world.test /host.test /extension.test - /target/jvm.test - )) + /target/jvm.test)) ))) (program: args diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index c9a6be500..29e3e9d6f 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -16,7 +16,7 @@ (def: (identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) @@ -25,7 +25,7 @@ (def: (homomorphism injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." @@ -35,7 +35,7 @@ (def: (interchange injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat)] (_.test "Interchange." @@ -45,7 +45,7 @@ (def: (composition injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat) decrease (:: @ map n.- random.nat)] diff --git a/stdlib/source/test/lux/abstract/functor.lux b/stdlib/source/test/lux/abstract/functor.lux index 0702f00ef..fcceca39b 100644 --- a/stdlib/source/test/lux/abstract/functor.lux +++ b/stdlib/source/test/lux/abstract/functor.lux @@ -28,7 +28,7 @@ (def: (identity injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do random.monad + (do {@ random.monad} [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) @@ -37,7 +37,7 @@ (def: (homomorphism injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." @@ -47,7 +47,7 @@ (def: (composition injection comparison (^open "/@.")) (All [f] (-> (Injection f) (Comparison f) (Functor f) Test)) - (do random.monad + (do {@ random.monad} [sample (:: @ map injection random.nat) increase (:: @ map n.+ random.nat) decrease (:: @ map n.- random.nat)] diff --git a/stdlib/source/test/lux/abstract/interval.lux b/stdlib/source/test/lux/abstract/interval.lux index c6f2cd36f..d57dfb5d2 100644 --- a/stdlib/source/test/lux/abstract/interval.lux +++ b/stdlib/source/test/lux/abstract/interval.lux @@ -137,7 +137,7 @@ (def: location Test - (do random.monad + (do {@ random.monad} [[l m r] (|> (random.set n.hash 3 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) @@ -159,7 +159,7 @@ (def: touch Test - (do random.monad + (do {@ random.monad} [[b t1 t2] (|> (random.set n.hash 3 random.nat) (:: @ map (|>> set.to-list (list.sort n.<) @@ -185,7 +185,7 @@ (def: nested Test - (do random.monad + (do {@ random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) (:: @ map (|>> set.to-list @@ -218,7 +218,7 @@ (def: overlap Test - (do random.monad + (do {@ random.monad} [some-interval ..interval [x0 x1 x2 x3] (|> (random.set n.hash 4 random.nat) (:: @ map (|>> set.to-list diff --git a/stdlib/source/test/lux/abstract/monad.lux b/stdlib/source/test/lux/abstract/monad.lux index 4d85a6e90..cc504777c 100644 --- a/stdlib/source/test/lux/abstract/monad.lux +++ b/stdlib/source/test/lux/abstract/monad.lux @@ -16,7 +16,7 @@ (def: (left-identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat morphism (:: @ map (function (_ diff) (|>> (n.+ diff) _@wrap)) @@ -37,7 +37,7 @@ (def: (associativity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Monad f) Test)) - (do random.monad + (do {@ random.monad} [sample random.nat increase (:: @ map (function (_ diff) (|>> (n.+ diff) _@wrap)) diff --git a/stdlib/source/test/lux/abstract/predicate.lux b/stdlib/source/test/lux/abstract/predicate.lux index fe942a044..3831ac0fb 100644 --- a/stdlib/source/test/lux/abstract/predicate.lux +++ b/stdlib/source/test/lux/abstract/predicate.lux @@ -30,7 +30,7 @@ (let [/2? (multiple? 2) /3? (multiple? 3)] (<| (_.context (%.name (name-of /.Predicate))) - (do r.monad + (do {@ r.monad} [sample r.nat]) ($_ _.and (_.test (%.name (name-of /.none)) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index e6c8c179d..77c024d33 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -121,7 +121,7 @@ (_.claim [/.filter] (list@= (list.filter n.even? inputs) output)))) - (wrap (do promise.monad + (wrap (do {@ promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) channel (/.sequential 0 inputs)] diff --git a/stdlib/source/test/lux/control/concurrency/process.lux b/stdlib/source/test/lux/control/concurrency/process.lux index 165fbad93..fc818e22d 100644 --- a/stdlib/source/test/lux/control/concurrency/process.lux +++ b/stdlib/source/test/lux/control/concurrency/process.lux @@ -23,7 +23,7 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad + (do {@ random.monad} [dummy random.nat expected random.nat delay (|> random.nat (:: @ map (n.% 100)))] diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 3e2d8982b..2eb43c596 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -47,7 +47,7 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad + (do {@ random.monad} [to-wait (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) #let [extra-time (n.* 2 to-wait)] expected random.nat diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index e26c1a0f2..6b382f6de 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -29,7 +29,7 @@ Test (_.with-cover [/.Semaphore] ($_ _.and - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad @@ -41,10 +41,10 @@ #.None false))))) - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [_ (monad.map @ /.wait (list.repeat initial-open-positions semaphore)) result (promise.time-out 10 (/.wait semaphore))] (_.claim [/.wait] @@ -54,10 +54,10 @@ #.None true))))) - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [_ (monad.map @ /.wait (list.repeat initial-open-positions semaphore)) #let [block (/.wait semaphore)] result/0 (promise.time-out 10 block) @@ -70,7 +70,7 @@ _ false))))) - (do random.monad + (do {@ random.monad} [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad @@ -88,7 +88,7 @@ Test (_.with-cover [/.Mutex] ($_ _.and - (do random.monad + (do {@ random.monad} [repetitions (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) #let [resource (atom.atom "") expected-As (text.join-with "" (list.repeat repetitions "A")) @@ -97,7 +97,7 @@ processA (<| (/.synchronize mutex) io.io promise.future - (do io.monad + (do {@ io.monad} [_ (<| (monad.seq @) (list.repeat repetitions) (atom.update (|>> (format "A")) resource))] @@ -105,7 +105,7 @@ processB (<| (/.synchronize mutex) io.io promise.future - (do io.monad + (do {@ io.monad} [_ (<| (monad.seq @) (list.repeat repetitions) (atom.update (|>> (format "B")) resource))] @@ -142,11 +142,11 @@ [_ (#.Some limit)] (and (n.> 0 raw) (n.= raw (refinement.un-refine limit)))))) - (do random.monad + (do {@ random.monad} [limit (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) #let [barrier (/.barrier (maybe.assume (/.limit limit))) resource (atom.atom "")]] - (wrap (do promise.monad + (wrap (do {@ promise.monad} [#let [ending (|> "_" (list.repeat limit) (text.join-with "")) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 07d0c946b..ab795ea79 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -11,7 +11,6 @@ [control ["." io (#+ IO)]] [data - ["%" text/format (#+ format)] [number ["n" nat]] [collection @@ -47,7 +46,7 @@ (def: #export test Test (<| (_.covering /._) - (do random.monad + (do {@ random.monad} [dummy random.nat expected random.nat iterations-per-process (|> random.nat (:: @ map (n.% 100)))] @@ -101,7 +100,7 @@ (list expected (n.* 2 expected)) changes)))) (wrap (let [var (/.var 0)] - (do promise.monad + (do {@ promise.monad} [_ (|> (list.repeat iterations-per-process []) (list@map (function (_ _) (/.commit (/.update inc var)))) (monad.seq @)) diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux index 8d6724614..1d07460c9 100644 --- a/stdlib/source/test/lux/control/continuation.lux +++ b/stdlib/source/test/lux/control/continuation.lux @@ -47,7 +47,7 @@ (_.test "Can use the current-continuation as a escape hatch." (n.= (n.* 2 sample) - (/.run (do /.monad + (/.run (do {@ /.monad} [value (/.call/cc (function (_ k) (do @ @@ -77,7 +77,7 @@ (_@wrap #.Nil) (#.Cons x xs') - (do /.monad + (do {@ /.monad} [output (/.shift (function (_ k) (do @ [tail (k xs')] diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 5d0fa3d47..8d54fa893 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -24,7 +24,7 @@ (def: #export test Test - (do random.monad + (do {@ random.monad} [expected random.nat wrong (|> random.nat (random.filter (|>> (n.= expected) not))) assertion-succeeded? random.bit diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index f7d4d7678..5244ad60b 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -20,7 +20,7 @@ (def: #export test Test - (do random.monad + (do {@ random.monad} [expected random.nat f0 (:: @ map n.+ random.nat) f1 (:: @ map n.* random.nat) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index bcb958210..3c6501afe 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -75,7 +75,7 @@ (def: combinators-0 Test - (do random.monad + (do {@ random.monad} [expected0 random.nat variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat) expected+ (random.list variadic random.nat) @@ -166,7 +166,7 @@ (def: combinators-1 Test - (do random.monad + (do {@ random.monad} [variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat) times (:: @ map (n.% variadic) random.nat) expected random.nat diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index c41a33878..210a1b5b5 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -21,7 +21,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [num-args (|> r.nat (:: @ map (n.% 10))) #let [gen-arg (:: @ map n@encode r.nat)] yes gen-arg diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 441f2f5da..d4f2568eb 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -42,7 +42,7 @@ (|> (/.run /.end "") (case> (#.Right _) true _ false))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) sample (r.unicode size) non-sample (|> (r.unicode size) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index d705e23ca..7bf7e5e0f 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -18,7 +18,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [sample r.nat] ($_ _.and (do @ diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index eec4e6903..d911c15d5 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -66,7 +66,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected-clean-ups (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1))))] ($_ _.and ($functor.spec ..injection ..comparison (: (All [! r] @@ -81,7 +81,7 @@ (_.test (%.name (name-of /.run)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -89,7 +89,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups))] (wrap []))) @@ -99,7 +99,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.fail)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -107,7 +107,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups)) _ (/.fail //@ (exception.construct ..oops []))] @@ -118,7 +118,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.throw)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -126,7 +126,7 @@ [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups)) _ (/.throw //@ ..oops [])] @@ -137,7 +137,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.acquire)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @ count-clean-up (function (_ value) @@ -146,7 +146,7 @@ (wrap (: (Try Any) (exception.throw ..oops [])))))] outcome (/.run @ - (do (/.monad @) + (do {@ (/.monad @)} [_ (monad.map @ (/.acquire //@ count-clean-up) (list.n/range 1 expected-clean-ups))] (wrap []))) @@ -157,7 +157,7 @@ actual-clean-ups)))))) (_.test (%.name (name-of /.lift)) (thread.run - (do thread.monad + (do {@ thread.monad} [clean-up-counter (thread.box 0) #let [//@ @] outcome (/.run @ diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux index 0b5537ef0..66add3672 100644 --- a/stdlib/source/test/lux/control/remember.lux +++ b/stdlib/source/test/lux/control/remember.lux @@ -67,7 +67,7 @@ prng (random.pcg-32 [123 (instant.to-millis now)]) message (product.right (random.run prng ..message)) expected (product.right (random.run prng ..focus))] - (do @ + (do macro.monad [should-fail0 (..try (macro.expand (to-remember macro yesterday message #.None))) should-fail1 (..try (macro.expand (to-remember macro yesterday message (#.Some expected)))) should-succeed0 (..try (macro.expand (to-remember macro tomorrow message #.None))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 72284ba5c..2475692ff 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -83,7 +83,7 @@ (def: loops Test - (do random.monad + (do {@ random.monad} [limit (|> random.nat (:: @ map (n.% 10))) #let [condition (do /.monad [state /.get] diff --git a/stdlib/source/test/lux/data/binary.lux b/stdlib/source/test/lux/data/binary.lux index 9889fa0ae..915260f35 100644 --- a/stdlib/source/test/lux/data/binary.lux +++ b/stdlib/source/test/lux/data/binary.lux @@ -55,7 +55,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [#let [gen-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 8))))] binary-size gen-size random-binary (binary binary-size) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index c6dc407eb..5ba6f453f 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -35,7 +35,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Array))) - (do r.monad + (do {@ r.monad} [size bounded-size] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (r.array size r.nat)) @@ -43,7 +43,7 @@ ($functor.spec ..injection /.equivalence /.functor) ($fold.spec ..injection /.equivalence /.fold) - (do r.monad + (do @ [size bounded-size original (r.array size r.nat)] ($_ _.and @@ -74,7 +74,7 @@ /.to-list /.from-list (:: (/.equivalence n.equivalence) = original))) )) - (do r.monad + (do @ [size bounded-size idx (:: @ map (n.% size) r.nat) array (|> (r.array size r.nat) @@ -99,7 +99,7 @@ (n.= size (n.+ (/.occupied array) (/.vacant array)))))) )) - (do r.monad + (do @ [size bounded-size array (|> (r.array size r.nat) (r.filter (|>> /.to-list (list.any? n.even?))))] diff --git a/stdlib/source/test/lux/data/collection/bits.lux b/stdlib/source/test/lux/data/collection/bits.lux index 77e346116..60b939645 100644 --- a/stdlib/source/test/lux/data/collection/bits.lux +++ b/stdlib/source/test/lux/data/collection/bits.lux @@ -23,7 +23,7 @@ (def: #export bits (Random Bits) - (do r.monad + (do {@ r.monad} [size (size 1 1,000) idx (|> r.nat (:: @ map (n.% size)))] (wrap (|> /.empty (/.set idx))))) @@ -33,7 +33,7 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and ($equivalence.spec /.equivalence ..bits) - (do r.monad + (do {@ r.monad} [size (size 1 1,000) idx (|> r.nat (:: @ map (n.% size))) sample bits] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index 19b124c40..f0d7c8222 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -40,7 +40,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Dictionary))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 100))) keys (r.set n.hash size r.nat) values (r.set n.hash size r.nat) diff --git a/stdlib/source/test/lux/data/collection/list.lux b/stdlib/source/test/lux/data/collection/list.lux index 954e3f15d..faa3dfda3 100644 --- a/stdlib/source/test/lux/data/collection/list.lux +++ b/stdlib/source/test/lux/data/collection/list.lux @@ -34,7 +34,7 @@ (def: signatures Test - (do r.monad + (do {@ r.monad} [size bounded-size] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (r.list size r.nat)) @@ -65,7 +65,7 @@ (def: #export test Test (<| (_.context (%.name (name-of .List))) - (do r.monad + (do {@ r.monad} [size bounded-size #let [(^open "/@.") (/.equivalence n.equivalence) (^open "/@.") /.functor @@ -180,7 +180,7 @@ (/@map product.left enum-sample)) (/@= sample (/@map product.right enum-sample))))) - (do r.monad + (do @ [from (|> r.nat (:: @ map (n.% 10))) to (|> r.nat (:: @ map (n.% 10)))] (_.test "Ranges can be constructed forward and backwards." diff --git a/stdlib/source/test/lux/data/collection/queue.lux b/stdlib/source/test/lux/data/collection/queue.lux index 64e9c5e56..a636e7164 100644 --- a/stdlib/source/test/lux/data/collection/queue.lux +++ b/stdlib/source/test/lux/data/collection/queue.lux @@ -23,7 +23,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Queue))) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 100) r.nat) sample (r.queue size r.nat) non-member (|> r.nat diff --git a/stdlib/source/test/lux/data/collection/queue/priority.lux b/stdlib/source/test/lux/data/collection/queue/priority.lux index 78e4bc2b8..7f9b42046 100644 --- a/stdlib/source/test/lux/data/collection/queue/priority.lux +++ b/stdlib/source/test/lux/data/collection/queue/priority.lux @@ -15,7 +15,7 @@ (def: #export (queue size) (-> Nat (Random (Queue Nat))) - (do r.monad + (do {@ r.monad} [inputs (r.list size r.nat)] (monad.fold @ (function (_ head tail) (do @ @@ -27,7 +27,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Queue))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 100))) sample (..queue size) non-member-priority r.nat diff --git a/stdlib/source/test/lux/data/collection/row.lux b/stdlib/source/test/lux/data/collection/row.lux index c6f462825..1c7a5878a 100644 --- a/stdlib/source/test/lux/data/collection/row.lux +++ b/stdlib/source/test/lux/data/collection/row.lux @@ -27,7 +27,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (r.row size r.nat)) diff --git a/stdlib/source/test/lux/data/collection/sequence.lux b/stdlib/source/test/lux/data/collection/sequence.lux index 6e4f59930..4b204d37a 100644 --- a/stdlib/source/test/lux/data/collection/sequence.lux +++ b/stdlib/source/test/lux/data/collection/sequence.lux @@ -21,7 +21,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Sequence))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2)))) offset (|> r.nat (:: @ map (n.% 100))) factor (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2)))) diff --git a/stdlib/source/test/lux/data/collection/set/ordered.lux b/stdlib/source/test/lux/data/collection/set/ordered.lux index 30ff8f6db..45f73fd27 100644 --- a/stdlib/source/test/lux/data/collection/set/ordered.lux +++ b/stdlib/source/test/lux/data/collection/set/ordered.lux @@ -46,7 +46,7 @@ ($_ _.and ($equivalence.spec /.equivalence (..set n.order r.nat size)) )) - (do r.monad + (do {@ r.monad} [sizeL gen-nat sizeR gen-nat listL (|> (r.set n.hash sizeL gen-nat) (:: @ map //.to-list)) diff --git a/stdlib/source/test/lux/data/collection/tree.lux b/stdlib/source/test/lux/data/collection/tree.lux index f42bc4f4d..862c5a973 100644 --- a/stdlib/source/test/lux/data/collection/tree.lux +++ b/stdlib/source/test/lux/data/collection/tree.lux @@ -48,7 +48,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Tree))) - (do r.monad + (do {@ r.monad} [size (:: @ map (|>> (n.% 100) (n.+ 1)) r.nat)] ($_ _.and ($equivalence.spec (/.equivalence n.equivalence) (..tree size r.nat)) diff --git a/stdlib/source/test/lux/data/collection/tree/zipper.lux b/stdlib/source/test/lux/data/collection/tree/zipper.lux index 9ed7da62e..74fda6cc1 100644 --- a/stdlib/source/test/lux/data/collection/tree/zipper.lux +++ b/stdlib/source/test/lux/data/collection/tree/zipper.lux @@ -23,7 +23,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /.Zipper))) - (do r.monad + (do {@ r.monad} [size (:: @ map (|>> (n.% 90) (n.+ 10)) r.nat) sample (//.tree size r.nat) mid-val r.nat diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux index 686edae01..ded118074 100644 --- a/stdlib/source/test/lux/data/format/json.lux +++ b/stdlib/source/test/lux/data/format/json.lux @@ -47,7 +47,7 @@ (def: #export json (Random JSON) (r.rec (function (_ recur) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 2) r.nat)] ($_ r.or (:: @ wrap []) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index a3dc6b0e0..47c16f72d 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -35,7 +35,7 @@ (def: char (Random Nat) - (do r.monad + (do {@ r.monad} [idx (|> r.nat (:: @ map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) @@ -73,7 +73,7 @@ ($equivalence.spec /.equivalence ..xml) ($codec.spec /.equivalence /.codec ..xml) - (do r.monad + (do {@ r.monad} [text (..text 1 10) num-children (|> r.nat (:: @ map (n.% 5))) children (r.list num-children (..text 1 10)) diff --git a/stdlib/source/test/lux/data/name.lux b/stdlib/source/test/lux/data/name.lux index 6190ab19a..57eed0237 100644 --- a/stdlib/source/test/lux/data/name.lux +++ b/stdlib/source/test/lux/data/name.lux @@ -31,7 +31,7 @@ (def: #export test Test (<| (_.context (%.name (name-of .Name))) - (do r.monad + (do {@ r.monad} [## First Name sizeM1 (|> r.nat (:: @ map (n.% 100))) sizeS1 (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) diff --git a/stdlib/source/test/lux/data/number/complex.lux b/stdlib/source/test/lux/data/number/complex.lux index 5890ce0d4..c7131575d 100644 --- a/stdlib/source/test/lux/data/number/complex.lux +++ b/stdlib/source/test/lux/data/number/complex.lux @@ -34,7 +34,7 @@ (def: dimension (Random Frac) - (do r.monad + (do {@ r.monad} [factor (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1)))) measure (|> r.safe-frac (r.filter (f.> +0.0)))] (wrap (f.* (|> factor .int int.frac) @@ -159,7 +159,7 @@ (def: trigonometry Test - (do r.monad + (do {@ r.monad} [angle (|> ..complex (:: @ map (|>> (update@ #/.real (f.% +1.0)) (update@ #/.imaginary (f.% +1.0)))))] ($_ _.and @@ -183,7 +183,7 @@ (def: root Test - (do r.monad + (do {@ r.monad} [sample ..complex degree (|> r.nat (:: @ map (|>> (n.max 1) (n.% 5))))] (_.test "Can calculate the N roots for any complex number." diff --git a/stdlib/source/test/lux/data/number/i16.lux b/stdlib/source/test/lux/data/number/i16.lux index d44ce68f0..c90b17dc3 100644 --- a/stdlib/source/test/lux/data/number/i16.lux +++ b/stdlib/source/test/lux/data/number/i16.lux @@ -28,7 +28,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i16) diff --git a/stdlib/source/test/lux/data/number/i32.lux b/stdlib/source/test/lux/data/number/i32.lux index ae7e0ae41..eb643c9d3 100644 --- a/stdlib/source/test/lux/data/number/i32.lux +++ b/stdlib/source/test/lux/data/number/i32.lux @@ -28,7 +28,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i32) diff --git a/stdlib/source/test/lux/data/number/i64.lux b/stdlib/source/test/lux/data/number/i64.lux index 838746854..4305bf461 100644 --- a/stdlib/source/test/lux/data/number/i64.lux +++ b/stdlib/source/test/lux/data/number/i64.lux @@ -22,7 +22,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [pattern r.nat idx (:: @ map (//nat.% /.width) r.nat)] ($_ _.and diff --git a/stdlib/source/test/lux/data/number/i8.lux b/stdlib/source/test/lux/data/number/i8.lux index dc4b799fe..7cd4a5149 100644 --- a/stdlib/source/test/lux/data/number/i8.lux +++ b/stdlib/source/test/lux/data/number/i8.lux @@ -28,7 +28,7 @@ (def: #export test Test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [expected (:: @ map (|>> (//i64.and ..mask) (: I64)) r.i64)] ($_ _.and ($equivalence.spec /.equivalence ..i8) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index b3cd2e735..c10d7a67e 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -32,7 +32,7 @@ ($equivalence.spec /.equivalence (r.ascii 2)) ($order.spec /.order (r.ascii 2)) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 10) r.nat) sample (r.unicode size)] ($_ _.and @@ -41,7 +41,7 @@ (_.test "Text with size 0 is considered 'empty'." (or (not (n.= 0 size)) (/.empty? sample))))) - (do r.monad + (do {@ r.monad} [size bounded-size idx (:: @ map (n.% size) r.nat) sample (r.unicode size)] @@ -110,7 +110,7 @@ _ #0))) )) - (do r.monad + (do {@ r.monad} [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 6160294c4..5efd43701 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -14,6 +14,7 @@ ["%" format (#+ format)]]] [tool [compiler + ["." phase] [language [lux ["." analysis] @@ -38,13 +39,13 @@ (as-is (generation: (..my-generation self phase {parameters (<>.some .any)}) (#try.Success (#jvm.Constant (#jvm.LDC (#jvm.String Text))))))} (as-is (analysis: (..my-analysis self phase {parameters (<>.some .any)}) - (do @ + (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Text self)))) ## Synthesis (analysis: (..my-synthesis self phase {parameters (<>.some .any)}) - (do @ + (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) @@ -53,7 +54,7 @@ ## Generation (analysis: (..my-generation self phase {parameters (<>.some .any)}) - (do @ + (do phase.monad [_ (type.infer .Text)] (wrap (#analysis.Extension self (list))))) @@ -62,7 +63,7 @@ ## Directive (directive: (..my-directive self phase {parameters (<>.some .any)}) - (do @ + (do phase.monad [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]] (wrap directive.no-requirements))) diff --git a/stdlib/source/test/lux/host.jvm.lux b/stdlib/source/test/lux/host.jvm.lux index 2bba4c4a7..65011a929 100644 --- a/stdlib/source/test/lux/host.jvm.lux +++ b/stdlib/source/test/lux/host.jvm.lux @@ -93,8 +93,8 @@ (def: miscellaneous Test - (do r.monad - [sample (:: @ map (|>> (:coerce java/lang/Object )) + (do {@ r.monad} + [sample (:: @ map (|>> (:coerce java/lang/Object)) (r.ascii 1))] ($_ _.and (_.test "Can check if an object is of a certain class." @@ -124,7 +124,7 @@ (def: arrays Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 1)))) idx (|> r.nat (:: @ map (n.% size))) value (:: @ map (|>> (:coerce java/lang/Long)) r.int)] diff --git a/stdlib/source/test/lux/host.old.lux b/stdlib/source/test/lux/host.old.lux index 9258aa5de..e297c1411 100644 --- a/stdlib/source/test/lux/host.old.lux +++ b/stdlib/source/test/lux/host.old.lux @@ -114,7 +114,7 @@ (def: arrays Test - (do r.monad + (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/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 00d734ee7..cc2d8012d 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -15,7 +15,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [bit r.bit nat r.nat int r.int diff --git a/stdlib/source/test/lux/macro/poly/equivalence.lux b/stdlib/source/test/lux/macro/poly/equivalence.lux index 7ba3bbd13..8280e000e 100644 --- a/stdlib/source/test/lux/macro/poly/equivalence.lux +++ b/stdlib/source/test/lux/macro/poly/equivalence.lux @@ -49,7 +49,7 @@ (def: gen-record (Random Record) - (do random.monad + (do {@ random.monad} [size (:: @ map (n.% 2) random.nat) #let [gen-int (|> random.int (:: @ map (|>> i.abs (i.% +1,000,000))))]] ($_ random.and diff --git a/stdlib/source/test/lux/macro/poly/json.lux b/stdlib/source/test/lux/macro/poly/json.lux index 063a20518..ae7c62655 100644 --- a/stdlib/source/test/lux/macro/poly/json.lux +++ b/stdlib/source/test/lux/macro/poly/json.lux @@ -89,7 +89,7 @@ (def: gen-record (Random Record) - (do r.monad + (do {@ r.monad} [size (:: @ map (n.% 2) r.nat)] ($_ r.and r.bit diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 17ed2086c..c29b25b97 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -36,7 +36,7 @@ (<| (_.context (%.name (name-of /._))) ($_ _.and (<| (_.context "Trigonometry") - (do r.monad + (do {@ r.monad} [angle (|> r.safe-frac (:: @ map (f.* /.tau)))] ($_ _.and (_.test "Sine and arc-sine are inverse functions." @@ -47,7 +47,7 @@ (trigonometric-symmetry /.tan /.atan angle)) ))) (<| (_.context "Rounding") - (do r.monad + (do {@ r.monad} [sample (|> r.safe-frac (:: @ map (f.* +1000.0)))] ($_ _.and (_.test "The ceiling will be an integer value, and will be >= the original." @@ -66,12 +66,12 @@ (f.<= +1.0 (f.abs (f.- sample round'd)))))) ))) (<| (_.context "Exponentials and logarithms") - (do r.monad + (do {@ r.monad} [sample (|> r.safe-frac (:: @ map (f.* +10.0)))] (_.test "Logarithm is the inverse of exponential." (|> sample /.exp /.log (within? +0.000000000000001 sample))))) (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") - (do r.monad + (do {@ r.monad} [#let [gen-nat (|> r.nat (:: @ map (|>> (n.% 1000) (n.max 1))))] x gen-nat y gen-nat] diff --git a/stdlib/source/test/lux/math/logic/fuzzy.lux b/stdlib/source/test/lux/math/logic/fuzzy.lux index e53028522..eeace02be 100644 --- a/stdlib/source/test/lux/math/logic/fuzzy.lux +++ b/stdlib/source/test/lux/math/logic/fuzzy.lux @@ -141,7 +141,7 @@ (def: predicates-and-sets Test - (do random.monad + (do {@ random.monad} [#let [set-10 (set.from-list n.hash (list.n/range 0 10))] sample (|> random.nat (:: @ map (n.% 20)))] ($_ _.and diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index a4a13cbe4..0ccd4c5e3 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -280,7 +280,7 @@ (template [ ] [(def: Test - (do random.monad + (do {@ random.monad} [expected (:: @ map (i64.and (i64.mask )) random.nat)] (<| (_.lift ) (..bytecode (|>> (:coerce ) ("jvm leq" expected))) @@ -327,7 +327,7 @@ instruction))))) shift (: (-> (-> java/lang/Integer java/lang/Integer java/lang/Integer) (Bytecode Any) (Random Bit)) (function (_ reference instruction) - (do random.monad + (do {@ random.monad} [parameter (:: @ map (|>> (n.% 32) .int host.long-to-int) random.nat) subject ..$Integer::random] (int (reference parameter subject) @@ -400,7 +400,7 @@ instruction))))) shift (: (-> (-> Nat Int Int) (Bytecode Any) (Random Bit)) (function (_ reference instruction) - (do random.monad + (do {@ random.monad} [parameter (:: @ map (n.% 64) random.nat) subject ..$Long::random] (long (reference parameter subject) @@ -816,7 +816,7 @@ (-> a Any Bit) Test)) (function (_ constructor random literal [*store *load *wrap] test) - (do random.monad + (do {@ random.monad} [size (:: @ map (|>> (n.% 1024) (n.max 1)) random.nat) value random] ($_ _.and @@ -853,7 +853,7 @@ (array (/.anewarray ..$String) $String::random $String::literal [/.aastore /.aaload /.nop] (function (_ expected) (|>> (:coerce Text) (text@= expected))))) (<| (_.context "multi") - (do random.monad + (do {@ random.monad} [#let [size (:: @ map (|>> (n.% 10) (n.+ 1)) random.nat)] dimensions size @@ -867,7 +867,7 @@ _ (recur (dec dimensions) (/type.array type))))]] (<| (_.lift "MULTIANEWARRAY") (..bytecode (|>> (:coerce java/lang/Long) ("jvm leq" (.int sizesH)))) - (do /.monad + (do {@ /.monad} [_ (monad.map @ (|>> host.long-to-int ..$Integer::literal) (#.Cons sizesH sizesT)) _ (/.multianewarray type (|> dimensions /unsigned.u1 try.assume)) @@ -974,7 +974,7 @@ (-> a (-> Any Bit)) (Random Bit))) (function (_ random-value literal *wrap [store load] test) - (do random.monad + (do {@ random.monad} [expected random-value register (:: @ map (n.% 128) random.nat)] (<| (..bytecode (test expected)) @@ -999,7 +999,7 @@ (function (_ expected actual) (|> actual (:coerce java/lang/Integer) ("jvm ieq" expected))))) (_.lift "IINC" - (do random.monad + (do {@ random.monad} [base ..$Byte::random increment (:: @ map (|>> (n.% 100) /unsigned.u1 try.assume) random.nat) @@ -1313,7 +1313,7 @@ Test ($_ _.and (<| (_.lift "TABLESWITCH") - (do random.monad + (do {@ random.monad} [expected ..$Long::random dummy ..$Long::random minimum (:: @ map (|>> (n.% 100) .int /signed.s4 try.assume) @@ -1334,7 +1334,7 @@ _ (/.set-label @return)] ..$Long::wrap)) (<| (_.lift "LOOKUPSWITCH") - (do random.monad + (do {@ random.monad} [options (:: @ map (|>> (n.% 10) (n.+ 1)) random.nat) choice (:: @ map (n.% options) random.nat) diff --git a/stdlib/source/test/lux/time/duration.lux b/stdlib/source/test/lux/time/duration.lux index fe196cb29..12c4b41ba 100644 --- a/stdlib/source/test/lux/time/duration.lux +++ b/stdlib/source/test/lux/time/duration.lux @@ -37,7 +37,7 @@ [millis r.int] (_.test "Can convert from/to milliseconds." (|> millis /.from-millis /.to-millis (i.= millis)))) - (do r.monad + (do {@ r.monad} [sample (|> duration (:: @ map (/.frame /.day))) frame duration factor (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1)))) diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/default/syntax.lux index 2b53cbfdb..4baa57891 100644 --- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/default/syntax.lux @@ -30,7 +30,7 @@ (def: name-part^ (Random Text) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 20) (n.max 1))))] (r.ascii/lower-alpha size))) @@ -77,7 +77,7 @@ (def: code Test - (do r.monad + (do {@ r.monad} [sample code^] ($_ _.and (_.test "Can parse Lux code." diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux index 1a74a3cf2..1ca4718c1 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/case.lux @@ -57,7 +57,7 @@ (^template [ ] [_ ( _)] (if allow-literals? - (do r.monad + (do {@ r.monad} [?sample (r.maybe )] (case ?sample (#.Some sample) @@ -78,7 +78,7 @@ (r@wrap (list (' []))) [_ (#.Tuple members)] - (do r.monad + (do {@ r.monad} [member-wise-patterns (monad.map @ (exhaustive-branches allow-literals? variantTC) members)] (wrap (|> member-wise-patterns exhaustive-weaving @@ -88,7 +88,7 @@ (r@wrap (list (' {}))) [_ (#.Record kvs)] - (do r.monad + (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)] @@ -97,7 +97,7 @@ (list@map (|>> (list.zip2 ks) code.record))))) (^ [_ (#.Form (list [_ (#.Tag _)] _))]) - (do r.monad + (do {@ r.monad} [bundles (monad.map @ (function (_ [_tag _code]) (do @ @@ -117,12 +117,12 @@ (function (_ input) ($_ r.either (r@map product.right _primitive.primitive) - (do r.monad + (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 + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) elems (r.list size input)] (wrap (code.tuple elems))) @@ -135,7 +135,7 @@ (def: #export test (<| (_.context (name.module (name-of /._))) - (do r.monad + (do {@ r.monad} [module-name (r.unicode 5) variant-name (r.unicode 5) record-name (|> (r.unicode 5) (r.filter (|>> (text@= variant-name) not))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux index 721e17b14..fc07f8963 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/function.lux @@ -75,7 +75,7 @@ )))) (def: apply - (do r.monad + (do {@ r.monad} [full-args (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) partial-args (|> r.nat (:: @ map (n.% full-args))) var-idx (|> r.nat (:: @ map (|>> (n.% full-args) (n.max 1)))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux index 1c23b1c8a..9cb0c1170 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux @@ -45,7 +45,7 @@ (def: (reach-test var-name [export? def-module] [import? dependent-module] check!) (-> Text [Bit Text] [Bit Text] Check Bit) - (|> (do ///.monad + (|> (do {@ ///.monad} [_ (//module.with-module 0 def-module (//module.define var-name (#.Right [export? Any (' {}) []])))] (//module.with-module 0 dependent-module diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux index ad2233b26..05461adf6 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/structure.lux @@ -113,7 +113,7 @@ false))) (def: sum - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) choice (|> r.nat (:: @ map (n.% size))) primitives (r.list size _primitive.primitive) @@ -165,7 +165,7 @@ )))) (def: product - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) primitives (r.list size _primitive.primitive) choice (|> r.nat (:: @ map (n.% size))) @@ -225,7 +225,7 @@ )))) (def: variant - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) choice (|> r.nat (:: @ map (n.% size))) @@ -271,7 +271,7 @@ )))) (def: record - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) tags (|> (r.set text.hash size (r.unicode 5)) (:: @ map set.to-list)) primitives (r.list size _primitive.primitive) diff --git a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux index c659d9db0..df4e5a7e5 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/extension/analysis/lux.lux @@ -67,7 +67,7 @@ (def: i64 Test - (do r.monad + (do {@ r.monad} [subjectC (|> r.nat (:: @ map code.nat)) signedC (|> r.int (:: @ map code.int)) paramC (|> r.nat (:: @ map code.nat))] @@ -94,7 +94,7 @@ (def: int Test - (do r.monad + (do {@ r.monad} [subjectC (|> r.int (:: @ map code.int)) paramC (|> r.int (:: @ map code.int))] ($_ _.and @@ -114,7 +114,7 @@ (def: frac Test - (do r.monad + (do {@ r.monad} [subjectC (|> r.safe-frac (:: @ map code.frac)) paramC (|> r.safe-frac (:: @ map code.frac)) encodedC (|> r.safe-frac (:: @ map (|>> %.frac code.text)))] @@ -149,7 +149,7 @@ (def: text Test - (do r.monad + (do {@ r.monad} [subjectC (|> (r.unicode 5) (:: @ map code.text)) paramC (|> (r.unicode 5) (:: @ map code.text)) replacementC (|> (r.unicode 5) (:: @ map code.text)) @@ -174,7 +174,7 @@ (def: io Test - (do r.monad + (do {@ r.monad} [logC (|> (r.unicode 5) (:: @ map code.text)) exitC (|> r.int (:: @ map code.int))] ($_ _.and diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux index 13418eba0..263f5e4a7 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/case.lux @@ -25,7 +25,7 @@ (def: dummy-vars Test - (do r.monad + (do {@ r.monad} [maskedA //primitive.primitive temp (|> r.nat (:: @ map (n.% 100))) #let [maskA (////analysis.control/case diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux index 32044f5dc..1a4993c92 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/function.lux @@ -35,7 +35,7 @@ (Random [Arity Analysis Analysis]) (r.rec (function (_ constant-function) - (do r.monad + (do {@ r.monad} [function? r.bit] (if function? (do @ @@ -53,7 +53,7 @@ (def: function-with-environment (Random [Arity Analysis Variable]) - (do r.monad + (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) @@ -102,7 +102,7 @@ (wrap [arity' (#////analysis.Function (list) bodyA) predictionA])) - (do r.monad + (do {@ r.monad} [chosen (|> r.nat (:: @ map (|>> (n.% 100) (n.max 2))))] (wrap [arity (#////analysis.Reference (////reference.local chosen)) @@ -149,7 +149,7 @@ (def: application Test - (do r.monad + (do {@ r.monad} [arity (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1)))) funcA //primitive.primitive argsA (r.list arity //primitive.primitive)] diff --git a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux index 087756562..d59065782 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux @@ -30,7 +30,7 @@ (def: variant Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.+ 2)))) tagA (|> r.nat (:: @ map (n.% size))) #let [right? (n.= (dec size) tagA) @@ -53,7 +53,7 @@ (def: tuple Test - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) membersA (r.list size //primitive.primitive)] (_.test "Can synthesize tuple." diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index f129f1c5a..eef749d8f 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -22,7 +22,7 @@ (def: short (r.Random Text) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 10)))] (r.unicode size))) @@ -83,7 +83,7 @@ (:: /.equivalence = (/.un-name base) (/.un-name aliased)))))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) members (|> ..type (r.filter (function (_ type) @@ -109,7 +109,7 @@ ["tuple" /.tuple /.flatten-tuple Any] )) ))) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) members (M.seq @ (list.repeat size ..type)) extra (|> ..type @@ -132,7 +132,7 @@ (let [[tfunc tparams] (|> extra (/.application members) /.flatten-application)] (n.= (list.size members) (list.size tparams)))) )) - (do r.monad + (do {@ r.monad} [size (|> r.nat (:: @ map (n.% 3))) extra (|> ..type (r.filter (function (_ type) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 2184de475..96fd5fcbb 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -81,7 +81,7 @@ (def: (build-ring num-connections) (-> Nat (/.Check [[Nat Type] (List [Nat Type]) [Nat Type]])) - (do /.monad + (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]) @@ -188,7 +188,7 @@ _ (/.check var Nothing)] (/.check .Bit var)))) ) - (do r.monad + (do {@ r.monad} [num-connections (|> r.nat (:: @ map (n.% 100))) boundT (|> ..type (r.filter (|>> (case> (#.Var _) #0 _ #1)))) pick-pcg (r.and r.nat r.nat)] @@ -209,7 +209,7 @@ expected-size? same-vars?)))))) (_.test "When a var in a ring is bound, all the ring is bound." - (type-checks? (do /.monad + (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) diff --git a/stdlib/source/test/lux/world/file.lux b/stdlib/source/test/lux/world/file.lux index d13a024e7..5f8d03273 100644 --- a/stdlib/source/test/lux/world/file.lux +++ b/stdlib/source/test/lux/world/file.lux @@ -68,7 +68,7 @@ (def: #export test Test (<| (_.context (%.name (name-of /._))) - (do r.monad + (do {@ r.monad} [file-size (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10)))) dataL (_binary.binary file-size) dataR (_binary.binary file-size) -- cgit v1.2.3