Made test-running parallel again.

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))))
             ))))