diff options
Diffstat (limited to 'stdlib')
-rw-r--r-- | stdlib/source/lux/control/concurrency/stm.lux | 4 | ||||
-rw-r--r-- | stdlib/source/test/lux/control.lux | 10 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/atom.lux | 6 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/promise.lux | 111 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/stm.lux | 103 |
5 files changed, 124 insertions, 110 deletions
diff --git a/stdlib/source/lux/control/concurrency/stm.lux b/stdlib/source/lux/control/concurrency/stm.lux index 6d1fd0d3b..1bc69f5e2 100644 --- a/stdlib/source/lux/control/concurrency/stm.lux +++ b/stdlib/source/lux/control/concurrency/stm.lux @@ -15,7 +15,7 @@ [// ["." atom (#+ Atom atom)] ["." promise (#+ Promise Resolver)] - ["." frp ("#;." functor)]]) + ["." frp]]) (type: #export (Observer a) (-> a (IO Any))) @@ -131,7 +131,7 @@ [(#.Cons [var (read!! var) value] tx) []]))) -(structure: #export _ (Functor STM) +(structure: #export functor (Functor STM) (def: (map f fa) (function (_ tx) (let [[tx' a] (fa tx)] diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 8bfd57da0..912729c42 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -13,9 +13,11 @@ ["#." thread] ["#." writer] [concurrency - ["#." actor] ["#." atom] - ["#." frp]] + ["#." promise] + ["#." frp] + ["#." actor] + ["#." stm]] [security ["#." privacy] ["#." integrity]]]) @@ -23,9 +25,11 @@ (def: concurrency Test ($_ _.and - /actor.test /atom.test + /promise.test /frp.test + /actor.test + /stm.test )) (def: security diff --git a/stdlib/source/test/lux/control/concurrency/atom.lux b/stdlib/source/test/lux/control/concurrency/atom.lux index 2776e4f54..a314e7193 100644 --- a/stdlib/source/test/lux/control/concurrency/atom.lux +++ b/stdlib/source/test/lux/control/concurrency/atom.lux @@ -3,10 +3,8 @@ ["_" test (#+ Test)] ["." io] [control - ["M" monad (#+ do Monad)]] - [data - [text - format]] + [monad (#+ Monad do)]] + data/text/format [math ["r" random]]] {1 diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 295c26e20..952e8fb7a 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -1,68 +1,73 @@ (.module: [lux #* + ["_" test (#+ Test)] ["." io] [control - ["M" monad (#+ Monad do)] - pipe - [concurrency - ["&" promise ("&;." monad)]]] + [monad (#+ Monad do)] + pipe] + data/text/format [math ["r" random]]] - lux/test) + {1 + ["." / ("#@." monad)]}) -(context: "Promises" - ($_ seq - (wrap (do &.monad - [running? (&.future (io.io #1))] - (assert "Can run IO actions in separate threads." - running?))) +(def: #export test + Test + (do r.monad + [_ (wrap [])] + (<| (_.context (%name (name-of /.Promise))) + ($_ _.and + (wrap (do /.monad + [running? (/.future (io.io #1))] + (_.assert "Can run IO actions in separate threads." + running?))) - (wrap (do &.monad - [_ (&.wait 500)] - (assert "Can wait for a specified amount of time." - #1))) + (wrap (do /.monad + [_ (/.wait 500)] + (_.assert "Can wait for a specified amount of time." + #1))) - (wrap (do &.monad - [[left right] (&.and (&.future (io.io #1)) - (&.future (io.io #0)))] - (assert "Can combine promises sequentially." - (and left (not right))))) + (wrap (do /.monad + [[left right] (/.and (/.future (io.io #1)) + (/.future (io.io #0)))] + (_.assert "Can combine promises sequentially." + (and left (not right))))) - (wrap (do &.monad - [?left (&.or (&.delay 100 #1) - (&.delay 200 #0)) - ?right (&.or (&.delay 200 #1) - (&.delay 100 #0))] - (assert "Can combine promises alternatively." - (case [?left ?right] - [(#.Left #1) (#.Right #0)] - #1 + (wrap (do /.monad + [?left (/.or (/.delay 100 #1) + (/.delay 200 #0)) + ?right (/.or (/.delay 200 #1) + (/.delay 100 #0))] + (_.assert "Can combine promises alternatively." + (case [?left ?right] + [(#.Left #1) (#.Right #0)] + #1 - _ - #0)))) + _ + #0)))) - (wrap (do &.monad - [?left (&.either (&.delay 100 #1) - (&.delay 200 #0)) - ?right (&.either (&.delay 200 #1) - (&.delay 100 #0))] - (assert "Can combine promises alternatively [Part 2]." - (and ?left (not ?right))))) + (wrap (do /.monad + [?left (/.either (/.delay 100 #1) + (/.delay 200 #0)) + ?right (/.either (/.delay 200 #1) + (/.delay 100 #0))] + (_.assert "Can combine promises alternatively [Part 2]." + (and ?left (not ?right))))) - (test "Can poll a promise for its value." - (and (|> (&.poll (&;wrap #1)) - (case> (#.Some #1) #1 _ #0)) - (|> (&.poll (&.delay 200 #1)) - (case> #.None #1 _ #0)))) + (_.test "Can poll a promise for its value." + (and (|> (/.poll (/@wrap #1)) + (case> (#.Some #1) #1 _ #0)) + (|> (/.poll (/.delay 200 #1)) + (case> #.None #1 _ #0)))) - (wrap (do &.monad - [?none (&.time-out 100 (&.delay 200 #1)) - ?some (&.time-out 200 (&.delay 100 #1))] - (assert "Can establish maximum waiting times for promises to be fulfilled." - (case [?none ?some] - [#.None (#.Some #1)] - #1 + (wrap (do /.monad + [?none (/.time-out 100 (/.delay 200 #1)) + ?some (/.time-out 200 (/.delay 100 #1))] + (_.assert "Can establish maximum waiting times for promises to be fulfilled." + (case [?none ?some] + [#.None (#.Some #1)] + #1 - _ - #0)))) - )) + _ + #0)))) + )))) diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index 6e386c630..52107f6fe 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -1,21 +1,24 @@ (.module: [lux #* + ["_" test (#+ Test)] ["." io (#+ IO)] [control ["M" monad (#+ do Monad)] [concurrency ["." atom (#+ Atom atom)] - ["&" stm] ["." process] ["." promise] ["." frp (#+ Channel)]]] [data - ["." number] + text/format + [number + ["." nat]] [collection - ["." list ("#;." functor)]]] + ["." list ("#@." functor)]]] [math ["r" random]]] - lux/test) + {1 + ["." /]}) (def: (read! channel) (All [a] (-> (Channel a) (IO (Atom (List a))))) @@ -31,47 +34,51 @@ (def: iterations-per-process Nat 100) -(context: "STM" - ($_ seq - (wrap (do promise.monad - [output (&.commit (&.read (&.var 0)))] - (assert "Can read STM vars." - (n/= 0 output)))) - (wrap (do promise.monad - [#let [_var (&.var 0)] - output (&.commit (do &.monad - [_ (&.write 5 _var)] - (&.read _var)))] - (assert "Can write STM vars." - (n/= 5 output)))) - (wrap (do promise.monad - [#let [_var (&.var 5)] - output (&.commit (do &.monad - [_ (&.update (n/* 3) _var)] - (&.read _var)))] - (assert "Can update STM vars." - (n/= 15 output)))) - (wrap (do promise.monad - [#let [_var (&.var 0) - changes (io.run (read! (io.run (&.follow _var))))] - _ (&.commit (&.write 5 _var)) - _ (&.commit (&.update (n/* 3) _var)) - changes (promise.future (atom.read changes))] - (assert "Can follow all the changes to STM vars." - (:: (list.equivalence number.equivalence) = - (list 5 15) - (list.reverse changes))))) - (wrap (let [_concurrency-var (&.var 0)] - (do promise.monad - [_ (|> process.parallelism - (list.n/range 1) - (list;map (function (_ _) - (|> iterations-per-process - (list.n/range 1) - (M.map @ (function (_ _) (&.commit (&.update inc _concurrency-var))))))) - (M.seq @)) - last-val (&.commit (&.read _concurrency-var))] - (assert "Can modify STM vars concurrently from multiple threads." - (|> process.parallelism - (n/* iterations-per-process) - (n/= last-val)))))))) +(def: #export test + Test + (do r.monad + [_ (wrap [])] + (<| (_.context (%name (name-of /.STM))) + ($_ _.and + (wrap (do promise.monad + [output (/.commit (/.read (/.var 0)))] + (_.assert "Can read STM vars." + (n/= 0 output)))) + (wrap (do promise.monad + [#let [_var (/.var 0)] + output (/.commit (do /.monad + [_ (/.write 5 _var)] + (/.read _var)))] + (_.assert "Can write STM vars." + (n/= 5 output)))) + (wrap (do promise.monad + [#let [_var (/.var 5)] + output (/.commit (do /.monad + [_ (/.update (n/* 3) _var)] + (/.read _var)))] + (_.assert "Can update STM vars." + (n/= 15 output)))) + (wrap (do promise.monad + [#let [_var (/.var 0) + changes (io.run (read! (io.run (/.follow _var))))] + _ (/.commit (/.write 5 _var)) + _ (/.commit (/.update (n/* 3) _var)) + changes (promise.future (atom.read changes))] + (_.assert "Can follow all the changes to STM vars." + (:: (list.equivalence nat.equivalence) = + (list 5 15) + (list.reverse changes))))) + (wrap (let [_concurrency-var (/.var 0)] + (do promise.monad + [_ (|> process.parallelism + (list.n/range 1) + (list@map (function (_ _) + (|> iterations-per-process + (list.n/range 1) + (M.map @ (function (_ _) (/.commit (/.update inc _concurrency-var))))))) + (M.seq @)) + last-val (/.commit (/.read _concurrency-var))] + (_.assert "Can modify STM vars concurrently from multiple threads." + (|> process.parallelism + (n/* iterations-per-process) + (n/= last-val)))))))))) |