From f605537d91450b347ce70eb2c5edff9674e72044 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Tue, 12 May 2020 20:23:24 -0400
Subject: Compiler versions are now natural numbers, and are included as part
 of the names/paths of artifacts.

---
 stdlib/source/lux/abstract/equivalence.lux         |   9 +-
 stdlib/source/lux/abstract/functor.lux             |   6 -
 .../source/lux/abstract/functor/contravariant.lux  |   8 +
 stdlib/source/lux/abstract/order.lux               |  13 +-
 stdlib/source/lux/abstract/predicate.lux           |   9 +-
 stdlib/source/lux/control/concurrency/frp.lux      |  17 +-
 stdlib/source/lux/control/security/policy.lux      |   4 +-
 stdlib/source/lux/data/collection/list.lux         |  30 ++-
 .../jvm/bytecode/environment/limit/registry.lux    |   2 +-
 .../jvm/bytecode/environment/limit/stack.lux       |   2 +-
 stdlib/source/lux/target/jvm/constant.lux          |   4 +-
 stdlib/source/lux/target/jvm/index.lux             |   2 +-
 .../lux/tool/compiler/language/lux/analysis.lux    |   5 +-
 .../language/lux/phase/generation/jvm/runtime.lux  |   7 +-
 .../lux/tool/compiler/language/lux/version.lux     |   4 +-
 stdlib/source/lux/tool/compiler/meta.lux           |   4 +-
 stdlib/source/lux/tool/compiler/meta/archive.lux   |  14 +-
 .../lux/tool/compiler/meta/archive/signature.lux   |  12 +-
 .../source/lux/tool/compiler/meta/io/archive.lux   |  17 +-
 stdlib/source/lux/tool/compiler/version.lux        |   3 +-
 stdlib/source/test/lux/abstract/order.lux          |  14 ++
 .../source/test/lux/control/concurrency/atom.lux   |  49 ++---
 stdlib/source/test/lux/control/concurrency/frp.lux | 227 +++++++++++++++++----
 stdlib/source/test/lux/control/state.lux           |  29 +--
 24 files changed, 348 insertions(+), 143 deletions(-)
 create mode 100644 stdlib/source/lux/abstract/functor/contravariant.lux

(limited to 'stdlib/source')

