Parallel compilation for the new compiler(s).

16 files changed, 633 insertions, 400 deletions

diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux
index cabbb1154..bda5f60d9 100644
--- a/stdlib/source/lux.lux
+++ b/stdlib/source/lux.lux
@@ -2702,7 +2702,11 @@
        (let' [[left right] pair]
              (list left right)))
 
-(def:' (%code code)
+(def:' (text@encode original)
+       (-> Text Text)
+       ($_ text@compose ..double-quote original ..double-quote))
+
+(def:' (code@encode code)
        (-> Code Text)
        ({[_ (#Bit value)]
          (bit@encode value)
@@ -2720,7 +2724,7 @@
          (frac@encode value)
 
          [_ (#Text value)]
-         ($_ text@compose ..double-quote value ..double-quote)
+         (text@encode value)
          
          [_ (#Identifier [prefix name])]
          (if (text@= "" prefix)
@@ -2734,21 +2738,21 @@
          
          [_ (#Form xs)]
          ($_ text@compose "(" (|> xs
-                                  (list@map %code)
+                                  (list@map code@encode)
                                   (interpose " ")
                                   list@reverse
                                   (list@fold text@compose "")) ")")
          
          [_ (#Tuple xs)]
          ($_ text@compose "[" (|> xs
-                                  (list@map %code)
+                                  (list@map code@encode)
                                   (interpose " ")
                                   list@reverse
                                   (list@fold text@compose "")) "]")
          
          [_ (#Record kvs)]
          ($_ text@compose "{" (|> kvs
-                                  (list@map (function' [kv] ({[k v] ($_ text@compose (%code k) " " (%code v))}
+                                  (list@map (function' [kv] ({[k v] ($_ text@compose (code@encode k) " " (code@encode v))}
                                                              kv)))
                                   (interpose " ")
                                   list@reverse
@@ -2782,7 +2786,7 @@
 
          _
          (fail ($_ text@compose "'lux.case' expects an even number of tokens: " (|> branches
-                                                                                    (list@map %code)
+                                                                                    (list@map code@encode)
                                                                                     (interpose " ")
                                                                                     list@reverse
                                                                                     (list@fold text@compose ""))))}
@@ -2991,13 +2995,13 @@
          _
          (` (#.Cons [[(~ cursor-code) (#.Tag ["lux" "func-args"])]
                      [(~ cursor-code) (#.Tuple (.list (~+ (list@map (function (_ arg)
-                                                                      (` [(~ cursor-code) (#.Text (~ (text$ (%code arg))))]))
+                                                                      (` [(~ cursor-code) (#.Text (~ (text$ (code@encode arg))))]))
                                                                     args))))]]
                     (~ meta)))))
 
 (def:' (with-type-args args)
        (-> (List Code) Code)
-       (` {#.type-args [(~+ (list@map (function (_ arg) (text$ (%code arg)))
+       (` {#.type-args [(~+ (list@map (function (_ arg) (text$ (code@encode arg)))
                                       args))]}))
 
 (def:' (export^ tokens)
@@ -3987,18 +3991,18 @@
                                   [current-module current-module-name]
                                   (fail ($_ text@compose
                                             "Wrong syntax for import @ " current-module
-                                            ..new-line (%code token)))))))
+                                            ..new-line (code@encode token)))))))
                          imports)]
     (wrap (list@join imports'))))
 
 (def: (exported-definitions module state)
   (-> Text (Meta (List Text)))
-  (let [modules (case state
-                  {#info info #source    source  #current-module _ #modules modules
-                   #scopes scopes #type-context types    #host    host
-                   #seed seed #expected  expected #cursor  cursor #extensions extensions
-                   #scope-type-vars scope-type-vars}
-                  modules)]
+  (let [[current-module modules] (case state
+                                   {#info info #source    source  #current-module current-module #modules modules
+                                    #scopes scopes #type-context types    #host    host
+                                    #seed seed #expected  expected #cursor  cursor #extensions extensions
+                                    #scope-type-vars scope-type-vars}
+                                   [current-module modules])]
     (case (get module modules)
       (#Some =module)
       (let [to-alias (list@map (: (-> [Text Global]
@@ -4017,7 +4021,19 @@
         (#Right state (list@join to-alias)))
       
       #None
-      (#Left ($_ text@compose "Unknown module: " module)))
+      (#Left ($_ text@compose
+                 "Unknown module: " (text@encode module) ..new-line
+                 "Current module: " (case current-module
+                                      (#Some current-module)
+                                      (text@encode current-module)
+
+                                      #None
+                                      "???") ..new-line
+                 "Known modules: " (|> modules
+                                       (list@map (function (_ [name module])
+                                                   (text$ name)))
+                                       tuple$
+                                       code@encode))))
     ))
 
 (def: (filter p xs)
@@ -4484,7 +4500,7 @@
       _
       (fail ($_ text@compose "Wrong syntax for refer @ " current-module
                 ..new-line (|> options
-                               (list@map %code)
+                               (list@map code@encode)
                                (interpose " ")
                                (list@fold text@compose "")))))))
 
@@ -4892,10 +4908,6 @@
     _
     (#Doc-Example code)))
 
-(def: (text@encode original)
-  (-> Text Text)
-  ($_ text@compose ..double-quote original ..double-quote))
-
 (template [<name> <extension> <doc>]
   [(def: #export <name>
      {#.doc <doc>}
@@ -5547,7 +5559,7 @@
                 (undefined)))}
   (case tokens
     #Nil
-    (return (list (` (error! "Undefined behavior."))))
+    (return (list (` (..error! "Undefined behavior."))))
     
     _
     (fail (..wrong-syntax-error (name-of ..undefined)))))
diff --git a/stdlib/source/lux/control/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux
index ade45984e..39bac32a1 100644
--- a/stdlib/source/lux/control/concurrency/semaphore.lux
+++ b/stdlib/source/lux/control/concurrency/semaphore.lux
@@ -2,79 +2,115 @@
   [lux #*
    [abstract
     [monad (#+ do)]]
+   [control
+    ["." io (#+ IO)]
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]
    [data
+    [text
+     ["%" format (#+ format)]]
     [number
-     ["n" nat]]]
-   [control
-    ["." io (#+ IO)]]
+     ["n" nat]
+     ["i" int]]
+    [collection
+     ["." queue (#+ Queue)]]]
    [type
     abstract
-    ["." refinement]]]
+    ["." refinement]]
+   ["." macro]]
   [//
    ["." atom (#+ Atom)]
-   ["." promise (#+ Promise)]])
+   ["." promise (#+ Promise Resolver)]])
 
 (type: State
-  {#open-positions Nat
-   #waiting-list (List (Promise Any))})
+  {#max-positions Nat
+   #open-positions Int
+   #waiting-list (Queue (Resolver Any))})
 
 (abstract: #export Semaphore
   {#.doc "A tool for controlling access to resources by multiple concurrent processes."}
 
   (Atom State)
 
-  (def: #export (semaphore init-open-positions)
+  (def: most-positions-possible
+    (.nat (:: i.interval top)))
+
+  (def: #export (semaphore initial-open-positions)
     (-> Nat Semaphore)
-    (:abstraction (atom.atom {#open-positions init-open-positions
-                              #waiting-list (list)})))
+    (let [max-positions (n.min initial-open-positions
+                               ..most-positions-possible)]
+      (:abstraction (atom.atom {#max-positions max-positions
+                                #open-positions (.int max-positions)
+                                #waiting-list queue.empty}))))
 
   (def: #export (wait semaphore)
     (Ex [k] (-> Semaphore (Promise Any)))
-    (let [semaphore (:representation semaphore)]
-      (io.run
-       (loop [signal (: (Promise Any)
-                        (promise.promise #.None))]
-         (do io.monad
-           [state (atom.read semaphore)
-            #let [[ready? state'] (: [Bit State]
-                                     (case (get@ #open-positions state)
-                                       0 [#0 (update@ #waiting-list (|>> (#.Cons signal))
-                                                      state)]
-                                       _ [#1 (update@ #open-positions dec
-                                                      state)]))]
-            success? (atom.compare-and-swap state state' semaphore)
-            _ (if ready?
-                (promise.resolve [] signal)
-                (wrap #0))]
-           (if success?
-             (wrap signal)
-             (recur signal)))))))
+    (let [semaphore (:representation semaphore)
+          [signal sink] (: [(Promise Any) (Resolver Any)]
+                           (promise.promise []))]
+      (exec (promise.future
+             (loop [_ []]
+               (do io.monad
+                 [state (atom.read semaphore)
+                  #let [[ready? state'] (: [Bit State]
+                                           (if (i.> +0 (get@ #open-positions state))
+                                             [true (|> state
+                                                       (update@ #open-positions dec))]
+                                             [false (|> state
+                                                        (update@ #open-positions dec)
+                                                        (update@ #waiting-list (queue.push sink)))]))]
+                  success? (atom.compare-and-swap state state' semaphore)]
+                 (if success?
+                   (if ready?
+                     (sink [])
+                     (wrap false))
+                   (recur [])))))
+        signal)))
+
+  (exception: #export (semaphore-is-maxed-out {max-positions Nat})
+    (exception.report
+     ["Max Positions" (%.nat max-positions)]))
 
   (def: #export (signal semaphore)
-    (Ex [k] (-> Semaphore (Promise Any)))
+    (Ex [k] (-> Semaphore (Promise (Try Int))))
     (let [semaphore (:representation semaphore)]
       (promise.future
        (loop [_ []]
          (do io.monad
            [state (atom.read semaphore)
-            #let [[?signal state'] (: [(Maybe (Promise Any)) State]
-                                      (case (get@ #waiting-list state)
-                                        #.Nil
-                                        [#.None (update@ #open-positions inc state)]
-                                        
-                                        (#.Cons head tail)
-                                        [(#.Some head) (set@ #waiting-list tail state)]))]
-            success? (atom.compare-and-swap state state' semaphore)]
-           (if success?
+            #let [[?sink state' maxed-out?] (: [(Maybe (Resolver Any)) State Bit]
+                                               (case (queue.peek (get@ #waiting-list state))
+                                                 #.None
+                                                 (if (n.= (get@ #max-positions state)
+                                                          (.nat (get@ #open-positions state)))
+                                                   [#.None
+                                                    state
+                                                    true]
+                                                   [#.None
+                                                    (update@ #open-positions inc state)
+                                                    false])
+                                                 
+                                                 (#.Some head)
+                                                 [(#.Some head)
+                                                  (|> state
+                                                      (update@ #open-positions inc)
+                                                      (update@ #waiting-list queue.pop))
+                                                  false]))]]
+           (if maxed-out?
+             (wrap (exception.throw ..semaphore-is-maxed-out [(get@ #max-positions state)]))
              (do @
-               [_ (case ?signal
-                    #.None
-                    (wrap #1)
-
-                    (#.Some signal)
-                    (promise.resolve [] signal))]
-               (wrap []))
-             (recur [])))))))
+               [#let [open-positions (get@ #open-positions state')]
+                success? (atom.compare-and-swap state state' semaphore)]
+               (if success?
+                 (do @
+                   [_ (case ?sink
+                        #.None
+                        (wrap true)
+
+                        (#.Some sink)
+                        (sink []))]
+                   (wrap (#try.Success open-positions)))
+                 (recur [])))))))))
   )
 
 (abstract: #export Mutex
@@ -104,7 +140,7 @@
   )
 
 (def: #export limit (refinement.refinement (n.> 0)))
-(`` (type: #export Limit (~~ (refinement.type limit))))
+(type: #export Limit (:~ (refinement.type limit)))
 
 (abstract: #export Barrier
   {#.doc "A barrier that blocks all processes from proceeding until a given number of processes are parked at the barrier."}
@@ -126,7 +162,7 @@
     (loop [step 0]
       (if (n.< times step)
         (do promise.monad
-          [_ (signal turnstile)]
+          [_ (..signal turnstile)]
           (recur (inc step)))
         (:: promise.monad wrap []))))
 
@@ -136,11 +172,11 @@
        (do promise.monad
          [#let [limit (refinement.un-refine (get@ #limit barrier))
                 goal <goal>
-                count (io.run (atom.update <update> (get@ #count barrier)))]
-          _ (if (n.= goal count)
-              (un-block limit (get@ <turnstile> barrier))
-              (wrap []))]
-         (wait (get@ <turnstile> barrier))))]
+                count (io.run (atom.update <update> (get@ #count barrier)))
+                reached? (n.= goal count)]]
+         (if reached?
+           (un-block limit (get@ <turnstile> barrier))
+           (wait (get@ <turnstile> barrier)))))]
 
     [start inc limit #start-turnstile]
     [end   dec 0     #end-turnstile]
@@ -149,6 +185,6 @@
   (def: #export (block barrier)
     (-> Barrier (Promise Any))
     (do promise.monad
-      [_ (start barrier)]
-      (end barrier)))
+      [_ (..start barrier)]
+      (..end barrier)))
   )
diff --git a/stdlib/source/lux/data/collection/queue.lux b/stdlib/source/lux/data/collection/queue.lux
index 9bf4dcf81..c0e16ee29 100644
--- a/stdlib/source/lux/data/collection/queue.lux
+++ b/stdlib/source/lux/data/collection/queue.lux
@@ -7,7 +7,7 @@
     [number
      ["n" nat]]
     [collection
-     ["." list ("#;." monoid functor)]]]])
+     ["." list ("#@." monoid functor)]]]])
 
 (type: #export (Queue a)
   {#front (List a)
@@ -26,7 +26,7 @@
 (def: #export (to-list queue)
   (All [a] (-> (Queue a) (List a)))
   (let [(^slots [#front #rear]) queue]
-    (list;compose front (list.reverse rear))))
+    (list@compose front (list.reverse rear))))
 
 (def: #export peek
   (All [a] (-> (Queue a) (Maybe a)))
@@ -79,5 +79,5 @@
 
 (structure: #export functor (Functor Queue)
   (def: (map f fa)
-    {#front (|> fa (get@ #front) (list;map f))
-     #rear (|> fa (get@ #rear) (list;map f))}))
+    {#front (|> fa (get@ #front) (list@map f))
+     #rear (|> fa (get@ #rear) (list@map f))}))
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 76939bb08..f562e762a 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -7,7 +7,8 @@
    [control
     ["." try (#+ Try)]
     [concurrency
-     ["." promise (#+ Promise) ("#@." monad)]]]
+     ["." promise (#+ Promise Resolver) ("#@." monad)]
+     ["." stm (#+ Var STM)]]]
    [data
     ["." binary (#+ Binary)]
     ["." bit]
@@ -15,10 +16,10 @@
     ["." text
      ["%" format (#+ format)]]
     [collection
-     [dictionary (#+ Dictionary)]
-     ["." row ("#@." fold)]
+     ["." dictionary (#+ Dictionary)]
+     ["." row (#+ Row) ("#@." fold)]
      ["." set]
-     ["." list ("#@." monoid)]]
+     ["." list ("#@." monoid functor fold)]]
     [format
      ["_" binary (#+ Writer)]]]
    [world
@@ -51,7 +52,8 @@
       ["ioW" archive]]]]]
   [program
    [compositor
-    ["." cli (#+ Configuration)]]])
+    ["." cli (#+ Configuration)]
+    ["." static (#+ Static)]]])
 
 (type: #export (Platform anchor expression directive)
   {#&file-system (file.System Promise)
@@ -79,23 +81,23 @@
     (_.and descriptor.writer
            (document.writer $.writer)))
 
-  (def: (cache-module platform host target-dir module-id extension [[descriptor document] output])
+  (def: (cache-module static platform module-id [[descriptor document] output])
     (All [<type-vars>]
-      (-> <Platform> Host Path archive.ID Text [[Descriptor (Document Any)] Output]
+      (-> Static <Platform> archive.ID [[Descriptor (Document Any)] Output]
           (Promise (Try Any))))
     (let [system (get@ #&file-system platform)
           write-artifact! (: (-> [Text Binary] (Action Any))
                              (function (_ [name content])
-                               (ioW.write system host target-dir module-id name extension content)))]
+                               (ioW.write system (get@ #static.host static) (get@ #static.target static) module-id name (get@ #static.artifact-extension static) content)))]
       (do ..monad
-        [_ (ioW.prepare system host target-dir module-id)
+        [_ (ioW.prepare system (get@ #static.host static) (get@ #static.target static) module-id)
          _ (|> output
                row.to-list
                (monad.map ..monad write-artifact!)
                (: (Action (List Any))))
          document (:: promise.monad wrap
                       (document.check $.key document))]
-        (ioW.cache system host target-dir module-id
+        (ioW.cache system (get@ #static.host static) (get@ #static.target static) module-id
                    (_.run ..writer [descriptor document])))))
 
   ## TODO: Inline ASAP
@@ -173,11 +175,9 @@
         (///phase.run' state)
         (:: try.monad map product.left)))
 
-  (def: #export (initialize extension target host module expander host-analysis platform generation-bundle host-directive-bundle program extender)
+  (def: #export (initialize static module expander host-analysis platform generation-bundle host-directive-bundle program extender)
     (All [<type-vars>]
-      (-> Text
-          Path
-          Host
+      (-> Static
           Module
           Expander
           ///analysis.Bundle
@@ -188,7 +188,7 @@
           Extender
           (Promise (Try [<State+> Archive]))))
     (do (try.with promise.monad)
-      [#let [state (//init.state host
+      [#let [state (//init.state (get@ #static.host static)
                                  module
                                  expander
                                  host-analysis
@@ -198,8 +198,8 @@
                                  host-directive-bundle
                                  program
                                  extender)]
-       _ (ioW.enable (get@ #&file-system platform) host target)
-       [archive analysis-state bundles] (ioW.thaw extension (get@ #host platform) (get@ #&file-system platform) host target)
+       _ (ioW.enable (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static))
+       [archive analysis-state bundles] (ioW.thaw (get@ #static.artifact-extension static) (get@ #host platform) (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static))
        state (promise@wrap (initialize-state extender bundles analysis-state state))]
       (if (archive.archived? archive archive.runtime-module)
         (wrap [state archive])
@@ -207,7 +207,7 @@
           [[state [archive payload]] (|> (..process-runtime archive platform)
                                          (///phase.run' state)
                                          promise@wrap)
-           _ (..cache-module platform host target 0 extension payload)]
+           _ (..cache-module static platform 0 payload)]
           (wrap [state archive])))))
 
   (def: module-compilation-log
@@ -232,83 +232,212 @@
            #///generation.log]
           row.empty))
 
-  (def: #export (compile target partial-host-extension expander platform host configuration archive extension state)
-    (All [<type-vars>]
-      (-> Text Text Expander <Platform> Host Configuration Archive Text <State+> (Promise (Try [Archive <State+>]))))
-    (let [source-module (get@ #cli.module configuration)
-          compiler (:share [<type-vars>]
-                           {<State+>
-                            state}
-                           {(///.Compiler <State+> .Module Any)
-                            ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list))})]
-      (loop [module source-module
-             [archive state] [archive state]]
-        (if (archive.archived? archive module)
-          (promise@wrap (#try.Success [archive state]))
-          (let [import! (:share [<type-vars>]
-                                {<Platform>
-                                 platform}
-                                {(-> Module [Archive <State+>]
-                                     (Action [Archive <State+>]))
-                                 recur})]
-            (do (try.with promise.monad)
-              [[module-id archive] (promise@wrap (archive.reserve module archive))
-               input (context.read (get@ #&file-system platform)
-                                   (get@ #cli.sources configuration)
-                                   partial-host-extension
-                                   module)]
-              (loop [archive archive
-                     state state
-                     compilation (compiler (:coerce ///.Input input))
-                     all-dependencies (: (List Module)
-                                         (list))]
-                (do @
-                  [#let [new-dependencies (get@ #///.dependencies compilation)
-                         all-dependencies (list@compose new-dependencies all-dependencies)]
-                   [archive state] (:share [<type-vars>]
-                                           {<Platform>
-                                            platform}
-                                           {(Action [Archive <State+>])
-                                            (monad.fold ..monad import! [archive state] new-dependencies)})
-                   #let [continue! (:share [<type-vars>]
-                                           {<Platform>
-                                            platform}
-                                           {(-> Archive <State+> (///.Compilation <State+> .Module Any) (List Module)
-                                                (Action [Archive <State+>]))
-                                            recur})]]
-                  (case ((get@ #///.process compilation)
-                         (case new-dependencies
-                           #.Nil
-                           state
+  (with-expansions [<Context> (as-is [Archive <State+>])
+                    <Result> (as-is (Try <Context>))
+                    <Return> (as-is (Promise <Result>))
+                    <Signal> (as-is (Resolver <Result>))
+                    <Pending> (as-is [<Return> <Signal>])
+                    <Importer> (as-is (-> Module <Return>))
+                    <Compiler> (as-is (-> <Importer> archive.ID <Context> Module <Return>))]
+    (def: (parallel initial)
+      (All [<type-vars>]
+        (-> <Context>
+            (-> <Compiler> <Importer>)))
+      (let [current (:share [<type-vars>]
+                            {<Context>
+                             initial}
+                            {(Var <Context>)
+                             (stm.var initial)})
+            pending (:share [<type-vars>]
+                            {<Context>
+                             initial}
+                            {(Var (Dictionary Module <Pending>))
+                             (stm.var (dictionary.new text.hash))})]
+        (function (_ compile)
+          (function (import! module)
+            (do promise.monad
+              [[return signal] (:share [<type-vars>]
+                                       {<Context>
+                                        initial}
+                                       {(Promise [<Return> (Maybe [<Context>
+                                                                   archive.ID
+                                                                   <Signal>])])
+                                        (stm.commit
+                                         (do stm.monad
+                                           [[archive state] (stm.read current)]
+                                           (if (archive.archived? archive module)
+                                             (wrap [(promise@wrap (#try.Success [archive state]))
+                                                    #.None])
+                                             (do @
+                                               [@pending (stm.read pending)]
+                                               (case (dictionary.get module @pending)
+                                                 (#.Some [return signal])
+                                                 (wrap [return
+                                                        #.None])
+                                                 
+                                                 #.None
+                                                 (case (archive.reserve module archive)
+                                                   (#try.Success [module-id archive])
+                                                   (do @
+                                                     [_ (stm.write [archive state] current)
+                                                      #let [[return signal] (:share [<type-vars>]
+                                                                                    {<Context>
+                                                                                     initial}
+                                                                                    {<Pending>
+                                                                                     (promise.promise [])})]
+                                                      _ (stm.update (dictionary.put module [return signal]) pending)]
+                                                     (wrap [return
+                                                            (#.Some [[archive state]
+                                                                     module-id
+                                                                     signal])]))
+                                                   
+                                                   (#try.Failure error)
+                                                   (wrap [(promise@wrap (#try.Failure error))
+                                                          #.None])))))))})
+               _ (case signal
+                   #.None
+                   (wrap [])
+                   
+                   (#.Some [context module-id resolver])
+                   (do @
+                     [result (compile import! module-id context module)
+                      result (case result
+                               (#try.Failure error)
+                               (wrap result)
+
+                               (#try.Success [resulting-archive resulting-state])
+                               (stm.commit (do stm.monad
+                                             [[_ [merged-archive _]] (stm.update (function (_ [archive state])
+                                                                                   [(archive.merge resulting-archive archive)
+                                                                                    state])
+                                                                                 current)]
+                                             (wrap (#try.Success [merged-archive resulting-state])))))
+                      _ (promise.future (resolver result))]
+                     (wrap [])))]
+              return)))))
+
+    ## TODO: Find a better way, as this only works for the Lux compiler.
+    (def: (updated-state archive state)
+      (All [<type-vars>]
+        (-> Archive <State+> (Try <State+>)))
+      (do try.monad
+        [modules (monad.map @ (function (_ module)
+                                (do @
+                                  [[descriptor document] (archive.find module archive)
+                                   lux-module (document.read $.key document)]
+                                  (wrap [module lux-module])))
+                            (archive.archived archive))
+         #let [additions (|> modules
+                             (list@map product.left)
+                             (set.from-list text.hash))]]
+        (wrap (update@ [#extension.state
+                        #///directive.analysis
+                        #///directive.state
+                        #extension.state]
+                       (function (_ analysis-state)
+                         (|> analysis-state
+                             (:coerce .Lux)
+                             (update@ #.modules (function (_ current)
+                                                  (list@compose (list.filter (|>> product.left
+                                                                                  (set.member? additions)
+                                                                                  not)
+                                                                             current)
+                                                                modules)))
+                             :assume))
+                       state))))
+
+    (def: (set-current-module module state)
+      (All [<type-vars>]
+        (-> Module <State+> <State+>))
+      (|> (///directive.set-current-module module)
+          (///phase.run' state)
+          try.assume
+          product.left))
+
+    (def: #export (compile static expander platform configuration context)
+      (All [<type-vars>]
+        (-> Static Expander <Platform> Configuration <Context> <Return>))
+      (let [base-compiler (:share [<type-vars>]
+                                  {<Context>
+                                   context}
+                                  {(///.Compiler <State+> .Module Any)
+                                   ((//init.compiler expander syntax.prelude (get@ #write platform)) $.key (list))})
+            parallel-compiler (..parallel
+                               context
+                               (function (_ import! module-id [archive state] module)
+                                 (do (try.with promise.monad)
+                                   [#let [state (..set-current-module module state)]
+                                    input (context.read (get@ #&file-system platform)
+                                                        (get@ #cli.sources configuration)
+                                                        (get@ #static.host-module-extension static)
+                                                        module)]
+                                   (loop [[archive state] [archive state]
+                                          compilation (base-compiler (:coerce ///.Input input))
+                                          all-dependencies (: (List Module)
+                                                              (list))]
+                                     (do (try.with promise.monad)
+                                       [#let [new-dependencies (get@ #///.dependencies compilation)
+                                              all-dependencies (list@compose new-dependencies all-dependencies)
+                                              continue! (:share [<type-vars>]
+                                                                {<Platform>
+                                                                 platform}
+                                                                {(-> <Context> (///.Compilation <State+> .Module Any) (List Module)
+                                                                     (Action [Archive <State+>]))
+                                                                 recur})]
+                                        archive,document+ (|> new-dependencies
+                                                              (list@map import!)
+                                                              (monad.seq ..monad))
+                                        #let [archive (case archive,document+
+                                                        #.Nil
+                                                        archive
+
+                                                        archive,document+
+                                                        (|> archive,document+
+                                                            (list@map product.left)
+                                                            (list@fold archive.merge archive)))
+                                              state (case archive,document+
+                                                      #.Nil
+                                                      state
 
-                           _
-                           ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
-                           ## TODO: The context shouldn't need to be re-set either.
-                           (|> (///directive.set-current-module module)
-                               (///phase.run' state)
-                               try.assume
-                               product.left))
-                         archive)
-                    (#try.Success [state more|done])
-                    (case more|done
-                      (#.Left more)
-                      (continue! archive state more all-dependencies)
+                                                      archive,document+
+                                                      (try.assume
+                                                       (:share [|state|]
+                                                               {|state|
+                                                                state}
+                                                               {(Try |state|)
+                                                                (..updated-state archive state)})))]]
+                                       (case ((get@ #///.process compilation)
+                                              ## TODO: The "///directive.set-current-module" below shouldn't be necessary. Remove it ASAP.
+                                              ## TODO: The context shouldn't need to be re-set either.
+                                              (|> (///directive.set-current-module module)
+                                                  (///phase.run' state)
+                                                  try.assume
+                                                  product.left)
+                                              archive)
+                                         (#try.Success [state more|done])
+                                         (case more|done
+                                           (#.Left more)
+                                           (continue! [archive state] more all-dependencies)
 
-                      (#.Right [[descriptor document] output])
-                      (do (try.with promise.monad)
-                        [#let [_ (log! (..module-compilation-log state))
-                               descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
-                         _ (..cache-module platform host target module-id extension [[descriptor document] output])]
-                        (case (archive.add module [descriptor document] archive)
-                          (#try.Success archive)
-                          (wrap [archive
-                                 (..with-reset-log state)])
-                          
-                          (#try.Failure error)
-                          (promise@wrap (#try.Failure error)))))
+                                           (#.Right [[descriptor document] output])
+                                           (do (try.with promise.monad)
+                                             [#let [_ (log! (..module-compilation-log state))
+                                                    descriptor (set@ #descriptor.references (set.from-list text.hash all-dependencies) descriptor)]
+                                              _ (..cache-module static platform module-id [[descriptor document] output])]
+                                             (case (archive.add module [descriptor document] archive)
+                                               (#try.Success archive)
+                                               (wrap [archive
+                                                      (..with-reset-log state)])
+                                               
+                                               (#try.Failure error)
+                                               (promise@wrap (#try.Failure error)))))
 
-                    (#try.Failure error)
-                    (do (try.with promise.monad)
-                      [_ (ioW.freeze (get@ #&file-system platform) host target archive)]
-                      (promise@wrap (#try.Failure error))))))))))))
-  )
+                                         (#try.Failure error)
+                                         (do (try.with promise.monad)
+                                           [_ (ioW.freeze (get@ #&file-system platform) (get@ #static.host static) (get@ #static.target static) archive)]
+                                           (promise@wrap (#try.Failure error))))
+                                       ))
+                                   )))]
+        (parallel-compiler (get@ #cli.module configuration))
+        ))
+    ))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux
index 66efb1dde..2e42e2c45 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis/evaluation.lux
@@ -1,16 +1,18 @@
 (.module:
-  [lux #*
+  [lux (#- Module)
    [abstract
     [monad (#+ do)]]
    [control
     ["." try]]
    [data
-    [text
-     ["%" format (#+ format)]]]]
+    ["." text
+     ["%" format (#+ format)]]]
+   ["." macro]]
   [// (#+ Operation)
    [macro (#+ Expander)]
    [//
     [phase
+     [".P" extension]
      [".P" synthesis]
      [".P" analysis
       ["." type]]
@@ -20,11 +22,20 @@
       [///
        ["." phase]
        [meta
-        [archive (#+ Archive)]]]]]]])
+        [archive (#+ Archive)
+         [descriptor (#+ Module)]]]]]]]])
 
 (type: #export Eval
   (-> Archive Nat Type Code (Operation Any)))
 
+(def: #export (id prefix module count)
+  (-> Text Module Nat Text)
+  (format prefix
+          "$"
+          (text.replace-all "/" "$" module)
+          "$"
+          (%.nat count)))
+
 (def: #export (evaluator expander synthesis-state generation-state generate)
   (All [anchor expression artifact]
     (-> Expander
@@ -36,10 +47,13 @@
     (function (eval archive count type exprC)
       (do phase.monad
         [exprA (type.with-type type
-                 (analyze archive exprC))]
+                 (analyze archive exprC))
+         module (extensionP.lift
+                 macro.current-module-name)]
         (phase.lift (do try.monad
                       [exprS (|> exprA (synthesisP.phase archive) (phase.run synthesis-state))]
                       (phase.run generation-state
                                  (do phase.monad
                                    [exprO (generate archive exprS)]
-                                   (generation.evaluate! (format "eval" (%.nat count)) exprO)))))))))
+                                   (generation.evaluate! (..id "analysis" module count)
+                                                         exprO)))))))))
diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
index 41dcdd990..7196d13f1 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux
@@ -177,6 +177,11 @@
     (-> Module (Operation anchor expression directive Any)))
   (extension.update (set@ #module module)))
 
+(def: #export module
+  (All [anchor expression directive]
+    (Operation anchor expression directive Module))
+  (extension.read (get@ #module)))
+
 (template [<name> <inputT>]
   [(def: #export (<name> label code)
      (All [anchor expression directive]
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index 24d059031..96eb95f41 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -11,7 +11,7 @@
    [data
     ["." product]
     ["." maybe]
-    [text
+    ["." text
      ["%" format (#+ format)]]
     [collection
      ["." dictionary]]]
@@ -65,9 +65,11 @@
         (Operation anchor expression directive [Type expression Any])))
   (/////directive.lift-generation
    (do phase.monad
-     [codeG (generate archive codeS)
+     [module /////generation.module
       id /////generation.next
-      codeV (/////generation.evaluate! (format "evaluate" (%.nat id)) codeG)]
+      codeG (generate archive codeS)
+      codeV (/////generation.evaluate! (/////analysis/evaluation.id "directive" module id)
+                                       codeG)]
      (wrap [code//type codeG codeV]))))
 
 (def: #export (evaluate! archive type codeC)
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index 37b47777d..3756e257a 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -173,22 +173,22 @@
                      [module id]))))
 
   (def: #export (merge additions archive)
-    (-> Archive Archive (Try Archive))
-    (|> additions
-        :representation
-        (get@ #resolver)
-        dictionary.entries
-        (monad.fold try.monad
-                    (function (_ [module' [id descriptor+document']] archive')
-                      (case descriptor+document'
-                        (#.Some descriptor+document')
-                        (if (archived? archive' module')
-                          (#try.Success archive')
-                          (..add module' descriptor+document' archive'))
-                        
-                        #.None
-                        (#try.Success archive')))
-                    archive)))
+    (-> Archive Archive Archive)
+    (let [[+next +resolver] (:representation additions)]
+      (|> archive
+          :representation
+          (update@ #next (n.max +next))
+          (update@ #resolver (function (_ resolver)
+                               (list@fold (function (_ [module [id entry]] resolver)
+                                            (case entry
+                                              (#.Some _)
+                                              (dictionary.put module [id entry] resolver)
+                                              
+                                              #.None
+                                              resolver))
+                                          resolver
+                                          (dictionary.entries +resolver))))
+          :abstraction)))
 
   (type: Reservation [Module ID])
   (type: Frozen [Version ID (List Reservation)])
diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux
index 247f2db15..c3a17f34a 100644
--- a/stdlib/source/lux/type.lux
+++ b/stdlib/source/lux/type.lux
@@ -410,11 +410,12 @@
 (syntax: #export (:by-example {type-vars type-parameters}
                               {exemplar typed}
                               {extraction s.any})
-  (wrap (list (` (:of (:share [(~+ (list@map code.local-identifier type-vars))]
-                              {(~ (get@ #type exemplar))
-                               (~ (get@ #expression exemplar))}
-                              {(~ extraction)
-                               (:assume [])}))))))
+  (wrap (list (` (:of ((~! :share)
+                       [(~+ (list@map code.local-identifier type-vars))]
+                       {(~ (get@ #type exemplar))
+                        (~ (get@ #expression exemplar))}
+                       {(~ extraction)
+                        (:assume [])}))))))
 
 (exception: #export (hole-type {location Cursor} {type Type})
   (exception.report
diff --git a/stdlib/source/lux/type/refinement.lux b/stdlib/source/lux/type/refinement.lux
index 1c428fc23..3a9b8cfd2 100644
--- a/stdlib/source/lux/type/refinement.lux
+++ b/stdlib/source/lux/type/refinement.lux
@@ -2,7 +2,9 @@
   [lux (#- type)
    [abstract
     [predicate (#+ Predicate)]]
-   [type (#+ :by-example) ("#;." equivalence)
+   ["." macro
+    [syntax (#+ syntax:)]]
+   [type (#+ :by-example)
     abstract]])
 
 (abstract: #export (Refined t r)
@@ -77,8 +79,9 @@
         [yes
          (#.Cons head no)]))))
 
-(template: #export (type <refiner>)
-  (:by-example [t r]
-               {(..Refiner t r)
-                <refiner>}
-               (..Refined t r)))
+(syntax: #export (type refiner)
+  (macro.with-gensyms [g!t g!r]
+    (wrap (list (` ((~! :by-example) [(~ g!t) (~ g!r)]
+                    {(..Refiner (~ g!t) (~ g!r))
+                     (~ refiner)}
+                    (..Refined (~ g!t) (~ g!r))))))))
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index fcf05f164..43bc084c5 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -49,7 +49,8 @@
     ## ["." interpreter]
     ]]
   ["." / #_
-   ["#." cli (#+ Service)]])
+   ["#." cli (#+ Configuration)]
+   ["#." static (#+ Static)]])
 
 (def: (or-crash! failure-description action)
   (All [a]
@@ -67,48 +68,20 @@
       (wrap output))))
 
 (with-expansions [<parameters> (as-is anchor expression artifact)]
-  ## TODO: Clean-up ASAP.
-  ## (def: (save-artifacts! system state [packager package])
-  ##   (All [<parameters>]
-  ##     (-> (file.System Promise)
-  ##         (directive.State+ <parameters>)
-  ##         [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
-  ##         (Promise (Try Any))))
-  ##   (let [?outcome (phase.run' state
-  ##                              (:share [<parameters>]
-  ##                                      {(directive.State+ <parameters>)
-  ##                                       state}
-  ##                                      {(directive.Operation <parameters>
-  ##                                                            (generation.Output artifact))
-  ##                                       (directive.lift-generation generation.output)}))]
-  ##     (case ?outcome
-  ##       (#try.Success [state output])
-  ##       (do (try.with promise.monad)
-  ##         [file (: (Promise (Try (File Promise)))
-  ##                  (file.get-file promise.monad system package))]
-  ##         (!.use (:: file over-write) (packager output)))
-
-  ##       (#try.Failure error)
-  ##       (promise@wrap (#try.Failure error)))))
-
-  (def: #export (compiler target partial-host-extension
-                          expander host-analysis platform host generation-bundle host-directive-bundle program extender
-                          service
-                          extension
+  (def: #export (compiler static
+                          expander host-analysis platform generation-bundle host-directive-bundle program extender
+                          configuration
                           packager,package)
     (All [<parameters>]
-      (-> Path
-          Text
+      (-> Static
           Expander
           analysis.Bundle
           (IO (Platform <parameters>))
-          Host
           (generation.Bundle <parameters>)
           (directive.Bundle <parameters>)
           (-> expression artifact)
           Extender
-          Service
-          Text
+          Configuration
           [(-> (Row [Module (generation.Buffer artifact)]) Binary) Path]
           (Promise Any)))
     (do promise.monad
@@ -116,8 +89,8 @@
        console (|> console.system
                    promise.future
                    (:: @ map (|>> try.assume console.async)))]
-      (case service
-        (#/cli.Compilation configuration)
+      (case (get@ #/cli.service configuration)
+        #/cli.Compilation
         (<| (or-crash! "Compilation failed:")
             (do (try.with promise.monad)
               [[state archive] (:share [<parameters>]
@@ -125,19 +98,16 @@
                                         platform}
                                        {(Promise (Try [(directive.State+ <parameters>)
                                                        Archive]))
-                                        (platform.initialize extension target host (get@ #/cli.module configuration) expander host-analysis platform generation-bundle host-directive-bundle program extender)})
+                                        (platform.initialize static (get@ #/cli.module configuration) expander host-analysis platform generation-bundle host-directive-bundle program extender)})
                [archive state] (:share [<parameters>]
                                        {(Platform <parameters>)
                                         platform}
                                        {(Promise (Try [Archive (directive.State+ <parameters>)]))
-                                        (platform.compile target partial-host-extension expander platform host configuration archive extension state)})
-               _ (ioW.freeze (get@ #platform.&file-system platform) host target archive)
-               ## _ (save-artifacts! (get@ #platform.&file-system platform) state packager,package)
-               ## _ (cache/io.clean target ...)
-               ]
+                                        (platform.compile static expander platform configuration [archive state])})
+               _ (ioW.freeze (get@ #platform.&file-system platform) (get@ #/static.host static) (get@ #/static.target static) archive)]
               (wrap (log! "Compilation complete!"))))
         
-        (#/cli.Interpretation configuration)
+        #/cli.Interpretation
         ## TODO: Fix the interpreter...
         (undefined)
         ## (<| (or-crash! "Interpretation failed:")
diff --git a/stdlib/source/program/compositor/cli.lux b/stdlib/source/program/compositor/cli.lux
index 4453d5d36..0c20257ed 100644
--- a/stdlib/source/program/compositor/cli.lux
+++ b/stdlib/source/program/compositor/cli.lux
@@ -4,23 +4,20 @@
     ["p" parser
      ["." cli (#+ Parser)]]]
    [world
-    [file (#+ Path)]]]
-  ## [///
-  ##  [importer (#+ Source)]]
-  )
+    [file (#+ Path)]]])
+
+(type: #export Service
+  #Compilation
+  #Interpretation)
 
 (type: #export Configuration
-  {## #sources (List Source)
+  {#service Service
    #sources (List Path)
    #target Path
    #module Text})
 
-(type: #export Service
-  (#Compilation Configuration)
-  (#Interpretation Configuration))
-
 (template [<name> <long>]
-  [(def: #export <name>
+  [(def: <name>
      (Parser Text)
      (cli.named <long> cli.any))]
 
@@ -29,15 +26,17 @@
   [module "--module"]
   )
 
+
+(def: service
+  (Parser Service)
+  ($_ p.or
+      (cli.this "build")
+      (cli.this "repl")))
+
 (def: #export configuration
   (Parser Configuration)
   ($_ p.and
+      ..service
       (p.some ..source)
       ..target
       ..module))
-
-(def: #export service
-  (Parser Service)
-  ($_ p.or
-      (p.after (cli.this "build") ..configuration)
-      (p.after (cli.this "repl") ..configuration)))
diff --git a/stdlib/source/program/compositor/static.lux b/stdlib/source/program/compositor/static.lux
new file mode 100644
index 000000000..3fdd8727e
--- /dev/null
+++ b/stdlib/source/program/compositor/static.lux
@@ -0,0 +1,11 @@
+(.module:
+  [lux #*
+   [target (#+ Host)]
+   [world
+    [file (#+ Path)]]])
+
+(type: #export Static
+  {#host Host
+   #host-module-extension Text
+   #target Path
+   #artifact-extension Text})
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
+          )))