diff options
| -rw-r--r-- | stdlib/source/lux/cli.lux | 52 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/actor.lux (renamed from stdlib/source/lux/concurrency/actor.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/atom.lux (renamed from stdlib/source/lux/concurrency/atom.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/frp.lux (renamed from stdlib/source/lux/concurrency/frp.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/process.lux (renamed from stdlib/source/lux/concurrency/process.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/promise.lux (renamed from stdlib/source/lux/concurrency/promise.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/semaphore.lux (renamed from stdlib/source/lux/concurrency/semaphore.lux) | 18 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/stm.lux (renamed from stdlib/source/lux/concurrency/stm.lux) | 10 | ||||
| -rw-r--r-- | stdlib/source/lux/control/concurrency/task.lux (renamed from stdlib/source/lux/concurrency/task.lux) | 0 | ||||
| -rw-r--r-- | stdlib/source/lux/test.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/world/console.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/world/file.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/lux/world/net/tcp.jvm.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/lux/world/net/udp.jvm.lux | 6 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/semaphore.lux | 143 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/actor.lux (renamed from stdlib/test/test/lux/concurrency/actor.lux) | 12 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/atom.lux (renamed from stdlib/test/test/lux/concurrency/atom.lux) | 6 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/frp.lux (renamed from stdlib/test/test/lux/concurrency/frp.lux) | 12 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/promise.lux (renamed from stdlib/test/test/lux/concurrency/promise.lux) | 6 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/semaphore.lux | 143 | ||||
| -rw-r--r-- | stdlib/test/test/lux/control/concurrency/stm.lux (renamed from stdlib/test/test/lux/concurrency/stm.lux) | 14 |
21 files changed, 223 insertions, 223 deletions
diff --git a/stdlib/source/lux/cli.lux b/stdlib/source/lux/cli.lux index 0ac9ff0bd..34514b5b9 100644 --- a/stdlib/source/lux/cli.lux +++ b/stdlib/source/lux/cli.lux @@ -2,22 +2,22 @@ [lux #* [control monad - ["p" parser]] + ["p" parser] + [concurrency + ["." process]]] [data [collection [list ("list/." Monoid<List> Monad<List>)]] ["." text ("text/." Equivalence<Text>) format] - ["E" error]] + ["." error (#+ Error)]] [macro (#+ with-gensyms) ["." code] ["s" syntax (#+ syntax: Syntax)]] [platform [compiler ["." host]]] - ["." io] - [concurrency - ["." process]]]) + ["." io]]) ## [Types] (type: #export (CLI a) @@ -26,18 +26,18 @@ ## [Combinators] (def: #export (run inputs parser) - (All [a] (-> (List Text) (CLI a) (E.Error a))) + (All [a] (-> (List Text) (CLI a) (Error a))) (case (p.run inputs parser) - (#E.Success [remaining output]) + (#error.Success [remaining output]) (case remaining #.Nil - (#E.Success output) + (#error.Success output) _ - (#E.Error (format "Remaining CLI inputs: " (text.join-with " " remaining)))) + (#error.Error (format "Remaining CLI inputs: " (text.join-with " " remaining)))) - (#E.Error error) - (#E.Error error))) + (#error.Error error) + (#error.Error error))) (def: #export any {#.doc "Just returns the next input without applying any logic."} @@ -45,16 +45,16 @@ (function (_ inputs) (case inputs (#.Cons arg inputs') - (#E.Success [inputs' arg]) + (#error.Success [inputs' arg]) _ - (#E.Error "Cannot parse empty arguments.")))) + (#error.Error "Cannot parse empty arguments.")))) (def: #export (parse parser) {#.doc "Parses the next input with a parsing function."} - (All [a] (-> (-> Text (E.Error a)) (CLI a))) + (All [a] (-> (-> Text (Error a)) (CLI a))) (function (_ inputs) - (do E.Monad<Error> + (do error.Monad<Error> [[remaining raw] (any inputs) output (parser raw)] (wrap [remaining output])))) @@ -63,11 +63,11 @@ {#.doc "Checks that a token is in the inputs."} (-> Text (CLI Any)) (function (_ inputs) - (do E.Monad<Error> + (do error.Monad<Error> [[remaining raw] (any inputs)] (if (text/= reference raw) (wrap [remaining []]) - (E.fail (format "Missing token: '" reference "'")))))) + (error.fail (format "Missing token: '" reference "'")))))) (def: #export (somewhere cli) {#.doc "Given a parser, tries to parse it somewhere in the inputs (i.e. not necessarily parsing the immediate inputs)."} @@ -75,16 +75,16 @@ (function (_ inputs) (loop [immediate inputs] (case (p.run immediate cli) - (#E.Success [remaining output]) - (#E.Success [remaining output]) + (#error.Success [remaining output]) + (#error.Success [remaining output]) - (#E.Error error) + (#error.Error error) (case immediate #.Nil - (#E.Error error) + (#error.Error error) (#.Cons to-omit immediate') - (do E.Monad<Error> + (do error.Monad<Error> [[remaining output] (recur immediate')] (wrap [(#.Cons to-omit remaining) output]))))))) @@ -94,8 +94,8 @@ (CLI Any) (function (_ inputs) (case inputs - #.Nil (#E.Success [inputs []]) - _ (#E.Error (format "Unknown parameters: " (text.join-with " " inputs)))))) + #.Nil (#error.Success [inputs []]) + _ (#error.Error (format "Unknown parameters: " (text.join-with " " inputs)))))) (def: #export (named name value) (All [a] (-> Text (CLI a) (CLI a))) @@ -168,10 +168,10 @@ (` process.run!)))))] ((~' wrap) (~ g!output)))))) (~ g!args)) - (#E.Success [(~ g!_) (~ g!output)]) + (#error.Success [(~ g!_) (~ g!output)]) (~ g!output) - (#E.Error (~ g!message)) + (#error.Error (~ g!message)) (.error! (~ g!message)) )))) ))) diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 0af0d09f9..0af0d09f9 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux diff --git a/stdlib/source/lux/concurrency/atom.lux b/stdlib/source/lux/control/concurrency/atom.lux index b1692b6e3..b1692b6e3 100644 --- a/stdlib/source/lux/concurrency/atom.lux +++ b/stdlib/source/lux/control/concurrency/atom.lux diff --git a/stdlib/source/lux/concurrency/frp.lux b/stdlib/source/lux/control/concurrency/frp.lux index 8db54f28f..8db54f28f 100644 --- a/stdlib/source/lux/concurrency/frp.lux +++ b/stdlib/source/lux/control/concurrency/frp.lux diff --git a/stdlib/source/lux/concurrency/process.lux b/stdlib/source/lux/control/concurrency/process.lux index a67734747..a67734747 100644 --- a/stdlib/source/lux/concurrency/process.lux +++ b/stdlib/source/lux/control/concurrency/process.lux diff --git a/stdlib/source/lux/concurrency/promise.lux b/stdlib/source/lux/control/concurrency/promise.lux index 1a471022f..1a471022f 100644 --- a/stdlib/source/lux/concurrency/promise.lux +++ b/stdlib/source/lux/control/concurrency/promise.lux diff --git a/stdlib/source/lux/concurrency/semaphore.lux b/stdlib/source/lux/control/concurrency/semaphore.lux index 7b749ea60..46762ecf3 100644 --- a/stdlib/source/lux/concurrency/semaphore.lux +++ b/stdlib/source/lux/control/concurrency/semaphore.lux @@ -1,13 +1,13 @@ (.module: [lux #* [control [monad (#+ do)]] - [concurrency - ["." atom (#+ Atom)] - ["." promise (#+ Promise)]] ["." io (#+ IO)] [type abstract - ["." refinement]]]) + ["." refinement]]] + [// + ["." atom (#+ Atom)] + ["." promise (#+ Promise)]]) (type: State {#open-positions Nat @@ -81,13 +81,13 @@ (-> Any Mutex) (:abstraction (semaphore 1))) - (def: (acquire mutex) + (def: acquire (-> Mutex (Promise Any)) - (wait (:representation mutex))) + (|>> :representation wait)) - (def: (release mutex) + (def: release (-> Mutex (Promise Any)) - (signal (:representation mutex))) + (|>> :representation signal)) (def: #export (synchronize mutex procedure) (All [a] (-> Mutex (IO (Promise a)) (Promise a))) @@ -138,7 +138,7 @@ (wait (get@ <turnstile> barrier))))] [start inc limit #start-turnstile] - [end dec 0 #end-turnstile] + [end dec 0 #end-turnstile] ) (def: #export (block barrier) diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 648d86d95..3203b2d52 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -10,12 +10,12 @@ ["." maybe] [collection ["." list ("list/." Functor<List> Fold<List>)]]] - [concurrency - ["." atom (#+ Atom atom)] - ["." promise (#+ Promise promise)] - ["." frp ("frp/." Functor<Channel>)]] [type - abstract]]) + abstract]] + [// + ["." atom (#+ Atom atom)] + ["." promise (#+ Promise promise)] + ["." frp ("frp/." Functor<Channel>)]]) (type: #export (Observer a) (-> a (IO Any))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/control/concurrency/task.lux index c03ab7647..c03ab7647 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/control/concurrency/task.lux diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index b928b1860..ea4e9b6de 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -2,7 +2,10 @@ [lux #* [control ["." monad (#+ do Monad)] - ["p" parser]] + ["p" parser] + [concurrency + ["." process] + ["." promise (#+ Promise)]]] [data ["." product] ["." maybe] @@ -19,9 +22,6 @@ ["." macro (#+ with-gensyms) ["s" syntax (#+ syntax: Syntax)] ["." code]] - [concurrency - ["." process] - ["." promise (#+ Promise)]] ["." io (#+ IO io)]]) ## [Types] diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 209063dfd..5c0aff910 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -3,6 +3,8 @@ [control [monad (#+ do)] ["ex" exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise)]] [security ["." taint (#+ Dirty taint)] [capability (#+ Capability)]]] @@ -11,8 +13,6 @@ ["." text format]] ["." io (#+ IO Process io)] - [concurrency - ["." promise (#+ Promise)]] [host (#+ import:)] [platform [compiler diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index e0975799d..ac033fd89 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -3,6 +3,8 @@ [control ["." monad (#+ Monad do)] ["ex" exception (#+ Exception exception:)] + [concurrency + ["." promise (#+ Promise)]] [security ["." taint (#+ Dirty taint)] ["." capability (#+ Capability)]]] @@ -20,8 +22,6 @@ [world ["." binary (#+ Binary)]] ["." io (#+ IO) ("io/." Functor<IO>)] - [concurrency - ["." promise (#+ Promise)]] [host (#+ import:)] [platform [compiler diff --git a/stdlib/source/lux/world/net/tcp.jvm.lux b/stdlib/source/lux/world/net/tcp.jvm.lux index add7427cb..f9bde2e2c 100644 --- a/stdlib/source/lux/world/net/tcp.jvm.lux +++ b/stdlib/source/lux/world/net/tcp.jvm.lux @@ -2,12 +2,12 @@ [lux #* [control monad + [concurrency + ["." promise (#+ Promise promise)] + [task (#+ Task)] + ["." frp]] [security ["." taint (#+ Dirty taint)]]] - [concurrency - ["." promise (#+ Promise promise)] - [task (#+ Task)] - ["." frp]] [data ["." error (#+ Error)]] [world diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index f27ca1c5e..3e9015b56 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -3,11 +3,11 @@ [control monad ["ex" exception (#+ exception:)] + [concurrency + ["." promise (#+ Promise)] + [task (#+ Task)]] [security ["." taint (#+ Dirty taint)]]] - [concurrency - ["." promise (#+ Promise)] - [task (#+ Task)]] [data ["." error (#+ Error)] ["." maybe] diff --git a/stdlib/test/test/lux/concurrency/semaphore.lux b/stdlib/test/test/lux/concurrency/semaphore.lux deleted file mode 100644 index f309fcd0c..000000000 --- a/stdlib/test/test/lux/concurrency/semaphore.lux +++ /dev/null @@ -1,143 +0,0 @@ -(.module: - [lux #* - [control - ["." monad (#+ do)]] - [data - ["." maybe] - ["." text ("text/." Equivalence<Text> Monoid<Text>) - format] - [collection - ["." list ("list/." Functor<List>)]]] - [concurrency - ["/" semaphore] - ["." promise (#+ Promise)] - ["." atom (#+ Atom)]] - ["." io] - [math - ["r" random]]] - lux/test) - -(def: (wait-many-times times semaphore) - (-> Nat /.Semaphore (Promise Any)) - (loop [steps times] - (if (n/> 0 steps) - (do promise.Monad<Promise> - [_ (/.wait semaphore)] - (recur (dec steps))) - (:: promise.Monad<Promise> wrap [])))) - -(context: "Semaphore." - (<| (times 100) - (do @ - [open-positions (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))] - ($_ seq - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [_ (wait-many-times open-positions semaphore)] - (assert "Can wait on a semaphore up to the number of open positions without blocking." - #1)))) - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [result (<| (promise.time-out 100) - (wait-many-times (inc open-positions) semaphore))] - (assert "Waiting on a semaphore more than the number of open positions blocks the process." - (case result - (#.Some _) - #0 - - #.None - #1))))) - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [_ (: (Promise Any) - (loop [steps (n/* 2 open-positions)] - (if (n/> 0 steps) - (do @ - [_ (/.wait semaphore) - _ (/.signal semaphore)] - (recur (dec steps))) - (wrap []))))] - (assert "Signaling a semaphore replenishes its open positions." - #1)))) - (let [semaphore (/.semaphore open-positions)] - (wrap (do promise.Monad<Promise> - [#let [resource (atom.atom "") - blocked (do @ - [_ (wait-many-times open-positions semaphore) - _ (/.wait semaphore) - #let [_ (io.run (atom.update (|>> (format "B")) - resource))]] - (wrap []))] - _ (promise.wait 100) - _ (exec (io.run (atom.update (|>> (format "A")) - resource)) - (/.signal semaphore)) - _ blocked] - (assert "A blocked process can be un-blocked by a signal somewhere else." - (text/= "BA" - (io.run (atom.read resource))))))) - )))) - -(context: "Mutex." - (<| (times 100) - (do @ - [repetitions (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] - ($_ seq - (let [mutex (/.mutex [])] - (wrap (do promise.Monad<Promise> - [#let [resource (atom.atom "") - expected-As (text.join-with "" (list.repeat repetitions "A")) - expected-Bs (text.join-with "" (list.repeat repetitions "B")) - processA (<| (/.synchronize mutex) - io.io - promise.future - (do io.Monad<IO> - [_ (<| (monad.seq @) - (list.repeat repetitions) - (atom.update (|>> (format "A")) resource))] - (wrap []))) - processB (<| (/.synchronize mutex) - io.io - promise.future - (do io.Monad<IO> - [_ (<| (monad.seq @) - (list.repeat repetitions) - (atom.update (|>> (format "B")) resource))] - (wrap [])))] - _ processA - _ processB - #let [outcome (io.run (atom.read resource))]] - (assert "Mutexes only allow one process to execute at a time." - (or (text/= (format expected-As expected-Bs) - outcome) - (text/= (format expected-Bs expected-As) - outcome)))))) - )))) - -(def: (waiter resource barrier id) - (-> (Atom Text) /.Barrier Nat (Promise Any)) - (do promise.Monad<Promise> - [_ (/.block barrier) - #let [_ (io.run (atom.update (|>> (format (%n id))) resource))]] - (wrap []))) - -(context: "Barrier." - (let [limit 10 - barrier (/.barrier (maybe.assume (/.limit limit))) - resource (atom.atom "")] - ($_ seq - (wrap (do promise.Monad<Promise> - [#let [ids (list.n/range 0 (dec limit)) - waiters (list/map (function (_ id) - (let [process (waiter resource barrier id)] - (exec (io.run (atom.update (|>> (format "_")) resource)) - process))) - ids)] - _ (monad.seq @ waiters) - #let [outcome (io.run (atom.read resource))]] - (assert "A barrier can stop all processes from acting, until an amount of waiting processes is reached, and then the barrier is un-blocked for all." - (and (text.ends-with? "__________" outcome) - (list.every? (function (_ id) - (text.contains? (%n id) outcome)) - ids) - ))))))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/control/concurrency/actor.lux index a43845380..90c3d6dd4 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/control/concurrency/actor.lux @@ -3,15 +3,15 @@ ["." io (#+ IO io)] [control ["M" monad (#+ do Monad)] - ["ex" exception]] + ["ex" exception] + [concurrency + ["P" promise ("promise/." Monad<Promise>)] + ["T" task] + ["&" actor (#+ actor: message:)]]] [data ["e" error] [text - format]] - [concurrency - ["P" promise ("promise/." Monad<Promise>)] - ["T" task] - ["&" actor (#+ actor: message:)]]] + format]]] lux/test) (actor: Counter diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/control/concurrency/atom.lux index a10edcae7..720547e27 100644 --- a/stdlib/test/test/lux/concurrency/atom.lux +++ b/stdlib/test/test/lux/control/concurrency/atom.lux @@ -2,9 +2,9 @@ [lux #* ["." io] [control - ["M" monad (#+ do Monad)]] - [concurrency - ["&" atom]] + ["M" monad (#+ do Monad)] + [concurrency + ["&" atom]]] [math ["r" random]]] lux/test) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/control/concurrency/frp.lux index 46db40889..04ddd5986 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/control/concurrency/frp.lux @@ -2,15 +2,15 @@ [lux #* ["." io (#+ IO io)] [control - ["." monad (#+ do Monad)]] + ["." monad (#+ do Monad)] + [concurrency + ["." promise ("promise/." Monad<Promise>)] + ["." frp (#+ Channel)] + ["." atom (#+ Atom atom)]]] [data ["." number] [collection - ["." list]]] - [concurrency - ["." promise ("promise/." Monad<Promise>)] - ["." frp (#+ Channel)] - ["." atom (#+ Atom atom)]]] + ["." list]]]] lux/test) (def: (write! values channel) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/control/concurrency/promise.lux index e857d0708..d666f3b31 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/control/concurrency/promise.lux @@ -3,9 +3,9 @@ ["." io] [control ["M" monad (#+ do Monad)] - pipe] - [concurrency - ["&" promise ("&/." Monad<Promise>)]] + pipe + [concurrency + ["&" promise ("&/." Monad<Promise>)]]] [math ["r" random]]] lux/test) diff --git a/stdlib/test/test/lux/control/concurrency/semaphore.lux b/stdlib/test/test/lux/control/concurrency/semaphore.lux new file mode 100644 index 000000000..5c09f4bac --- /dev/null +++ b/stdlib/test/test/lux/control/concurrency/semaphore.lux @@ -0,0 +1,143 @@ +(.module: + [lux #* + [control + ["." monad (#+ do)] + [concurrency + ["/" semaphore] + ["." promise (#+ Promise)] + ["." atom (#+ Atom)]]] + [data + ["." maybe] + ["." text ("text/." Equivalence<Text> Monoid<Text>) + format] + [collection + ["." list ("list/." Functor<List>)]]] + ["." io] + [math + ["r" random]]] + lux/test) + +## (def: (wait-many-times times semaphore) +## (-> Nat /.Semaphore (Promise Any)) +## (loop [steps times] +## (if (n/> 0 steps) +## (do promise.Monad<Promise> +## [_ (/.wait semaphore)] +## (recur (dec steps))) +## (:: promise.Monad<Promise> wrap [])))) + +## (context: "Semaphore." +## (<| (times 100) +## (do @ +## [open-positions (|> r.nat (:: @ map (|>> (n/% 10) (n/max 1))))] +## ($_ seq +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [_ (wait-many-times open-positions semaphore)] +## (assert "Can wait on a semaphore up to the number of open positions without blocking." +## true)))) +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [result (<| (promise.time-out 100) +## (wait-many-times (inc open-positions) semaphore))] +## (assert "Waiting on a semaphore more than the number of open positions blocks the process." +## (case result +## (#.Some _) +## false + +## #.None +## true))))) +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [_ (: (Promise Any) +## (loop [steps (n/* 2 open-positions)] +## (if (n/> 0 steps) +## (do @ +## [_ (/.wait semaphore) +## _ (/.signal semaphore)] +## (recur (dec steps))) +## (wrap []))))] +## (assert "Signaling a semaphore replenishes its open positions." +## true)))) +## (let [semaphore (/.semaphore open-positions)] +## (wrap (do promise.Monad<Promise> +## [#let [resource (atom.atom "") +## blocked (do @ +## [_ (wait-many-times open-positions semaphore) +## _ (/.wait semaphore) +## #let [_ (io.run (atom.update (|>> (format "B")) +## resource))]] +## (wrap []))] +## _ (promise.wait 100) +## _ (exec (io.run (atom.update (|>> (format "A")) +## resource)) +## (/.signal semaphore)) +## _ blocked] +## (assert "A blocked process can be un-blocked by a signal somewhere else." +## (text/= "BA" +## (io.run (atom.read resource))))))) +## )))) + +## (context: "Mutex." +## (<| (times 100) +## (do @ +## [repetitions (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10))))] +## ($_ seq +## (let [mutex (/.mutex [])] +## (wrap (do promise.Monad<Promise> +## [#let [resource (atom.atom "") +## expected-As (text.join-with "" (list.repeat repetitions "A")) +## expected-Bs (text.join-with "" (list.repeat repetitions "B")) +## processA (<| (/.synchronize mutex) +## io.io +## promise.future +## (do io.Monad<IO> +## [_ (<| (monad.seq @) +## (list.repeat repetitions) +## (atom.update (|>> (format "A")) resource))] +## (wrap []))) +## processB (<| (/.synchronize mutex) +## io.io +## promise.future +## (do io.Monad<IO> +## [_ (<| (monad.seq @) +## (list.repeat repetitions) +## (atom.update (|>> (format "B")) resource))] +## (wrap [])))] +## _ processA +## _ processB +## #let [outcome (io.run (atom.read resource))]] +## (assert "Mutexes only allow one process to execute at a time." +## (or (text/= (format expected-As expected-Bs) +## outcome) +## (text/= (format expected-Bs expected-As) +## outcome)))))) +## )))) + +## (def: (waiter resource barrier id) +## (-> (Atom Text) /.Barrier Nat (Promise Any)) +## (do promise.Monad<Promise> +## [_ (/.block barrier) +## #let [_ (io.run (atom.update (|>> (format (%n id))) resource))]] +## (wrap []))) + +## (context: "Barrier." +## (let [limit 10 +## barrier (/.barrier (maybe.assume (/.limit limit))) +## resource (atom.atom "")] +## ($_ seq +## (wrap (do promise.Monad<Promise> +## [#let [ids (list.n/range 0 (dec limit)) +## waiters (list/map (function (_ id) +## (let [process (waiter resource barrier id)] +## (exec (io.run (atom.update (|>> (format "_")) resource)) +## process))) +## ids)] +## _ (monad.seq @ waiters) +## #let [outcome (io.run (atom.read resource))]] +## (assert "A barrier can stop all processes from acting, until an amount of waiting processes is reached, and then the barrier is un-blocked for all." +## (and (text.ends-with? "__________" outcome) +## (list.every? (function (_ id) +## (text.contains? (%n id) outcome)) +## ids) +## ))))))) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/control/concurrency/stm.lux index ee84f193e..c84ce44cc 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/control/concurrency/stm.lux @@ -2,17 +2,17 @@ [lux #* ["." io (#+ IO)] [control - ["M" monad (#+ do Monad)]] + ["M" monad (#+ do Monad)] + [concurrency + ["." atom (#+ Atom atom)] + ["&" stm] + ["." process] + ["." promise] + ["." frp (#+ Channel)]]] [data ["." number] [collection ["." list ("list/." Functor<List>)]]] - [concurrency - ["." atom (#+ Atom atom)] - ["&" stm] - ["." process] - ["." promise] - ["." frp (#+ Channel)]] [math ["r" random]]] lux/test) |