diff options
Diffstat (limited to '')
34 files changed, 467 insertions, 261 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index c1aa9ae9b..ed32b969c 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -12,6 +12,7 @@ ["#/." pom] ["#/." install]] ["#." local] + ["#." cache] ["#." dependency] ["#." package] ["#." profile] @@ -29,6 +30,7 @@ /command/pom.test /command/install.test /local.test + /cache.test /dependency.test /package.test /profile.test diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux new file mode 100644 index 000000000..e1b4abfc5 --- /dev/null +++ b/stdlib/source/test/aedifex/cache.lux @@ -0,0 +1,137 @@ +(.module: + [lux (#- Type type) + ["_" test (#+ Test)] + [abstract + ["." monad (#+ do)]] + [control + ["." try] + [concurrency + ["." promise (#+ Promise)]]] + [data + [binary (#+ Binary)] + ["." text] + [number + ["n" nat]] + [format + [xml (#+ XML)]] + [collection + ["." set] + ["." dictionary]]] + [math + ["." random (#+ Random) ("#@." monad)]] + [world + ["." file]]] + [// + ["@." profile] + ["@." artifact] + [// + [lux + [data + ["_." binary]]]]] + {#program + ["." / + ["/#" // #_ + ["#" profile (#+ Profile)] + ["#." package (#+ Package)] + ["#." pom] + ["#." dependency (#+ Dependency) + ["#/." resolution (#+ Resolution)]] + ["#." artifact (#+ Artifact) + ["#/." type (#+ Type)]]]]}) + +(def: type + (Random Type) + ($_ random.either + (random@wrap //artifact/type.lux-library) + (random@wrap //artifact/type.jvm-library))) + +(def: profile + (Random [Artifact Profile XML]) + (random.one (function (_ profile) + (try.to-maybe + (do try.monad + [pom (//pom.write profile) + identity (try.from-maybe (get@ #//.identity profile))] + (wrap [identity profile pom])))) + @profile.random)) + +(def: content + (Random Binary) + (do {! random.monad} + [content-size (:: ! map (n.% 100) random.nat)] + (_binary.random content-size))) + +(def: package + (Random [Dependency Package]) + (do {! random.monad} + [[identity profile pom] ..profile + type ..type + content ..content] + (wrap [{#//dependency.artifact identity + #//dependency.type type} + (//package.local pom content)]))) + +(def: resolution + (Random Resolution) + (do {! random.monad} + [[main-dependency main-package] ..package + dependencies (|> (//package.dependencies main-package) + (:: try.monad map set.to-list) + (try.default (list)) + (monad.map ! (function (_ dependency) + (do ! + [pom (random.one (function (_ [identity profile pom]) + (|> profile + (set@ #//.dependencies (set.new //dependency.hash)) + (set@ #//.identity (#.Some (get@ #//dependency.artifact dependency))) + //pom.write + try.to-maybe)) + ..profile) + content ..content] + (wrap [dependency + (//package.local pom content)])))))] + (wrap (dictionary.from-list //dependency.hash (list& [main-dependency main-package] dependencies))))) + +(def: singular + Test + (do {! random.monad} + [[dependency expected-package] ..package + #let [fs (: (file.System Promise) + (file.mock (:: file.default separator)))]] + (wrap (do promise.monad + [wrote! (/.write-one fs dependency expected-package) + read! (/.read-one fs dependency)] + (_.claim [/.write-one /.read-one] + (<| (try.default false) + (do try.monad + [_ wrote! + actual-package read!] + (wrap (:: //package.equivalence = + expected-package + actual-package))))))))) + +(def: plural + Test + (do {! random.monad} + [expected ..resolution + #let [fs (: (file.System Promise) + (file.mock (:: file.default separator)))]] + (wrap (do promise.monad + [wrote! (/.write-all fs expected) + read! (/.read-all fs (dictionary.keys expected) //dependency/resolution.empty)] + (_.claim [/.write-all /.read-all] + (<| (try.default false) + (do try.monad + [_ wrote! + actual read!] + (wrap (:: //dependency/resolution.equivalence = + expected + actual))))))))) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + ..singular + ..plural + ))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index 7f8a4557f..60a46116d 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -69,7 +69,7 @@ #let [fs (file.mock (:: file.default separator))]] (wrap (case (get@ #///.identity sample) (#.Some identity) - (do {@ promise.monad} + (do {! promise.monad} [verdict (do ///action.monad [_ (..execute! fs sample) #let [artifact-path (format (///local.path fs identity) @@ -90,7 +90,7 @@ (try.default false verdict))) #.None - (do {@ promise.monad} + (do {! promise.monad} [outcome (..execute! fs sample)] (_.claim [/.do!] (case outcome diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index cd0eed8e9..c973678cc 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -34,15 +34,15 @@ (do random.monad [sample @profile.random #let [fs (file.mock (:: file.default separator))]] - (wrap (do {@ promise.monad} + (wrap (do {! promise.monad} [outcome (/.do! fs sample)] (case outcome (#try.Success path) - (do @ + (do ! [verdict (do ///action.monad [expected (|> (///pom.write sample) (try@map (|>> (:: xml.codec encode) encoding.to-utf8)) - (:: @ wrap)) + (:: ! wrap)) file (: (Promise (Try (File Promise))) (file.get-file promise.monad fs path)) actual (!.use (:: file content) []) diff --git a/stdlib/source/test/aedifex/hash.lux b/stdlib/source/test/aedifex/hash.lux index bc6bb1b4b..745ec0910 100644 --- a/stdlib/source/test/aedifex/hash.lux +++ b/stdlib/source/test/aedifex/hash.lux @@ -29,9 +29,9 @@ (All [h] (-> (-> Binary (/.Hash h)) (Random (/.Hash h)))) - (do {@ random.monad} - [size (:: @ map (n.% 100) random.nat)] - (:: @ map hash (_binary.random size)))) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat)] + (:: ! map hash (_binary.random size)))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index 50b99a218..b05d0afcb 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -31,8 +31,8 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} - [expected (:: @ map (set@ #//.parents (list)) @profile.random) + (do {! random.monad} + [expected (:: ! map (set@ #//.parents (list)) @profile.random) #let [fs (: (file.System Promise) (file.mock (:: file.default separator)))]] (wrap (do promise.monad diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index a883f565e..1c713684c 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -22,7 +22,7 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [sample @artifact.random #let [fs (: (file.System Promise) (file.mock (:: file.default separator)))]] diff --git a/stdlib/source/test/aedifex/parser.lux b/stdlib/source/test/aedifex/parser.lux index 0c85156d2..e26240562 100644 --- a/stdlib/source/test/aedifex/parser.lux +++ b/stdlib/source/test/aedifex/parser.lux @@ -38,8 +38,8 @@ (def: (list-of random) (All [a] (-> (Random a) (Random (List a)))) - (do {@ random.monad} - [size (:: @ map (n.% 5) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 5) random.nat)] (random.list size random))) (def: (dictionary-of key-hash key-random value-random) diff --git a/stdlib/source/test/aedifex/profile.lux b/stdlib/source/test/aedifex/profile.lux index 398a85f5b..d0da1ff2a 100644 --- a/stdlib/source/test/aedifex/profile.lux +++ b/stdlib/source/test/aedifex/profile.lux @@ -70,8 +70,8 @@ (def: (list-of random) (All [a] (-> (Random a) (Random (List a)))) - (do {@ random.monad} - [size (:: @ map (n.% 5) random.nat)] + (do {! random.monad} + [size (:: ! map (n.% 5) random.nat)] (random.list size random))) (def: (set-of hash random) diff --git a/stdlib/source/test/licentia.lux b/stdlib/source/test/licentia.lux index 619d9c711..f73d55ab4 100644 --- a/stdlib/source/test/licentia.lux +++ b/stdlib/source/test/licentia.lux @@ -42,11 +42,11 @@ (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)] - end (:: @ map + end (:: ! map (|>> (n.% wiggle-room) (n.max 1)) r.nat)] (wrap {#time.start start @@ -104,8 +104,8 @@ (def: (variable-list max-size gen-element) (All [a] (-> Nat (Random a) (Random (List a)))) - (do {@ r.monad} - [amount (:: @ map (n.% (n.max 1 max-size)) + (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 6549f9a17..809e906fb 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -138,8 +138,7 @@ ["#." host] ["#." extension] ["#." target #_ - ["#/." jvm]]] - ) + ["#/." jvm]]]) ## TODO: Get rid of this ASAP (template: (!bundle body) @@ -150,12 +149,12 @@ (def: identity Test - (do {@ random.monad} + (do {! random.monad} [self (random.unicode 1)] ($_ _.and (_.test "Every value is identical to itself." (is? self self)) - (do @ + (do ! [other (random.unicode 1)] (_.test "Values created separately can't be identical." (not (is? self other)))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index d31e6aef8..1b1a01242 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -45,11 +45,12 @@ Test (do random.monad [initial-state random.nat - #let [inc! (: (/.Mail Nat) - (function (_ state actor) - (promise@wrap - (#try.Success - (inc state)))))]] + #let [as-mail (: (All [a] (-> (-> a a) (/.Mail a))) + (function (_ transform) + (function (_ state actor) + (|> state transform #try.Success promise@wrap)))) + inc! (: (/.Mail Nat) (as-mail inc)) + dec! (: (/.Mail Nat) (as-mail dec))]] (<| (_.covering /._) (_.with-cover [/.Actor]) ($_ _.and @@ -159,4 +160,33 @@ (#try.Failure error) false)))) + + (wrap (do promise.monad + [verdict (promise.future + (do io.monad + [anonymous (/.actor {Nat + initial-state} + ((on-mail message state self) + (message (inc state) self)) + + ((on-stop cause state) + (promise@wrap (exec (%.nat state) + [])))) + sent/inc? (/.mail! inc! anonymous) + sent/dec? (/.mail! dec! anonymous) + poisoned? (/.poison! anonymous) + obituary (/.obituary anonymous)] + (wrap (and (..mailed? sent/inc?) + (..mailed? sent/dec?) + (..mailed? poisoned?) + (case obituary + (^ (#.Some [error final-state (list)])) + (and (exception.match? /.poisoned error) + (n.= (inc (inc initial-state)) + final-state)) + + _ + false)))))] + (_.claim [/.actor] + verdict))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 6c52dc5ad..43198ff5b 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)] @@ -134,7 +134,7 @@ listened (|> sink atom.read promise.future - (:: @ map row.to-list))] + (:: ! map row.to-list))] (_.claim [/.listen] (and (list@= inputs output) diff --git a/stdlib/source/test/lux/control/concurrency/process.lux b/stdlib/source/test/lux/control/concurrency/process.lux index fc818e22d..6d59672ca 100644 --- a/stdlib/source/test/lux/control/concurrency/process.lux +++ b/stdlib/source/test/lux/control/concurrency/process.lux @@ -23,10 +23,10 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [dummy random.nat expected random.nat - delay (|> random.nat (:: @ map (n.% 100)))] + delay (|> random.nat (:: ! map (n.% 100)))] ($_ _.and (_.cover [/.parallelism] (n.> 0 /.parallelism)) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 1c8933499..0dc28819d 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -47,8 +47,8 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} - [to-wait (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) + (do {! random.monad} + [to-wait (|> random.nat (:: ! map (|>> (n.% 100) (n.max 10)))) #let [extra-time (n.* 2 to-wait)] expected random.nat dummy random.nat diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index dcdb78f78..763ae41f8 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -30,8 +30,8 @@ Test (_.with-cover [/.Semaphore] ($_ _.and - (do {@ random.monad} - [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (do {! random.monad} + [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad [result (promise.time-out 10 (/.wait semaphore))] @@ -42,11 +42,11 @@ #.None false))))) - (do {@ random.monad} - [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (do {! random.monad} + [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] - (wrap (do {@ promise.monad} - [_ (monad.map @ /.wait (list.repeat initial-open-positions semaphore)) + (wrap (do {! promise.monad} + [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore)) result (promise.time-out 10 (/.wait semaphore))] (_.claim [/.wait] (case result @@ -55,11 +55,11 @@ #.None true))))) - (do {@ random.monad} - [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (do {! random.monad} + [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] - (wrap (do {@ promise.monad} - [_ (monad.map @ /.wait (list.repeat initial-open-positions semaphore)) + (wrap (do {! promise.monad} + [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore)) #let [block (/.wait semaphore)] result/0 (promise.time-out 10 block) open-positions (/.signal semaphore) @@ -71,8 +71,8 @@ _ false))))) - (do {@ random.monad} - [initial-open-positions (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (do {! random.monad} + [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad [outcome (/.signal semaphore)] @@ -89,8 +89,8 @@ Test (_.with-cover [/.Mutex] ($_ _.and - (do {@ random.monad} - [repetitions (|> random.nat (:: @ map (|>> (n.% 100) (n.max 10)))) + (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")) expected-Bs (text.join-with "" (list.repeat repetitions "B")) @@ -98,16 +98,16 @@ processA (<| (/.synchronize mutex) io.io promise.future - (do {@ io.monad} - [_ (<| (monad.seq @) + (do {! io.monad} + [_ (<| (monad.seq !) (list.repeat repetitions) (atom.update (|>> (format "A")) resource))] (wrap []))) processB (<| (/.synchronize mutex) io.io promise.future - (do {@ io.monad} - [_ (<| (monad.seq @) + (do {! io.monad} + [_ (<| (monad.seq !) (list.repeat repetitions) (atom.update (|>> (format "B")) resource))] (wrap [])))]] @@ -146,11 +146,11 @@ _ false))) - (do {@ random.monad} - [limit (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (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 "")) @@ -159,7 +159,7 @@ (exec (io.run (atom.update (|>> (format "_")) resource)) (waiter resource barrier id))) ids)] - _ (monad.seq @ waiters) + _ (monad.seq ! waiters) #let [outcome (io.run (atom.read resource))]] (_.claim [/.barrier /.block] (and (text.ends-with? ending outcome) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 040d97924..fd3cd53d9 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -38,10 +38,10 @@ (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)))] + iterations-per-process (|> random.nat (:: ! map (n.% 100)))] ($_ _.and (_.with-cover [/.functor] ($functor.spec ..injection ..comparison /.functor)) @@ -92,10 +92,10 @@ (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 @)) + (monad.seq !)) cummulative (/.commit (/.read var))] (_.claim [/.STM] (n.= iterations-per-process diff --git a/stdlib/source/test/lux/control/exception.lux b/stdlib/source/test/lux/control/exception.lux index 599eb5863..db97197e3 100644 --- a/stdlib/source/test/lux/control/exception.lux +++ b/stdlib/source/test/lux/control/exception.lux @@ -24,11 +24,11 @@ (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 - #let [report-element (:: @ map %.nat random.nat)] + #let [report-element (:: ! map %.nat random.nat)] field0 report-element value0 report-element field1 report-element diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index f795d27c0..6e9fc74ac 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -9,7 +9,7 @@ [data [number ["n" nat]] - ["." text ("#@." equivalence)]] + ["." text ("#!." equivalence)]] [math ["." random (#+ Random)]] ["_" test (#+ Test)]] @@ -18,10 +18,10 @@ (def: #export test Test - (do {@ random.monad} + (do {! random.monad} [expected random.nat - f0 (:: @ map n.+ random.nat) - f1 (:: @ map n.* random.nat) + f0 (:: ! map n.+ random.nat) + f1 (:: ! map n.* random.nat) dummy random.nat extra (|> random.nat (random.filter (|>> (n.= expected) not)))] (<| (_.covering /._) @@ -32,7 +32,7 @@ (n.= (left extra) (right extra))))) generator (: (Random (-> Nat Nat)) - (:: @ map n.- random.nat))] + (:: ! map n.- random.nat))] (_.with-cover [/.monoid] ($monoid.spec equivalence /.monoid generator))) diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux index 0cde16295..422c98618 100644 --- a/stdlib/source/test/lux/control/function/contract.lux +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -17,7 +17,7 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} + (do {! random.monad} [expected random.nat]) ($_ _.and (_.cover [/.pre] diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux index 85fe41f8d..90a2064af 100644 --- a/stdlib/source/test/lux/control/function/memo.lux +++ b/stdlib/source/test/lux/control/function/memo.lux @@ -49,8 +49,8 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} - [input (|> random.nat (:: @ map (|>> (n.% 5) (n.+ 23))))]) + (do {! random.monad} + [input (|> random.nat (:: ! map (|>> (n.% 5) (n.+ 23))))]) (_.with-cover [/.Memo]) ($_ _.and (_.cover [/.closed /.none] diff --git a/stdlib/source/test/lux/control/function/mixin.lux b/stdlib/source/test/lux/control/function/mixin.lux index 2d83f5515..accf7659d 100644 --- a/stdlib/source/test/lux/control/function/mixin.lux +++ b/stdlib/source/test/lux/control/function/mixin.lux @@ -24,8 +24,8 @@ (def: #export test Test (<| (_.covering /._) - (do {@ random.monad} - [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20)))) + (do {! random.monad} + [input (|> random.nat (:: ! map (|>> (n.% 6) (n.+ 20)))) dummy random.nat shift (|> random.nat (random.filter (|>> (n.= dummy) not))) #let [equivalence (: (Equivalence (/.Mixin Nat Nat)) @@ -34,7 +34,7 @@ (n.= ((/.mixin left) input) ((/.mixin right) input))))) generator (: (Random (/.Mixin Nat Nat)) - (do @ + (do ! [output random.nat] (wrap (function (_ delegate recur input) output)))) diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 092152160..cbf390441 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -74,9 +74,9 @@ (def: combinators-0 Test - (do {@ random.monad} + (do {! random.monad} [expected0 random.nat - variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat) + variadic (:: ! map (|>> (n.max 1) (n.min 20)) random.nat) expected+ (random.list variadic random.nat) even0 (random.filter n.even? random.nat) odd0 (random.filter n.odd? random.nat) @@ -165,9 +165,9 @@ (def: combinators-1 Test - (do {@ random.monad} - [variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat) - times (:: @ map (n.% variadic) random.nat) + (do {! random.monad} + [variadic (:: ! map (|>> (n.max 1) (n.min 20)) random.nat) + times (:: ! map (n.% variadic) random.nat) expected random.nat wrong (|> random.nat (random.filter (|>> (n.= expected) not))) expected+ (random.list variadic random.nat) diff --git a/stdlib/source/test/lux/control/parser/analysis.lux b/stdlib/source/test/lux/control/parser/analysis.lux index 47a987d03..dca66b9ef 100644 --- a/stdlib/source/test/lux/control/parser/analysis.lux +++ b/stdlib/source/test/lux/control/parser/analysis.lux @@ -48,11 +48,11 @@ Test (<| (_.covering /._) (_.with-cover [/.Parser]) - (do {@ random.monad} + (do {! random.monad} [] (`` ($_ _.and - (do {@ random.monad} - [expected (:: @ map (|>> analysis.bit) random.bit)] + (do {! random.monad} + [expected (:: ! map (|>> analysis.bit) random.bit)] (_.cover [/.run /.any] (|> (list expected) (/.run /.any) @@ -62,7 +62,7 @@ (#try.Failure _) false)))) (~~ (template [<query> <check> <random> <analysis> <=>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random>] (_.cover [<query>] (|> (list (<analysis> expected)) @@ -72,7 +72,7 @@ (#try.Failure _) false)))) - (do {@ random.monad} + (do {! random.monad} [expected <random>] (_.cover [<check>] (|> (list (<analysis> expected)) @@ -89,7 +89,7 @@ [/.foreign /.foreign! random.nat analysis.variable/foreign n.=] [/.constant /.constant! ..constant analysis.constant name@=] )) - (do {@ random.monad} + (do {! random.monad} [expected random.bit] (_.cover [/.tuple] (|> (list (analysis.tuple (list (analysis.bit expected)))) @@ -99,7 +99,7 @@ (#try.Failure _) false)))) - (do {@ random.monad} + (do {! random.monad} [dummy random.bit] (_.cover [/.end?] (and (|> (/.run /.end? (list)) @@ -110,14 +110,14 @@ (wrap verdict)) (list (analysis.bit dummy))) (!expect (#try.Success #0)))))) - (do {@ random.monad} + (do {! random.monad} [dummy random.bit] (_.cover [/.end!] (and (|> (/.run /.end! (list)) (!expect (#try.Success _))) (|> (/.run /.end! (list (analysis.bit dummy))) (!expect (#try.Failure _)))))) - (do {@ random.monad} + (do {! random.monad} [expected random.bit] (_.cover [/.cannot-parse] (and (|> (list (analysis.bit expected)) @@ -134,7 +134,7 @@ (#try.Failure error) (exception.match? /.cannot-parse error)))))) - (do {@ random.monad} + (do {! random.monad} [expected random.bit] (_.cover [/.unconsumed-input] (|> (list (analysis.bit expected) (analysis.bit expected)) diff --git a/stdlib/source/test/lux/control/parser/code.lux b/stdlib/source/test/lux/control/parser/code.lux index 696f70265..de2601c45 100644 --- a/stdlib/source/test/lux/control/parser/code.lux +++ b/stdlib/source/test/lux/control/parser/code.lux @@ -43,15 +43,15 @@ (<| (_.covering /._) (_.with-cover [/.Parser]) (`` ($_ _.and - (do {@ random.monad} - [expected (:: @ map code.bit random.bit)] + (do {! random.monad} + [expected (:: ! map code.bit random.bit)] (_.cover [/.run] (and (|> (/.run /.any (list expected)) (!expect (#try.Success _))) (|> (/.run /.any (list)) (!expect (#try.Failure _)))))) (~~ (template [<query> <check> <random> <code> <equivalence>] - [(do {@ random.monad} + [(do {! random.monad} [expected <random> dummy (|> <random> (random.filter (|>> (:: <equivalence> = expected) not)))] ($_ _.and @@ -66,7 +66,7 @@ (!expect (#try.Failure _))))) ))] - [/.any /.this! (:: @ map code.bit random.bit) function.identity code.equivalence] + [/.any /.this! (:: ! map code.bit random.bit) function.identity code.equivalence] [/.bit /.bit! random.bit code.bit bit.equivalence] [/.nat /.nat! random.nat code.nat nat.equivalence] [/.int /.int! random.int code.int int.equivalence] @@ -79,7 +79,7 @@ [/.local-tag /.local-tag! (random.unicode 1) code.local-tag text.equivalence] )) (~~ (template [<query> <code>] - [(do {@ random.monad} + [(do {! random.monad} [expected-left random.nat expected-right random.int] (_.cover [<query>] @@ -93,7 +93,7 @@ [/.form code.form] [/.tuple code.tuple] )) - (do {@ random.monad} + (do {! random.monad} [expected-left random.nat expected-right random.int] (_.cover [/.record] @@ -103,7 +103,7 @@ (!expect (^multi (#try.Success [actual-left actual-right]) (and (:: nat.equivalence = expected-left actual-left) (:: int.equivalence = expected-right actual-right))))))) - (do {@ random.monad} + (do {! random.monad} [expected-local random.nat expected-global random.int] (_.cover [/.local] @@ -113,8 +113,8 @@ (!expect (^multi (#try.Success [actual-local actual-global]) (and (:: nat.equivalence = expected-local actual-local) (:: int.equivalence = expected-global actual-global))))))) - (do {@ random.monad} - [dummy (:: @ map code.bit random.bit)] + (do {! random.monad} + [dummy (:: ! map code.bit random.bit)] (_.cover [/.end?] (|> (/.run (do <>.monad [pre /.end? @@ -125,8 +125,8 @@ (list dummy)) (!expect (^multi (#try.Success verdict) verdict))))) - (do {@ random.monad} - [dummy (:: @ map code.bit random.bit)] + (do {! random.monad} + [dummy (:: ! map code.bit random.bit)] (_.cover [/.end!] (and (|> (/.run /.end! (list)) (!expect (#try.Success []))) diff --git a/stdlib/source/test/lux/control/parser/tree.lux b/stdlib/source/test/lux/control/parser/tree.lux index d451e6298..efea74853 100644 --- a/stdlib/source/test/lux/control/parser/tree.lux +++ b/stdlib/source/test/lux/control/parser/tree.lux @@ -27,7 +27,7 @@ false)) (template: (!cover <coverage> <parser> <sample>) - (do {@ random.monad} + (do {! random.monad} [dummy random.nat expected (|> random.nat (random.filter (|>> (n.= dummy) not)))] (_.cover <coverage> @@ -37,7 +37,7 @@ (n.= expected actual))))))) (template: (!cover2 <coverage> <parser> <sample0> <sample1>) - (do {@ random.monad} + (do {! random.monad} [dummy random.nat expected (|> random.nat (random.filter (|>> (n.= dummy) not)))] (_.cover <coverage> @@ -56,7 +56,7 @@ (!cover [/.run /.value] /.value (tree.leaf expected)) - (do {@ random.monad} + (do {! random.monad} [expected random.nat] (_.cover [/.run'] (|> (/.run' /.value @@ -156,7 +156,7 @@ (tree.branch expected (list (tree.leaf dummy) (tree.leaf dummy)))) - (do {@ random.monad} + (do {! random.monad} [dummy random.nat] (_.cover [/.cannot-move-further] (`` (and (~~ (template [<parser>] diff --git a/stdlib/source/test/lux/control/region.lux b/stdlib/source/test/lux/control/region.lux index 763a4be0c..691bcbbce 100644 --- a/stdlib/source/test/lux/control/region.lux +++ b/stdlib/source/test/lux/control/region.lux @@ -74,8 +74,8 @@ Test (<| (_.covering /._) (_.with-cover [/.Region]) - (do {@ random.monad} - [expected-clean-ups (|> random.nat (:: @ map (|>> (n.% 100) (n.max 1))))] + (do {! random.monad} + [expected-clean-ups (|> random.nat (:: ! map (|>> (n.% 100) (n.max 1))))] ($_ _.and (_.with-cover [/.functor] ($functor.spec ..injection ..comparison (: (All [! r] @@ -92,16 +92,16 @@ (_.cover [/.run] (thread.run - (do {@ thread.monad} + (do {! thread.monad} [clean-up-counter (thread.box 0) - #let [//@ @ + #let [//@ ! count-clean-up (function (_ value) - (do @ + (do ! [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] - outcome (/.run @ - (do {@ (/.monad @)} - [_ (monad.map @ (/.acquire //@ count-clean-up) + outcome (/.run ! + (do {! (/.monad !)} + [_ (monad.map ! (/.acquire //@ count-clean-up) (enum.range n.enum 1 expected-clean-ups))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] @@ -110,16 +110,16 @@ actual-clean-ups)))))) (_.cover [/.fail] (thread.run - (do {@ thread.monad} + (do {! thread.monad} [clean-up-counter (thread.box 0) - #let [//@ @ + #let [//@ ! count-clean-up (function (_ value) - (do @ + (do ! [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] - outcome (/.run @ - (do {@ (/.monad @)} - [_ (monad.map @ (/.acquire //@ count-clean-up) + outcome (/.run ! + (do {! (/.monad !)} + [_ (monad.map ! (/.acquire //@ count-clean-up) (enum.range n.enum 1 expected-clean-ups)) _ (/.fail //@ (exception.construct ..oops []))] (wrap []))) @@ -129,16 +129,16 @@ actual-clean-ups)))))) (_.cover [/.throw] (thread.run - (do {@ thread.monad} + (do {! thread.monad} [clean-up-counter (thread.box 0) - #let [//@ @ + #let [//@ ! count-clean-up (function (_ value) - (do @ + (do ! [_ (thread.update inc clean-up-counter)] (wrap (#try.Success []))))] - outcome (/.run @ - (do {@ (/.monad @)} - [_ (monad.map @ (/.acquire //@ count-clean-up) + outcome (/.run ! + (do {! (/.monad !)} + [_ (monad.map ! (/.acquire //@ count-clean-up) (enum.range n.enum 1 expected-clean-ups)) _ (/.throw //@ ..oops [])] (wrap []))) @@ -148,17 +148,17 @@ actual-clean-ups)))))) (_.cover [/.acquire] (thread.run - (do {@ thread.monad} + (do {! thread.monad} [clean-up-counter (thread.box 0) - #let [//@ @ + #let [//@ ! count-clean-up (function (_ value) - (do @ + (do ! [_ (thread.update inc clean-up-counter)] (wrap (: (Try Any) (exception.throw ..oops [])))))] - outcome (/.run @ - (do {@ (/.monad @)} - [_ (monad.map @ (/.acquire //@ count-clean-up) + outcome (/.run ! + (do {! (/.monad !)} + [_ (monad.map ! (/.acquire //@ count-clean-up) (enum.range n.enum 1 expected-clean-ups))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] @@ -168,11 +168,11 @@ actual-clean-ups)))))) (_.cover [/.lift] (thread.run - (do {@ thread.monad} + (do {! thread.monad} [clean-up-counter (thread.box 0) - #let [//@ @] - outcome (/.run @ - (do (/.monad @) + #let [//@ !] + outcome (/.run ! + (do (/.monad !) [_ (/.lift //@ (thread.write expected-clean-ups clean-up-counter))] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index b2a4fba96..ffac9570f 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -83,8 +83,8 @@ (def: loops Test - (do {@ random.monad} - [limit (|> random.nat (:: @ map (n.% 10))) + (do {! random.monad} + [limit (|> random.nat (:: ! map (n.% 10))) #let [condition (do /.monad [state /.get] (wrap (n.< limit state)))]] diff --git a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux index e396dd81a..8b32295d9 100644 --- a/stdlib/source/test/lux/data/collection/dictionary/ordered.lux +++ b/stdlib/source/test/lux/data/collection/dictionary/ordered.lux @@ -1,6 +1,5 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)] @@ -11,13 +10,15 @@ ["$." equivalence]]}] [data ["." product] + ["." bit ("#@." equivalence)] + ["." maybe ("#@." monad)] [number ["n" nat]] [collection ["." set] ["." list ("#@." functor)]]] [math - ["r" random (#+ Random) ("#@." monad)]]] + ["." random (#+ Random) ("#@." monad)]]] {1 ["." /]}) @@ -26,26 +27,29 @@ (-> (Order k) (Random k) (Random v) Nat (Random (/.Dictionary k v)))) (case size 0 - (r@wrap (/.new order)) + (random@wrap (/.new order)) _ - (do r.monad + (do random.monad [partial (dictionary order gen-key gen-value (dec size)) - key (r.filter (function (_ candidate) - (not (/.contains? candidate partial))) - gen-key) + key (random.filter (function (_ candidate) + (not (/.contains? candidate partial))) + gen-key) value gen-value] (wrap (/.put key value partial))))) (def: #export test Test - (<| (_.context (%.name (name-of /.Dictionary))) - (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) - extra-key (|> r.nat (r.filter (|>> (set.member? keys) not))) - extra-value r.nat + (<| (_.covering /._) + (_.with-cover [/.Dictionary]) + (do {! random.monad} + [size (:: ! map (n.% 100) random.nat) + keys (random.set n.hash size random.nat) + values (random.set n.hash size random.nat) + extra-key (random.filter (|>> (set.member? keys) not) + random.nat) + extra-value random.nat + shift random.nat #let [pairs (list.zip/2 (set.to-list keys) (set.to-list values)) sample (/.from-list n.order pairs) @@ -53,58 +57,81 @@ (n.< left right)) pairs) sorted-values (list@map product.right sorted-pairs) + (^open "list@.") (list.equivalence (: (Equivalence [Nat Nat]) + (function (_ [kr vr] [ks vs]) + (and (n.= kr ks) + (n.= vr vs))))) (^open "/@.") (/.equivalence n.equivalence)]] ($_ _.and - ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order r.nat r.nat size)) + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (..dictionary n.order random.nat random.nat size))) - (_.test "Can query the size of a dictionary." - (n.= size (/.size sample))) - (_.test "Can query value for minimum key." - (case [(/.min sample) (list.head sorted-values)] - [#.None #.None] - #1 + (_.cover [/.size] + (n.= size (/.size sample))) + (_.cover [/.empty?] + (bit@= (n.= 0 (/.size sample)) + (/.empty? sample))) + (_.cover [/.new] + (/.empty? (/.new n.order))) + (_.cover [/.min] + (case [(/.min sample) (list.head sorted-values)] + [#.None #.None] + #1 - [(#.Some reference) (#.Some sample)] - (n.= reference sample) + [(#.Some reference) (#.Some sample)] + (n.= reference sample) - _ - #0)) - (_.test "Can query value for maximum key." - (case [(/.max sample) (list.last sorted-values)] - [#.None #.None] - #1 + _ + #0)) + (_.cover [/.max] + (case [(/.max sample) (list.last sorted-values)] + [#.None #.None] + #1 - [(#.Some reference) (#.Some sample)] - (n.= reference sample) + [(#.Some reference) (#.Some sample)] + (n.= reference sample) - _ - #0)) - (_.test "Converting dictionaries to/from lists cannot change their values." - (|> sample - /.entries (/.from-list n.order) - (/@= sample))) - (_.test "Order is preserved." - (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))) - (_.test "Every key in a dictionary must be identifiable." - (list.every? (function (_ key) (/.contains? key sample)) - (/.keys sample))) - (_.test "Can add and remove elements in a dictionary." - (and (not (/.contains? extra-key sample)) - (let [sample' (/.put extra-key extra-value sample) - sample'' (/.remove extra-key sample')] - (and (/.contains? extra-key sample') - (not (/.contains? extra-key sample'')) - (case [(/.get extra-key sample') - (/.get extra-key sample'')] - [(#.Some found) #.None] - (n.= extra-value found) - - _ - #0))) - )) + _ + #0)) + (_.cover [/.entries] + (list@= (/.entries sample) + sorted-pairs)) + (_.cover [/.keys /.values] + (list@= (/.entries sample) + (list.zip/2 (/.keys sample) (/.values sample)))) + (_.cover [/.from-list] + (|> sample + /.entries (/.from-list n.order) + (/@= sample))) + (_.cover [/.contains?] + (and (list.every? (function (_ key) (/.contains? key sample)) + (/.keys sample)) + (not (/.contains? extra-key sample)))) + (_.cover [/.put] + (and (not (/.contains? extra-key sample)) + (let [sample+ (/.put extra-key extra-value sample)] + (and (/.contains? extra-key sample+) + (n.= (inc (/.size sample)) + (/.size sample+)))))) + (_.cover [/.get] + (let [sample+ (/.put extra-key extra-value sample)] + (case [(/.get extra-key sample) + (/.get extra-key sample+)] + [#.None (#.Some actual)] + (n.= extra-value actual) + + _ + false))) + (_.cover [/.remove] + (|> sample + (/.put extra-key extra-value) + (/.remove extra-key) + (/@= sample))) + (_.cover [/.update] + (|> sample + (/.put extra-key extra-value) + (/.update extra-key (n.+ shift)) + (/.get extra-key) + (maybe@map (n.= (n.+ shift extra-value))) + (maybe.default false))) )))) diff --git a/stdlib/source/test/lux/host.js.lux b/stdlib/source/test/lux/host.js.lux index 9112716ca..507cda9ff 100644 --- a/stdlib/source/test/lux/host.js.lux +++ b/stdlib/source/test/lux/host.js.lux @@ -38,11 +38,11 @@ (def: #export test Test - (do {@ random.monad} + (do {! random.monad} [boolean random.bit - number (:: @ map (|>> (nat.% 100) nat.frac) random.nat) + number (:: ! map (|>> (nat.% 100) nat.frac) random.nat) string (random.ascii 5) - function (:: @ map (function (_ shift) + function (:: ! map (function (_ shift) (: (-> Nat Nat) (nat.+ shift))) random.nat) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux index 5f8e46d3c..0a59b5534 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/case.lux @@ -41,9 +41,9 @@ (def: masking-test Test - (do {@ random.monad} + (do {! random.monad} [maskedA //primitive.primitive - temp (|> random.nat (:: @ map (n.% 100))) + temp (|> random.nat (:: ! map (n.% 100))) #let [maskA (analysis.control/case [maskedA [[(#analysis.Bind temp) @@ -109,8 +109,8 @@ (def: random-member (Random synthesis.Member) - (do {@ random.monad} - [lefts (|> random.nat (:: @ map (n.% 10))) + (do {! random.monad} + [lefts (|> random.nat (:: ! map (n.% 10))) right? random.bit] (wrap (if right? (#.Right lefts) @@ -118,8 +118,8 @@ (def: random-path (Random (analysis.Tuple synthesis.Member)) - (do {@ random.monad} - [size-1 (|> random.nat (:: @ map (|>> (n.% 10) inc)))] + (do {! random.monad} + [size-1 (|> random.nat (:: ! map (|>> (n.% 10) inc)))] (random.list size-1 ..random-member))) (def: (get-pattern path) @@ -144,11 +144,11 @@ (def: get-test Test - (do {@ random.monad} + (do {! random.monad} [recordA (|> random.nat - (:: @ map (|>> analysis.nat)) + (:: ! map (|>> analysis.nat)) (random.list 10) - (:: @ map (|>> analysis.tuple))) + (:: ! map (|>> analysis.tuple))) pathA ..random-path [pattern @member] (get-pattern pathA) #let [getA (analysis.control/case [recordA [[pattern @@ -167,7 +167,7 @@ (def: random-bit (Random [Path Match]) - (do {@ random.monad} + (do {! random.monad} [test random.bit then random.nat else random.nat] @@ -194,7 +194,7 @@ (template [<name> <hash> <random> <path> <synthesis> <pattern> <analysis>] [(def: <name> (Random [Path Match]) - (do {@ random.monad} + (do {! random.monad} [[test/0 test/1 test/2 test/3 test/4] (random-five <hash> <random>) [body/0 body/1 body/2 body/3 body/4] (random-five <hash> <random>)] (wrap [($_ #synthesis.Alt @@ -228,7 +228,7 @@ (def: random-variant (Random [Path Match]) - (do {@ random.monad} + (do {! random.monad} [[lefts/0 lefts/1 lefts/2 lefts/3 lefts/4] (random-five n.hash random.nat) [value/0 value/1 value/2 value/3 value/4] (random-five text.hash (random.unicode 1)) last-is-right? random.bit @@ -261,8 +261,8 @@ (def: random-tuple (Random [Path Match]) - (do {@ random.monad} - [mid-size (:: @ map (n.% 4) random.nat) + (do {! random.monad} + [mid-size (:: ! map (n.% 4) random.nat) value/first (random.unicode 1) value/mid (random.list mid-size (random.unicode 1)) @@ -327,8 +327,8 @@ (def: case-test Test - (do {@ random.monad} - [expected-input (:: @ map (|>> .i64 synthesis.i64) random.nat) + (do {! random.monad} + [expected-input (:: ! map (|>> .i64 synthesis.i64) random.nat) [expected-path match] ..random-case] (_.cover [/.synthesize-case] (|> (/.synthesize-case //.phase archive.empty expected-input match) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux index eaca9c528..4d92094d3 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/function.lux @@ -88,7 +88,7 @@ (template [<name> <random> <synthesis> <analysis>] [(def: (<name> output?) Scenario - (do {@ random.monad} + (do {! random.monad} [value <random>] (wrap [true (<synthesis> value) @@ -114,7 +114,7 @@ (def: (random-variant random-value output?) (-> Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [lefts random.nat right? random.bit [loop? expected-value actual-value] (random-value false)] @@ -130,7 +130,7 @@ (def: (random-tuple random-value output?) (-> Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [[loop?-left expected-left actual-left] (random-value false) [loop?-right expected-right actual-right] (random-value false)] (wrap [(and loop?-left @@ -146,8 +146,8 @@ (def: (random-variable arity output?) (-> Arity Scenario) - (do {@ random.monad} - [register (:: @ map (|>> (n.% arity) inc) random.nat)] + (do {! random.monad} + [register (:: ! map (|>> (n.% arity) inc) random.nat)] (wrap [(not (n.= 0 register)) (synthesis.variable/local register) (if (n.= arity register) @@ -156,7 +156,7 @@ (def: (random-constant output?) Scenario - (do {@ random.monad} + (do {! random.monad} [module (random.unicode 1) short (random.unicode 1)] (wrap [true @@ -170,14 +170,14 @@ (def: (random-case arity random-value output?) (-> Arity Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [bit-test random.bit i64-test random.nat f64-test random.frac text-test (random.unicode 1) [loop?-input expected-input actual-input] (random-value false) [loop?-output expected-output actual-output] (random-value output?) - lefts (|> random.nat (:: @ map (n.% 10))) + lefts (|> random.nat (:: ! map (n.% 10))) right? random.bit #let [side|member (if right? (#.Right lefts) @@ -238,7 +238,7 @@ (def: (random-let arity random-value output?) (-> Arity Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [[loop?-input expected-input actual-input] (random-value false) [loop?-output expected-output actual-output] (random-value output?)] (wrap [(and loop?-input @@ -253,7 +253,7 @@ (def: (random-if random-value output?) (-> Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [[loop?-test expected-test actual-test] (random-value false) [loop?-then expected-then actual-then] (random-value output?) [loop?-else expected-else actual-else] (random-value output?) @@ -278,8 +278,8 @@ (def: (random-get random-value output?) (-> Scenario Scenario) - (do {@ random.monad} - [lefts (|> random.nat (:: @ map (n.% 10))) + (do {! random.monad} + [lefts (|> random.nat (:: ! map (n.% 10))) right? random.bit [loop?-record expected-record actual-record] (random-value false)] (wrap [loop?-record @@ -305,7 +305,7 @@ (def: (random-recur arity random-value output?) (-> Arity Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [resets (random.list arity (random-value false))] (wrap [true (synthesis.loop/recur (list@map (|>> product.right product.left) resets)) @@ -316,7 +316,7 @@ (def: (random-scope arity output?) (-> Arity Scenario) - (do {@ random.monad} + (do {! random.monad} [resets (random.list arity (..random-variable arity output?)) [_ expected-output actual-output] (..random-nat output?)] (wrap [(list@fold (function (_ new old) @@ -341,9 +341,9 @@ (def: (random-abstraction' output?) Scenario - (do {@ random.monad} + (do {! random.monad} [[loop?-output expected-output actual-output] (..random-nat output?) - arity (|> random.nat (:: @ map (|>> (n.% 5) inc))) + arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) #let [environment ($_ list@compose (list@map (|>> #variable.Foreign) (list.indices arity)) @@ -361,9 +361,9 @@ (def: (random-apply random-value output?) (-> Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [[loop?-abstraction expected-abstraction actual-abstraction] (..random-nat output?) - arity (|> random.nat (:: @ map (|>> (n.% 5) inc))) + arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) inputs (random.list arity (random-value false))] (wrap [(list@fold (function (_ new old) (and new old)) @@ -393,7 +393,7 @@ (def: (random-extension random-value output?) (-> Scenario Scenario) - (do {@ random.monad} + (do {! random.monad} [name (random.unicode 1) [loop?-first expected-first actual-first] (random-value false) [loop?-second expected-second actual-second] (random-value false) @@ -418,8 +418,8 @@ (def: random-abstraction (Random [Synthesis Analysis]) - (do {@ random.monad} - [arity (|> random.nat (:: @ map (|>> (n.% 5) inc))) + (do {! random.monad} + [arity (|> random.nat (:: ! map (|>> (n.% 5) inc))) [loop? expected-body actual-body] (random-body arity true)] (wrap [(..n-function loop? arity expected-body) (..n-abstraction arity actual-body)]))) @@ -437,8 +437,8 @@ (def: application Test - (do {@ random.monad} - [arity (|> random.nat (:: @ map (|>> (n.% 10) (n.max 1)))) + (do {! random.monad} + [arity (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) funcA //primitive.primitive argsA (random.list arity //primitive.primitive)] (_.cover [/.apply] diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux index 24adb599c..d759ff213 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux @@ -34,9 +34,9 @@ (def: variant Test - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.+ 2)))) - tagA (|> r.nat (:: @ map (n.% size))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.+ 2)))) + tagA (|> r.nat (:: ! map (n.% size))) #let [right? (n.= (dec size) tagA) lefts (if right? (dec tagA) @@ -57,8 +57,8 @@ (def: tuple Test - (do {@ r.monad} - [size (|> r.nat (:: @ map (|>> (n.% 10) (n.max 2)))) + (do {! r.monad} + [size (|> r.nat (:: ! map (|>> (n.% 10) (n.max 2)))) membersA (r.list size //primitive.primitive)] (_.test "Can synthesize tuple." (|> (////analysis.tuple membersA) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index d4bf9ed8e..ccd44ed89 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -29,26 +29,37 @@ (r.Random Name) (r.and ..short ..short)) +(def: (type' num-vars) + (-> Nat (r.Random Type)) + (do r.monad + [_ (wrap [])] + (let [(^open "R@.") r.monad + pairG (r.and (type' num-vars) + (type' num-vars)) + quantifiedG (r.and (R@wrap (list)) (type' (n.+ 2 num-vars))) + random-pair (r.either (r.either (R@map (|>> #.Sum) pairG) + (R@map (|>> #.Product) pairG)) + (r.either (R@map (|>> #.Function) pairG) + (R@map (|>> #.Apply) pairG))) + random-id (let [random-id (r.either (R@map (|>> #.Var) r.nat) + (R@map (|>> #.Ex) r.nat))] + (case num-vars + 0 random-id + _ (r.either (R@map (|>> (n.% num-vars) #.Parameter) r.nat) + random-id))) + random-quantified (r.either (R@map (|>> #.UnivQ) quantifiedG) + (R@map (|>> #.ExQ) quantifiedG))] + ($_ r.either + (R@map (|>> #.Primitive) (r.and ..short (R@wrap (list)))) + random-pair + random-id + random-quantified + (R@map (|>> #.Named) (r.and ..name (type' num-vars))) + )))) + (def: type (r.Random Type) - (let [(^open "R@.") r.monad] - (r.rec (function (_ recur) - (let [pairG (r.and recur recur) - idG r.nat - quantifiedG (r.and (R@wrap (list)) recur)] - ($_ r.or - (r.and ..short (R@wrap (list))) - pairG - pairG - pairG - idG - idG - idG - quantifiedG - quantifiedG - pairG - (r.and ..name recur) - )))))) + (..type' 0)) (def: (valid-type? type) (-> Type Bit) |