diff --git a/stdlib/source/lux/abstract/equivalence.lux b/stdlib/source/lux/abstract/equivalence.lux
index ccfc55928..d65e101a8 100644
--- a/stdlib/source/lux/abstract/equivalence.lux
+++ b/stdlib/source/lux/abstract/equivalence.lux
@@ -1,7 +1,8 @@
 (.module:
   [lux #*]
   [//
-   [functor (#+ Contravariant)]])
+   [functor
+    ["." contravariant]]])
 
 (signature: #export (Equivalence a)
   {#.doc "Equivalence for a type's instances."}
@@ -35,10 +36,10 @@
    (def: (= left right)
      (sub = left right))))
 
-(structure: #export contravariant
-  (Contravariant Equivalence)
+(structure: #export functor
+  (contravariant.Functor Equivalence)
   
-  (def: (map-1 f equivalence)
+  (def: (map f equivalence)
     (structure
      (def: (= reference sample)
        (:: equivalence = (f reference) (f sample))))))
diff --git a/stdlib/source/lux/abstract/functor.lux b/stdlib/source/lux/abstract/functor.lux
index a9fc6796c..9ba47aaf8 100644
--- a/stdlib/source/lux/abstract/functor.lux
+++ b/stdlib/source/lux/abstract/functor.lux
@@ -42,9 +42,3 @@
   (structure
    (def: (map f fga)
      (f@map (g@map f) fga))))
-
-(signature: #export (Contravariant f)
-  (: (All [a b]
-       (-> (-> b a)
-           (-> (f a) (f b))))
-     map-1))
diff --git a/stdlib/source/lux/abstract/functor/contravariant.lux b/stdlib/source/lux/abstract/functor/contravariant.lux
new file mode 100644
index 000000000..79ae218fa
--- /dev/null
+++ b/stdlib/source/lux/abstract/functor/contravariant.lux
@@ -0,0 +1,8 @@
+(.module:
+  [lux #*])
+
+(signature: #export (Functor f)
+  (: (All [a b]
+       (-> (-> b a)
+           (-> (f a) (f b))))
+     map))
diff --git a/stdlib/source/lux/abstract/order.lux b/stdlib/source/lux/abstract/order.lux
index c28026036..dad99b8b4 100644
--- a/stdlib/source/lux/abstract/order.lux
+++ b/stdlib/source/lux/abstract/order.lux
@@ -3,8 +3,9 @@
    [control
     ["." function]]]
   [//
-   [functor (#+ Contravariant)]
-   ["." equivalence (#+ Equivalence)]])
+   ["." equivalence (#+ Equivalence)]
+   [functor
+    ["." contravariant]]])
 
 (signature: #export (Order a)
   {#.doc "A signature for types that possess some sense of ordering among their elements."}
@@ -44,13 +45,13 @@
   Choice
   (if (:: order < y x) y x))
 
-(structure: #export contravariant
-  (Contravariant Order)
+(structure: #export functor
+  (contravariant.Functor Order)
   
-  (def: (map-1 f order)
+  (def: (map f order)
     (structure
      (def: &equivalence
-       (:: equivalence.contravariant map-1 f (:: order &equivalence)))
+       (:: equivalence.functor map f (:: order &equivalence)))
      
      (def: (< reference sample)
        (:: order < (f reference) (f sample))))))
diff --git a/stdlib/source/lux/abstract/predicate.lux b/stdlib/source/lux/abstract/predicate.lux
index b69b43415..13aa9a083 100644
--- a/stdlib/source/lux/abstract/predicate.lux
+++ b/stdlib/source/lux/abstract/predicate.lux
@@ -4,7 +4,8 @@
     ["." function]]]
   [//
    [monoid (#+ Monoid)]
-   [functor (#+ Contravariant)]])
+   [functor
+    ["." contravariant]]])
 
 (type: #export (Predicate a)
   (-> a Bit))
@@ -52,8 +53,8 @@
   (function (recur input)
     (predicate recur input)))
 
-(structure: #export contravariant
-  (Contravariant Predicate)
+(structure: #export functor
+  (contravariant.Functor Predicate)
   
-  (def: (map-1 f fb)
+  (def: (map f fb)
     (|>> f fb)))
diff --git a/stdlib/source/lux/control/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux
index 2be15ea23..3dc596a91 100644
--- a/stdlib/source/lux/control/concurrency/frp.lux
+++ b/stdlib/source/lux/control/concurrency/frp.lux
@@ -207,29 +207,30 @@
         (folds f init' tail)))))
 
 (def: #export (poll milli-seconds action)
-  (All [a] (-> Nat (IO a) (Channel a)))
+  (All [a]
+    (-> Nat (IO a) [(Channel a) (Sink a)]))
   (let [[output sink] (channel [])]
     (exec (io.run (loop [_ []]
                     (do io.monad
                       [value action
                        _ (:: sink feed value)]
                       (promise.await recur (promise.wait milli-seconds)))))
-      output)))
+      [output sink])))
 
 (def: #export (periodic milli-seconds)
-  (-> Nat (Channel Any))
-  (poll milli-seconds (io [])))
+  (-> Nat [(Channel Any) (Sink Any)])
+  (..poll milli-seconds (io [])))
 
 (def: #export (iterate f init)
-  (All [a] (-> (-> a (Promise (Maybe a))) a (Channel a)))
+  (All [s o] (-> (-> s (Promise (Maybe [s o]))) s (Channel o)))
   (do promise.monad
     [?next (f init)]
     (case ?next
-      (#.Some next)
-      (wrap (#.Some [init (iterate f next)]))
+      (#.Some [state output])
+      (wrap (#.Some [output (iterate f state)]))
       
       #.None
-      (wrap (#.Some [init (wrap #.None)])))))
+      (wrap #.None))))
 
 (def: (distinct' equivalence previous channel)
   (All [a] (-> (Equivalence a) a (Channel a) (Channel a)))
diff --git a/stdlib/source/lux/control/security/policy.lux b/stdlib/source/lux/control/security/policy.lux
index d210f91e1..69489b0da 100644
--- a/stdlib/source/lux/control/security/policy.lux
+++ b/stdlib/source/lux/control/security/policy.lux
@@ -34,7 +34,9 @@
 
   (type: #export (Delegation brand from to)
     {#.doc (doc "Represents the act of delegating policy capacities.")}
-    (All [value] (-> (Policy brand value from) (Policy brand value to))))
+    (All [value]
+      (-> (Policy brand value from)
+          (Policy brand value to))))
 
   (def: #export (delegation downgrade upgrade)
     {#.doc (doc "Delegating policy capacities.")}
diff --git a/stdlib/source/lux/data/collection/list.lux b/stdlib/source/lux/data/collection/list.lux
index eaf7df755..1c18dcf63 100644
--- a/stdlib/source/lux/data/collection/list.lux
+++ b/stdlib/source/lux/data/collection/list.lux
@@ -19,7 +19,9 @@
 ##   #Nil
 ##   (#Cons a (List a)))
 
-(structure: #export fold (Fold List)
+(structure: #export fold
+  (Fold List)
+  
   (def: (fold f init xs)
     (case xs
       #.Nil
@@ -28,6 +30,15 @@
       (#.Cons x xs')
       (fold f (f x init) xs'))))
 
+(def: #export (folds f init inputs)
+  (All [a b] (-> (-> a b b) b (List a) (List b)))
+  (case inputs
+    #.Nil
+    (list init)
+    
+    (#.Cons [head tail])
+    (#.Cons [init (folds f (f head init) tail)])))
+
 (def: #export (reverse xs)
   (All [a]
     (-> (List a) (List a)))
@@ -274,6 +285,7 @@
 
 (structure: #export (equivalence Equivalence<a>)
   (All [a] (-> (Equivalence a) (Equivalence (List a))))
+  
   (def: (= xs ys)
     (case [xs ys]
       [#.Nil #.Nil]
@@ -287,7 +299,9 @@
       #0
       )))
 
-(structure: #export monoid (All [a] (Monoid (List a)))
+(structure: #export monoid
+  (All [a] (Monoid (List a)))
+  
   (def: identity #.Nil)
   (def: (compose xs ys)
     (case xs
@@ -296,7 +310,9 @@
 
 (open: "." monoid)
 
-(structure: #export functor (Functor List)
+(structure: #export functor
+  (Functor List)
+  
   (def: (map f ma)
     (case ma
       #.Nil          #.Nil
@@ -304,7 +320,9 @@
 
 (open: "." ..functor)
 
-(structure: #export apply (Apply List)
+(structure: #export apply
+  (Apply List)
+  
   (def: &functor ..functor)
 
   (def: (apply ff fa)
@@ -315,7 +333,9 @@
       (#.Cons f ff')
       (compose (map f fa) (apply ff' fa)))))
 
-(structure: #export monad (Monad List)
+(structure: #export monad
+  (Monad List)
+  
   (def: &functor ..functor)
 
   (def: (wrap a)
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
index 3a8bd4482..660f6c85c 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/registry.lux
@@ -59,7 +59,7 @@
 
   (def: #export equivalence
     (Equivalence Registry)
-    (:: equivalence.contravariant map-1
+    (:: equivalence.functor map
         (|>> :representation)
         /////unsigned.equivalence))
 
diff --git a/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux b/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux
index fe72f79a5..18ca09fb0 100644
--- a/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux
+++ b/stdlib/source/lux/target/jvm/bytecode/environment/limit/stack.lux
@@ -32,7 +32,7 @@
 
   (def: #export equivalence
     (Equivalence Stack)
-    (:: equivalence.contravariant map-1
+    (:: equivalence.functor map
         (|>> :representation)
         /////unsigned.equivalence))
 
diff --git a/stdlib/source/lux/target/jvm/constant.lux b/stdlib/source/lux/target/jvm/constant.lux
index 91a72390a..3e225a7c2 100644
--- a/stdlib/source/lux/target/jvm/constant.lux
+++ b/stdlib/source/lux/target/jvm/constant.lux
@@ -51,7 +51,7 @@
 
   (def: #export class-equivalence
     (Equivalence Class)
-    (:: equivalence.contravariant map-1
+    (:: equivalence.functor map
         ..index
         //index.equivalence))
 
@@ -92,7 +92,7 @@
     (All [kind]
       (-> (Equivalence kind)
           (Equivalence (Value kind))))
-    (:: equivalence.contravariant map-1
+    (:: equivalence.functor map
         (|>> :representation)
         Equivalence<kind>))
 
diff --git a/stdlib/source/lux/target/jvm/index.lux b/stdlib/source/lux/target/jvm/index.lux
index 490667436..2922c74b1 100644
--- a/stdlib/source/lux/target/jvm/index.lux
+++ b/stdlib/source/lux/target/jvm/index.lux
@@ -29,7 +29,7 @@
 
   (def: #export equivalence
     (All [kind] (Equivalence (Index kind)))
-    (:: equivalence.contravariant map-1
+    (:: equivalence.functor map
         ..value
         //unsigned.equivalence))
 
diff --git a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
index 59a1cf2eb..27bc09652 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/analysis.lux
@@ -20,6 +20,7 @@
     ["." extension (#+ Extension)]]
    [///
     [arity (#+ Arity)]
+    [version (#+ Version)]
     ["." reference (#+ Register Variable Reference)]
     ["." phase]]])
 
@@ -387,9 +388,9 @@
    #.var-bindings (list)})
 
 (def: #export (info version host)
-  (-> Text Text Info)
+  (-> Version Text Info)
   {#.target host
-   #.version version
+   #.version (%.nat version)
    #.mode #.Build})
 
 (def: #export (state info)
diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index e08a6219f..304629c6f 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -51,7 +51,7 @@
       ["#" phase]
       [arity (#+ Arity)]
       [reference (#+ Register)]
-      [meta
+      ["." meta
        [io (#+ lux-context)]
        [archive (#+ Archive)]]]]]])
 
@@ -79,7 +79,10 @@
 
 (def: #export (class-name [module id])
   (-> generation.Context Text)
-  (format lux-context "/" (%.nat module) "/" (%.nat id)))
+  (format lux-context
+          "/" (%.nat meta.version)
+          "/" (%.nat module)
+          "/" (%.nat id)))
 
 (def: #export class (type.class "LuxRuntime" (list)))
 
diff --git a/stdlib/source/lux/tool/compiler/language/lux/version.lux b/stdlib/source/lux/tool/compiler/language/lux/version.lux
index 013cdc72e..53b3424ae 100644
--- a/stdlib/source/lux/tool/compiler/language/lux/version.lux
+++ b/stdlib/source/lux/tool/compiler/language/lux/version.lux
@@ -3,4 +3,6 @@
   [////
    [version (#+ Version)]])
 
-(def: #export version Version "0.6.0")
+(def: #export version
+  Version
+  00,06,00)
diff --git a/stdlib/source/lux/tool/compiler/meta.lux b/stdlib/source/lux/tool/compiler/meta.lux
index dfa57dd4c..df3eb31a7 100644
--- a/stdlib/source/lux/tool/compiler/meta.lux
+++ b/stdlib/source/lux/tool/compiler/meta.lux
@@ -3,4 +3,6 @@
   [//
    [version (#+ Version)]])
 
-(def: #export version Version "0.1.0")
+(def: #export version
+  Version
+  00,01,00)
diff --git a/stdlib/source/lux/tool/compiler/meta/archive.lux b/stdlib/source/lux/tool/compiler/meta/archive.lux
index f95d713a4..37b47777d 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive.lux
@@ -13,12 +13,12 @@
     [binary (#+ Binary)]
     ["." product]
     ["." name]
-    ["." text ("#@." equivalence)
+    ["." text
      ["%" format (#+ format)]]
     [format
      ["." binary (#+ Writer)]]
     [number
-     ["n" nat]]
+     ["n" nat ("#@." equivalence)]]
     [collection
      ["." list ("#@." functor fold)]
      ["." dictionary (#+ Dictionary)]
@@ -196,14 +196,14 @@
   (def: reader
     (Parser ..Frozen)
     ($_ <>.and
-        <b>.text
+        <b>.nat
         <b>.nat
         (<b>.list (<>.and <b>.text <b>.nat))))
 
   (def: writer
     (Writer ..Frozen)
     ($_ binary.and
-        binary.text
+        binary.nat
         binary.nat
         (binary.list (binary.and binary.text binary.nat))))
   
@@ -221,8 +221,8 @@
 
   (exception: #export (version-mismatch {expected Version} {actual Version})
     (exception.report
-     ["Expected" (%.text expected)]
-     ["Actual" (%.text actual)]))
+     ["Expected" (%.nat expected)]
+     ["Actual" (%.nat actual)]))
 
   (exception: #export corrupt-data)
 
@@ -252,7 +252,7 @@
     (do try.monad
       [[actual next reservations] (<b>.run ..reader binary)
        _ (exception.assert ..version-mismatch [expected actual]
-                           (text@= expected actual))
+                           (n@= expected actual))
        _ (exception.assert ..corrupt-data []
                            (correct-reservations? reservations))]
       (wrap (:abstraction
diff --git a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
index 3d795ff50..95bfc166b 100644
--- a/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
+++ b/stdlib/source/lux/tool/compiler/meta/archive/signature.lux
@@ -10,7 +10,9 @@
     ["." text
      ["%" format (#+ format)]]
     [format
-     ["." binary (#+ Writer)]]]]
+     ["." binary (#+ Writer)]]
+    [number
+     ["." nat]]]]
   [////
    [version (#+ Version)]])
 
@@ -20,18 +22,18 @@
 
 (def: #export equivalence
   (Equivalence Signature)
-  (equivalence.product name.equivalence text.equivalence))
+  (equivalence.product name.equivalence nat.equivalence))
 
 (def: #export (description signature)
   (-> Signature Text)
-  (format (%.name (get@ #name signature)) " " (get@ #version signature)))
+  (format (%.name (get@ #name signature)) " " (%.nat (get@ #version signature))))
 
 (def: #export writer
   (Writer Signature)
   (binary.and (binary.and binary.text binary.text)
-              binary.text))
+              binary.nat))
 
 (def: #export parser
   (Parser Signature)
   (<>.and (<>.and <b>.text <b>.text)
-          <b>.text))
+          <b>.nat))
diff --git a/stdlib/source/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
index 3cf3ed4c4..ef73d321d 100644
--- a/stdlib/source/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/lux/tool/compiler/meta/io/archive.lux
@@ -48,23 +48,29 @@
    ["Module ID" (%.nat module-id)]
    ["Error" error]))
 
-(def: #export (archive system host root)
+(def: (archive system host root)
   (-> (file.System Promise) Host Path Path)
   (format root (:: system separator) host))
 
-(def: #export (lux-archive system host root)
+(def: (unversioned-lux-archive system host root)
   (-> (file.System Promise) Host Path Path)
   (format (..archive system host root)
           (:: system separator)
           //.lux-context))
 
+(def: (versioned-lux-archive system host root)
+  (-> (file.System Promise) Host Path Path)
+  (format (..unversioned-lux-archive system host root)
+          (:: system separator)
+          (%.nat ///.version)))
+
 (def: (module system host root module-id)
   (-> (file.System Promise) Host Path archive.ID Path)
-  (format (..lux-archive system host root)
+  (format (..versioned-lux-archive system host root)
           (:: system separator)
           (%.nat module-id)))
 
-(def: #export (artifact system host root module-id name extension)
+(def: (artifact system host root module-id name extension)
   (-> (file.System Promise) Host Path archive.ID Text Text Path)
   (format (..module system host root module-id)
           (:: system separator)
@@ -79,7 +85,8 @@
     (if module-exists?
       (wrap (#try.Success []))
       (do @
-        [_ (file.get-directory @ system (..lux-archive system host root))
+        [_ (file.get-directory @ system (..unversioned-lux-archive system host root))
+         _ (file.get-directory @ system (..versioned-lux-archive system host root))
          outcome (!.use (:: system create-directory) module)]
         (case outcome
           (#try.Success output)
diff --git a/stdlib/source/lux/tool/compiler/version.lux b/stdlib/source/lux/tool/compiler/version.lux
index d2c14c50b..3965b9b28 100644
--- a/stdlib/source/lux/tool/compiler/version.lux
+++ b/stdlib/source/lux/tool/compiler/version.lux
@@ -1,4 +1,5 @@
 (.module:
   [lux #*])
 
-(type: #export Version Text)
+(type: #export Version
+  Nat)
diff --git a/stdlib/source/test/lux/abstract/order.lux b/stdlib/source/test/lux/abstract/order.lux
index a92dd06ad..7157a6c01 100644
--- a/stdlib/source/test/lux/abstract/order.lux
+++ b/stdlib/source/test/lux/abstract/order.lux
@@ -4,6 +4,7 @@
    [abstract
     [monad (#+ do)]]
    [data
+    ["." bit ("#@." equivalence)]
     [number
      ["n" nat]]]
    [math
@@ -21,6 +22,19 @@
           (_.cover [/.Choice /.min /.max]
                    (n.< (/.max n.order left right)
                         (/.min n.order left right)))
+          (_.cover [/.Comparison /.>]
+                   (not (bit@= (n.< left right)
+                               (/.> n.order left right))))
+          (_.cover [/.<=]
+                   (and (/.<= n.order left left)
+                        (/.<= n.order right right)
+                        (bit@= (:: n.order < left right)
+                               (/.<= n.order left right))))
+          (_.cover [/.>=]
+                   (and (/.>= n.order left left)
+                        (/.>= n.order right right)
+                        (bit@= (/.> n.order left right)
+                               (/.>= n.order left right))))
           )))
 
 (def: #export (spec (^open "/@.") generator)
diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux
index 1cf645530..8902f0a8f 100644
--- a/stdlib/source/test/lux/control/concurrency/atom.lux
+++ b/stdlib/source/test/lux/control/concurrency/atom.lux
@@ -1,39 +1,40 @@
 (.module:
   [lux #*
    ["_" test (#+ Test)]
-   [abstract/monad (#+ do)]
-   ["%" data/text/format (#+ format)]
-   [math
-    ["r" random]]
+   [abstract
+    [monad (#+ do)]]
    [control
     ["." io]]
    [data
     [number
-     ["n" nat]]]]
+     ["n" nat]]]
+   [math
+    ["." random]]]
   {1
    ["." /]})
 
 (def: #export test
   Test
-  (<| (_.context (%.name (name-of /.Atom)))
-      (do r.monad
-        [value r.nat
-         swap-value r.nat
-         set-value r.nat
+  (<| (_.covering /._)
+      (do random.monad
+        [value random.nat
+         swap-value random.nat
+         set-value random.nat
          #let [box (/.atom value)]]
         ($_ _.and
-            (_.test "Can obtain the value of an atom."
-                    (n.= value (io.run (/.read box))))
-
-            (_.test "Can swap the value of an atom."
-                    (and (io.run (/.compare-and-swap value swap-value box))
-                         (n.= swap-value (io.run (/.read box)))))
-
-            (_.test "Can update the value of an atom."
-                    (exec (io.run (/.update inc box))
-                      (n.= (inc swap-value) (io.run (/.read box)))))
-
-            (_.test "Can immediately set the value of an atom."
-                    (exec (io.run (/.write set-value box))
-                      (n.= set-value (io.run (/.read box)))))
+            (_.cover [/.Atom /.atom /.read]
+                     (n.= value
+                          (io.run (/.read box))))
+            (_.cover [/.compare-and-swap]
+                     (and (io.run (/.compare-and-swap value swap-value box))
+                          (n.= swap-value
+                               (io.run (/.read box)))))
+            (_.cover [/.update]
+                     (exec (io.run (/.update inc box))
+                       (n.= (inc swap-value)
+                            (io.run (/.read box)))))
+            (_.cover [/.write]
+                     (exec (io.run (/.write set-value box))
+                       (n.= set-value
+                            (io.run (/.read box)))))
             ))))
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index ab705bfce..f7f7427b6 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -1,59 +1,202 @@
 (.module:
   [lux #*
    ["_" test (#+ Test)]
-   [abstract/monad (#+ do)]
+   [abstract
+    [monad (#+ do)]
+    {[0 #test]
+     [/
+      ["$." functor (#+ Injection Comparison)]
+      ["$." apply]
+      ["$." monad]]}]
    [control
+    ["." try]
+    ["." exception]
     ["." io (#+ IO io)]]
    [data
+    [text
+     ["%" format (#+ format)]]
     [number
      ["n" nat]]
     [collection
-     ["." list ("#@." functor)]]]
+     ["." list ("#@." functor fold)]
+     ["." row (#+ Row)]]]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
-   ["." / (#+ Channel)
+   ["." /
     [//
      ["." promise ("#@." monad)]
      ["." atom (#+ Atom atom)]]]})
 
+(def: injection
+  (Injection /.Channel)
+  (|>> promise.resolved
+       /.from-promise))
+
+(def: comparison
+  (Comparison /.Channel)
+  (function (_ == left right)
+    (case [(promise.poll left)
+           (promise.poll right)]
+      [(#.Some (#.Some [left _]))
+       (#.Some (#.Some [right _]))]
+      (== left right)
+      
+      _
+      false)))
+
 (def: #export test
   Test
-  (let [(^open "list@.") (list.equivalence n.equivalence)]
-    (do r.monad
-      [inputs (r.list 5 r.nat)
-       sample r.nat]
-      ($_ _.and
-          (wrap (do promise.monad
-                  [output (|> inputs
-                              (/.sequential 0)
-                              (/.filter n.even?)
-                              /.consume)]
-                  (_.assert "Can filter a channel's elements."
-                            (list@= (list.filter n.even? inputs)
-                                    output))))
-          (wrap (do promise.monad
-                  [output (|> inputs
-                              (/.sequential 0)
-                              (:: /.functor map inc)
-                              /.consume)]
-                  (_.assert "Functor goes over every element in a channel."
-                            (list@= (list@map inc inputs)
-                                    output))))
-          (wrap (do promise.monad
-                  [output (/.consume (:: /.apply apply
-                                         (/.sequential 0 (list inc))
-                                         (/.sequential 0 (list sample))))]
-                  (_.assert "Apply works over all channel values."
-                            (list@= (list (inc sample))
-                                    output))))
-          (wrap (do promise.monad
-                  [output (/.consume
-                           (do /.monad
-                             [f (/.from-promise (promise@wrap inc))
-                              a (/.from-promise (promise@wrap sample))]
-                             (wrap (f a))))]
-                  (_.assert "Valid monad."
-                            (list@= (list (inc sample))
-                                    output))))
-          ))))
+  (<| (_.covering /._)
+      (let [(^open "list@.") (list.equivalence n.equivalence)]
+        (do random.monad
+          [inputs (random.list 5 random.nat)
+           sample random.nat
+           distint/0 random.nat
+           distint/1 (|> random.nat (random.filter (|>> (n.= distint/0) not)))
+           distint/2 (|> random.nat (random.filter (function (_ value)
+                                                     (not (or (n.= distint/0 value)
+                                                              (n.= distint/1 value))))))
+           shift random.nat]
+          ($_ _.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))
+              
+              (_.cover [/.Channel /.Sink /.channel]
+                       (case (io.run
+                              (do (try.with io.monad)
+                                [#let [[channel sink] (/.channel [])]
+                                 _ (:: sink feed sample)
+                                 _ (:: sink close)]
+                                (wrap channel)))
+                         (#try.Success channel)
+                         (case (promise.poll channel)
+                           (#.Some (#.Some [actual _]))
+                           (n.= sample actual)
+                           
+                           _
+                           false)
+                         
+                         (#try.Failure error)
+                         false))
+              (_.cover [/.channel-is-already-closed]
+                       (case (io.run
+                              (do (try.with io.monad)
+                                [#let [[channel sink] (/.channel [])]
+                                 _ (:: sink close)]
+                                (:: sink feed sample)))
+                         (#try.Success _)
+                         false
+                         
+                         (#try.Failure error)
+                         (exception.match? /.channel-is-already-closed error)))
+              (wrap (do promise.monad
+                      [output (|> sample
+                                  promise.resolved
+                                  /.from-promise
+                                  /.consume)]
+                      (_.claim [/.from-promise /.consume]
+                               (list@= (list sample)
+                                       output))))
+              (wrap (do promise.monad
+                      [output (|> inputs
+                                  (/.sequential 0)
+                                  /.consume)]
+                      (_.claim [/.sequential]
+                               (list@= inputs
+                                       output))))
+              (wrap (do promise.monad
+                      [output (|> inputs
+                                  (/.sequential 0)
+                                  (/.filter n.even?)
+                                  /.consume)]
+                      (_.claim [/.filter]
+                               (list@= (list.filter n.even? inputs)
+                                       output))))
+              (wrap (do promise.monad
+                      [#let [sink (: (Atom (Row Nat))
+                                     (atom.atom row.empty))
+                             channel (/.sequential 0 inputs)]
+                       _ (promise.future (/.listen (function (_ value)
+                                                     (do io.monad
+                                                       [_ (atom.update (row.add value) sink)]
+                                                       (wrap [])))
+                                                   channel))
+                       output (/.consume channel)
+                       listened (|> sink
+                                    atom.read
+                                    promise.future
+                                    (:: @ map row.to-list))]
+                      (_.claim [/.listen]
+                               (and (list@= inputs
+                                            output)
+                                    (list@= output
+                                            listened)))))
+              (wrap (do promise.monad
+                      [actual (/.fold (function (_ input total)
+                                        (promise.resolved (n.+ input total)))
+                                      0
+                                      (/.sequential 0 inputs))]
+                      (_.claim [/.fold]
+                               (n.= (list@fold n.+ 0 inputs)
+                                    actual))))
+              (wrap (do promise.monad
+                      [actual (|> inputs
+                                  (/.sequential 0)
+                                  (/.folds (function (_ input total)
+                                             (promise.resolved (n.+ input total)))
+                                           0)
+                                  /.consume)]
+                      (_.claim [/.folds]
+                               (list@= (list.folds n.+ 0 inputs)
+                                       actual))))
+              (wrap (do promise.monad
+                      [actual (|> (list distint/0 distint/0 distint/0
+                                        distint/1
+                                        distint/2 distint/2)
+                                  (/.sequential 0)
+                                  (/.distinct n.equivalence)
+                                  /.consume)]
+                      (_.claim [/.distinct]
+                               (list@= (list distint/0 distint/1 distint/2)
+                                       actual))))
+              (wrap (do promise.monad
+                      [#let [polling-delay 10
+                             amount-of-polls 5
+                             total-delay (n.* amount-of-polls polling-delay)
+                             [channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))]
+                       _ (promise.schedule total-delay (io.io []))
+                       _ (promise.future (:: sink close))
+                       actual (/.consume channel)]
+                      (_.claim [/.poll]
+                               (and (list.every? (n.= sample) actual)
+                                    (n.>= amount-of-polls (list.size actual))))))
+              (wrap (do promise.monad
+                      [#let [polling-delay 10
+                             amount-of-polls 5
+                             total-delay (n.* amount-of-polls polling-delay)
+                             [channel sink] (/.periodic polling-delay)]
+                       _ (promise.schedule total-delay (io.io []))
+                       _ (promise.future (:: sink close))
+                       actual (/.consume channel)]
+                      (_.claim [/.periodic]
+                               (n.>= amount-of-polls (list.size actual)))))
+              (wrap (do promise.monad
+                      [#let [max-iterations 10]
+                       actual (|> [0 sample]
+                                  (/.iterate (function (_ [iterations current])
+                                               (promise.resolved
+                                                (if (n.< max-iterations iterations)
+                                                  (#.Some [[(inc iterations) (n.+ shift current)]
+                                                           current])
+                                                  #.None))))
+                                  /.consume)]
+                      (_.claim [/.iterate]
+                               (and (n.= max-iterations (list.size actual))
+                                    (list@= (list.folds n.+ sample (list.repeat (dec max-iterations) shift))
+                                            actual)))))
+              )))))
diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux
index cb7c94b83..72284ba5c 100644
--- a/stdlib/source/test/lux/control/state.lux
+++ b/stdlib/source/test/lux/control/state.lux
@@ -18,7 +18,7 @@
     [text
      ["%" format (#+ format)]]]
    [math
-    ["r" random]]]
+    ["." random]]]
   {1
    ["." / (#+ State)]})
 
@@ -30,9 +30,9 @@
       (n.= output)))
 
 (def: basics
-  (do r.monad
-    [state r.nat
-     value r.nat]
+  (do random.monad
+    [state random.nat
+     value random.nat]
     ($_ _.and
         (_.cover [/.State /.get]
                  (with-conditions [state state]
@@ -58,7 +58,8 @@
 
 (def: (injection value)
   (All [s] (Injection (State s)))
-  (function (_ state) [state value]))
+  (function (_ state)
+    [state value]))
 
 (def: (comparison init)
   (All [s] (-> s (Comparison (State s))))
@@ -68,9 +69,9 @@
 
 (def: structures
   Test
-  (do r.monad
-    [state r.nat
-     value r.nat]
+  (do random.monad
+    [state random.nat
+     value random.nat]
     ($_ _.and
         (_.with-cover [/.functor]
           ($functor.spec ..injection (..comparison state) /.functor))
@@ -82,8 +83,8 @@
 
 (def: loops
   Test
-  (do r.monad
-    [limit (|> r.nat (:: @ map (n.% 10)))
+  (do random.monad
+    [limit (|> random.nat (:: @ map (n.% 10)))
      #let [condition (do /.monad
                        [state /.get]
                        (wrap (n.< limit state)))]]
@@ -104,10 +105,10 @@
 
 (def: monad-transformer
   Test
-  (do r.monad
-    [state r.nat
-     left r.nat
-     right r.nat]
+  (do random.monad
+    [state random.nat
+     left random.nat
+     right random.nat]
     (let [(^open "io@.") io.monad]
       (_.cover [/.State' /.with /.lift /.run']
                (|> (: (/.State' io.IO Nat Nat)
-- 
cgit v1.2.3