diff options
-rw-r--r-- | stdlib/source/lux/abstract/monoid.lux | 8 | ||||
-rw-r--r-- | stdlib/source/lux/control/concurrency/actor.lux | 63 | ||||
-rw-r--r-- | stdlib/source/lux/control/concurrency/promise.lux | 37 | ||||
-rw-r--r-- | stdlib/source/lux/control/concurrency/stm.lux | 22 | ||||
-rw-r--r-- | stdlib/source/lux/data/number/int.lux | 28 | ||||
-rw-r--r-- | stdlib/source/lux/test.lux | 24 | ||||
-rw-r--r-- | stdlib/source/test/lux.lux | 89 | ||||
-rw-r--r-- | stdlib/source/test/lux/abstract.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/abstract/monoid.lux | 44 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/actor.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/frp.lux | 34 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/promise.lux | 202 |
12 files changed, 372 insertions, 183 deletions
diff --git a/stdlib/source/lux/abstract/monoid.lux b/stdlib/source/lux/abstract/monoid.lux index 088fda263..7f4254af3 100644 --- a/stdlib/source/lux/abstract/monoid.lux +++ b/stdlib/source/lux/abstract/monoid.lux @@ -9,12 +9,12 @@ (: (-> a a a) compose)) -(def: #export (compose Monoid<l> Monoid<r>) +(def: #export (compose left right) (All [l r] (-> (Monoid l) (Monoid r) (Monoid [l r]))) (structure (def: identity - [(:: Monoid<l> identity) (:: Monoid<r> identity)]) + [(:: left identity) (:: right identity)]) (def: (compose [lL rL] [lR rR]) - [(:: Monoid<l> compose lL lR) - (:: Monoid<r> compose rL rR)]))) + [(:: left compose lL lR) + (:: right compose rL rR)]))) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index a4c345967..0f38c4c3d 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -3,6 +3,7 @@ [abstract monad] [control + [pipe (#+ case>)] ["." function] ["." try (#+ Try)] ["." exception (#+ exception:)] @@ -49,13 +50,16 @@ (-> (Rec Mailbox [(Promise [a Mailbox]) (Resolver [a Mailbox])]) - (List a))) - (case (promise.poll read) - (#.Some [head tail]) - (#.Cons head (pending tail)) - - #.None - #.Nil)) + (IO (List a)))) + (do io.monad + [current (promise.poll read)] + (case current + (#.Some [head tail]) + (:: @ map (|>> (#.Cons head)) + (pending tail)) + + #.None + (wrap #.Nil)))) (abstract: #export (Actor s) {#.doc "An actor, defined as all the necessities it requires."} @@ -101,7 +105,10 @@ (do @ [_ (end error state)] (let [[_ resolve] (get@ #obituary (:representation self))] - (exec (io.run (resolve [error state (#.Cons head (..pending tail))])) + (exec (io.run + (do io.monad + [pending (..pending tail)] + (resolve [error state (#.Cons head pending)]))) (wrap [])))) (#try.Success state') @@ -111,17 +118,19 @@ (def: #export (alive? actor) (All [s] (-> (Actor s) (IO Bit))) (let [[obituary _] (get@ #obituary (:representation actor))] - (io.io (case (promise.poll obituary) - #.None - yes + (|> obituary + promise.poll + (:: io.functor map + (|>> (case> #.None + yes - _ - no)))) + _ + no)))))) (def: #export (obituary actor) (All [s] (-> (Actor s) (IO (Maybe (Obituary s))))) (let [[obituary _] (get@ #obituary (:representation actor))] - (io.io (promise.poll obituary)))) + (promise.poll obituary))) (def: #export (send message actor) {#.doc "Communicate with an actor through message passing."} @@ -133,18 +142,20 @@ (do @ [|mailbox|&resolve (atom.read (get@ #mailbox (:representation actor)))] (loop [[|mailbox| resolve] |mailbox|&resolve] - (case (promise.poll |mailbox|) - #.None - (do @ - [resolved? (resolve entry)] - (if resolved? - (do @ - [_ (atom.write (product.right entry) (get@ #mailbox (:representation actor)))] - (wrap true)) - (recur |mailbox|&resolve))) - - (#.Some [_ |mailbox|']) - (recur |mailbox|'))))) + (do @ + [|mailbox| (promise.poll |mailbox|)] + (case |mailbox| + #.None + (do @ + [resolved? (resolve entry)] + (if resolved? + (do @ + [_ (atom.write (product.right entry) (get@ #mailbox (:representation actor)))] + (wrap true)) + (recur |mailbox|&resolve))) + + (#.Some [_ |mailbox|']) + (recur |mailbox|')))))) (wrap false)))) ) ) diff --git a/stdlib/source/lux/control/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index 49d4247b4..def999622 100644 --- a/stdlib/source/lux/control/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux @@ -5,6 +5,7 @@ [apply (#+ Apply)] ["." monad (#+ Monad do)]] [control + [pipe (#+ case>)] ["." function] ["." io (#+ IO io)]] [data @@ -55,11 +56,10 @@ (def: #export poll {#.doc "Polls a promise's value."} - (All [a] (-> (Promise a) (Maybe a))) + (All [a] (-> (Promise a) (IO (Maybe a)))) (|>> :representation atom.read - io.run - product.left)) + (:: io.functor map product.left))) (def: #export (await f promise) (All [a] (-> (-> a (IO Any)) (Promise a) (IO Any))) @@ -76,23 +76,28 @@ (await f (:abstraction promise))))))) ) -(def: #export (resolved? promise) +(def: #export resolved? {#.doc "Checks whether a promise's value has already been resolved."} - (All [a] (-> (Promise a) Bit)) - (case (poll promise) - #.None - #0 - - (#.Some _) - #1)) - -(structure: #export functor (Functor Promise) + (All [a] (-> (Promise a) (IO Bit))) + (|>> ..poll + (:: io.functor map + (|>> (case> #.None + #0 + + (#.Some _) + #1))))) + +(structure: #export functor + (Functor Promise) + (def: (map f fa) (let [[fb resolve] (..promise [])] (exec (io.run (await (|>> f resolve) fa)) fb)))) -(structure: #export apply (Apply Promise) +(structure: #export apply + (Apply Promise) + (def: &functor ..functor) (def: (apply ff fa) @@ -102,7 +107,9 @@ ff)) fb)))) -(structure: #export monad (Monad Promise) +(structure: #export monad + (Monad Promise) + (def: &functor ..functor) (def: wrap ..resolved) diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 9d97b389f..783bc2117 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -202,16 +202,18 @@ (do io.monad [|commits|&resolve (atom.read pending-commits)] (loop [[|commits| resolve] |commits|&resolve] - (case (promise.poll |commits|) - #.None - (do io.monad - [resolved? (resolve entry)] - (if resolved? - (atom.write (product.right entry) pending-commits) - (recur |commits|&resolve))) - - (#.Some [head tail]) - (recur tail)))))) + (do @ + [|commits| (promise.poll |commits|)] + (case |commits| + #.None + (do io.monad + [resolved? (resolve entry)] + (if resolved? + (atom.write (product.right entry) pending-commits) + (recur |commits|&resolve))) + + (#.Some [head tail]) + (recur tail))))))) (def: (process-commit commit) (All [a] (-> (Commit a) (IO Any))) diff --git a/stdlib/source/lux/data/number/int.lux b/stdlib/source/lux/data/number/int.lux index 67f2c8177..80842692e 100644 --- a/stdlib/source/lux/data/number/int.lux +++ b/stdlib/source/lux/data/number/int.lux @@ -128,25 +128,35 @@ (-> Int Frac) (|>> "lux i64 f64")) -(structure: #export equivalence (Equivalence Int) +(structure: #export equivalence + (Equivalence Int) + (def: = ..=)) -(structure: #export order (Order Int) +(structure: #export order + (Order Int) + (def: &equivalence ..equivalence) (def: < ..<)) -(structure: #export enum (Enum Int) +(structure: #export enum + (Enum Int) + (def: &order ..order) (def: succ inc) (def: pred dec)) -(structure: #export interval (Interval Int) +(structure: #export interval + (Interval Int) + (def: &enum ..enum) (def: top +9,223,372,036,854,775,807) (def: bottom -9,223,372,036,854,775,808)) (template [<name> <compose> <identity>] - [(structure: #export <name> (Monoid Int) + [(structure: #export <name> + (Monoid Int) + (def: identity <identity>) (def: compose <compose>))] @@ -189,7 +199,9 @@ (#try.Success (..* sign output))))) (template [<struct> <base> <to-character> <to-value> <error>] - [(structure: #export <struct> (Codec Text Int) + [(structure: #export <struct> + (Codec Text Int) + (def: (encode value) (if (..= +0 value) "+0" @@ -220,6 +232,8 @@ [hex +16 //nat.hexadecimal-character //nat.hexadecimal-value "Invalid hexadecimal syntax for Int: "] ) -(structure: #export hash (Hash Int) +(structure: #export hash + (Hash Int) + (def: &equivalence ..equivalence) (def: hash .nat)) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index 18f487ff4..96535b886 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -19,7 +19,7 @@ ["." text ["%" format (#+ format)]] [collection - ["." list ("#@." functor)] + ["." list ("#@." functor fold)] ["." set (#+ Set)]]] [time ["." instant] @@ -308,3 +308,25 @@ (~ (code.text module)) (.list (~+ coverage)) (~ test))))))) + +(def: #export (in-parallel tests) + (-> (List Test) Test) + (do random.monad + [seed random.nat + #let [prng (random.pcg-32 [..pcg-32-magic-inc seed]) + run! (: (-> Test Assertion) + (function (_ test) + (|> test + (random.run prng) + product.right + io.io + promise.future + promise@join)))]] + (wrap (do promise.monad + [assertions (monad.seq @ (list@map run! tests))] + (wrap [(|> assertions + (list@map product.left) + (list@fold ..add-counters ..start)) + (|> assertions + (list@map product.right) + (text.join-with ..separator))]))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index c03076d26..c43c2abf4 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -13,7 +13,7 @@ [predicate (#+ Predicate)]] [control ["." io (#+ io)] - ["." function + [function [mixin (#+)]] [parser [cli (#+ program:)]]] @@ -49,28 +49,37 @@ [php (#+)] [common-lisp (#+)] [scheme (#+)]] - [tool - [compiler - [phase - [generation - [jvm (#+) - <host-modules>] - [js (#+) - <host-modules>] - [python (#+) - <host-modules>] - [lua (#+) - <host-modules>] - [ruby (#+) - <host-modules>] - [php (#+) - <host-modules>] - [common-lisp (#+) - <host-modules>] - [scheme (#+) - <host-modules>]]]]] + ## [tool + ## [compiler + ## [language + ## [lux + ## [phase + ## [generation + ## [jvm (#+) + ## <host-modules>] + ## [js (#+) + ## <host-modules>] + ## [python (#+) + ## <host-modules>] + ## [lua (#+) + ## <host-modules>] + ## [ruby (#+) + ## <host-modules>] + ## ## [php (#+) + ## ## <host-modules>] + ## ## [common-lisp (#+) + ## ## <host-modules>] + ## ## [scheme (#+) + ## ## <host-modules>] + ## ] + ## [extension + ## [generation + ## [jvm (#+)] + ## [js (#+)] + ## [python (#+)] + ## [lua (#+)] + ## [ruby (#+)]]]]]]]] ## [control - ## ["._" concatenative] ## ["._" predicate] ## [function ## ["._" contract]] @@ -131,7 +140,7 @@ ["#." macro] ["#." math] ["#." time] - ["#." tool] + ## ["#." tool] ["#." type] ["#." world] ["#." host] @@ -154,8 +163,6 @@ ($_ _.and (_.test "Every value is identical to itself." (is? self self)) - (_.test "The identity function doesn't change values in any way." - (is? self (function.identity self))) (do @ [other (random.unicode 1)] (_.test "Values created separately can't be identical." @@ -357,27 +364,23 @@ ..templates) (<| (_.context "Cross-platform support.") ..cross-platform-support))) - (!bundle ($_ _.and - /abstract.test - /control.test - /data.test - /macro.test - /math.test)) - (!bundle ($_ _.and - /time.test - /tool.test - /type.test - /world.test)) - (!bundle ($_ _.and - /host.test - /extension.test - ($_ _.and - /target/jvm.test))) + (_.in-parallel (list /abstract.test + /control.test + /data.test + /macro.test + /math.test + /time.test + ## /tool.test + /type.test + /world.test + /host.test + /extension.test + /target/jvm.test + )) ))) (program: args (<| io _.run! - ## (_.times 100) - (_.seed 8070500311708372420) + (_.times 100) ..test)) diff --git a/stdlib/source/test/lux/abstract.lux b/stdlib/source/test/lux/abstract.lux index 4becb6344..b9aa18c9c 100644 --- a/stdlib/source/test/lux/abstract.lux +++ b/stdlib/source/test/lux/abstract.lux @@ -9,6 +9,7 @@ ["#." functor] ["#." interval] ["#." monad] + ["#." monoid] ["#." order] ["#." predicate]]) @@ -22,6 +23,7 @@ /functor.test /interval.test /monad.test + /monoid.test /order.test /predicate.test )) diff --git a/stdlib/source/test/lux/abstract/monoid.lux b/stdlib/source/test/lux/abstract/monoid.lux index 5353e29cd..e1271ed2f 100644 --- a/stdlib/source/test/lux/abstract/monoid.lux +++ b/stdlib/source/test/lux/abstract/monoid.lux @@ -1,31 +1,55 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] - [abstract/monad (#+ do)] - [math - ["." random (#+ Random)]] + [abstract + [monad (#+ do)]] [control - ["." function]]] + ["." function]] + [data + [number + ["." nat] + ["." int]]] + [math + ["." random (#+ Random)]]] {1 - ["." / (#+ Monoid) + ["." / [// [equivalence (#+ Equivalence)]]]}) (def: #export (spec (^open "/@.") (^open "/@.") gen-sample) - (All [a] (-> (Equivalence a) (Monoid a) (Random a) Test)) + (All [a] (-> (Equivalence a) (/.Monoid a) (Random a) Test)) (do random.monad [sample gen-sample left gen-sample mid gen-sample right gen-sample] - (<| (_.context (%.name (name-of /.Monoid))) + (<| (_.with-cover [/.Monoid]) ($_ _.and (_.test "Left identity." - (/@= sample (/@compose /@identity sample))) + (/@= sample + (/@compose /@identity sample))) (_.test "Right identity." - (/@= sample (/@compose sample /@identity))) + (/@= sample + (/@compose sample /@identity))) (_.test "Associativity." (/@= (/@compose left (/@compose mid right)) (/@compose (/@compose left mid) right))) )))) + +(def: #export test + Test + (do random.monad + [natL random.nat + natR random.nat + intL random.int + intR random.int] + (<| (_.covering /._) + ($_ _.and + (_.cover [/.compose] + (let [[natLR intLR] (:: (/.compose nat.addition int.multiplication) compose + [natL intL] [natR intR])] + (and (nat.= (:: nat.addition compose natL natR) + natLR) + (int.= (:: int.multiplication compose intL intR) + intLR)))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 741b848cb..fe9362b07 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -91,7 +91,7 @@ (promise.future (write cause)))} write) _ (/.poison actor)] - (io.io (promise.poll read))))] + (promise.poll read)))] (_.claim [/.poisoned] (case result (#.Some error) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 8752a195f..e6c8c179d 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -34,14 +34,17 @@ (def: comparison (Comparison /.Channel) (function (_ == left right) - (case [(promise.poll left) - (promise.poll right)] - [(#.Some (#.Some [left _])) - (#.Some (#.Some [right _]))] - (== left right) - - _ - false))) + (io.run + (do io.monad + [?left (promise.poll left) + ?right (promise.poll right)] + (wrap (case [?left ?right] + [(#.Some (#.Some [left _])) + (#.Some (#.Some [right _]))] + (== left right) + + _ + false)))))) (def: #export test Test @@ -72,12 +75,15 @@ _ (:: sink close)] (wrap channel))) (#try.Success channel) - (case (promise.poll channel) - (#.Some (#.Some [actual _])) - (n.= sample actual) - - _ - false) + (io.run + (do io.monad + [?actual (promise.poll channel)] + (wrap (case ?actual + (#.Some (#.Some [actual _])) + (n.= sample actual) + + _ + false)))) (#try.Failure error) false)) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 5b412e212..3e2d8982b 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -1,73 +1,171 @@ (.module: [lux #* ["_" test (#+ Test)] - [abstract/monad (#+ do)] + [abstract + [monad (#+ do)] + {[0 #test] + [/ + ["$." functor (#+ Injection Comparison)] + ["$." apply] + ["$." monad]]}] [control - pipe + [pipe (#+ case>)] ["." io]] - ["%" data/text/format (#+ format)] + [data + [number + ["n" nat] + ["i" int]]] + [time + ["." instant] + ["." duration]] [math - ["r" random]]] + ["." random]]] {1 - ["." / ("#@." monad)]}) + ["." / + [// + ["." atom (#+ Atom)]]]}) + +(def: injection + (Injection /.Promise) + /.resolved) + +(def: comparison + (Comparison /.Promise) + (function (_ == left right) + (io.run + (do io.monad + [?left (/.poll left) + ?right (/.poll right)] + (wrap (case [?left ?right] + [(#.Some left) + (#.Some right)] + (== left right) + + _ + false)))))) (def: #export test Test - (do r.monad - [_ (wrap [])] - (<| (_.context (%.name (name-of /.Promise))) + (<| (_.covering /._) + (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 + #let [not-dummy (|> random.nat (random.filter (|>> (n.= dummy) not)))] + leftE not-dummy + rightE not-dummy] ($_ _.and + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + (wrap (do /.monad - [running? (/.future (io.io #1))] - (_.assert "Can run IO actions in separate threads." - running?))) - + [#let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] + (/.promise []))] + resolved? (/.future (resolver expected)) + actual promise] + (_.claim [/.Promise /.Resolver /.promise] + (and resolved? + (n.= expected actual))))) (wrap (do /.monad - [_ (/.wait 500)] - (_.assert "Can wait for a specified amount of time." - #1))) - + [actual (/.resolved expected)] + (_.claim [/.resolved] + (n.= expected actual)))) (wrap (do /.monad - [[left right] (/.and (/.future (io.io #1)) - (/.future (io.io #0)))] - (_.assert "Can combine promises sequentially." - (and left (not right))))) - + [actual (/.future (io.io expected))] + (_.claim [/.future] + (n.= expected actual)))) (wrap (do /.monad - [?left (/.or (/.delay 100 #1) - (/.delay 200 #0)) - ?right (/.or (/.delay 200 #1) - (/.delay 100 #0))] - (_.assert "Can combine promises alternatively." - (case [?left ?right] - [(#.Left #1) (#.Right #0)] - #1 - - _ - #0)))) - + [pre (/.future instant.now) + actual (/.schedule to-wait (io.io expected)) + post (/.future instant.now)] + (_.claim [/.schedule] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad - [?left (/.either (/.delay 100 #1) - (/.delay 200 #0)) - ?right (/.either (/.delay 200 #1) - (/.delay 100 #0))] - (_.assert "Can combine promises alternatively [Part 2]." - (and ?left (not ?right))))) + [pre (/.future instant.now) + _ (/.wait to-wait) + post (/.future instant.now)] + (_.claim [/.wait] + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post)))))) + (wrap (do /.monad + [[leftA rightA] (/.and (/.future (io.io leftE)) + (/.future (io.io rightE)))] + (_.claim [/.and] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (wrap (do /.monad + [pre (/.future instant.now) + actual (/.delay to-wait expected) + post (/.future instant.now)] + (_.claim [/.delay] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) + (wrap (do /.monad + [?left (/.or (/.delay 10 leftE) + (/.delay 20 dummy)) + ?right (/.or (/.delay 20 dummy) + (/.delay 10 rightE))] + (_.claim [/.or] + (case [?left ?right] + [(#.Left leftA) (#.Right rightA)] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA)) - (_.test "Can poll a promise for its value." - (and (|> (/.poll (/@wrap #1)) - (case> (#.Some #1) #1 _ #0)) - (|> (/.poll (/.delay 200 #1)) - (case> #.None #1 _ #0)))) + _ + false)))) + (wrap (do /.monad + [leftA (/.either (/.delay 10 leftE) + (/.delay 20 dummy)) + rightA (/.either (/.delay 20 dummy) + (/.delay 10 rightE))] + (_.claim [/.either] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) + (wrap (do /.monad + [?actual (/.future (/.poll (/.resolved expected))) + #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] + (/.promise []))] + ?never (/.future (/.poll promise))] + (_.claim [/.poll] + (case [?actual ?never] + [(#.Some actual) #.None] + (n.= expected actual) + _ + false)))) + (wrap (do /.monad + [yep (/.future (/.resolved? (/.resolved expected))) + #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] + (/.promise []))] + nope (/.future (/.resolved? promise))] + (_.claim [/.resolved?] + (and yep + (not nope))))) (wrap (do /.monad - [?none (/.time-out 100 (/.delay 200 #1)) - ?some (/.time-out 200 (/.delay 100 #1))] - (_.assert "Can establish maximum waiting times for promises to be fulfilled." - (case [?none ?some] - [#.None (#.Some #1)] - #1 + [?none (/.time-out to-wait (/.delay extra-time dummy)) + ?actual (/.time-out extra-time (/.delay to-wait expected))] + (_.claim [/.time-out] + (case [?none ?actual] + [#.None (#.Some actual)] + (n.= expected actual) - _ - #0)))) + _ + false)))) + (wrap (do /.monad + [#let [box (: (Atom Nat) + (atom.atom dummy))] + _ (/.future (/.await (function (_ value) + (atom.write value box)) + (/.resolved expected))) + actual (/.future (atom.read box))] + (_.claim [/.await] + (n.= expected actual)))) )))) |