Lightweight machinery for agent-oriented programming.

8 files changed, 346 insertions, 22 deletions

diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux
index 1b1a01242..7ab561360 100644
--- a/stdlib/source/test/lux/control/concurrency/actor.lux
+++ b/stdlib/source/test/lux/control/concurrency/actor.lux
@@ -11,13 +11,18 @@
     [number
      ["n" nat]]
     [text
-     ["%" format (#+ format)]]]
+     ["%" format (#+ format)]]
+    [collection
+     ["." list]
+     ["." row (#+ Row)]]]
    [math
     ["." random]]]
   {1
    ["." / (#+ actor: message:)
     [//
-     ["." promise (#+ Promise Resolver) ("#@." monad)]]]})
+     ["." atom (#+ Atom)]
+     ["." promise (#+ Promise Resolver) ("#@." monad)]
+     ["." frp]]]})
 
 (exception: got-wrecked)
 
@@ -43,7 +48,7 @@
 
 (def: #export test
   Test
-  (do random.monad
+  (do {! random.monad}
     [initial-state random.nat
      #let [as-mail (: (All [a] (-> (-> a a) (/.Mail a)))
                       (function (_ transform)
@@ -189,4 +194,47 @@
                                              false)))))]
                     (_.claim [/.actor]
                              verdict)))
+            (do !
+              [num-events (:: ! map (|>> (n.% 10) inc) random.nat)
+               events (random.list num-events random.nat)
+               num-observations (:: ! map (n.% num-events) random.nat)
+               #let [expected (list.take num-observations events)
+                     sink (: (Atom (Row Nat))
+                             (atom.atom row.empty))
+                     [signal signal!] (: [(Promise Any) (Resolver Any)]
+                                         (promise.promise []))]]
+              (wrap (do promise.monad
+                      [agent (promise.future
+                              (do {! io.monad}
+                                [agent (/.actor {Nat 0})
+                                 _ (/.observe (function (_ event stop)
+                                                (function (_ events-seen self)
+                                                  (promise.future
+                                                   (cond (n.< num-observations events-seen)
+                                                         (do !
+                                                           [_ (atom.update (row.add event) sink)]
+                                                           (wrap (#try.Success (inc events-seen))))
+                                                         
+                                                         (n.= num-observations events-seen)
+                                                         (do !
+                                                           [_ stop
+                                                            _ (signal! [])]
+                                                           (wrap (#try.Success (inc events-seen))))
+
+                                                         (wrap (#try.Failure "YOLO"))))))
+                                              (frp.sequential 0 events)
+                                              agent)]
+                                (wrap agent)))
+                       _ signal
+                       actual (promise.future (atom.read sink))
+                       died? (promise.time-out 1,000 (/.await agent))
+                       #let [died? (case died?
+                                     (#.Some _)
+                                     true
+
+                                     #.None
+                                     false)]]
+                      (_.claim [/.observe]
+                               (and (:: (list.equivalence n.equivalence) = expected (row.to-list actual))
+                                    (not died?))))))
             ))))
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 43198ff5b..e7d418bf7 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -16,7 +16,7 @@
     [number
      ["n" nat]]
     [collection
-     ["." list ("#@." functor fold)]
+     ["." list ("#@." functor fold monoid)]
      ["." row (#+ Row)]]]
    [math
     ["." random]]]
@@ -124,18 +124,23 @@
               (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))
+                             channel (/.sequential 0 (list@compose inputs inputs))]
+                       _ (promise.future (/.subscribe (function (_ value)
+                                                        (do {! io.monad}
+                                                          [current (atom.read sink)]
+                                                          (if (n.< (list.size inputs)
+                                                                   (row.size current))
+                                                            (do !
+                                                              [_ (atom.update (row.add value) sink)]
+                                                              (wrap (#.Some [])))
+                                                            (wrap (#.Some [])))))
+                                                      channel))
                        output (/.consume channel)
                        listened (|> sink
                                     atom.read
                                     promise.future
                                     (:: ! map row.to-list))]
-                      (_.claim [/.listen]
+                      (_.claim [/.Subscriber /.subscribe]
                                (and (list@= inputs
                                             output)
                                     (list@= output
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux
index 82643dfde..497123614 100644
--- a/stdlib/source/test/lux/data/collection.lux
+++ b/stdlib/source/test/lux/data/collection.lux
@@ -14,6 +14,7 @@
    ["#." queue
     ["#/." priority]]
    ["#." set
+    ["#/." multi]
     ["#/." ordered]]
    ["#." tree
     ["#/." zipper]]])
@@ -37,6 +38,7 @@
   Test
   ($_ _.and
       /set.test
+      /set/multi.test
       /set/ordered.test
       ))
 
diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux
index e09e502bc..7a5e686ac 100644
--- a/stdlib/source/test/lux/data/collection/array.lux
+++ b/stdlib/source/test/lux/data/collection/array.lux
@@ -31,6 +31,21 @@
   (:: random.monad map (|>> (n.% 100) (n.+ 1))
       random.nat))
 
+(def: structures
+  Test
+  (do {! random.monad}
+    [size ..bounded-size]
+    ($_ _.and
+        (_.with-cover [/.equivalence]
+          ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat)))
+        (_.with-cover [/.monoid]
+          ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat)))
+        (_.with-cover [/.functor]
+          ($functor.spec ..injection /.equivalence /.functor))
+        (_.with-cover [/.fold]
+          ($fold.spec ..injection /.equivalence /.fold))
+        )))
+
 (def: #export test
   Test
   (<| (_.covering /._)
@@ -43,14 +58,7 @@
          #let [expected (n.+ base shift)]
          the-array (random.array size random.nat)]
         ($_ _.and
-            (_.with-cover [/.equivalence]
-              ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat)))
-            (_.with-cover [/.monoid]
-              ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat)))
-            (_.with-cover [/.functor]
-              ($functor.spec ..injection /.equivalence /.functor))
-            (_.with-cover [/.fold]
-              ($fold.spec ..injection /.equivalence /.fold))
+            ..structures
 
             (_.cover [/.new /.size]
                      (n.= size (/.size (: (Array Nat)
diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux
new file mode 100644
index 000000000..039f67200
--- /dev/null
+++ b/stdlib/source/test/lux/data/collection/set/multi.lux
@@ -0,0 +1,216 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [hash (#+ Hash)]
+    [monad (#+ do)]
+    ["." predicate]
+    {[0 #spec]
+     [/
+      ["$." equivalence]]}]
+   [data
+    ["." bit ("#@." equivalence)]
+    [number
+     ["n" nat]]
+    [collection
+     ["." set]
+     ["." list ("#@." fold)]]]
+   [math
+    ["." random (#+ Random)]]]
+  {1
+   ["." /]})
+
+(def: count
+  (Random Nat)
+  (:: random.monad map (|>> (n.% 10) inc) random.nat))
+
+(def: #export (random size hash count element)
+  (All [a] (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a))))
+  (do {! random.monad}
+    [elements (random.set hash size element)
+     element-counts (random.list size ..count)]
+    (wrap (list@fold (function (_ [count element] set)
+                       (/.add count element set))
+                     (/.new hash)
+                     (list.zip/2 element-counts
+                                 (set.to-list elements))))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.Set])
+      (do {! random.monad}
+        [diversity (:: ! map (n.% 10) random.nat)
+         sample (..random diversity n.hash ..count random.nat)
+         non-member (random.filter (predicate.complement (set.member? (/.support sample)))
+                                   random.nat)
+         addition-count ..count
+         partial-removal-count (:: ! map (n.% addition-count) random.nat)
+         another (..random diversity n.hash ..count random.nat)]
+        (`` ($_ _.and
+                (_.with-cover [/.equivalence]
+                  ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat)))
+
+                (_.cover [/.to-list /.from-list]
+                         (|> sample
+                             /.to-list
+                             (/.from-list n.hash)
+                             (:: /.equivalence = sample)))
+                (_.cover [/.size]
+                         (n.= (list.size (/.to-list sample))
+                              (/.size sample)))
+                (_.cover [/.empty?]
+                         (bit@= (/.empty? sample)
+                                (n.= 0 (/.size sample))))
+                (_.cover [/.new]
+                         (/.empty? (/.new n.hash)))
+                (_.cover [/.support]
+                         (list.every? (set.member? (/.support sample))
+                                      (/.to-list sample)))
+                (_.cover [/.member?]
+                         (let [non-member-is-not-identified!
+                               (not (/.member? sample non-member))
+
+                               all-members-are-identified!
+                               (list.every? (/.member? sample)
+                                            (/.to-list sample))]
+                           (and non-member-is-not-identified!
+                                all-members-are-identified!)))
+                (_.cover [/.multiplicity]
+                         (let [non-members-have-0-multiplicity!
+                               (n.= 0 (/.multiplicity sample non-member))
+
+                               every-member-has-positive-multiplicity!
+                               (list.every? (|>> (/.multiplicity sample) (n.> 0))
+                                            (/.to-list sample))]
+                           (and non-members-have-0-multiplicity!
+                                every-member-has-positive-multiplicity!)))
+                (_.cover [/.add]
+                         (let [null-scenario!
+                               (|> sample
+                                   (/.add 0 non-member)
+                                   (:: /.equivalence = sample))
+
+                               normal-scenario!
+                               (let [sample+ (/.add addition-count non-member sample)]
+                                 (and (not (/.member? sample non-member))
+                                      (/.member? sample+ non-member)
+                                      (n.= addition-count (/.multiplicity sample+ non-member))))]
+                           (and null-scenario!
+                                normal-scenario!)))
+                (_.cover [/.remove]
+                         (let [null-scenario!
+                               (:: /.equivalence =
+                                   (|> sample
+                                       (/.add addition-count non-member))
+                                   (|> sample
+                                       (/.add addition-count non-member)
+                                       (/.remove 0 non-member)))
+
+                               partial-scenario!
+                               (let [sample* (|> sample
+                                                 (/.add addition-count non-member)
+                                                 (/.remove partial-removal-count non-member))]
+                                 (and (/.member? sample* non-member)
+                                      (n.= (n.- partial-removal-count
+                                                addition-count)
+                                           (/.multiplicity sample* non-member))))
+
+                               total-scenario!
+                               (|> sample
+                                   (/.add addition-count non-member)
+                                   (/.remove addition-count non-member)
+                                   (:: /.equivalence = sample))]
+                           (and null-scenario!
+                                partial-scenario!
+                                total-scenario!)))
+                (_.cover [/.from-set]
+                         (let [unary (|> sample /.support /.from-set)]
+                           (list.every? (|>> (/.multiplicity unary) (n.= 1))
+                                        (/.to-list unary))))
+                (_.cover [/.sub?]
+                         (let [unary (|> sample /.support /.from-set)]
+                           (and (/.sub? sample unary)
+                                (or (not (/.sub? unary sample))
+                                    (:: /.equivalence = sample unary)))))
+                (_.cover [/.super?]
+                         (let [unary (|> sample /.support /.from-set)]
+                           (and (/.super? unary sample)
+                                (or (not (/.super? sample unary))
+                                    (:: /.equivalence = sample unary)))))
+                (~~ (template [<name> <composition>]
+                      [(_.cover [<name>]
+                                (let [|sample| (/.support sample)
+                                      |another| (/.support another)
+                                      sample-only (set.difference |another| |sample|)
+                                      another-only (set.difference |sample| |another|)
+                                      common (set.intersection |sample| |another|)
+                                      composed (<name> sample another)
+
+                                      no-left-changes! (list.every? (function (_ member)
+                                                                      (n.= (/.multiplicity sample member)
+                                                                           (/.multiplicity composed member)))
+                                                                    (set.to-list sample-only))
+                                      no-right-changes! (list.every? (function (_ member)
+                                                                       (n.= (/.multiplicity another member)
+                                                                            (/.multiplicity composed member)))
+                                                                     (set.to-list another-only))
+                                      common-changes! (list.every? (function (_ member)
+                                                                     (n.= (<composition> (/.multiplicity sample member)
+                                                                                         (/.multiplicity another member))
+                                                                          (/.multiplicity composed member)))
+                                                                   (set.to-list common))]
+                                  (and no-left-changes!
+                                       no-right-changes!
+                                       common-changes!)))]
+
+                      [/.sum n.+]
+                      [/.union n.max]
+                      ))
+                (_.cover [/.intersection]
+                         (let [|sample| (/.support sample)
+                               |another| (/.support another)
+                               sample-only (set.difference |another| |sample|)
+                               another-only (set.difference |sample| |another|)
+                               common (set.intersection |sample| |another|)
+                               composed (/.intersection sample another)
+
+                               left-removals! (list.every? (|>> (/.member? composed) not)
+                                                           (set.to-list sample-only))
+                               right-removals! (list.every? (|>> (/.member? composed) not)
+                                                            (set.to-list another-only))
+                               common-changes! (list.every? (function (_ member)
+                                                              (n.= (n.min (/.multiplicity sample member)
+                                                                          (/.multiplicity another member))
+                                                                   (/.multiplicity composed member)))
+                                                            (set.to-list common))]
+                           (and left-removals!
+                                right-removals!
+                                common-changes!)))
+                (_.cover [/.difference]
+                         (let [|sample| (/.support sample)
+                               |another| (/.support another)
+                               sample-only (set.difference |another| |sample|)
+                               another-only (set.difference |sample| |another|)
+                               common (set.intersection |sample| |another|)
+                               composed (/.difference sample another)
+
+                               ommissions! (list.every? (|>> (/.member? composed) not)
+                                                        (set.to-list sample-only))
+                               intact! (list.every? (function (_ member)
+                                                      (n.= (/.multiplicity another member)
+                                                           (/.multiplicity composed member)))
+                                                    (set.to-list another-only))
+                               subtractions! (list.every? (function (_ member)
+                                                            (let [sample-multiplicity (/.multiplicity sample member)
+                                                                  another-multiplicity (/.multiplicity another member)]
+                                                              (n.= (if (n.> another-multiplicity sample-multiplicity)
+                                                                     0
+                                                                     (n.- sample-multiplicity
+                                                                          another-multiplicity))
+                                                                   (/.multiplicity composed member))))
+                                                          (set.to-list common))]
+                           (and ommissions!
+                                intact!
+                                subtractions!)))
+                )))))
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 3a98b5380..2fbfc92b9 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -1010,11 +1010,11 @@
                           (function (_ expected) (|>> (:coerce Text) (text@= (:coerce Text expected))))))
         (<| (_.context "multi")
             (do {! random.monad}
-              [#let [size (:: ! map (|>> (n.% 10) (n.+ 1))
+              [#let [size (:: ! map (|>> (n.% 5) (n.+ 1))
                               random.nat)]
                dimensions size
                sizesH size
-               sizesT (monad.seq ! (list.repeat (dec dimensions) size))
+               sizesT (random.list (dec dimensions) size)
                #let [type (loop [dimensions dimensions
                                  type (: (Type Object)
                                          ..$Object)]
diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux
index c5b0ecc59..a01bdb929 100644
--- a/stdlib/source/test/lux/world.lux
+++ b/stdlib/source/test/lux/world.lux
@@ -3,11 +3,13 @@
    ["_" test (#+ Test)]]
   ["." / #_
    ["#." file]
-   ["#." shell]])
+   ["#." shell]
+   ["#." console]])
 
 (def: #export test
   Test
   ($_ _.and
       /file.test
       /shell.test
+      /console.test
       ))
diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux
new file mode 100644
index 000000000..d17559cec
--- /dev/null
+++ b/stdlib/source/test/lux/world/console.lux
@@ -0,0 +1,43 @@
+(.module:
+  [lux #*
+   ["_" test (#+ Test)]
+   [abstract
+    [monad (#+ do)]]
+   [control
+    ["." try (#+ Try)]
+    ["." exception (#+ exception:)]]]
+  {1
+   ["." /]}
+  {[1 #spec]
+   ["$." /]})
+
+(exception: dead)
+
+(def: simulation
+  (/.Simulation Bit)
+  (structure
+   (def: (on-read dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success [dead? (char "a")])))
+
+   (def: (on-read-line dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success [dead? "YOLO"])))
+
+   (def: (on-write message dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success dead?)))
+
+   (def: (on-close dead?)
+     (if dead?
+       (exception.throw ..dead [])
+       (#try.Success true)))))
+
+(def: #export test
+  Test
+  (<| (_.covering /._)
+      (_.with-cover [/.mock /.Simulation]
+        ($/.spec (/.mock ..simulation false)))))