Added support for incremental computation.

5 files changed, 278 insertions, 4 deletions

diff --git a/stdlib/source/library/lux/control/concurrency/incremental.lux b/stdlib/source/library/lux/control/concurrency/incremental.lux
new file mode 100644
index 000000000..7bbddd8cc
--- /dev/null
+++ b/stdlib/source/library/lux/control/concurrency/incremental.lux
@@ -0,0 +1,148 @@
+(.require
+ [library
+  [lux (.except or and)
+   [abstract
+    [functor (.only Functor)]
+    ["[0]" monad (.only do)]]
+   [control
+    ["[0]" io (.only IO) (.use "[1]#[0]" functor)]
+    ["[0]" function]]
+   [data
+    ["[0]" product]
+    [collection
+     ["[0]" list]]]
+   [meta
+    [type
+     [primitive (.except)]]]]]
+ [//
+  ["[0]" atom (.only Atom)]])
+
+(type (Dependency a)
+  (-> a (IO Any)))
+
+(primitive .public (Computation a)
+  (Atom [a (List (Dependency a))])
+
+  (def .public value
+    (All (_ a) (-> (Computation a) (IO a)))
+    (|>> representation
+         atom.read!
+         (io#each product.left)))
+
+  (def (computation value)
+    (All (_ a) (-> a (Computation a)))
+    (abstraction (atom.atom [value (list)])))
+
+  (def .public functor
+    (Functor Computation)
+    (implementation
+     (def (each $ input)
+       (io.run! (do [! io.monad]
+                  [old (atom.read! (representation input))
+                   .let [[current dependencies] old
+                         output (computation ($ current))]
+                   ? (atom.compare_and_swap! old
+                                             [current (list.partial (function (retry! next)
+                                                                      (do !
+                                                                        [old (atom.read! (representation output))
+                                                                         .let [[_ dependencies] old]
+                                                                         ? (atom.compare_and_swap! old
+                                                                                                   [($ next) dependencies]
+                                                                                                   (representation output))]
+                                                                        (if ?
+                                                                          (in [])
+                                                                          (retry! next))))
+                                                                    dependencies)]
+                                             (representation input))]
+                  (in (if ?
+                        output
+                        (each $ input))))))))
+
+  (def (watch! dependency it)
+    (All (_ a) (-> (Dependency a) (Computation a) (IO Any)))
+    (do io.monad
+      [.let [it' (representation it)]
+       old (atom.read! it')
+       .let [[current dependencies] old]
+       ? (atom.compare_and_swap! old [current (list.partial dependency dependencies)] it')]
+      (if ?
+        (in [])
+        (watch! dependency it))))
+
+  (def (update! $ output)
+    (All (_ a) (-> (-> a a) (Computation a) (IO Any)))
+    (atom.update! (function (_ [current dependencies])
+                    [($ current) dependencies])
+                  (representation output)))
+
+  (def .public (or left right)
+    (All (_ a b) (-> (Computation a) (Computation b) (Computation (Or a b))))
+    (io.run! (do io.monad
+               [left' (value left)
+                .let [output (computation {.#Left left'})]
+                _ (watch! (function (_ it)
+                            (update! (function.constant {.#Left it}) output))
+                          left)
+                _ (watch! (function (_ it)
+                            (update! (function.constant {.#Right it}) output))
+                          right)]
+               (in output))))
+
+  (def .public (and left right)
+    (All (_ a b) (-> (Computation a) (Computation b) (Computation (And a b))))
+    (io.run! (do io.monad
+               [left' (value left)
+                right' (value right)
+                .let [output (computation [left' right'])]
+                _ (watch! (function (_ left)
+                            (update! (function (_ [_ right])
+                                       [left right])
+                                     output))
+                          left)
+                _ (watch! (function (_ right)
+                            (update! (function (_ [left _])
+                                       [left right])
+                                     output))
+                          right)]
+               (in output))))
+
+  (def .public (either left right)
+    (All (_ a) (-> (Computation a) (Computation a) (Computation a)))
+    (io.run! (do io.monad
+               [left' (value left)
+                .let [output (computation left')]
+                .let [update! (function (_ it)
+                                (update! (function.constant it) output))]
+                _ (watch! update! left)
+                _ (watch! update! right)]
+               (in output))))
+
+  (primitive .public (Var a)
+    (Computation a)
+
+    (def .public (var value)
+      (All (_ a) (-> a (Var a)))
+      (<| (abstraction Var)
+          (abstraction Computation)
+          (atom.atom [value (list)])))
+
+    (def .public mutations
+      (All (_ a) (-> (Var a) (Computation a)))
+      (|>> (representation Var)))
+
+    (def .public (mutate! value it)
+      (All (_ a) (-> a (Var a) (IO Any)))
+      (do [! io.monad]
+        [.let [it' (|> it
+                       (representation Var)
+                       (representation Computation))]
+         old (atom.read! it')
+         .let [[_ dependencies] old]
+         ? (atom.compare_and_swap! old [value dependencies] it')]
+        (if ?
+          (do !
+            [_ (monad.each ! (function.on value) dependencies)]
+            (in []))
+          (mutate! value it))))
+    )
+  )
diff --git a/stdlib/source/library/lux/meta/type/variance.lux b/stdlib/source/library/lux/meta/type/variance.lux
index ac7e120d4..929d6268b 100644
--- a/stdlib/source/library/lux/meta/type/variance.lux
+++ b/stdlib/source/library/lux/meta/type/variance.lux
@@ -1,8 +1,6 @@
 (.require
  [library
-  [lux (.except)
-   [meta
-    ["[0]" symbol]]]])
+  [lux (.except)]])
 
 (type .public (Co it)
   (-> Any it))
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))))
+                       ))
            )))