Parallel compilation for the new compiler(s).

3 files changed, 179 insertions, 128 deletions

diff --git a/stdlib/source/test/lux/abstract/equivalence.lux b/stdlib/source/test/lux/abstract/equivalence.lux
index b7db2ee70..7cc5c95f9 100644
--- a/stdlib/source/test/lux/abstract/equivalence.lux
+++ b/stdlib/source/test/lux/abstract/equivalence.lux
@@ -18,7 +18,9 @@
     [leftN random.nat
      rightN random.nat
      leftI random.int
-     rightI random.int]
+     rightI random.int
+     sample random.nat
+     different (|> random.nat (random.filter (|>> (n.= sample) not)))]
     (<| (_.covering /._)
         ($_ _.and
             (_.cover [/.sum]
@@ -38,7 +40,26 @@
                                    (:: equivalence = [leftN leftI] [leftN leftI]))
                             (bit@= (and (:: n.equivalence = leftN rightN)
                                         (:: i.equivalence = leftI rightI))
-                                   (:: equivalence = [leftN leftI] [rightN rightI])))))))))
+                                   (:: equivalence = [leftN leftI] [rightN rightI])))))
+            (_.cover [/.rec]
+                     (let [equivalence (: (Equivalence (List Nat))
+                                          (/.rec (function (_ equivalence)
+                                                   (structure
+                                                    (def: (= left right)
+                                                      (case [left right]
+                                                        [#.Nil #.Nil]
+                                                        true
+
+                                                        [(#.Cons leftH lefT) (#.Cons rightH rightT)]
+                                                        (and (n.= leftH rightH)
+                                                             (:: equivalence = lefT rightT))
+
+                                                        _
+                                                        false))))))]
+                       (and (:: equivalence = (list sample sample) (list sample sample))
+                            (not (:: equivalence = (list sample sample) (list sample)))
+                            (not (:: equivalence = (list sample sample) (list different different))))))
+            ))))
 
 (def: #export (spec (^open "_@.") generator)
   (All [a] (-> (Equivalence a) (Random a) Test))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index b393e1325..dbfb5b4a4 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -22,6 +22,7 @@
     ["#." frp]
     ["#." process]
     ["#." promise]
+    ["#." semaphore]
     ["#." stm]]
    ["#." parser #_
     ["#/." text]
@@ -29,8 +30,7 @@
    [security
     ["#." policy]]
    [function
-    ["#." memo]]
-   ])
+    ["#." memo]]])
 
 (def: concurrency
   Test
@@ -40,6 +40,7 @@
       /frp.test
       /process.test
       /promise.test
+      /semaphore.test
       /stm.test
       ))
 
diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux
index bd5d72d43..e26c1a0f2 100644
--- a/stdlib/source/test/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux
@@ -1,146 +1,175 @@
 (.module:
   [lux #*
+   ["_" test (#+ Test)]
    [abstract
     ["." monad (#+ do)]]
    [control
     ["." io]
+    ["." try]
+    ["." exception (#+ exception:)]
     [concurrency
-     ["/" semaphore]
      ["." promise (#+ Promise)]
      ["." atom (#+ Atom)]]]
    [data
     ["." maybe]
     [number
      ["n" nat]]
-    ["." text ("#;." equivalence monoid)
+    ["." text ("#@." equivalence)
      ["%" format (#+ format)]]
     [collection
-     ["." list ("#;." functor)]]]
+     ["." list ("#@." functor)]]]
+   [type
+    ["." refinement]]
    [math
-    ["r" random]]]
-  lux/test)
+    ["." random]]]
+  {1
+   ["." /]})
 
-## (def: (wait-many-times times semaphore)
-##   (-> Nat /.Semaphore (Promise Any))
-##   (loop [steps times]
-##     (if (n.> 0 steps)
-##       (do promise.monad
-##         [_ (/.wait semaphore)]
-##         (recur (dec steps)))
-##       (:: promise.monad wrap []))))
+(def: semaphore
+  Test
+  (_.with-cover [/.Semaphore]
+    ($_ _.and
+        (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))]
+                  (_.claim [/.semaphore]
+                           (case result
+                             (#.Some _)
+                             true
 
-## (context: "Semaphore."
-##   (<| (times 100)
-##       (do @
-##         [open-positions (|> r.nat (:: @ map (|>> (n.% 10) (n.max 1))))]
-##         ($_ seq
-##             (let [semaphore (/.semaphore open-positions)]
-##               (wrap (do promise.monad
-##                       [_ (wait-many-times open-positions semaphore)]
-##                       (assert "Can wait on a semaphore up to the number of open positions without blocking."
-##                               true))))
-##             (let [semaphore (/.semaphore open-positions)]
-##               (wrap (do promise.monad
-##                       [result (<| (promise.time-out 100)
-##                                   (wait-many-times (inc open-positions) semaphore))]
-##                       (assert "Waiting on a semaphore more than the number of open positions blocks the process."
-##                               (case result
-##                                 (#.Some _)
-##                                 false
+                             #.None
+                             false)))))
+        (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))
+                   result (promise.time-out 10 (/.wait semaphore))]
+                  (_.claim [/.wait]
+                           (case result
+                             (#.Some _)
+                             false
 
-##                                 #.None
-##                                 true)))))
-##             (let [semaphore (/.semaphore open-positions)]
-##               (wrap (do promise.monad
-##                       [_ (: (Promise Any)
-##                             (loop [steps (n.* 2 open-positions)]
-##                               (if (n.> 0 steps)
-##                                 (do @
-##                                   [_ (/.wait semaphore)
-##                                    _ (/.signal semaphore)]
-##                                   (recur (dec steps)))
-##                                 (wrap []))))]
-##                       (assert "Signaling a semaphore replenishes its open positions."
-##                               true))))
-##             (let [semaphore (/.semaphore open-positions)]
-##               (wrap (do promise.monad
-##                       [#let [resource (atom.atom "")
-##                              blocked (do @
-##                                        [_ (wait-many-times open-positions semaphore)
-##                                         _ (/.wait semaphore)
-##                                         #let [_ (io.run (atom.update (|>> (format "B"))
-##                                                                      resource))]]
-##                                        (wrap []))]
-##                        _ (promise.wait 100)
-##                        _ (exec (io.run (atom.update (|>> (format "A"))
-##                                                     resource))
-##                            (/.signal semaphore))
-##                        _ blocked]
-##                       (assert "A blocked process can be un-blocked by a signal somewhere else."
-##                               (text;= "BA"
-##                                       (io.run (atom.read resource)))))))
-##             ))))
+                             #.None
+                             true)))))
+        (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))
+                   #let [block (/.wait semaphore)]
+                   result/0 (promise.time-out 10 block)
+                   open-positions (/.signal semaphore)
+                   result/1 (promise.time-out 10 block)]
+                  (_.claim [/.signal]
+                           (case [result/0 result/1 open-positions]
+                             [#.None (#.Some _) (#try.Success +0)]
+                             true
 
-## (context: "Mutex."
-##   (<| (times 100)
-##       (do @
-##         [repetitions (|> r.nat (:: @ map (|>> (n.% 100) (n.max 10))))]
-##         ($_ seq
-##             (let [mutex (/.mutex [])]
-##               (wrap (do promise.monad
-##                       [#let [resource (atom.atom "")
-##                              expected-As (text.join-with "" (list.repeat repetitions "A"))
-##                              expected-Bs (text.join-with "" (list.repeat repetitions "B"))
-##                              processA (<| (/.synchronize mutex)
-##                                           io.io
-##                                           promise.future
-##                                           (do io.monad
-##                                             [_ (<| (monad.seq @)
-##                                                    (list.repeat repetitions)
-##                                                    (atom.update (|>> (format "A")) resource))]
-##                                             (wrap [])))
-##                              processB (<| (/.synchronize mutex)
-##                                           io.io
-##                                           promise.future
-##                                           (do io.monad
-##                                             [_ (<| (monad.seq @)
-##                                                    (list.repeat repetitions)
-##                                                    (atom.update (|>> (format "B")) resource))]
-##                                             (wrap [])))]
-##                        _ processA
-##                        _ processB
-##                        #let [outcome (io.run (atom.read resource))]]
-##                       (assert "Mutexes only allow one process to execute at a time."
-##                               (or (text;= (format expected-As expected-Bs)
-##                                           outcome)
-##                                   (text;= (format expected-Bs expected-As)
-##                                           outcome))))))
-##             ))))
+                             _
+                             false)))))
+        (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)]
+                  (_.claim [/.semaphore-is-maxed-out]
+                           (case outcome
+                             (#try.Failure error)
+                             (exception.match? /.semaphore-is-maxed-out error)
 
-## (def: (waiter resource barrier id)
-##   (-> (Atom Text) /.Barrier Nat (Promise Any))
-##   (do promise.monad
-##     [_ (/.block barrier)
-##      #let [_ (io.run (atom.update (|>> (format (%.nat id))) resource))]]
-##     (wrap [])))
+                             _
+                             false)))))
+        )))
 
