SafeHaskell: Added SafeHaskell to base
[ghc.git] / libraries / base / Control / Concurrent.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE CPP
3 , ForeignFunctionInterface
4 , MagicHash
5 , UnboxedTuples
6 , ScopedTypeVariables
7 #-}
8 {-# OPTIONS_GHC -fno-warn-unused-imports #-}
9
10 -----------------------------------------------------------------------------
11 -- |
12 -- Module : Control.Concurrent
13 -- Copyright : (c) The University of Glasgow 2001
14 -- License : BSD-style (see the file libraries/base/LICENSE)
15 --
16 -- Maintainer : libraries@haskell.org
17 -- Stability : experimental
18 -- Portability : non-portable (concurrency)
19 --
20 -- A common interface to a collection of useful concurrency
21 -- abstractions.
22 --
23 -----------------------------------------------------------------------------
24
25 module Control.Concurrent (
26 -- * Concurrent Haskell
27
28 -- $conc_intro
29
30 -- * Basic concurrency operations
31
32 ThreadId,
33 #ifdef __GLASGOW_HASKELL__
34 myThreadId,
35 #endif
36
37 forkIO,
38 #ifdef __GLASGOW_HASKELL__
39 forkIOWithUnmask,
40 killThread,
41 throwTo,
42 #endif
43
44 -- ** Threads with affinity
45 forkOn,
46 forkOnWithUnmask,
47 getNumCapabilities,
48 threadCapability,
49
50 -- * Scheduling
51
52 -- $conc_scheduling
53 yield, -- :: IO ()
54
55 -- ** Blocking
56
57 -- $blocking
58
59 #ifdef __GLASGOW_HASKELL__
60 -- ** Waiting
61 threadDelay, -- :: Int -> IO ()
62 threadWaitRead, -- :: Int -> IO ()
63 threadWaitWrite, -- :: Int -> IO ()
64 #endif
65
66 -- * Communication abstractions
67
68 module Control.Concurrent.MVar,
69 module Control.Concurrent.Chan,
70 module Control.Concurrent.QSem,
71 module Control.Concurrent.QSemN,
72 module Control.Concurrent.SampleVar,
73
74 -- * Merging of streams
75 #ifndef __HUGS__
76 mergeIO, -- :: [a] -> [a] -> IO [a]
77 nmergeIO, -- :: [[a]] -> IO [a]
78 #endif
79 -- $merge
80
81 #ifdef __GLASGOW_HASKELL__
82 -- * Bound Threads
83 -- $boundthreads
84 rtsSupportsBoundThreads,
85 forkOS,
86 isCurrentThreadBound,
87 runInBoundThread,
88 runInUnboundThread,
89 #endif
90
91 -- * GHC's implementation of concurrency
92
93 -- |This section describes features specific to GHC's
94 -- implementation of Concurrent Haskell.
95
96 -- ** Haskell threads and Operating System threads
97
98 -- $osthreads
99
100 -- ** Terminating the program
101
102 -- $termination
103
104 -- ** Pre-emption
105
106 -- $preemption
107
108 -- * Deprecated functions
109 forkIOUnmasked
110
111 ) where
112
113 import Prelude
114
115 import Control.Exception.Base as Exception
116
117 #ifdef __GLASGOW_HASKELL__
118 import GHC.Exception
119 import GHC.Conc hiding (threadWaitRead, threadWaitWrite)
120 import qualified GHC.Conc
121 import GHC.IO ( IO(..), unsafeInterleaveIO, unsafeUnmask )
122 import GHC.IORef ( newIORef, readIORef, writeIORef )
123 import GHC.Base
124
125 import System.Posix.Types ( Fd )
126 import Foreign.StablePtr
127 import Foreign.C.Types ( CInt )
128 import Control.Monad ( when )
129
130 #ifdef mingw32_HOST_OS
131 import Foreign.C
132 import System.IO
133 #endif
134 #endif
135
136 #ifdef __HUGS__
137 import Hugs.ConcBase
138 #endif
139
140 import Control.Concurrent.MVar
141 import Control.Concurrent.Chan
142 import Control.Concurrent.QSem
143 import Control.Concurrent.QSemN
144 import Control.Concurrent.SampleVar
145
146 #ifdef __HUGS__
147 type ThreadId = ()
148 #endif
149
150 {- $conc_intro
151
152 The concurrency extension for Haskell is described in the paper
153 /Concurrent Haskell/
154 <http://www.haskell.org/ghc/docs/papers/concurrent-haskell.ps.gz>.
155
156 Concurrency is \"lightweight\", which means that both thread creation
157 and context switching overheads are extremely low. Scheduling of
158 Haskell threads is done internally in the Haskell runtime system, and
159 doesn't make use of any operating system-supplied thread packages.
160
161 However, if you want to interact with a foreign library that expects your
162 program to use the operating system-supplied thread package, you can do so
163 by using 'forkOS' instead of 'forkIO'.
164
165 Haskell threads can communicate via 'MVar's, a kind of synchronised
166 mutable variable (see "Control.Concurrent.MVar"). Several common
167 concurrency abstractions can be built from 'MVar's, and these are
168 provided by the "Control.Concurrent" library.
169 In GHC, threads may also communicate via exceptions.
170 -}
171
172 {- $conc_scheduling
173
174 Scheduling may be either pre-emptive or co-operative,
175 depending on the implementation of Concurrent Haskell (see below
176 for information related to specific compilers). In a co-operative
177 system, context switches only occur when you use one of the
178 primitives defined in this module. This means that programs such
179 as:
180
181
182 > main = forkIO (write 'a') >> write 'b'
183 > where write c = putChar c >> write c
184
185 will print either @aaaaaaaaaaaaaa...@ or @bbbbbbbbbbbb...@,
186 instead of some random interleaving of @a@s and @b@s. In
187 practice, cooperative multitasking is sufficient for writing
188 simple graphical user interfaces.
189 -}
190
191 {- $blocking
192 Different Haskell implementations have different characteristics with
193 regard to which operations block /all/ threads.
194
195 Using GHC without the @-threaded@ option, all foreign calls will block
196 all other Haskell threads in the system, although I\/O operations will
197 not. With the @-threaded@ option, only foreign calls with the @unsafe@
198 attribute will block all other threads.
199
200 Using Hugs, all I\/O operations and foreign calls will block all other
201 Haskell threads.
202 -}
203
204 #ifndef __HUGS__
205 max_buff_size :: Int
206 max_buff_size = 1
207
208 mergeIO :: [a] -> [a] -> IO [a]
209 nmergeIO :: [[a]] -> IO [a]
210
211 -- $merge
212 -- The 'mergeIO' and 'nmergeIO' functions fork one thread for each
213 -- input list that concurrently evaluates that list; the results are
214 -- merged into a single output list.
215 --
216 -- Note: Hugs does not provide these functions, since they require
217 -- preemptive multitasking.
218
219 mergeIO ls rs
220 = newEmptyMVar >>= \ tail_node ->
221 newMVar tail_node >>= \ tail_list ->
222 newQSem max_buff_size >>= \ e ->
223 newMVar 2 >>= \ branches_running ->
224 let
225 buff = (tail_list,e)
226 in
227 forkIO (suckIO branches_running buff ls) >>
228 forkIO (suckIO branches_running buff rs) >>
229 takeMVar tail_node >>= \ val ->
230 signalQSem e >>
231 return val
232
233 type Buffer a
234 = (MVar (MVar [a]), QSem)
235
236 suckIO :: MVar Int -> Buffer a -> [a] -> IO ()
237
238 suckIO branches_running buff@(tail_list,e) vs
239 = case vs of
240 [] -> takeMVar branches_running >>= \ val ->
241 if val == 1 then
242 takeMVar tail_list >>= \ node ->
243 putMVar node [] >>
244 putMVar tail_list node
245 else
246 putMVar branches_running (val-1)
247 (x:xs) ->
248 waitQSem e >>
249 takeMVar tail_list >>= \ node ->
250 newEmptyMVar >>= \ next_node ->
251 unsafeInterleaveIO (
252 takeMVar next_node >>= \ y ->
253 signalQSem e >>
254 return y) >>= \ next_node_val ->
255 putMVar node (x:next_node_val) >>
256 putMVar tail_list next_node >>
257 suckIO branches_running buff xs
258
259 nmergeIO lss
260 = let
261 len = length lss
262 in
263 newEmptyMVar >>= \ tail_node ->
264 newMVar tail_node >>= \ tail_list ->
265 newQSem max_buff_size >>= \ e ->
266 newMVar len >>= \ branches_running ->
267 let
268 buff = (tail_list,e)
269 in
270 mapIO (\ x -> forkIO (suckIO branches_running buff x)) lss >>
271 takeMVar tail_node >>= \ val ->
272 signalQSem e >>
273 return val
274 where
275 mapIO f xs = sequence (map f xs)
276 #endif /* __HUGS__ */
277
278 #ifdef __GLASGOW_HASKELL__
279 -- ---------------------------------------------------------------------------
280 -- Bound Threads
281
282 {- $boundthreads
283 #boundthreads#
284
285 Support for multiple operating system threads and bound threads as described
286 below is currently only available in the GHC runtime system if you use the
287 /-threaded/ option when linking.
288
289 Other Haskell systems do not currently support multiple operating system threads.
290
291 A bound thread is a haskell thread that is /bound/ to an operating system
292 thread. While the bound thread is still scheduled by the Haskell run-time
293 system, the operating system thread takes care of all the foreign calls made
294 by the bound thread.
295
296 To a foreign library, the bound thread will look exactly like an ordinary
297 operating system thread created using OS functions like @pthread_create@
298 or @CreateThread@.
299
300 Bound threads can be created using the 'forkOS' function below. All foreign
301 exported functions are run in a bound thread (bound to the OS thread that
302 called the function). Also, the @main@ action of every Haskell program is
303 run in a bound thread.
304
305 Why do we need this? Because if a foreign library is called from a thread
306 created using 'forkIO', it won't have access to any /thread-local state/ -
307 state variables that have specific values for each OS thread
308 (see POSIX's @pthread_key_create@ or Win32's @TlsAlloc@). Therefore, some
309 libraries (OpenGL, for example) will not work from a thread created using
310 'forkIO'. They work fine in threads created using 'forkOS' or when called
311 from @main@ or from a @foreign export@.
312
313 In terms of performance, 'forkOS' (aka bound) threads are much more
314 expensive than 'forkIO' (aka unbound) threads, because a 'forkOS'
315 thread is tied to a particular OS thread, whereas a 'forkIO' thread
316 can be run by any OS thread. Context-switching between a 'forkOS'
317 thread and a 'forkIO' thread is many times more expensive than between
318 two 'forkIO' threads.
319
320 Note in particular that the main program thread (the thread running
321 @Main.main@) is always a bound thread, so for good concurrency
322 performance you should ensure that the main thread is not doing
323 repeated communication with other threads in the system. Typically
324 this means forking subthreads to do the work using 'forkIO', and
325 waiting for the results in the main thread.
326
327 -}
328
329 -- | 'True' if bound threads are supported.
330 -- If @rtsSupportsBoundThreads@ is 'False', 'isCurrentThreadBound'
331 -- will always return 'False' and both 'forkOS' and 'runInBoundThread' will
332 -- fail.
333 foreign import ccall rtsSupportsBoundThreads :: Bool
334
335
336 {- |
337 Like 'forkIO', this sparks off a new thread to run the 'IO'
338 computation passed as the first argument, and returns the 'ThreadId'
339 of the newly created thread.
340
341 However, 'forkOS' creates a /bound/ thread, which is necessary if you
342 need to call foreign (non-Haskell) libraries that make use of
343 thread-local state, such as OpenGL (see "Control.Concurrent#boundthreads").
344
345 Using 'forkOS' instead of 'forkIO' makes no difference at all to the
346 scheduling behaviour of the Haskell runtime system. It is a common
347 misconception that you need to use 'forkOS' instead of 'forkIO' to
348 avoid blocking all the Haskell threads when making a foreign call;
349 this isn't the case. To allow foreign calls to be made without
350 blocking all the Haskell threads (with GHC), it is only necessary to
351 use the @-threaded@ option when linking your program, and to make sure
352 the foreign import is not marked @unsafe@.
353 -}
354
355 forkOS :: IO () -> IO ThreadId
356
357 foreign export ccall forkOS_entry
358 :: StablePtr (IO ()) -> IO ()
359
360 foreign import ccall "forkOS_entry" forkOS_entry_reimported
361 :: StablePtr (IO ()) -> IO ()
362
363 forkOS_entry :: StablePtr (IO ()) -> IO ()
364 forkOS_entry stableAction = do
365 action <- deRefStablePtr stableAction
366 action
367
368 foreign import ccall forkOS_createThread
369 :: StablePtr (IO ()) -> IO CInt
370
371 failNonThreaded :: IO a
372 failNonThreaded = fail $ "RTS doesn't support multiple OS threads "
373 ++"(use ghc -threaded when linking)"
374
375 forkOS action0
376 | rtsSupportsBoundThreads = do
377 mv <- newEmptyMVar
378 b <- Exception.getMaskingState
379 let
380 -- async exceptions are masked in the child if they are masked
381 -- in the parent, as for forkIO (see #1048). forkOS_createThread
382 -- creates a thread with exceptions masked by default.
383 action1 = case b of
384 Unmasked -> unsafeUnmask action0
385 MaskedInterruptible -> action0
386 MaskedUninterruptible -> uninterruptibleMask_ action0
387
388 action_plus = Exception.catch action1 childHandler
389
390 entry <- newStablePtr (myThreadId >>= putMVar mv >> action_plus)
391 err <- forkOS_createThread entry
392 when (err /= 0) $ fail "Cannot create OS thread."
393 tid <- takeMVar mv
394 freeStablePtr entry
395 return tid
396 | otherwise = failNonThreaded
397
398 -- | Returns 'True' if the calling thread is /bound/, that is, if it is
399 -- safe to use foreign libraries that rely on thread-local state from the
400 -- calling thread.
401 isCurrentThreadBound :: IO Bool
402 isCurrentThreadBound = IO $ \ s# ->
403 case isCurrentThreadBound# s# of
404 (# s2#, flg #) -> (# s2#, not (flg ==# 0#) #)
405
406
407 {- |
408 Run the 'IO' computation passed as the first argument. If the calling thread
409 is not /bound/, a bound thread is created temporarily. @runInBoundThread@
410 doesn't finish until the 'IO' computation finishes.
411
412 You can wrap a series of foreign function calls that rely on thread-local state
413 with @runInBoundThread@ so that you can use them without knowing whether the
414 current thread is /bound/.
415 -}
416 runInBoundThread :: IO a -> IO a
417
418 runInBoundThread action
419 | rtsSupportsBoundThreads = do
420 bound <- isCurrentThreadBound
421 if bound
422 then action
423 else do
424 ref <- newIORef undefined
425 let action_plus = Exception.try action >>= writeIORef ref
426 bracket (newStablePtr action_plus)
427 freeStablePtr
428 (\cEntry -> forkOS_entry_reimported cEntry >> readIORef ref) >>=
429 unsafeResult
430 | otherwise = failNonThreaded
431
432 {- |
433 Run the 'IO' computation passed as the first argument. If the calling thread
434 is /bound/, an unbound thread is created temporarily using 'forkIO'.
435 @runInBoundThread@ doesn't finish until the 'IO' computation finishes.
436
437 Use this function /only/ in the rare case that you have actually observed a
438 performance loss due to the use of bound threads. A program that
439 doesn't need it's main thread to be bound and makes /heavy/ use of concurrency
440 (e.g. a web server), might want to wrap it's @main@ action in
441 @runInUnboundThread@.
442
443 Note that exceptions which are thrown to the current thread are thrown in turn
444 to the thread that is executing the given computation. This ensures there's
445 always a way of killing the forked thread.
446 -}
447 runInUnboundThread :: IO a -> IO a
448
449 runInUnboundThread action = do
450 bound <- isCurrentThreadBound
451 if bound
452 then do
453 mv <- newEmptyMVar
454 mask $ \restore -> do
455 tid <- forkIO $ Exception.try (restore action) >>= putMVar mv
456 let wait = takeMVar mv `Exception.catch` \(e :: SomeException) ->
457 Exception.throwTo tid e >> wait
458 wait >>= unsafeResult
459 else action
460
461 unsafeResult :: Either SomeException a -> IO a
462 unsafeResult = either Exception.throwIO return
463 #endif /* __GLASGOW_HASKELL__ */
464
465 #ifdef __GLASGOW_HASKELL__
466 -- ---------------------------------------------------------------------------
467 -- threadWaitRead/threadWaitWrite
468
469 -- | Block the current thread until data is available to read on the
470 -- given file descriptor (GHC only).
471 --
472 -- This will throw an 'IOError' if the file descriptor was closed
473 -- while this thread was blocked. To safely close a file descriptor
474 -- that has been used with 'threadWaitRead', use
475 -- 'GHC.Conc.closeFdWith'.
476 threadWaitRead :: Fd -> IO ()
477 threadWaitRead fd
478 #ifdef mingw32_HOST_OS
479 -- we have no IO manager implementing threadWaitRead on Windows.
480 -- fdReady does the right thing, but we have to call it in a
481 -- separate thread, otherwise threadWaitRead won't be interruptible,
482 -- and this only works with -threaded.
483 | threaded = withThread (waitFd fd 0)
484 | otherwise = case fd of
485 0 -> do _ <- hWaitForInput stdin (-1)
486 return ()
487 -- hWaitForInput does work properly, but we can only
488 -- do this for stdin since we know its FD.
489 _ -> error "threadWaitRead requires -threaded on Windows, or use System.IO.hWaitForInput"
490 #else
491 = GHC.Conc.threadWaitRead fd
492 #endif
493
494 -- | Block the current thread until data can be written to the
495 -- given file descriptor (GHC only).
496 --
497 -- This will throw an 'IOError' if the file descriptor was closed
498 -- while this thread was blocked. To safely close a file descriptor
499 -- that has been used with 'threadWaitWrite', use
500 -- 'GHC.Conc.closeFdWith'.
501 threadWaitWrite :: Fd -> IO ()
502 threadWaitWrite fd
503 #ifdef mingw32_HOST_OS
504 | threaded = withThread (waitFd fd 1)
505 | otherwise = error "threadWaitWrite requires -threaded on Windows"
506 #else
507 = GHC.Conc.threadWaitWrite fd
508 #endif
509
510 #ifdef mingw32_HOST_OS
511 foreign import ccall unsafe "rtsSupportsBoundThreads" threaded :: Bool
512
513 withThread :: IO a -> IO a
514 withThread io = do
515 m <- newEmptyMVar
516 _ <- mask_ $ forkIO $ try io >>= putMVar m
517 x <- takeMVar m
518 case x of
519 Right a -> return a
520 Left e -> throwIO (e :: IOException)
521
522 waitFd :: Fd -> CInt -> IO ()
523 waitFd fd write = do
524 throwErrnoIfMinus1_ "fdReady" $
525 fdReady (fromIntegral fd) write iNFINITE 0
526
527 iNFINITE :: CInt
528 iNFINITE = 0xFFFFFFFF -- urgh
529
530 foreign import ccall safe "fdReady"
531 fdReady :: CInt -> CInt -> CInt -> CInt -> IO CInt
532 #endif
533
534 -- ---------------------------------------------------------------------------
535 -- More docs
536
537 {- $osthreads
538
539 #osthreads# In GHC, threads created by 'forkIO' are lightweight threads, and
540 are managed entirely by the GHC runtime. Typically Haskell
541 threads are an order of magnitude or two more efficient (in
542 terms of both time and space) than operating system threads.
543
544 The downside of having lightweight threads is that only one can
545 run at a time, so if one thread blocks in a foreign call, for
546 example, the other threads cannot continue. The GHC runtime
547 works around this by making use of full OS threads where
548 necessary. When the program is built with the @-threaded@
549 option (to link against the multithreaded version of the
550 runtime), a thread making a @safe@ foreign call will not block
551 the other threads in the system; another OS thread will take
552 over running Haskell threads until the original call returns.
553 The runtime maintains a pool of these /worker/ threads so that
554 multiple Haskell threads can be involved in external calls
555 simultaneously.
556
557 The "System.IO" library manages multiplexing in its own way. On
558 Windows systems it uses @safe@ foreign calls to ensure that
559 threads doing I\/O operations don't block the whole runtime,
560 whereas on Unix systems all the currently blocked I\/O requests
561 are managed by a single thread (the /IO manager thread/) using
562 @select@.
563
564 The runtime will run a Haskell thread using any of the available
565 worker OS threads. If you need control over which particular OS
566 thread is used to run a given Haskell thread, perhaps because
567 you need to call a foreign library that uses OS-thread-local
568 state, then you need bound threads (see "Control.Concurrent#boundthreads").
569
570 If you don't use the @-threaded@ option, then the runtime does
571 not make use of multiple OS threads. Foreign calls will block
572 all other running Haskell threads until the call returns. The
573 "System.IO" library still does multiplexing, so there can be multiple
574 threads doing I\/O, and this is handled internally by the runtime using
575 @select@.
576 -}
577
578 {- $termination
579
580 In a standalone GHC program, only the main thread is
581 required to terminate in order for the process to terminate.
582 Thus all other forked threads will simply terminate at the same
583 time as the main thread (the terminology for this kind of
584 behaviour is \"daemonic threads\").
585
586 If you want the program to wait for child threads to
587 finish before exiting, you need to program this yourself. A
588 simple mechanism is to have each child thread write to an
589 'MVar' when it completes, and have the main
590 thread wait on all the 'MVar's before
591 exiting:
592
593 > myForkIO :: IO () -> IO (MVar ())
594 > myForkIO io = do
595 > mvar <- newEmptyMVar
596 > forkIO (io `finally` putMVar mvar ())
597 > return mvar
598
599 Note that we use 'finally' from the
600 "Control.Exception" module to make sure that the
601 'MVar' is written to even if the thread dies or
602 is killed for some reason.
603
604 A better method is to keep a global list of all child
605 threads which we should wait for at the end of the program:
606
607 > children :: MVar [MVar ()]
608 > children = unsafePerformIO (newMVar [])
609 >
610 > waitForChildren :: IO ()
611 > waitForChildren = do
612 > cs <- takeMVar children
613 > case cs of
614 > [] -> return ()
615 > m:ms -> do
616 > putMVar children ms
617 > takeMVar m
618 > waitForChildren
619 >
620 > forkChild :: IO () -> IO ThreadId
621 > forkChild io = do
622 > mvar <- newEmptyMVar
623 > childs <- takeMVar children
624 > putMVar children (mvar:childs)
625 > forkIO (io `finally` putMVar mvar ())
626 >
627 > main =
628 > later waitForChildren $
629 > ...
630
631 The main thread principle also applies to calls to Haskell from
632 outside, using @foreign export@. When the @foreign export@ed
633 function is invoked, it starts a new main thread, and it returns
634 when this main thread terminates. If the call causes new
635 threads to be forked, they may remain in the system after the
636 @foreign export@ed function has returned.
637 -}
638
639 {- $preemption
640
641 GHC implements pre-emptive multitasking: the execution of
642 threads are interleaved in a random fashion. More specifically,
643 a thread may be pre-empted whenever it allocates some memory,
644 which unfortunately means that tight loops which do no
645 allocation tend to lock out other threads (this only seems to
646 happen with pathological benchmark-style code, however).
647
648 The rescheduling timer runs on a 20ms granularity by
649 default, but this may be altered using the
650 @-i\<n\>@ RTS option. After a rescheduling
651 \"tick\" the running thread is pre-empted as soon as
652 possible.
653
654 One final note: the
655 @aaaa@ @bbbb@ example may not
656 work too well on GHC (see Scheduling, above), due
657 to the locking on a 'System.IO.Handle'. Only one thread
658 may hold the lock on a 'System.IO.Handle' at any one
659 time, so if a reschedule happens while a thread is holding the
660 lock, the other thread won't be able to run. The upshot is that
661 the switch from @aaaa@ to
662 @bbbbb@ happens infrequently. It can be
663 improved by lowering the reschedule tick period. We also have a
664 patch that causes a reschedule whenever a thread waiting on a
665 lock is woken up, but haven't found it to be useful for anything
666 other than this example :-)
667 -}
668 #endif /* __GLASGOW_HASKELL__ */