1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
|
{-# LANGUAGE CPP, DeriveDataTypeable, MagicHash, UnboxedTuples #-}
#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
-----------------------------------------------------------------------------
-- |
-- Module : Control.Concurrent.STM.TMVar
-- Copyright : (c) The University of Glasgow 2004
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : non-portable (requires STM)
--
-- TMVar: Transactional MVars, for use in the STM monad
-- (GHC only)
--
-----------------------------------------------------------------------------
module Control.Concurrent.STM.TMVar (
#ifdef __GLASGOW_HASKELL__
-- * TMVars
TMVar,
newTMVar,
newEmptyTMVar,
newTMVarIO,
newEmptyTMVarIO,
takeTMVar,
putTMVar,
readTMVar,
writeTMVar,
tryReadTMVar,
swapTMVar,
tryTakeTMVar,
tryPutTMVar,
isEmptyTMVar,
mkWeakTMVar
#endif
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.Conc
import GHC.Weak
import Data.Typeable (Typeable)
newtype TMVar a = TMVar (TVar (Maybe a)) deriving (Eq, Typeable)
{- ^
A 'TMVar' is a synchronising variable, used
for communication between concurrent threads. It can be thought of
as a box, which may be empty or full.
-}
-- |Create a 'TMVar' which contains the supplied value.
newTMVar :: a -> STM (TMVar a)
newTMVar a = do
t <- newTVar (Just a)
return (TMVar t)
-- |@IO@ version of 'newTMVar'. This is useful for creating top-level
-- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
-- possible.
newTMVarIO :: a -> IO (TMVar a)
newTMVarIO a = do
t <- newTVarIO (Just a)
return (TMVar t)
-- |Create a 'TMVar' which is initially empty.
newEmptyTMVar :: STM (TMVar a)
newEmptyTMVar = do
t <- newTVar Nothing
return (TMVar t)
-- |@IO@ version of 'newEmptyTMVar'. This is useful for creating top-level
-- 'TMVar's using 'System.IO.Unsafe.unsafePerformIO', because using
-- 'atomically' inside 'System.IO.Unsafe.unsafePerformIO' isn't
-- possible.
newEmptyTMVarIO :: IO (TMVar a)
newEmptyTMVarIO = do
t <- newTVarIO Nothing
return (TMVar t)
-- |Return the contents of the 'TMVar'. If the 'TMVar' is currently
-- empty, the transaction will 'retry'. After a 'takeTMVar',
-- the 'TMVar' is left empty.
takeTMVar :: TMVar a -> STM a
takeTMVar (TMVar t) = do
m <- readTVar t
case m of
Nothing -> retry
Just a -> do writeTVar t Nothing; return a
-- | A version of 'takeTMVar' that does not 'retry'. The 'tryTakeTMVar'
-- function returns 'Nothing' if the 'TMVar' was empty, or @'Just' a@ if
-- the 'TMVar' was full with contents @a@. After 'tryTakeTMVar', the
-- 'TMVar' is left empty.
tryTakeTMVar :: TMVar a -> STM (Maybe a)
tryTakeTMVar (TMVar t) = do
m <- readTVar t
case m of
Nothing -> return Nothing
Just a -> do writeTVar t Nothing; return (Just a)
-- |Put a value into a 'TMVar'. If the 'TMVar' is currently full,
-- 'putTMVar' will 'retry'.
putTMVar :: TMVar a -> a -> STM ()
putTMVar (TMVar t) a = do
m <- readTVar t
case m of
Nothing -> do writeTVar t (Just a); return ()
Just _ -> retry
-- | A version of 'putTMVar' that does not 'retry'. The 'tryPutTMVar'
-- function attempts to put the value @a@ into the 'TMVar', returning
-- 'True' if it was successful, or 'False' otherwise.
tryPutTMVar :: TMVar a -> a -> STM Bool
tryPutTMVar (TMVar t) a = do
m <- readTVar t
case m of
Nothing -> do writeTVar t (Just a); return True
Just _ -> return False
-- | This is a combination of 'takeTMVar' and 'putTMVar'; ie. it
-- takes the value from the 'TMVar', puts it back, and also returns
-- it.
readTMVar :: TMVar a -> STM a
readTMVar (TMVar t) = do
m <- readTVar t
case m of
Nothing -> retry
Just a -> return a
-- | A version of 'readTMVar' which does not retry. Instead it
-- returns @Nothing@ if no value is available.
--
-- @since 2.3
tryReadTMVar :: TMVar a -> STM (Maybe a)
tryReadTMVar (TMVar t) = readTVar t
-- |Swap the contents of a 'TMVar' for a new value.
swapTMVar :: TMVar a -> a -> STM a
swapTMVar (TMVar t) new = do
m <- readTVar t
case m of
Nothing -> retry
Just old -> do writeTVar t (Just new); return old
-- | Non-blocking write of a new value to a 'TMVar'
-- Puts if empty. Replaces if populated.
--
-- @since 2.5.1
writeTMVar :: TMVar a -> a -> STM ()
writeTMVar (TMVar t) new = writeTVar t (Just new)
-- |Check whether a given 'TMVar' is empty.
isEmptyTMVar :: TMVar a -> STM Bool
isEmptyTMVar (TMVar t) = do
m <- readTVar t
case m of
Nothing -> return True
Just _ -> return False
-- | Make a 'Weak' pointer to a 'TMVar', using the second argument as
-- a finalizer to run when the 'TMVar' is garbage-collected.
--
-- @since 2.4.4
mkWeakTMVar :: TMVar a -> IO () -> IO (Weak (TMVar a))
mkWeakTMVar tmv@(TMVar (TVar t#)) (IO finalizer) = IO $ \s ->
case mkWeak# t# tmv finalizer s of (# s1, w #) -> (# s1, Weak w #)
#endif
|