-## (context: "Barrier."
-##   (let [limit 10
-##         barrier (/.barrier (maybe.assume (/.limit limit)))
-##         resource (atom.atom "")]
-##     ($_ seq
-##         (wrap (do promise.monad
-##                 [#let [ids (list.n/range 0 (dec limit))
-##                        waiters (list;map (function (_ id)
-##                                            (let [process (waiter resource barrier id)]
-##                                              (exec (io.run (atom.update (|>> (format "_")) resource))
-##                                                process)))
-##                                          ids)]
-##                  _ (monad.seq @ waiters)
-##                  #let [outcome (io.run (atom.read resource))]]
-##                 (assert "A barrier can stop all processes from acting, until an amount of waiting processes is reached, and then the barrier is un-blocked for all."
-##                         (and (text.ends-with? "__________" outcome)
-##                              (list.every? (function (_ id)
-##                                             (text.contains? (%.nat id) outcome))
-##                                           ids)
-##                              )))))))
+(def: mutex
+  Test
+  (_.with-cover [/.Mutex]
+    ($_ _.and
+        (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"))
+                 mutex (/.mutex [])
+                 processA (<| (/.synchronize mutex)
+                              io.io
+                              promise.future
+                              (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 @)
+                                       (list.repeat repetitions)
+                                       (atom.update (|>> (format "B")) resource))]
+                                (wrap [])))]]
+          (wrap (do promise.monad
+                  [_ processA
+                   _ processB
+                   #let [outcome (io.run (atom.read resource))]]
+                  (_.claim [/.mutex /.synchronize]
+                           (or (text@= (format expected-As expected-Bs)
+                                       outcome)
+                               (text@= (format expected-Bs expected-As)
+                                       outcome))))))
+        )))
+
+(def: (waiter resource barrier id)
+  (-> (Atom Text) /.Barrier Nat (Promise Any))
+  (do promise.monad
+    [_ (/.block barrier)
+     _ (promise.future (atom.update (|>> (format (%.nat id))) resource))]
+    (wrap [])))
+
+(def: barrier
+  Test
+  (_.with-cover [/.Barrier]
+    ($_ _.and
+        (do random.monad
+          [raw random.nat]
+          (_.cover [/.Limit /.limit]
+                   (case [raw (/.limit raw)]
+                     [0 #.None]
+                     true
+                     
+                     [_ (#.Some limit)]
+                     (and (n.> 0 raw)
+                          (n.= raw (refinement.un-refine limit))))))
+        (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
+                  [#let [ending (|> "_"
+                                    (list.repeat limit)
+                                    (text.join-with ""))
+                         ids (list.n/range 0 (dec limit))
+                         waiters (list@map (function (_ id)
+                                             (exec (io.run (atom.update (|>> (format "_")) resource))
+                                               (waiter resource barrier id)))
+                                           ids)]
+                   _ (monad.seq @ waiters)
+                   #let [outcome (io.run (atom.read resource))]]
+                  (_.claim [/.barrier /.block]
+                           (and (text.ends-with? ending outcome)
+                                (list.every? (function (_ id)
+                                               (text.contains? (%.nat id) outcome))
+                                             ids)
+                                )))))
+        )))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      ($_ _.and
+          ..semaphore
+          ..mutex
+          ..barrier
+          )))