From 156fac89df89669ee660bd075f516dd8d57abd19 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 25 Aug 2022 16:13:32 -0400 Subject: Added support for structured concurrency. --- stdlib/source/test/lux/control.lux | 4 +- .../test/lux/control/concurrency/structured.lux | 240 +++++++++++++++++++++ stdlib/source/test/lux/meta/compiler/version.lux | 6 +- stdlib/source/test/lux/meta/type/implicit.lux | 6 +- 4 files changed, 249 insertions(+), 7 deletions(-) create mode 100644 stdlib/source/test/lux/control/concurrency/structured.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 4eba3a2a7..18ab1d19d 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -16,7 +16,8 @@ ["[1]/[0]" stm] ["[1]/[0]" event] ["[1]/[0]" cps] - ["[1]/[0]" incremental]] + ["[1]/[0]" incremental] + ["[1]/[0]" structured]] ["[1][0]" continuation] ["[1][0]" exception] ["[1][0]" function] @@ -50,6 +51,7 @@ /concurrency/event.test /concurrency/cps.test /concurrency/incremental.test + /concurrency/structured.test )) (def security diff --git a/stdlib/source/test/lux/control/concurrency/structured.lux b/stdlib/source/test/lux/control/concurrency/structured.lux new file mode 100644 index 000000000..cd42dd4f0 --- /dev/null +++ b/stdlib/source/test/lux/control/concurrency/structured.lux @@ -0,0 +1,240 @@ +(.require + [library + [lux (.except) + [abstract + ["[0]" monad (.only do)] + [\\specification + ["$[0]" functor (.only Injection Comparison)] + ["$[0]" monad]]] + [control + ["[0]" maybe (.use "[1]#[0]" functor)] + ["[0]" try] + ["[0]" io (.use "[1]#[0]" monad)]] + [data + [collection + ["[0]" list (.use "[1]#[0]" functor)]]] + [math + ["[0]" random] + [number + ["n" nat]]] + [test + ["_" property (.only Test)] + ["[0]" unit]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" atom (.only Atom)] + ["[0]" async]]]]) + +(def injection + (Injection /.Async) + (at /.monad in)) + +(def comparison + (Comparison /.Async) + (function (_ == left right) + (io.run! + (do io.monad + [?left (async.value (/.async left)) + ?right (async.value (/.async right))] + (in (when [?left ?right] + [{.#Some {.#Some left}} + {.#Some {.#Some right}}] + (== left right) + + _ + false)))))) + +(def (action _) + (-> [] [(Atom Bit) (/.Action Any)]) + (let [completed? (is (Atom Bit) + (atom.atom false))] + [completed? + (function (_ it) + (do io.monad + [? (/.pending? it)] + (if ? + (do io.monad + [_ (atom.write! true completed?)] + (in {.#Some []})) + (io#in {.#Some []}))))])) + +(def .public test + Test + (do [! random.monad] + [short (at ! each (|>> (n.% 10) ++) random.nat) + long (at ! each (|>> (n.% 2) ++ (n.* 50)) random.nat) + leftE random.nat + rightE random.nat + + in_parallel (at ! each (|>> (n.% 10) (n.+ 2)) random.nat)] + (<| (_.covering /._) + (_.for [/.Async]) + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + + (in (do async.monad + [leftA (<| /.async + (at /.monad in leftE))] + (unit.coverage [/.async] + (|> leftA + (maybe#each (same? leftE)) + (maybe.else false))))) + (in (do async.monad + [? (<| /.async + /.with_scope + (function (_ scope)) + (/.schedule! scope short (function (_ _) (io#in {.#Some true}))))] + (unit.coverage [/.schedule!] + (maybe.else false ?)))) + (in (do async.monad + [_ (<| /.async + /.with_scope + (function (_ scope)) + (/.future scope (function (_ _) (io#in {.#Some true}))))] + (unit.coverage [/.future] + true))) + (in (do async.monad + [_ (<| /.async + /.with_scope + (function (_ scope)) + (/.after scope short []))] + (unit.coverage [/.after] + true))) + (in (do async.monad + [_ (<| /.async + /.with_scope + (function (_ scope)) + (/.delay scope short))] + (unit.coverage [/.delay] + true))) + (in (do async.monad + [.let [all_cancelled (is (Atom Nat) + (atom.atom 0)) + [done? done!] (is [(async.Async []) (async.Resolver [])] + (async.async [])) + scope (<| /.with_scope + (function (_ scope)) + (monad.all /.monad) + (list#each (function (_ _) + (/.schedule! scope long + (function (_ it) + (do [! io.monad] + [? (/.cancelled? it)] + (if ? + (do ! + [[before after] (atom.update! ++ all_cancelled) + _ (if (n.= in_parallel after) + (done! []) + (in false))] + (in {.#Some []})) + (io#in {.#Some []}))))))) + (list.repeated in_parallel [])) + _ (io.run! (/.cancel! scope))] + _ (/.async scope) + _ done? + all_cancelled (async.future (atom.read! all_cancelled))] + (unit.coverage [/.with_scope] + (n.= in_parallel all_cancelled)))) + + (_.coverage [/.pending?] + (io.run! (/.pending? (<| /.with_scope + (function (_ scope)) + (/.schedule! scope long (function (_ _) (io#in {.#Some []}))))))) + (_.coverage [/.completed?] + (io.run! (/.completed? (at /.monad in [])))) + (in (do async.monad + [.let [[done? done!] (is [(async.Async Bit) (async.Resolver Bit)] + (async.async [])) + it (<| /.with_scope + (function (_ scope)) + (/.schedule! scope long) + (function (_ it) + (do io.monad + [pre (/.cancel! it) + post (/.cancelled? it) + _ (done! (and pre post))] + (in {.#Some []}))))] + _ (/.async it) + ? done?] + (unit.coverage [/.cancel! /.cancelled?] + ?))) + (in (do async.monad + [.let [[done? done!] (is [(async.Async Bit) (async.Resolver Bit)] + (async.async [])) + + [@not_completed action] (..action []) + to_cancel (<| /.with_scope + (function (_ scope)) + (/.schedule! scope long) + (function (_ it) + (do [! io.monad] + [pre (/.cancel! it) + _ (done! pre)] + (in {.#None}))))] + cancelled! done? + .let [confirmed! (io.run! (/.cancelled? to_cancel))] + _ (/.async to_cancel) + not_completed! (async.future (io#each not (atom.read! @not_completed))) + + .let [[@completed action] (..action []) + to_complete (<| /.with_scope + (function (_ scope)) + (/.schedule! scope long action))] + _ (/.async to_complete) + completed! (async.future (atom.read! @completed))] + (unit.coverage [/.Action] + (and cancelled! + confirmed! + not_completed! + completed!)))) + + (in (do async.monad + [left&right (/.async (with /.monad + (/.and (in leftE) (in rightE))))] + (unit.coverage [/.and] + (<| (maybe.else false) + (do maybe.monad + [[leftA rightA] left&right] + (in (and (same? leftE leftA) + (same? rightE rightA)))))))) + (in (do [! async.monad] + [left (/.async (with /.monad + (/.or (in leftE) (in rightE)))) + right (let [left (<| /.with_scope + (function (_ scope)) + (/.schedule! scope long (function (_ _) (io#in {.#Some leftE}))))] + (do ! + [_ (async.future (/.cancel! left))] + (/.async (/.or left (at /.monad in rightE)))))] + (unit.coverage [/.or] + (when [left right] + [{.#Some {.#Left leftA}} + {.#Some {.#Right rightA}}] + (and (same? leftE leftA) + (same? rightE rightA)) + + _ + false)))) + (in (do [! async.monad] + [left (/.async (with /.monad + (/.either (in leftE) (in rightE)))) + right (let [left (<| /.with_scope + (function (_ scope)) + (/.schedule! scope long (function (_ _) (io#in {.#Some leftE}))))] + (do ! + [_ (async.future (/.cancel! left))] + (/.async (/.either left (at /.monad in rightE)))))] + (unit.coverage [/.either] + (when [left right] + [{.#Some leftA} + {.#Some rightA}] + (and (same? leftE leftA) + (same? rightE rightA)) + + _ + false)))) + )))) diff --git a/stdlib/source/test/lux/meta/compiler/version.lux b/stdlib/source/test/lux/meta/compiler/version.lux index 2129286ae..fd1df3bd7 100644 --- a/stdlib/source/test/lux/meta/compiler/version.lux +++ b/stdlib/source/test/lux/meta/compiler/version.lux @@ -6,11 +6,11 @@ [data ["[0]" bit (.use "[1]#[0]" equivalence)] ["[0]" text (.use "[1]#[0]" equivalence) - ["%" \\format (.only format)]]] + ["%" \\format]]] [math ["[0]" random (.only Random)] [number - ["n" nat]]] + ["[0]" nat]]] [test ["_" property (.only Test)]]]] [\\library @@ -29,7 +29,7 @@ that ..random] (`` (all _.and (_.coverage [/.format] - (bit#= (n.= this that) + (bit#= (nat.= this that) (text#= (/.format this) (/.format that)))) (,, (with_template [] [(_.coverage [] diff --git a/stdlib/source/test/lux/meta/type/implicit.lux b/stdlib/source/test/lux/meta/type/implicit.lux index 66daa4a32..233c121ca 100644 --- a/stdlib/source/test/lux/meta/type/implicit.lux +++ b/stdlib/source/test/lux/meta/type/implicit.lux @@ -35,13 +35,13 @@ left random.nat right random.nat] (all _.and - (_.coverage [/.a/an] + (_.coverage [/.a/an /.a /.an] (let [first_order! (let [(open "list#[0]") (list.equivalence n.equivalence)] (and (bit#= (at n.equivalence = left right) - (/.a/an = left right)) + (/.a = left right)) (list#= (at list.functor each ++ (enum.range n.enum start end)) - (/.a/an each ++ (enum.range n.enum start end))))) + (/.an each ++ (enum.range n.enum start end))))) second_order! (/.a/an = -- cgit v1.2.3