From ff6914a0e3bd85b2ae49b5bee6028dff8a47568a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 19 Aug 2022 13:27:19 -0400
Subject: Added support for incremental computation.

---
 stdlib/source/test/lux/control.lux                 |   4 +-
 .../test/lux/control/concurrency/incremental.lux   | 101 +++++++++++++++++++++
 stdlib/source/test/lux/meta/type/variance.lux      |  25 +++++
 3 files changed, 129 insertions(+), 1 deletion(-)
 create mode 100644 stdlib/source/test/lux/control/concurrency/incremental.lux

(limited to 'stdlib/source/test')

diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index bdef6e1b1..c51399523 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -14,7 +14,8 @@
    ["[1]/[0]" semaphore]
    ["[1]/[0]" stm]
    ["[1]/[0]" event]
-   ["[1]/[0]" cps]]
+   ["[1]/[0]" cps]
+   ["[1]/[0]" incremental]]
   ["[1][0]" continuation]
   ["[1][0]" exception]
   ["[1][0]" function]
@@ -46,6 +47,7 @@
        /concurrency/stm.test
        /concurrency/event.test
        /concurrency/cps.test
+       /concurrency/incremental.test
        ))
 
 (def security
diff --git a/stdlib/source/test/lux/control/concurrency/incremental.lux b/stdlib/source/test/lux/control/concurrency/incremental.lux
new file mode 100644
index 000000000..c606cec28
--- /dev/null
+++ b/stdlib/source/test/lux/control/concurrency/incremental.lux
@@ -0,0 +1,101 @@
+(.require
+ [library
+  [lux (.except)
+   [abstract
+    [monad (.only do)]
+    [\\specification
+     ["$[0]" functor (.only Injection Comparison)]
+     ["$[0]" monad]]]
+   [control
+    ["[0]" io]
+    ["[0]" try]
+    ["[0]" exception]]
+   [data
+    ["[0]" bit (.use "[1]#[0]" equivalence)]]
+   [math
+    ["[0]" random]]
+   [test
+    ["_" property (.only Test)]
+    ["[0]" unit]]]]
+ [\\library
+  ["[0]" / (.only)
+   [//
+    ["[0]" async]]]])
+
+(def injection
+  (Injection /.Computation)
+  (|>> /.var /.mutations))
+
+(def comparison
+  (Comparison /.Computation)
+  (function (_ == left right)
+    (io.run!
+     (do io.monad
+       [left (/.value left)
+        right (/.value right)]
+       (in (== left right))))))
+
+(def .public test
+  Test
+  (<| (_.covering /._)
+      (do [! random.monad]
+        [expected random.nat
+         .let [dummy (++ expected)]
+
+         expected_right random.safe_frac])
+      (all _.and
+           (_.for [/.Var]
+                  (all _.and
+                       (_.coverage [/.var /.mutations /.value]
+                         (|> expected
+                             /.var
+                             /.mutations
+                             /.value
+                             io.run!
+                             (same? expected)))
+                       (_.coverage [/.mutate!]
+                         (let [it (/.var dummy)]
+                           (io.run! (do io.monad
+                                      [before (/.value (/.mutations it))
+                                       _ (/.mutate! expected it)
+                                       after (/.value (/.mutations it))]
+                                      (in (and (same? dummy before)
+                                               (same? expected after)))))))
+                       ))
+           (_.for [/.Computation]
+                  (all _.and
+                       (_.for [/.functor]
+                              ($functor.spec ..injection ..comparison /.functor))
+                       
+                       (_.coverage [/.or]
+                         (let [left (/.var dummy)
+                               right (/.var expected_right)
+                               l,r (/.or (/.mutations left) (/.mutations right))]
+                           (io.run! (do io.monad
+                                      [_ (/.mutate! expected left)
+                                       left'|right' (/.value l,r)]
+                                      (in (when left'|right'
+                                            {.#Left left'}
+                                            (same? expected left')
+                                            
+                                            {.#Right right'}
+                                            false))))))
+                       (_.coverage [/.and]
+                         (let [left (/.var dummy)
+                               right (/.var expected_right)
+                               l,r (/.and (/.mutations left) (/.mutations right))]
+                           (io.run! (do io.monad
+                                      [_ (/.mutate! expected left)
+                                       [left' right'] (/.value l,r)]
+                                      (in (and (same? expected left')
+                                               (same? expected_right right')))))))
+                       (_.coverage [/.either]
+                         (let [left (/.var dummy)
+                               right (/.var dummy)
+                               l,r (/.either (/.mutations left) (/.mutations right))]
+                           (io.run! (do io.monad
+                                      [_ (/.mutate! expected right)
+                                       actual (/.value l,r)]
+                                      (in (same? expected actual))))))
+                       ))
+           )))
diff --git a/stdlib/source/test/lux/meta/type/variance.lux b/stdlib/source/test/lux/meta/type/variance.lux
index 494aa23f9..5024bda85 100644
--- a/stdlib/source/test/lux/meta/type/variance.lux
+++ b/stdlib/source/test/lux/meta/type/variance.lux
@@ -21,6 +21,8 @@
 (def .public test
   Test
   (<| (_.covering /._)
+      (do random.monad
+        [expected random.nat])
       (all _.and
            (_.coverage [/.Co]
              (and (//check.subsumes? (type_literal (/.Co Super)) (type_literal (/.Co Sub)))
@@ -33,4 +35,27 @@
                   (//check.subsumes? (type_literal (/.In Sub)) (type_literal (/.In Sub)))
                   (not (//check.subsumes? (type_literal (/.In Sub)) (type_literal (/.In Super))))
                   (not (//check.subsumes? (type_literal (/.In Super)) (type_literal (/.In Sub))))))
+           (_.for [/.Mutable]
+                  (all _.and
+                       (_.coverage [/.write /.read]
+                         (|> (/.write expected)
+                             (is (/.Mutable I64 Nat))
+                             /.read
+                             (same? (.i64 expected))))
+                       (_.coverage [/.Read_Only /.read_only]
+                         (|> (/.write expected)
+                             (is (/.Mutable I64 Nat))
+                             /.read_only
+                             (is (/.Read_Only I64))
+                             /.read
+                             (same? (.i64 expected))))
+                       (_.coverage [/.Write_Only /.write_only]
+                         (|> (/.write expected)
+                             (is (/.Mutable I64 Nat))
+                             /.write_only
+                             (is (/.Write_Only Nat))
+                             /.read
+                             (is Any)
+                             (same? (as Any expected))))
+                       ))
            )))
-- 
cgit v1.2.3