diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/concurrency/stm.lux | 18 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/actor.lux | 99 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/atom.lux | 38 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/frp.lux | 163 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/promise.lux | 91 | ||||
| -rw-r--r-- | stdlib/test/test/lux/concurrency/stm.lux | 110 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 51 |
7 files changed, 383 insertions, 187 deletions
diff --git a/stdlib/source/lux/concurrency/stm.lux b/stdlib/source/lux/concurrency/stm.lux index cf9624409..89bbab2af 100644 --- a/stdlib/source/lux/concurrency/stm.lux +++ b/stdlib/source/lux/concurrency/stm.lux @@ -13,6 +13,7 @@ [dict #+ Dict]) [product] [text] + maybe text/format) host [compiler] @@ -52,16 +53,13 @@ (def: (find-var-value var tx) (All [a] (-> (Var a) Tx (Maybe a))) - (:! (Maybe ($ +0)) - (find (: (-> (Ex [a] (Tx-Frame a)) - (Maybe Unit)) - (lambda [[_var _original _current]] - (:! (Maybe Unit) - (if (== (:! (Var Unit) var) - (:! (Var Unit) _var)) - (#;Some _current) - #;None)))) - tx))) + (|> tx + (find (lambda [[_var _original _current]] + (== (:! (Var Unit) var) + (:! (Var Unit) _var)))) + (:: Monad<Maybe> map (lambda [[_var _original _current]] + _current)) + (:! (Maybe ($ +0))))) (def: #export (read var) (All [a] (-> (Var a) (STM a))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index 718ce080a..ff1d831b6 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -1,3 +1,8 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (control monad) @@ -5,7 +10,7 @@ text/format error) (concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>] - actor) + ["&" actor #+ actor:]) (codata function [io #- run])) lux/test) @@ -23,48 +28,60 @@ (log! (format "Current state: " (%i *state*))) (wrap [])))) -(test: "lux/concurrency/actor exports" - (let [counter-proc (: (Proc Int (Promise Int)) +(test: "Actors" + (let [counter-proc (: (&;Proc Int (Promise Int)) [(lambda [self output state] (let [state' (i.inc state)] (exec (io;run (promise;resolve state' output)) (Promise/wrap (#;Right state'))))) (lambda [?error state] (Promise/wrap []))])] - (test-all (match true - (let [counter (: (Actor Int (Promise Int)) - (io;run (spawn 0 counter-proc)))] - (alive? counter))) - (match [true false] - (let [counter (: (Actor Int (Promise Int)) - (io;run (spawn 0 counter-proc)))] - [(io;run (poison counter)) - (alive? counter)])) - (match [true false] - (let [counter (: (Actor Int (Promise Int)) - (io;run (spawn 0 counter-proc)))] - [(io;run (poison counter)) - (io;run (poison counter))])) - (match+ [1 2 3] - (do Monad<Promise> - [#let [counter (: (Actor Int (Promise Int)) - (io;run (spawn 0 counter-proc))) - output-1 (: (Promise Int) (promise;promise)) - output-2 (: (Promise Int) (promise;promise)) - output-3 (: (Promise Int) (promise;promise))] - ?1 (send output-1 counter) - ?2 (send output-2 counter) - ?3 (send output-3 counter)] - (if (and ?1 ?2 ?3) - (from-promise ($_ promise;seq output-1 output-2 output-3)) - (wrap (#;Left "Uh, oh..."))))) - (match+ [[0 1] [1 3] [3 6]] - (do Monad<Promise> - [#let [adder (: Adder - (io;run (spawn 0 Adder//new)))] - t1 (add! 1 adder) - t2 (add! 2 adder) - t3 (add! 3 adder) - #let [? (io;run (poison adder))]] - (wrap (#;Right [t1 t2 t3])) - )) - ))) + ($_ seq + (assert "Can check where an actor is alive." + (let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc)))] + (&;alive? counter))) + + (assert "Can poison/kill actors." + (let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc)))] + (and (io;run (&;poison counter)) + (not (&;alive? counter))))) + + (assert "Can't poison an already poisoned actor." + (let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc)))] + (and (io;run (&;poison counter)) + (not (io;run (&;poison counter)))))) + + (do Monad<Promise> + [#let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc))) + output-1 (: (Promise Int) (promise;promise)) + output-2 (: (Promise Int) (promise;promise)) + output-3 (: (Promise Int) (promise;promise))] + _ (&;send output-1 counter) + _ (&;send output-2 counter) + _ (&;send output-3 counter) + =1 output-1 + =2 output-2 + =3 output-3] + (assert "Can send messages to actors." + (and (i.= 1 =1) + (i.= 2 =2) + (i.= 3 =3)))) + + (do Monad<Promise> + [#let [adder (: Adder + (io;run (&;spawn 0 Adder//new)))] + t1 (add! 1 adder) + t2 (add! 2 adder) + t3 (add! 3 adder) + #let [_ (io;run (&;poison adder))]] + (assert "Can use custom-defined actors." + (case [t1 t2 t3] + [[0 1] [1 3] [3 6]] + true + + _ + false))) + ))) diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux new file mode 100644 index 000000000..6e92e364d --- /dev/null +++ b/stdlib/test/test/lux/concurrency/atom.lux @@ -0,0 +1,38 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data [number] + (struct [list "" Functor<List>]) + text/format) + (concurrency ["&" atom]) + (math ["R" random]) + pipe) + lux/test) + +(test: "Atoms" + [value R;nat + swap-value R;nat + set-value R;nat + #let [box (&;atom value)]] + ($_ seq + (assert "Can obtain the value of an atom." + (n.= value (io;run (&;get box)))) + + (assert "Can swap the value of an atom." + (and (io;run (&;compare-and-swap value swap-value box)) + (n.= swap-value (io;run (&;get box))))) + + (assert "Can update the value of an atom." + (exec (io;run (&;update n.inc box)) + (n.= (n.inc swap-value) (io;run (&;get box))))) + + (assert "Can immediately set the value of an atom." + (exec (io;run (&;set set-value box)) + (n.= set-value (io;run (&;get box))))) + )) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux index b163aaa3f..65d38b9c2 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -1,3 +1,8 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (control monad) @@ -5,50 +10,122 @@ text/format error) (concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>] - frp) + ["&" frp]) (codata function - io)) + [io #- run])) lux/test) (def: (List->Chan values) - (-> (List Int) (Chan Int)) - (let [_chan (: (Chan Int) (chan))] - (run (do Monad<IO> - [_ (mapM Monad<IO> - (lambda [value] - (write value _chan)) - values) - _ (close _chan)] - (wrap _chan))))) - -(test: "lux/concurrency/frp exports" - (test-all (match+ (^ (list 0 1 2 3 4 5)) - (from-promise (consume (List->Chan (list 0 1 2 3 4 5))))) - (match+ (^ (list 0 1 2 3 4 5)) - (from-promise (consume (let [input (List->Chan (list 0 1 2 3 4 5)) - output (: (Chan Int) (chan))] - (exec (pipe input output) - output))))) - (match+ (^ (list 0 2 4)) - (from-promise (consume (filter even? (List->Chan (list 0 1 2 3 4 5)))))) - (match+ (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5)) - (from-promise (consume (merge (list (List->Chan (list 0 1 2 3 4 5)) - (List->Chan (list 0 -1 -2 -3 -4 -5))))))) - (match+ 15 (from-promise (fold (lambda [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5))))) - (match+ (^ (list 0 1 2 3 4 5)) - (from-promise (consume (no-dups number;Eq<Int> (List->Chan (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5)))))) - (match+ (^ (list 12345)) - (from-promise (consume (as-chan (:: promise;Monad<Promise> wrap 12345))))) - (match+ (^ (list 1 2 3 4 5 6)) - (from-promise (consume (:: Functor<Chan> map i.inc (List->Chan (list 0 1 2 3 4 5)))))) - (match+ (^ (list 12345)) - (from-promise (consume (:: Applicative<Chan> wrap 12345)))) - (match+ (^ (list 12346)) - (from-promise (consume (let [(^open) Applicative<Chan>] - (apply (wrap i.inc) (wrap 12345)))))) - (match+ (^ (list 12346)) - (from-promise (consume (do Monad<Chan> - [f (wrap i.inc) - a (wrap 12345)] - (wrap (f a)))))) - )) + (-> (List Int) (&;Chan Int)) + (let [_chan (: (&;Chan Int) (&;chan))] + (io;run (do Monad<IO> + [_ (mapM @ (lambda [value] (&;write value _chan)) + values) + _ (&;close _chan)] + (wrap _chan))))) + +(test: "FRP" + ($_ seq + (do Monad<Promise> + [elems (&;consume (List->Chan (list 0 1 2 3 4 5)))] + (assert "Can consume a chan into a list." + (case elems + (^ (list 0 1 2 3 4 5)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (let [input (List->Chan (list 0 1 2 3 4 5)) + output (: (&;Chan Int) (&;chan))] + (exec (&;pipe input output) + output)))] + (assert "Can pipe one channel into another." + (case elems + (^ (list 0 1 2 3 4 5)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (&;filter i.even? (List->Chan (list 0 1 2 3 4 5))))] + (assert "Can filter a channel's elements." + (case elems + (^ (list 0 2 4)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (&;merge (list (List->Chan (list 0 1 2 3 4 5)) + (List->Chan (list 0 -1 -2 -3 -4 -5)))))] + (assert "Can merge channels." + (case elems + (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5)) + true + + _ + false))) + + (do Monad<Promise> + [output (&;fold (lambda [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))] + (assert "Can fold over a channel." + (i.= 15 output))) + + (do Monad<Promise> + [elems (&;consume (&;no-dups number;Eq<Int> (List->Chan (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))] + (assert "Can avoid immediate repetition in the channel." + (case elems + (^ (list 0 1 2 3 4 5)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (&;as-chan (:: promise;Monad<Promise> wrap 12345)))] + (assert "Can convert a promise into a single-value channel." + (case elems + (^ (list 12345)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (:: &;Functor<Chan> map i.inc (List->Chan (list 0 1 2 3 4 5))))] + (assert "Functor goes over every element in a channel." + (case elems + (^ (list 1 2 3 4 5 6)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (let [(^open) &;Applicative<Chan>] + (apply (wrap i.inc) (wrap 12345))))] + (assert "Applicative works over all channel values." + (case elems + (^ (list 12346)) + true + + _ + false))) + + (do Monad<Promise> + [elems (&;consume (do &;Monad<Chan> + [f (wrap i.inc) + a (wrap 12345)] + (wrap (f a))))] + (assert "Monad works over all channel values." + (case elems + (^ (list 12346)) + true + + _ + false))) + )) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index 77e5a0aed..c8e8acad7 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -1,31 +1,78 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (control monad) (data [number] text/format error) - (concurrency promise) + (concurrency ["&" promise]) (codata function - [io #*])) + [io #- run]) + (math ["R" random]) + pipe) lux/test) -(test: "lux/concurrency/promise exports" - (test-all (match+ true (from-promise (future (io true)))) - (match+ [] (from-promise (wait +500))) - (match+ [true false] (from-promise (seq (future (io true)) - (future (io false))))) - (match+ (#;Left true) (from-promise (alt (delay +100 true) - (delay +200 false)))) - (match+ (#;Right false) (from-promise (alt (delay +200 true) - (delay +100 false)))) - (match+ true (from-promise (either (delay +100 true) - (delay +200 false)))) - (match+ false (from-promise (either (delay +200 true) - (delay +100 false)))) - (match (#;Some true) (poll (:: Monad<Promise> wrap true))) - (match #;None (poll (delay +200 true))) - (match false (io;run (resolve false (:: Monad<Promise> wrap true)))) - (match true (io;run (resolve true (: (Promise Bool) (promise))))) - (match+ #;None (from-promise (time-out +100 (delay +200 true)))) - (match+ (#;Some true) (from-promise (time-out +200 (delay +100 true)))) - )) +(test: "Promises" + ($_ seq + (do &;Monad<Promise> + [running? (&;future (io true))] + (assert "Can run IO actions in separate threads." + running?)) + + (do &;Monad<Promise> + [_ (&;wait +500)] + (assert "Can wait for a specified amount of time." + true)) + + (do &;Monad<Promise> + [[left right] (&;seq (&;future (io true)) + (&;future (io false)))] + (assert "Can combine promises sequentially." + (and left (not right)))) + + (do &;Monad<Promise> + [?left (&;alt (&;delay +100 true) + (&;delay +200 false)) + ?right (&;alt (&;delay +200 true) + (&;delay +100 false))] + (assert "Can combine promises alternatively." + (case [?left ?right] + [(#;Left true) (#;Right false)] + true + + _ + false))) + + (do &;Monad<Promise> + [?left (&;either (&;delay +100 true) + (&;delay +200 false)) + ?right (&;either (&;delay +200 true) + (&;delay +100 false))] + (assert "Can combine promises alternatively [Part 2]." + (and ?left (not ?right)))) + + (assert "Can poll a promise for its value." + (and (|> (&;poll (:: &;Monad<Promise> wrap true)) + (case> (#;Some true) true _ false)) + (|> (&;poll (&;delay +200 true)) + (case> #;None true _ false)))) + + (assert "Cant re-resolve a resolved promise." + (and (not (io;run (&;resolve false (:: &;Monad<Promise> wrap true)))) + (io;run (&;resolve true (: (&;Promise Bool) (&;promise)))))) + + (do &;Monad<Promise> + [?none (&;time-out +100 (&;delay +200 true)) + ?some (&;time-out +200 (&;delay +100 true))] + (assert "Can establish maximum waiting times for promises to be fulfilled." + (case [?none ?some] + [#;None (#;Some true)] + true + + _ + false))) + )) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux index da3c10dca..71c82dfab 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -1,3 +1,8 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (codata [io]) @@ -5,53 +10,74 @@ (data [number] (struct [list "" Functor<List>]) text/format) - (concurrency stm + (concurrency ["&" stm] [promise]) - (codata function)) + (codata function) + (math ["R" random]) + pipe) lux/test) (def: vars Int 5) (def: processes/vars Int 5) (def: iterations/processes Int 100) -(test: "lux/concurrency/stm exports" - (let [_var (var 0) - changes (io;run (follow "test" _var)) - tests (: (List (Test Int)) +(test: "STM" + (let [_var (&;var 0) + changes (io;run (&;follow "test" _var)) + tests (: (List Test) (map (lambda [_] - (let [_concurrency-var (var 0)] - (from-promise (do promise;Monad<Promise> - [_ (seqM @ - (map (lambda [_] - (mapM @ (lambda [_] (commit (update i.inc _concurrency-var))) - (list;range 1 iterations/processes))) - (list;range 1 processes/vars)))] - (commit (read _concurrency-var)))))) - (list;range 1 vars)))] - (test-all (match+ 0 (commit (do Monad<STM> - [value (read _var)] - (wrap (#;Right value))))) - (match+ 5 (commit (do Monad<STM> - [_ (write 5 _var) - value (read _var)] - (wrap (#;Right value))))) - (match+ 5 (commit (do Monad<STM> - [value (read _var)] - (wrap (#;Right value))))) - (match+ 15 (commit (do Monad<STM> - [_ (update (i.* 3) _var) - value (read _var)] - (wrap (#;Right value))))) - (match+ 15 (commit (do Monad<STM> - [value (read _var)] - (wrap (#;Right value))))) - (match+ [5 15] (do promise;Monad<Promise> - [?c1+changes' changes - #let [[c1 changes'] (default [-1 changes] ?c1+changes')] - ?c2+changes' changes' - #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] - (wrap (#;Right [c1 c2])))) - ## Temporarily commented-out due to type-checking bug in - ## compiler... - ## (match+ _ (seqM Monad<Test> tests)) - ))) + (let [_concurrency-var (&;var 0)] + (do promise;Monad<Promise> + [_ (seqM @ + (map (lambda [_] + (mapM @ (lambda [_] (&;commit (&;update i.inc _concurrency-var))) + (list;i.range 1 iterations/processes))) + (list;i.range 1 processes/vars))) + _ (&;commit (&;read _concurrency-var))] + (assert "" true)))) + (list;i.range 1 vars)))] + ($_ seq + (do promise;Monad<Promise> + [output (&;commit (do &;Monad<STM> + [value (&;read _var)] + (wrap value)))] + (assert "" (i.= 0 output))) + + (do promise;Monad<Promise> + [output (&;commit (do &;Monad<STM> + [_ (&;write 5 _var) + value (&;read _var)] + (wrap value)))] + (assert "" (i.= 5 output))) + + (do promise;Monad<Promise> + [output (&;commit (do &;Monad<STM> + [value (&;read _var)] + (wrap value)))] + (assert "" (i.= 5 output))) + + (do promise;Monad<Promise> + [output (&;commit (do &;Monad<STM> + [_ (&;update (i.* 3) _var) + value (&;read _var)] + (wrap value)))] + (assert "" (i.= 15 output))) + + (do promise;Monad<Promise> + [output (&;commit (do &;Monad<STM> + [value (&;read _var)] + (wrap value)))] + (assert "" (i.= 15 output))) + + (do promise;Monad<Promise> + [?c1+changes' changes + #let [[c1 changes'] (default [-1 changes] ?c1+changes')] + ?c2+changes' changes' + #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] + (assert "" + (and (i.= 5 c1) + (i.= 15 c2)))) + ## Temporarily commented-out due to type-checking bug in + ## compiler... + ## (match+ _ (seqM Monad<Test> tests)) + ))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 2a373a872..7b2e05f01 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -17,6 +17,11 @@ [env] [state] (struct [stream])) + (concurrency [actor] + ["_;" atom] + [frp] + ["_;" promise] + [stm]) (data [bit] [bool] [char] @@ -39,18 +44,12 @@ [stack] [tree] [vector] - [zipper] - ) - (text [format]) - ) + [zipper]) + (text [format])) + ## (macro [ast] ## [syntax]) ## [type] - ## (concurrency ["_;" promise] - ## [frp] - ## [stm] - ## [actor] - ## ) ## [math] ## [pipe] ## [lexer] @@ -58,27 +57,21 @@ ## (data (format [json])) ) ) - ## (lux ## (codata [cont]) - ## ## (data (struct [stack] - ## ## [tree] - ## ## [zipper]) - ## ## (error exception)) - ## ## (concurrency [atom]) - ## ## [macro] - ## ## (macro [template] - ## ## [poly] - ## ## (poly ["poly_;" eq] - ## ## ["poly_;" text-encoder] - ## ## ["poly_;" functor])) - ## ## (math [ratio] - ## ## [complex] - ## ## [random]) - ## ## (type [check] [auto]) - ## ## (control [effect]) + ## (lux (codata [cont]) + ## (concurrency [atom]) + ## [macro] + ## (macro [template] + ## [poly] + ## (poly ["poly_;" eq] + ## ["poly_;" text-encoder] + ## ["poly_;" functor])) + ## (math [ratio] + ## [complex] + ## [random]) + ## (type [check] [auto]) + ## (control [effect]) ## ["_;" lexer] - ## ["_;" regex] - ## (data (format ["_;" json])) - ## ) + ## ["_;" regex]) ) ## [Program] |