2 {-# OPTIONS -fno-implicit-prelude #-}
3 -----------------------------------------------------------------------------
6 -- Copyright : (c) The University of Glasgow, 1994-2002
7 -- License : see libraries/base/LICENSE
9 -- Maintainer : cvs-ghc@haskell.org
10 -- Stability : internal
11 -- Portability : non-portable (GHC extensions)
13 -- Basic concurrency stuff.
15 -----------------------------------------------------------------------------
20 -- Forking and suchlike
21 , myThreadId -- :: IO ThreadId
22 , killThread -- :: ThreadId -> IO ()
23 , throwTo -- :: ThreadId -> Exception -> IO ()
24 , par -- :: a -> b -> b
25 , pseq -- :: a -> b -> b
27 , labelThread -- :: ThreadId -> String -> IO ()
28 , forkProcess -- :: IO Int
31 , threadDelay -- :: Int -> IO ()
32 , threadWaitRead -- :: Int -> IO ()
33 , threadWaitWrite -- :: Int -> IO ()
37 , newMVar -- :: a -> IO (MVar a)
38 , newEmptyMVar -- :: IO (MVar a)
39 , takeMVar -- :: MVar a -> IO a
40 , putMVar -- :: MVar a -> a -> IO ()
41 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
42 , tryPutMVar -- :: MVar a -> a -> IO Bool
43 , isEmptyMVar -- :: MVar a -> IO Bool
44 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
51 import GHC.IOBase ( IO(..), MVar(..) )
52 import GHC.Base ( Int(..) )
53 import GHC.Exception ( Exception(..), AsyncException(..) )
54 import GHC.Pack ( packCString# )
56 infixr 0 `par`, `pseq`
59 %************************************************************************
61 \subsection{@ThreadId@, @par@, and @fork@}
63 %************************************************************************
66 data ThreadId = ThreadId ThreadId#
67 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
68 -- But since ThreadId# is unlifted, the Weak type must use open
71 A 'ThreadId' is an abstract type representing a handle to a thread.
72 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where
73 the 'Ord' instance implements an arbitrary total ordering over
74 'ThreadId's. The 'Show' instance lets you convert an arbitrary-valued
75 'ThreadId' to string form; showing a 'ThreadId' value is occasionally
76 useful when debugging or diagnosing the behaviour of a concurrent
79 NOTE: in GHC, if you have a 'ThreadId', you essentially have
80 a pointer to the thread itself. This means the thread itself can\'t be
81 garbage collected until you drop the 'ThreadId'.
82 This misfeature will hopefully be corrected at a later date.
85 --forkIO has now been hoisted out into the Concurrent library.
87 {- | 'killThread' terminates the given thread (Note: 'killThread' is
88 not implemented in Hugs). Any work already done by the thread isn\'t
89 lost: the computation is suspended until required by another thread.
90 The memory used by the thread will be garbage collected if it isn\'t
91 referenced from anywhere. The 'killThread' function may be defined in
94 > killThread = throwTo (AsyncException ThreadKilled)
96 killThread :: ThreadId -> IO ()
97 killThread (ThreadId id) = IO $ \ s ->
98 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
100 {- | 'throwTo' raises an arbitrary exception in the target thread.
102 'throwTo' does not return until the exception has been raised in the
103 target thread. The calling thread can thus be certain that the target
104 thread has received the exception. This is a useful property to know
105 when dealing with race conditions: eg. if there are two threads that
106 can kill each other, it is guaranteed that only one of the threads
107 will get to kill the other. -}
108 throwTo :: ThreadId -> Exception -> IO ()
109 throwTo (ThreadId id) ex = IO $ \ s ->
110 case (killThread# id ex s) of s1 -> (# s1, () #)
112 -- | Returns the 'ThreadId' of the calling thread.
113 myThreadId :: IO ThreadId
114 myThreadId = IO $ \s ->
115 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
118 -- |The 'yield' action allows (forces, in a co-operative multitasking
119 -- implementation) a context-switch to any other currently runnable
120 -- threads (if any), and is occasionally useful when implementing
121 -- concurrency abstractions.
124 case (yield# s) of s1 -> (# s1, () #)
126 labelThread :: ThreadId -> String -> IO ()
127 labelThread (ThreadId t) str = IO $ \ s ->
128 let ps = packCString# str
129 adr = byteArrayContents# ps in
130 case (labelThread# t adr s) of s1 -> (# s1, () #)
132 forkProcess :: IO Int
133 forkProcess = IO $ \s -> case (forkProcess# s) of (# s1, id #) -> (# s1, (I# id) #)
135 -- Nota Bene: 'pseq' used to be 'seq'
136 -- but 'seq' is now defined in PrelGHC
138 -- "pseq" is defined a bit weirdly (see below)
140 -- The reason for the strange "lazy" call is that
141 -- it fools the compiler into thinking that pseq and par are non-strict in
142 -- their second argument (even if it inlines pseq at the call site).
143 -- If it thinks pseq is strict in "y", then it often evaluates
144 -- "y" before "x", which is totally wrong.
148 pseq x y = x `seq` lazy y
152 par x y = case (par# x) of { _ -> lazy y }
155 %************************************************************************
157 \subsection[mvars]{M-Structures}
159 %************************************************************************
161 M-Vars are rendezvous points for concurrent threads. They begin
162 empty, and any attempt to read an empty M-Var blocks. When an M-Var
163 is written, a single blocked thread may be freed. Reading an M-Var
164 toggles its state from full back to empty. Therefore, any value
165 written to an M-Var may only be read once. Multiple reads and writes
166 are allowed, but there must be at least one read between any two
170 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
172 -- |Create an 'MVar' which is initially empty.
173 newEmptyMVar :: IO (MVar a)
174 newEmptyMVar = IO $ \ s# ->
176 (# s2#, svar# #) -> (# s2#, MVar svar# #)
178 -- |Create an 'MVar' which contains the supplied value.
179 newMVar :: a -> IO (MVar a)
181 newEmptyMVar >>= \ mvar ->
182 putMVar mvar value >>
185 -- |Return the contents of the 'MVar'. If the 'MVar' is currently
186 -- empty, 'takeMVar' will wait until it is full. After a 'takeMVar',
187 -- the 'MVar' is left empty.
189 -- If several threads are competing to take the same 'MVar', one is chosen
190 -- to continue at random when the 'MVar' becomes full.
191 takeMVar :: MVar a -> IO a
192 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
194 -- |Put a value into an 'MVar'. If the 'MVar' is currently full,
195 -- 'putMVar' will wait until it becomes empty.
197 -- If several threads are competing to fill the same 'MVar', one is
198 -- chosen to continue at random with the 'MVar' becomes empty.
199 putMVar :: MVar a -> a -> IO ()
200 putMVar (MVar mvar#) x = IO $ \ s# ->
201 case putMVar# mvar# x s# of
204 -- |A non-blocking version of 'takeMVar'. The 'tryTakeMVar' function
205 -- returns immediately, with 'Nothing' if the 'MVar' was empty, or
206 -- @'Just' a@ if the 'MVar' was full with contents @a@. After 'tryTakeMVar',
207 -- the 'MVar' is left empty.
208 tryTakeMVar :: MVar a -> IO (Maybe a)
209 tryTakeMVar (MVar m) = IO $ \ s ->
210 case tryTakeMVar# m s of
211 (# s, 0#, _ #) -> (# s, Nothing #) -- MVar is empty
212 (# s, _, a #) -> (# s, Just a #) -- MVar is full
214 -- |A non-blocking version of 'putMVar'. The 'tryPutMVar' function
215 -- attempts to put the value @a@ into the 'MVar', returning 'True' if
216 -- it was successful, or 'False' otherwise.
217 tryPutMVar :: MVar a -> a -> IO Bool
218 tryPutMVar (MVar mvar#) x = IO $ \ s# ->
219 case tryPutMVar# mvar# x s# of
220 (# s, 0# #) -> (# s, False #)
221 (# s, _ #) -> (# s, True #)
223 -- |Check whether a given 'MVar' is empty.
225 -- Notice that the boolean value returned is just a snapshot of
226 -- the state of the MVar. By the time you get to react on its result,
227 -- the MVar may have been filled (or emptied) - so be extremely
228 -- careful when using this operation. Use 'tryTakeMVar' instead if possible.
229 isEmptyMVar :: MVar a -> IO Bool
230 isEmptyMVar (MVar mv#) = IO $ \ s# ->
231 case isEmptyMVar# mv# s# of
232 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
234 -- |Add a finalizer to an 'MVar'. See "Foreign.ForeignPtr" and
235 -- "System.Mem.Weak" for more about finalizers.
236 addMVarFinalizer :: MVar a -> IO () -> IO ()
237 addMVarFinalizer (MVar m) finalizer =
238 IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) }
242 %************************************************************************
244 \subsection{Thread waiting}
246 %************************************************************************
248 @threadWaitRead@ delays rescheduling of a thread until input on the
249 specified file descriptor is available for reading (just like select).
250 @threadWaitWrite@ is similar, but for writing on a file descriptor.
253 -- |The 'threadDelay' operation will cause the current thread to
254 -- suspend for a given number of microseconds. Note that the resolution
255 -- used by the Haskell runtime system\'s internal timer together with the
256 -- fact that the thread may take some time to be rescheduled after the
257 -- time has expired, means that the accuracy is more like 1\/50 second.
258 threadDelay :: Int -> IO ()
260 -- | Block the current thread until data is available to read on the
261 -- given file descriptor.
262 threadWaitRead :: Int -> IO ()
264 -- | Block the current thread until data can be written to the
265 -- given file descriptor.
266 threadWaitWrite :: Int -> IO ()
268 threadDelay (I# ms) = IO $ \s -> case delay# ms s of s -> (# s, () #)
269 threadWaitRead (I# fd) = IO $ \s -> case waitRead# fd s of s -> (# s, () #)
270 threadWaitWrite (I# fd) = IO $ \s -> case waitWrite# fd s of s -> (# s, () #)