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 , forkProcessPrim -- :: IO Int
29 , forkProcess -- :: IO (Maybe Int)
32 , threadDelay -- :: Int -> IO ()
33 , threadWaitRead -- :: Int -> IO ()
34 , threadWaitWrite -- :: Int -> IO ()
38 , newMVar -- :: a -> IO (MVar a)
39 , newEmptyMVar -- :: IO (MVar a)
40 , takeMVar -- :: MVar a -> IO a
41 , putMVar -- :: MVar a -> a -> IO ()
42 , tryTakeMVar -- :: MVar a -> IO (Maybe a)
43 , tryPutMVar -- :: MVar a -> a -> IO Bool
44 , isEmptyMVar -- :: MVar a -> IO Bool
45 , addMVarFinalizer -- :: MVar a -> IO () -> IO ()
52 import GHC.IOBase ( IO(..), MVar(..), ioException, IOException(..), IOErrorType(..) )
53 import GHC.Num ( fromInteger, negate )
54 import GHC.Base ( Int(..) )
55 import GHC.Exception ( Exception(..), AsyncException(..) )
56 import GHC.Pack ( packCString# )
58 infixr 0 `par`, `pseq`
61 %************************************************************************
63 \subsection{@ThreadId@, @par@, and @fork@}
65 %************************************************************************
68 data ThreadId = ThreadId ThreadId#
69 -- ToDo: data ThreadId = ThreadId (Weak ThreadId#)
70 -- But since ThreadId# is unlifted, the Weak type must use open
73 A 'ThreadId' is an abstract type representing a handle to a thread.
74 'ThreadId' is an instance of 'Eq', 'Ord' and 'Show', where
75 the 'Ord' instance implements an arbitrary total ordering over
76 'ThreadId's. The 'Show' instance lets you convert an arbitrary-valued
77 'ThreadId' to string form; showing a 'ThreadId' value is occasionally
78 useful when debugging or diagnosing the behaviour of a concurrent
81 NOTE: in GHC, if you have a 'ThreadId', you essentially have
82 a pointer to the thread itself. This means the thread itself can\'t be
83 garbage collected until you drop the 'ThreadId'.
84 This misfeature will hopefully be corrected at a later date.
87 --forkIO has now been hoisted out into the Concurrent library.
89 {- | 'killThread' terminates the given thread (Note: 'killThread' is
90 not implemented in Hugs). Any work already done by the thread isn\'t
91 lost: the computation is suspended until required by another thread.
92 The memory used by the thread will be garbage collected if it isn\'t
93 referenced from anywhere. The 'killThread' function may be defined in
96 > killThread = throwTo (AsyncException ThreadKilled)
98 killThread :: ThreadId -> IO ()
99 killThread (ThreadId id) = IO $ \ s ->
100 case (killThread# id (AsyncException ThreadKilled) s) of s1 -> (# s1, () #)
102 {- | 'throwTo' raises an arbitrary exception in the target thread.
104 'throwTo' does not return until the exception has been raised in the
105 target thread. The calling thread can thus be certain that the target
106 thread has received the exception. This is a useful property to know
107 when dealing with race conditions: eg. if there are two threads that
108 can kill each other, it is guaranteed that only one of the threads
109 will get to kill the other. -}
110 throwTo :: ThreadId -> Exception -> IO ()
111 throwTo (ThreadId id) ex = IO $ \ s ->
112 case (killThread# id ex s) of s1 -> (# s1, () #)
114 -- | Returns the 'ThreadId' of the calling thread.
115 myThreadId :: IO ThreadId
116 myThreadId = IO $ \s ->
117 case (myThreadId# s) of (# s1, id #) -> (# s1, ThreadId id #)
120 -- |The 'yield' action allows (forces, in a co-operative multitasking
121 -- implementation) a context-switch to any other currently runnable
122 -- threads (if any), and is occasionally useful when implementing
123 -- concurrency abstractions.
126 case (yield# s) of s1 -> (# s1, () #)
128 {- | 'labelThread' stores a string as identifier for this thread if
129 you built a RTS with debugging support. This identifier will be used in
130 the debugging output to make distinction of different threads easier
131 (otherwise you only have the thread state object\'s address in the heap).
133 Other applications like the graphical Concurrent Haskell Debugger
134 (<http://www.informatik.uni-kiel.de/~fhu/chd/>) may choose to overload
135 'labelThread' for their purposes as well.
138 labelThread :: ThreadId -> String -> IO ()
139 labelThread (ThreadId t) str = IO $ \ s ->
140 let ps = packCString# str
141 adr = byteArrayContents# ps in
142 case (labelThread# t adr s) of s1 -> (# s1, () #)
144 {- | This function is a replacement for "Posix.forkProcess": This implementation
145 /will stop all other Concurrent Haskell threads/ in the (heavyweight) forked copy.
146 'forkProcessPrim' returns the pid of the child process to the parent, 0 to the child,
147 and a value less than 0 in case of errors. See also: 'forkProcess'.
149 Without this function, you need excessive and often impractical
150 explicit synchronization using the regular Concurrent Haskell constructs to assure
151 that only the desired thread is running after the fork().
153 The stopped threads are /not/ garbage collected! This behaviour may change in
157 forkProcessPrim :: IO Int
158 forkProcessPrim = IO $ \s -> case (forkProcess# s) of (# s1, id #) -> (# s1, (I# id) #)
160 {- | 'forkProcess' is a wrapper around 'forkProcessPrim' similar to the one found in
161 "Posix.forkProcess" which returns a Maybe-type. The child receives @Nothing@, the
162 parent @Just (pid::Int)@. In case of an error, an exception is thrown.
165 forkProcess :: IO (Maybe Int)
167 pid <- forkProcessPrim
169 -1 -> ioException (IOError Nothing -- stolen from hslibs/posix/PosixUtil
175 _ -> return (Just pid)
177 -- Nota Bene: 'pseq' used to be 'seq'
178 -- but 'seq' is now defined in PrelGHC
180 -- "pseq" is defined a bit weirdly (see below)
182 -- The reason for the strange "lazy" call is that
183 -- it fools the compiler into thinking that pseq and par are non-strict in
184 -- their second argument (even if it inlines pseq at the call site).
185 -- If it thinks pseq is strict in "y", then it often evaluates
186 -- "y" before "x", which is totally wrong.
190 pseq x y = x `seq` lazy y
194 par x y = case (par# x) of { _ -> lazy y }
197 %************************************************************************
199 \subsection[mvars]{M-Structures}
201 %************************************************************************
203 M-Vars are rendezvous points for concurrent threads. They begin
204 empty, and any attempt to read an empty M-Var blocks. When an M-Var
205 is written, a single blocked thread may be freed. Reading an M-Var
206 toggles its state from full back to empty. Therefore, any value
207 written to an M-Var may only be read once. Multiple reads and writes
208 are allowed, but there must be at least one read between any two
212 --Defined in IOBase to avoid cycle: data MVar a = MVar (SynchVar# RealWorld a)
214 -- |Create an 'MVar' which is initially empty.
215 newEmptyMVar :: IO (MVar a)
216 newEmptyMVar = IO $ \ s# ->
218 (# s2#, svar# #) -> (# s2#, MVar svar# #)
220 -- |Create an 'MVar' which contains the supplied value.
221 newMVar :: a -> IO (MVar a)
223 newEmptyMVar >>= \ mvar ->
224 putMVar mvar value >>
227 -- |Return the contents of the 'MVar'. If the 'MVar' is currently
228 -- empty, 'takeMVar' will wait until it is full. After a 'takeMVar',
229 -- the 'MVar' is left empty.
231 -- If several threads are competing to take the same 'MVar', one is chosen
232 -- to continue at random when the 'MVar' becomes full.
233 takeMVar :: MVar a -> IO a
234 takeMVar (MVar mvar#) = IO $ \ s# -> takeMVar# mvar# s#
236 -- |Put a value into an 'MVar'. If the 'MVar' is currently full,
237 -- 'putMVar' will wait until it becomes empty.
239 -- If several threads are competing to fill the same 'MVar', one is
240 -- chosen to continue at random with the 'MVar' becomes empty.
241 putMVar :: MVar a -> a -> IO ()
242 putMVar (MVar mvar#) x = IO $ \ s# ->
243 case putMVar# mvar# x s# of
246 -- |A non-blocking version of 'takeMVar'. The 'tryTakeMVar' function
247 -- returns immediately, with 'Nothing' if the 'MVar' was empty, or
248 -- @'Just' a@ if the 'MVar' was full with contents @a@. After 'tryTakeMVar',
249 -- the 'MVar' is left empty.
250 tryTakeMVar :: MVar a -> IO (Maybe a)
251 tryTakeMVar (MVar m) = IO $ \ s ->
252 case tryTakeMVar# m s of
253 (# s, 0#, _ #) -> (# s, Nothing #) -- MVar is empty
254 (# s, _, a #) -> (# s, Just a #) -- MVar is full
256 -- |A non-blocking version of 'putMVar'. The 'tryPutMVar' function
257 -- attempts to put the value @a@ into the 'MVar', returning 'True' if
258 -- it was successful, or 'False' otherwise.
259 tryPutMVar :: MVar a -> a -> IO Bool
260 tryPutMVar (MVar mvar#) x = IO $ \ s# ->
261 case tryPutMVar# mvar# x s# of
262 (# s, 0# #) -> (# s, False #)
263 (# s, _ #) -> (# s, True #)
265 -- |Check whether a given 'MVar' is empty.
267 -- Notice that the boolean value returned is just a snapshot of
268 -- the state of the MVar. By the time you get to react on its result,
269 -- the MVar may have been filled (or emptied) - so be extremely
270 -- careful when using this operation. Use 'tryTakeMVar' instead if possible.
271 isEmptyMVar :: MVar a -> IO Bool
272 isEmptyMVar (MVar mv#) = IO $ \ s# ->
273 case isEmptyMVar# mv# s# of
274 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
276 -- |Add a finalizer to an 'MVar'. See "Foreign.ForeignPtr" and
277 -- "System.Mem.Weak" for more about finalizers.
278 addMVarFinalizer :: MVar a -> IO () -> IO ()
279 addMVarFinalizer (MVar m) finalizer =
280 IO $ \s -> case mkWeak# m () finalizer s of { (# s1, w #) -> (# s1, () #) }
284 %************************************************************************
286 \subsection{Thread waiting}
288 %************************************************************************
290 @threadWaitRead@ delays rescheduling of a thread until input on the
291 specified file descriptor is available for reading (just like select).
292 @threadWaitWrite@ is similar, but for writing on a file descriptor.
295 -- |The 'threadDelay' operation will cause the current thread to
296 -- suspend for a given number of microseconds. Note that the resolution
297 -- used by the Haskell runtime system\'s internal timer together with the
298 -- fact that the thread may take some time to be rescheduled after the
299 -- time has expired, means that the accuracy is more like 1\/50 second.
300 threadDelay :: Int -> IO ()
302 -- | Block the current thread until data is available to read on the
303 -- given file descriptor.
304 threadWaitRead :: Int -> IO ()
306 -- | Block the current thread until data can be written to the
307 -- given file descriptor.
308 threadWaitWrite :: Int -> IO ()
310 threadDelay (I# ms) = IO $ \s -> case delay# ms s of s -> (# s, () #)
311 threadWaitRead (I# fd) = IO $ \s -> case waitRead# fd s of s -> (# s, () #)
312 threadWaitWrite (I# fd) = IO $ \s -> case waitWrite# fd s of s -> (# s, () #)