1 -----------------------------------------------------------------------------
3 -- Module : Control.Concurrent
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (concurrency)
11 -- A common interface to a collection of useful concurrency
14 -----------------------------------------------------------------------------
16 module Control.Concurrent (
17 -- * Concurrent Haskell
21 -- * Basic concurrency operations
39 #ifdef __GLASGOW_HASKELL__
41 threadDelay, -- :: Int -> IO ()
42 threadWaitRead, -- :: Int -> IO ()
43 threadWaitWrite, -- :: Int -> IO ()
46 -- * Communication abstractions
48 module Control.Concurrent.MVar,
49 module Control.Concurrent.Chan,
50 module Control.Concurrent.QSem,
51 module Control.Concurrent.QSemN,
52 module Control.Concurrent.SampleVar,
54 -- * Merging of streams
55 mergeIO, -- :: [a] -> [a] -> IO [a]
56 nmergeIO, -- :: [[a]] -> IO [a]
59 -- * GHC's implementation of concurrency
61 -- |This section describes features specific to GHC's
62 -- implementation of Concurrent Haskell.
64 -- ** Terminating the program
76 import Control.Exception as Exception
78 #ifdef __GLASGOW_HASKELL__
80 import GHC.TopHandler ( reportStackOverflow, reportError )
81 import GHC.IOBase ( IO(..) )
82 import GHC.IOBase ( unsafeInterleaveIO )
88 import IOExts ( unsafeInterleaveIO )
92 import Control.Concurrent.MVar
93 import Control.Concurrent.Chan
94 import Control.Concurrent.QSem
95 import Control.Concurrent.QSemN
96 import Control.Concurrent.SampleVar
100 The concurrency extension for Haskell is described in the paper
102 <http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.
104 Concurrency is \"lightweight\", which means that both thread creation
105 and context switching overheads are extremely low. Scheduling of
106 Haskell threads is done internally in the Haskell runtime system, and
107 doesn't make use of any operating system-supplied thread packages.
109 Haskell threads can communicate via 'MVar's, a kind of synchronised
110 mutable variable (see "Control.Concurrent.MVar"). Several common
111 concurrency abstractions can be built from 'MVar's, and these are
112 provided by the "Concurrent" library. Threads may also communicate
118 Scheduling may be either pre-emptive or co-operative,
119 depending on the implementation of Concurrent Haskell (see below
120 for imformation related to specific compilers). In a co-operative
121 system, context switches only occur when you use one of the
122 primitives defined in this module. This means that programs such
126 > main = forkIO (write 'a') >> write 'b'
127 > where write c = putChar c >> write c
129 will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
130 instead of some random interleaving of @a@s and @b@s. In
131 practice, cooperative multitasking is sufficient for writing
132 simple graphical user interfaces.
136 Calling a foreign C procedure (such as @getchar@) that blocks waiting
137 for input will block /all/ threads, unless the @threadsafe@ attribute
138 is used on the foreign call (and your compiler \/ operating system
139 supports it). GHC's I\/O system uses non-blocking I\/O internally to
140 implement thread-friendly I\/O, so calling standard Haskell I\/O
141 functions blocks only the thread making the call.
144 -- Thread Ids, specifically the instances of Eq and Ord for these things.
145 -- The ThreadId type itself is defined in std/PrelConc.lhs.
147 -- Rather than define a new primitve, we use a little helper function
148 -- cmp_thread in the RTS.
150 #ifdef __GLASGOW_HASKELL__
153 id2TSO :: ThreadId -> StgTSO
154 id2TSO (ThreadId t) = unsafeCoerce# t
156 foreign import ccall unsafe "cmp_thread" cmp_thread :: StgTSO -> StgTSO -> Int
159 cmpThread :: ThreadId -> ThreadId -> Ordering
161 case cmp_thread (id2TSO t1) (id2TSO t2) of
166 instance Eq ThreadId where
168 case t1 `cmpThread` t2 of
172 instance Ord ThreadId where
175 foreign import ccall unsafe "rts_getThreadId" getThreadId :: StgTSO -> Int
177 instance Show ThreadId where
179 showString "ThreadId " .
180 showsPrec d (getThreadId (id2TSO t))
183 This sparks off a new thread to run the 'IO' computation passed as the
184 first argument, and returns the 'ThreadId' of the newly created
187 forkIO :: IO () -> IO ThreadId
188 forkIO action = IO $ \ s ->
189 case (fork# action_plus s) of (# s1, id #) -> (# s1, ThreadId id #)
191 action_plus = Exception.catch action childHandler
193 childHandler :: Exception -> IO ()
194 childHandler err = Exception.catch (real_handler err) childHandler
196 real_handler :: Exception -> IO ()
199 -- ignore thread GC and killThread exceptions:
200 BlockedOnDeadMVar -> return ()
201 AsyncException ThreadKilled -> return ()
203 -- report all others:
204 AsyncException StackOverflow -> reportStackOverflow False
205 ErrorCall s -> reportError False s
206 other -> reportError False (showsPrec 0 other "\n")
208 #endif /* __GLASGOW_HASKELL__ */
214 mergeIO :: [a] -> [a] -> IO [a]
215 nmergeIO :: [[a]] -> IO [a]
218 -- The 'mergeIO' and 'nmergeIO' functions fork one thread for each
219 -- input list that concurrently evaluates that list; the results are
220 -- merged into a single output list.
222 -- Note: Hugs does not provide these functions, since they require
223 -- preemptive multitasking.
226 = newEmptyMVar >>= \ tail_node ->
227 newMVar tail_node >>= \ tail_list ->
228 newQSem max_buff_size >>= \ e ->
229 newMVar 2 >>= \ branches_running ->
233 forkIO (suckIO branches_running buff ls) >>
234 forkIO (suckIO branches_running buff rs) >>
235 takeMVar tail_node >>= \ val ->
240 = (MVar (MVar [a]), QSem)
242 suckIO :: MVar Int -> Buffer a -> [a] -> IO ()
244 suckIO branches_running buff@(tail_list,e) vs
246 [] -> takeMVar branches_running >>= \ val ->
248 takeMVar tail_list >>= \ node ->
250 putMVar tail_list node
252 putMVar branches_running (val-1)
255 takeMVar tail_list >>= \ node ->
256 newEmptyMVar >>= \ next_node ->
258 takeMVar next_node >>= \ y ->
260 return y) >>= \ next_node_val ->
261 putMVar node (x:next_node_val) >>
262 putMVar tail_list next_node >>
263 suckIO branches_running buff xs
269 newEmptyMVar >>= \ tail_node ->
270 newMVar tail_node >>= \ tail_list ->
271 newQSem max_buff_size >>= \ e ->
272 newMVar len >>= \ branches_running ->
276 mapIO (\ x -> forkIO (suckIO branches_running buff x)) lss >>
277 takeMVar tail_node >>= \ val ->
281 mapIO f xs = sequence (map f xs)
283 -- ---------------------------------------------------------------------------
288 In a standalone GHC program, only the main thread is
289 required to terminate in order for the process to terminate.
290 Thus all other forked threads will simply terminate at the same
291 time as the main thread (the terminology for this kind of
292 behaviour is \"daemonic threads\").
294 If you want the program to wait for child threads to
295 finish before exiting, you need to program this yourself. A
296 simple mechanism is to have each child thread write to an
297 'MVar' when it completes, and have the main
298 thread wait on all the 'MVar's before
301 > myForkIO :: IO () -> IO (MVar ())
303 > mvar \<- newEmptyMVar
304 > forkIO (io \`finally\` putMVar mvar ())
307 Note that we use 'finally' from the
308 "Exception" module to make sure that the
309 'MVar' is written to even if the thread dies or
310 is killed for some reason.
312 A better method is to keep a global list of all child
313 threads which we should wait for at the end of the program:
315 > children :: MVar [MVar ()]
316 > children = unsafePerformIO (newMVar [])
318 > waitForChildren :: IO ()
319 > waitForChildren = do
320 > (mvar:mvars) \<- takeMVar children
321 > putMVar children mvars
325 > forkChild :: IO () -> IO ()
327 > mvar \<- newEmptyMVar
328 > forkIO (p \`finally\` putMVar mvar ())
329 > childs \<- takeMVar children
330 > putMVar children (mvar:childs)
332 > later = flip finally
335 > later waitForChildren $
338 The main thread principle also applies to calls to Haskell from
339 outside, using @foreign export@. When the @foreign export@ed
340 function is invoked, it starts a new main thread, and it returns
341 when this main thread terminates. If the call causes new
342 threads to be forked, they may remain in the system after the
343 @foreign export@ed function has returned.
348 GHC implements pre-emptive multitasking: the execution of
349 threads are interleaved in a random fashion. More specifically,
350 a thread may be pre-empted whenever it allocates some memory,
351 which unfortunately means that tight loops which do no
352 allocation tend to lock out other threads (this only seems to
353 happen with pathalogical benchmark-style code, however).
355 The rescheduling timer runs on a 20ms granularity by
356 default, but this may be altered using the
357 @-i<n>@ RTS option. After a rescheduling
358 \"tick\" the running thread is pre-empted as soon as
362 @aaaa@ @bbbb@ example may not
363 work too well on GHC (see Scheduling, above), due
364 to the locking on a 'Handle'. Only one thread
365 may hold the lock on a 'Handle' at any one
366 time, so if a reschedule happens while a thread is holding the
367 lock, the other thread won't be able to run. The upshot is that
368 the switch from @aaaa@ to
369 @bbbbb@ happens infrequently. It can be
370 improved by lowering the reschedule tick period. We also have a
371 patch that causes a reschedule whenever a thread waiting on a
372 lock is woken up, but haven't found it to be useful for anything
373 other than this example :-)