aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux/control/concurrency/incremental.lux148
-rw-r--r--stdlib/source/library/lux/meta/type/variance.lux4
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/concurrency/incremental.lux101
-rw-r--r--stdlib/source/test/lux/meta/type/variance.lux25
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))))
+ ))
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 00:58:46 +0000