Slightly cleaner application of variance for FRP channels.

7 files changed, 99 insertions, 85 deletions

diff --git a/stdlib/source/library/lux/control/concurrency/async.lux b/stdlib/source/library/lux/control/concurrency/async.lux
index 822627610..c492b9b5e 100644
--- a/stdlib/source/library/lux/control/concurrency/async.lux
+++ b/stdlib/source/library/lux/control/concurrency/async.lux
@@ -22,8 +22,16 @@
   ["[0]" thread]
   ["[0]" atom (.only Atom atom)]])
 
+(def Value
+  (template (_ a)
+    [(Maybe a)]))
+
+(def Handler
+  (template (_ a)
+    [(-> a (IO Any))]))
+
 (primitive .public (Async'' a)
-  (Atom [(Maybe a) (List (-> a (IO Any)))])
+  (Atom [(Value a) (List (Handler a))])
 
   (type .public (Async' r w)
     (Async'' (Mutable r w)))
@@ -65,14 +73,14 @@
       [async (..resolver async)]))
 
   (def .public value
-    (All (_ r w) (-> (Async' r w) (IO (Maybe r))))
+    (All (_ r w) (-> (Async' r w) (IO (Value r))))
     (|>> representation
          atom.read!
          (at io.functor each (|>> product.left
                                   (maybe#each (|>> variance.read))))))
 
   (def .public (upon! f async)
-    (All (_ r w) (-> (-> r (IO Any)) (Async' r w) (IO Any)))
+    (All (_ r w) (-> (Handler r) (Async' r w) (IO Any)))
     (do [! io.monad]
       [.let [async (representation async)]
        (^.let old [_value _observers]) (atom.read! async)]
diff --git a/stdlib/source/library/lux/control/concurrency/frp.lux b/stdlib/source/library/lux/control/concurrency/frp.lux
index 1311d9b3d..36275bef4 100644
--- a/stdlib/source/library/lux/control/concurrency/frp.lux
+++ b/stdlib/source/library/lux/control/concurrency/frp.lux
@@ -12,22 +12,19 @@
     ["[0]" exception (.only exception)]
     ["[0]" io (.only IO io)]]
    [meta
-    [type (.only sharing)
-     ["[0]" variance (.only Mutable)]]]]]
+    ["[0]" type (.only sharing)]]]]
  [//
   ["[0]" atom (.only Atom)]
   ["[0]" async (.only Async Async') (.use "[1]#[0]" monad)]])
 
-(type .public (Channel'' a)
-  (Async (Maybe [a (Channel'' a)])))
-
 (type .public (Channel' r w)
-  (Channel'' (Mutable r w)))
+  (Async' (Maybe [r (Channel' r w)])
+          (Maybe [w (Channel' r w)])))
 
 (type .public (Channel a)
-  (Channel'' (Mutable a a)))
+  (Channel' a a))
 
-(exception .public channel_is_already_closed)
+(exception .public already_closed)
 
 (type .public (Sink w)
   (Interface
@@ -38,7 +35,7 @@
 
 (def (sink resolution)
   (All (_ a)
-    (-> (async.Resolver (Maybe [(Mutable a a) (Channel a)]))
+    (-> (async.Resolver (Maybe [a (Channel a)]))
         (Sink a)))
   (let [sink (atom.atom resolution)]
     (implementation
@@ -55,7 +52,7 @@
                [latter (atom.read! sink)]
                (if (same? current latter)
                  ... Someone else closed the sink.
-                 (in (exception.except ..channel_is_already_closed []))
+                 (in (exception.except ..already_closed []))
                  ... Someone else fed the sink while I was closing it.
                  (again [])))))))
      
@@ -64,12 +61,12 @@
          (do [! io.monad]
            [current (atom.read! sink)
             .let [[next resolve_next] (sharing [a]
-                                        (is (async.Resolver (Maybe [(Mutable a a) (Channel a)]))
+                                        (is (async.Resolver (Maybe [a (Channel a)]))
                                             current)
                                         (is [(Channel a)
-                                             (async.Resolver (Maybe [(Mutable a a) (Channel a)]))]
+                                             (async.Resolver (Maybe [a (Channel a)]))]
                                             (async.async [])))]
-            fed? (current {.#Some [(variance.write value) next]})]
+            fed? (current {.#Some [value next]})]
            (if fed?
              ... I fed the sink.
              (do !
@@ -80,7 +77,7 @@
                [latter (atom.read! sink)]
                (if (same? current latter)
                  ... Someone else closed the sink while I was feeding it.
-                 (in (exception.except ..channel_is_already_closed []))
+                 (in (exception.except ..already_closed []))
                  ... Someone else fed the sink.
                  (again []))))))))))
 
@@ -96,7 +93,7 @@
      (async#each
       (maybe#each
        (function (_ [head tail])
-         [(variance.write (f (variance.read head)))
+         [(f head)
           (each f tail)]))))))
 
 (def .public apply
@@ -110,7 +107,7 @@
         item_a fa]
        (case [item_f item_a]
          [{.#Some [head_f tail_f]} {.#Some [head_a tail_a]}]
-         (in {.#Some [(variance.write ((variance.read head_f) (variance.read head_a)))
+         (in {.#Some [(head_f head_a)
                       (on tail_a tail_f)]})
 
          _
@@ -126,7 +123,7 @@
    (def functor ..functor)
 
    (def (in a)
-     (async.resolved {.#Some [(variance.write a) ..empty]}))
+     (async.resolved {.#Some [a ..empty]}))
 
    (def (conjoint mma)
      (let [[output sink] (sharing [a]
@@ -144,12 +141,12 @@
                    (do !
                      [_ (loop (again [ma ma])
                           (do !
-                            [?ma (variance.read ma)]
+                            [?ma ma]
                             (case ?ma
                               {.#Some [a ma']}
                               (exec
-                                (io.run! (at sink feed (variance.read a)))
-                                (again (variance.write ma')))
+                                (io.run! (at sink feed a))
+                                (again ma'))
                               
                               {.#None}
                               (in []))))]
@@ -162,16 +159,19 @@
 (type .public (Subscriber a)
   (-> a (IO (Maybe Any))))
 
-(def .public (subscribe! subscriber channel)
+(def .public (subscribe! subscriber it)
   (All (_ r w) (-> (Subscriber r) (Channel' r w) (IO Any)))
   (io (exec
         (is (Async Any)
-            (loop (again [channel channel])
+            (loop (again [it (type.as [r w]
+                                      (Channel' r w)
+                                      (Channel r)
+                                      it)])
               (do async.monad
-                [item channel]
+                [item it]
                 (case item
                   {.#Some [head tail]}
-                  (case (io.run! (subscriber (variance.read head)))
+                  (case (io.run! (subscriber head))
                     {.#Some _}
                     (again tail)
                     
@@ -182,14 +182,14 @@
                   (in [])))))
         [])))
 
-(def .public (only pass? channel)
+(def .public (only pass? it)
   (All (_ a) (-> (-> a Bit) (Channel a) (Channel a)))
   (do async.monad
-    [item channel]
+    [item it]
     (case item
       {.#Some [head tail]}
       (let [tail' (only pass? tail)]
-        (if (pass? (variance.read head))
+        (if (pass? head)
           (in {.#Some [head tail']})
           tail'))
       
@@ -199,40 +199,40 @@
 (def .public (of_async async)
   (All (_ a) (-> (Async a) (Channel a)))
   (async#each (function (_ value)
-                {.#Some [(variance.write value) ..empty]})
+                {.#Some [value ..empty]})
               async))
 
-(def .public (mix f init channel)
+(def .public (mix f init it)
   (All (_ a b)
     (-> (-> b a (Async a)) a (Channel b)
         (Async a)))
   (do [! async.monad]
-    [item channel]
+    [item it]
     (case item
       {.#None}
       (in init)
       
       {.#Some [head tail]}
       (do !
-        [init' (f (variance.read head) init)]
+        [init' (f head init)]
         (mix f init' tail)))))
 
-(def .public (mixes f init channel)
+(def .public (mixes f init it)
   (All (_ a b)
     (-> (-> b a (Async a)) a (Channel b)
         (Channel a)))
   (<| async#in
       {.#Some}
-      [(variance.write init)]
+      [init]
       (do [! async.monad]
-        [item channel]
+        [item it]
         (case item
           {.#None}
           (in {.#None})
           
           {.#Some [head tail]}
           (do !
-            [init' (f (variance.read head) init)]
+            [init' (f head init)]
             (mixes f init' tail))))))
 
 (def .public (poll milli_seconds action)
@@ -257,42 +257,42 @@
     [?next (f init)]
     (in (case ?next
           {.#Some [state output]}
-          {.#Some [(variance.write output) (iterations f state)]}
+          {.#Some [output (iterations f state)]}
           
           {.#None}
           {.#None}))))
 
-(def (distinct' equivalence previous channel)
+(def (distinct' equivalence previous it)
   (All (_ a) (-> (Equivalence a) a (Channel a) (Channel a)))
   (do async.monad
-    [item channel]
+    [item it]
     (case item
       {.#Some [head tail]}
-      (if (at equivalence = previous (variance.read head))
+      (if (at equivalence = previous head)
         (distinct' equivalence previous tail)
-        (in {.#Some [head (distinct' equivalence (variance.read head) tail)]}))
+        (in {.#Some [head (distinct' equivalence head tail)]}))
       
       {.#None}
       (in {.#None}))))
 
-(def .public (distinct equivalence channel)
+(def .public (distinct equivalence it)
   (All (_ a) (-> (Equivalence a) (Channel a) (Channel a)))
   (do async.monad
-    [item channel]
+    [item it]
     (in (case item
           {.#Some [head tail]}
-          {.#Some [head (distinct' equivalence (variance.read head) tail)]}
+          {.#Some [head (distinct' equivalence head tail)]}
           
           {.#None}
           {.#None}))))
 
-(def .public (list channel)
+(def .public (list it)
   (All (_ a) (-> (Channel a) (Async (List a))))
   (do [! async.monad]
-    [item channel]
+    [item it]
     (case item
       {.#Some [head tail]}
-      (at ! each (|>> {.#Item (variance.read head)})
+      (at ! each (|>> {.#Item head})
           (list tail))
 
       {.#None}
@@ -305,7 +305,7 @@
     ..empty
 
     {.#Item head tail}
-    (async.resolved {.#Some [(variance.write head)
+    (async.resolved {.#Some [head
                              (do async.monad
                                [_ (async.delay milli_seconds)]
                                (sequential milli_seconds tail))]})))
diff --git a/stdlib/source/library/lux/data/collection/array.lux b/stdlib/source/library/lux/data/collection/array.lux
index 40e8c6599..3158b04d6 100644
--- a/stdlib/source/library/lux/data/collection/array.lux
+++ b/stdlib/source/library/lux/data/collection/array.lux
@@ -17,9 +17,9 @@
      [variance (.only)]]]]]
  ["!" \\unsafe])
 
-(def .public type_name
+(def .public primitive
   Text
-  !.type)
+  !.primitive)
 
 (type .public Array'
   !.Array')
diff --git a/stdlib/source/library/lux/ffi.jvm.lux b/stdlib/source/library/lux/ffi.jvm.lux
index 1f40f0d76..f9fd3472a 100644
--- a/stdlib/source/library/lux/ffi.jvm.lux
+++ b/stdlib/source/library/lux/ffi.jvm.lux
@@ -1928,7 +1928,7 @@
                         [jvm.double]
                         [jvm.char]))
 
-                  (text#= array.type_name name)
+                  (text#= array.primitive name)
                   (case params
                     {.#Item {.#Apply writeLT {.#Apply readLT _Mutable}} {.#End}}
                     (at meta.monad each jvm.array
diff --git a/stdlib/source/library/lux/ffi.old.lux b/stdlib/source/library/lux/ffi.old.lux
index d0a3132c7..7bcd63ce1 100644
--- a/stdlib/source/library/lux/ffi.old.lux
+++ b/stdlib/source/library/lux/ffi.old.lux
@@ -1025,7 +1025,7 @@
     (format "(" (safe name) " " (spaced (list#each generic_type$ params)) ")")
     
     {#GenericArray param}
-    (format "(" array.type_name " " (generic_type$ param) ")")
+    (format "(" array.primitive " " (generic_type$ param) ")")
     
     {#GenericWildcard {.#None}}
     "?"
diff --git a/stdlib/source/library/lux/meta/type.lux b/stdlib/source/library/lux/meta/type.lux
index b751e9270..f53222cf1 100644
--- a/stdlib/source/library/lux/meta/type.lux
+++ b/stdlib/source/library/lux/meta/type.lux
@@ -390,14 +390,14 @@
     _ (|> element_type
           (array (-- depth))
           (list)
-          {.#Primitive array.type_name})))
+          {.#Primitive array.primitive})))
 
 (def .public (flat_array type)
   (-> Type [Nat Type])
   (with_expansions [<default> [0 type]]
     (case type
       {.#Primitive name (list element_type)}
-      (if (text#= array.type_name name)
+      (if (text#= array.primitive name)
         (.let [[depth element_type] (flat_array element_type)]
           [(++ depth) element_type])
         <default>)
diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux
index 5c3b9451e..a29acfefe 100644
--- a/stdlib/source/library/lux/test.lux
+++ b/stdlib/source/library/lux/test.lux
@@ -42,28 +42,31 @@
      ["[0]" instant]
      ["[0]" duration (.only Duration)]]]]])
 
+(type .public Coverage
+  (Set Symbol))
+
 (type .public Tally
   (Record
    [#successes Nat
     #failures Nat
-    #expected_coverage (Set Symbol)
-    #actual_coverage (Set Symbol)]))
+    #expected Coverage
+    #actual Coverage]))
 
 (def (total parameter subject)
   (-> Tally Tally Tally)
   [#successes (n.+ (the #successes parameter) (the #successes subject))
    #failures (n.+ (the #failures parameter) (the #failures subject))
-   #expected_coverage (set.union (the #expected_coverage parameter)
-                                 (the #expected_coverage subject))
-   #actual_coverage (set.union (the #actual_coverage parameter)
-                               (the #actual_coverage subject))])
+   #expected (set.union (the #expected parameter)
+                        (the #expected subject))
+   #actual (set.union (the #actual parameter)
+                      (the #actual subject))])
 
 (def start
   Tally
   [#successes 0
    #failures 0
-   #expected_coverage (set.empty symbol.hash)
-   #actual_coverage (set.empty symbol.hash)])
+   #expected (set.empty symbol.hash)
+   #actual (set.empty symbol.hash)])
 
 (with_template [<name> <category>]
   [(def <name>
@@ -189,19 +192,19 @@
   (-> Duration Tally Text)
   (let [successes (the #successes tally)
         failures (the #failures tally)
-        missing (set.difference (the #actual_coverage tally)
-                                (the #expected_coverage tally))
-        unexpected (set.difference (the #expected_coverage tally)
-                                   (the #actual_coverage tally))
-        report (is (-> (Set Symbol) Text)
+        missing (set.difference (the #actual tally)
+                                (the #expected tally))
+        unexpected (set.difference (the #expected tally)
+                                   (the #actual tally))
+        report (is (-> Coverage Text)
                    (|>> set.list
                         (list.sorted (at symbol.order <))
                         (exception.listing %.symbol)))
-        expected_definitions_to_cover (set.size (the #expected_coverage tally))
-        unexpected_definitions_covered (set.size unexpected)
-        actual_definitions_covered (n.- unexpected_definitions_covered
-                                        (set.size (the #actual_coverage tally)))
-        coverage (case expected_definitions_to_cover
+        expected_coverage (set.size (the #expected tally))
+        unexpected_coverage (set.size unexpected)
+        actual_coverage (n.- unexpected_coverage
+                             (set.size (the #actual tally)))
+        coverage (case expected_coverage
                    0 "N/A"
                    expected (let [missing_ratio (f./ (n.frac expected)
                                                      (n.frac (set.size missing)))
@@ -223,17 +226,20 @@
                                       (text.suffix "%"))))))]
     (exception.report
      (list ["Duration" (%.duration duration)]
+
            ["Tests" (%.nat (n.+ successes failures))]
            ["Successes" (%.nat successes)]
            ["Failures" (%.nat failures)]
-           ["Expected definitions to cover" (%.nat expected_definitions_to_cover)]
-           ["Actual definitions covered" (%.nat actual_definitions_covered)]
-           ["Pending definitions to cover" (%.nat (n.- actual_definitions_covered
-                                                       expected_definitions_to_cover))]
-           ["Unexpected definitions covered" (%.nat unexpected_definitions_covered)]
+           
+           ["Expected coverage" (%.nat expected_coverage)]
+           ["Actual coverage" (%.nat actual_coverage)]
+           ["Pending coverage" (%.nat (n.- actual_coverage
+                                           expected_coverage))]
+           ["Unexpected coverage" (%.nat unexpected_coverage)]
+           
            ["Coverage" coverage]
-           ["Pending definitions to cover" (report missing)]
-           ["Unexpected definitions covered" (report unexpected)]))))
+           ["Pending" (report missing)]
+           ["Unexpected" (report unexpected)]))))
 
 (def failure_exit_code +1)
 (def success_exit_code +0)
@@ -280,7 +286,7 @@
         coverage (set.of_list symbol.hash coverage)]
     (|> (..assertion message condition)
         (async#each (function (_ [tally documentation])
-                      [(revised #actual_coverage (set.union coverage) tally)
+                      [(revised #actual (set.union coverage) tally)
                        documentation])))))
 
 (def .public (with_coverage coverage condition)
@@ -295,7 +301,7 @@
                     (text.interposed ..definition_separator))
         coverage (set.of_list symbol.hash coverage)]
     (random#each (async#each (function (_ [tally documentation])
-                               [(revised #actual_coverage (set.union coverage) tally)
+                               [(revised #actual (set.union coverage) tally)
                                 documentation]))
                  (..context' context test))))
 
@@ -323,7 +329,7 @@
             ""))
 
 (def (coverage_definitions module encoding)
-  (-> Text Text (Set Symbol))
+  (-> Text Text Coverage)
   (loop (again [remaining encoding
                 output (set.of_list symbol.hash (list))])
     (case (text.split_by ..coverage_separator remaining)
@@ -363,7 +369,7 @@
   (let [coverage (..coverage_definitions module coverage)]
     (|> (..context' module test)
         (random#each (async#each (function (_ [tally documentation])
-                                   [(revised #expected_coverage (set.union coverage) tally)
+                                   [(revised #expected (set.union coverage) tally)
                                     (|> documentation
                                         (text.replaced (format ..clean_up_marker module symbol.separator) "")
                                         (text.replaced ..clean_up_marker ""))]))))))