0 | module IO.Async.MVar
 1 |
 2 | import Data.IORef
 3 | import Data.Queue
 4 | import System.Concurrency
 5 |
 6 | %default total
 7 |
 8 | --------------------------------------------------------------------------------
 9 | -- MVar
10 | --------------------------------------------------------------------------------
11 |
12 | ||| A thread-safe mutable variable.
13 | |||
14 | ||| This comes with several atomic operations: `readMVar`,
15 | ||| `writeMVar`, `modifyMVar`, and `evalState`.
16 | |||
17 | ||| "Atomic" in this context means, that during such an operation,
18 | ||| no other thread will be able to access the mutable variable.
19 | |||
20 | ||| This uses a `System.Concurrency.Mutex` internally, so it will only
21 | ||| be available on the Scheme backends.
22 | export
23 | record MVar a where
24 |   constructor MV
25 |   ref  : IORef a
26 |   lock : Mutex
27 |
28 | ||| Create a new mutable variable.
29 | export
30 | newMVar : a -> IO (MVar a)
31 | newMVar v = [| MV (newIORef v) makeMutex |]
32 |
33 | withLock : MVar a -> (IORef a -> IO b) -> IO b
34 | withLock mv f = do
35 |   mutexAcquire mv.lock
36 |   vb <- f mv.ref
37 |   mutexRelease mv.lock
38 |   pure vb
39 |
40 | ||| Atomically read the value from a mutable variable.
41 | export %inline
42 | readMVar : MVar a -> IO a
43 | readMVar mv = withLock mv readIORef
44 |
45 | ||| Atomically write a value into a mutable variable.
46 | export %inline
47 | writeMVar : MVar a -> a -> IO ()
48 | writeMVar mv v = withLock mv (`writeIORef` v)
49 |
50 | ||| Atomically modify the value in a mutable variable.
51 | export %inline
52 | modifyMVar : MVar a -> (a -> a) -> IO ()
53 | modifyMVar mv f = withLock mv (`modifyIORef` f)
54 |
55 | ||| Atomically modify and extract the value from a
56 | ||| mutable variable.
57 | export
58 | evalState : MVar a -> (a -> (a,b)) -> IO b
59 | evalState mv f =
60 |   withLock mv $ \ref => do
61 |     (st,res) <- f <$> readIORef ref
62 |     writeIORef ref st
63 |     pure res
64 |
65 | --------------------------------------------------------------------------------
66 | -- MQueue
67 | --------------------------------------------------------------------------------
68 |
69 | export
70 | record MQueue a where
71 |   constructor MQ
72 |   var : MVar (Queue a)
73 |
74 | export
75 | newMQueue : IO (MQueue a)
76 | newMQueue = MQ <$> newMVar empty
77 |
78 | export
79 | enqueue : MQueue a -> a -> IO ()
80 | enqueue (MQ m) v = modifyMVar m (`enqueue` v)
81 |
82 | export
83 | dequeue : MQueue a -> IO (Maybe a)
84 | dequeue (MQ m) =
85 |   evalState m $ \x => case dequeue x of
86 |     Nothing    => (x,Nothing)
87 |     Just (v,y) => (y, Just v)
88 |