change unsafeDupableInterleaveIO from INLINE to NOINLINE (#5943)
[ghc.git] / libraries / base / GHC / IO.hs
1 {-# LANGUAGE Unsafe #-}
2 {-# LANGUAGE NoImplicitPrelude
3 , BangPatterns
4 , RankNTypes
5 , MagicHash
6 , UnboxedTuples
7 #-}
8 {-# OPTIONS_GHC -funbox-strict-fields #-}
9 {-# OPTIONS_HADDOCK hide #-}
10
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : GHC.IO
14 -- Copyright : (c) The University of Glasgow 1994-2002
15 -- License : see libraries/base/LICENSE
16 --
17 -- Maintainer : cvs-ghc@haskell.org
18 -- Stability : internal
19 -- Portability : non-portable (GHC Extensions)
20 --
21 -- Definitions for the 'IO' monad and its friends.
22 --
23 -----------------------------------------------------------------------------
24
25 -- #hide
26 module GHC.IO (
27 IO(..), unIO, failIO, liftIO,
28 unsafePerformIO, unsafeInterleaveIO,
29 unsafeDupablePerformIO, unsafeDupableInterleaveIO,
30 noDuplicate,
31
32 -- To and from from ST
33 stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
34
35 FilePath,
36
37 catchException, catchAny, throwIO,
38 mask, mask_, uninterruptibleMask, uninterruptibleMask_,
39 MaskingState(..), getMaskingState,
40 block, unblock, blocked, unsafeUnmask,
41 onException, bracket, finally, evaluate
42 ) where
43
44 import GHC.Base
45 import GHC.ST
46 import GHC.Exception
47 import GHC.Show
48 import Data.Maybe
49
50 import {-# SOURCE #-} GHC.IO.Exception ( userError )
51
52 -- ---------------------------------------------------------------------------
53 -- The IO Monad
54
55 {-
56 The IO Monad is just an instance of the ST monad, where the state is
57 the real world. We use the exception mechanism (in GHC.Exception) to
58 implement IO exceptions.
59
60 NOTE: The IO representation is deeply wired in to various parts of the
61 system. The following list may or may not be exhaustive:
62
63 Compiler - types of various primitives in PrimOp.lhs
64
65 RTS - forceIO (StgMiscClosures.hc)
66 - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
67 (Exceptions.hc)
68 - raiseAsync (Schedule.c)
69
70 Prelude - GHC.IO.lhs, and several other places including
71 GHC.Exception.lhs.
72
73 Libraries - parts of hslibs/lang.
74
75 --SDM
76 -}
77
78 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
79 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
80
81 failIO :: String -> IO a
82 failIO s = IO (raiseIO# (toException (userError s)))
83
84 -- ---------------------------------------------------------------------------
85 -- Coercions between IO and ST
86
87 -- | A monad transformer embedding strict state transformers in the 'IO'
88 -- monad. The 'RealWorld' parameter indicates that the internal state
89 -- used by the 'ST' computation is a special one supplied by the 'IO'
90 -- monad, and thus distinct from those used by invocations of 'runST'.
91 stToIO :: ST RealWorld a -> IO a
92 stToIO (ST m) = IO m
93
94 ioToST :: IO a -> ST RealWorld a
95 ioToST (IO m) = (ST m)
96
97 -- This relies on IO and ST having the same representation modulo the
98 -- constraint on the type of the state
99 --
100 unsafeIOToST :: IO a -> ST s a
101 unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s
102
103 unsafeSTToIO :: ST s a -> IO a
104 unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
105
106 -- ---------------------------------------------------------------------------
107 -- Unsafe IO operations
108
109 {-|
110 This is the \"back door\" into the 'IO' monad, allowing
111 'IO' computation to be performed at any time. For
112 this to be safe, the 'IO' computation should be
113 free of side effects and independent of its environment.
114
115 If the I\/O computation wrapped in 'unsafePerformIO' performs side
116 effects, then the relative order in which those side effects take
117 place (relative to the main I\/O trunk, or other calls to
118 'unsafePerformIO') is indeterminate. Furthermore, when using
119 'unsafePerformIO' to cause side-effects, you should take the following
120 precautions to ensure the side effects are performed as many times as
121 you expect them to be. Note that these precautions are necessary for
122 GHC, but may not be sufficient, and other compilers may require
123 different precautions:
124
125 * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
126 that calls 'unsafePerformIO'. If the call is inlined,
127 the I\/O may be performed more than once.
128
129 * Use the compiler flag @-fno-cse@ to prevent common sub-expression
130 elimination being performed on the module, which might combine
131 two side effects that were meant to be separate. A good example
132 is using multiple global variables (like @test@ in the example below).
133
134 * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the
135 call to 'unsafePerformIO' cannot float outside a lambda. For example,
136 if you say:
137 @
138 f x = unsafePerformIO (newIORef [])
139 @
140 you may get only one reference cell shared between all calls to @f@.
141 Better would be
142 @
143 f x = unsafePerformIO (newIORef [x])
144 @
145 because now it can't float outside the lambda.
146
147 It is less well known that
148 'unsafePerformIO' is not type safe. For example:
149
150 > test :: IORef [a]
151 > test = unsafePerformIO $ newIORef []
152 >
153 > main = do
154 > writeIORef test [42]
155 > bang <- readIORef test
156 > print (bang :: [Char])
157
158 This program will core dump. This problem with polymorphic references
159 is well known in the ML community, and does not arise with normal
160 monadic use of references. There is no easy way to make it impossible
161 once you use 'unsafePerformIO'. Indeed, it is
162 possible to write @coerce :: a -> b@ with the
163 help of 'unsafePerformIO'. So be careful!
164 -}
165 unsafePerformIO :: IO a -> a
166 unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
167
168 {-|
169 This version of 'unsafePerformIO' is more efficient
170 because it omits the check that the IO is only being performed by a
171 single thread. Hence, when you use 'unsafeDupablePerformIO',
172 there is a possibility that the IO action may be performed multiple
173 times (on a multiprocessor), and you should therefore ensure that
174 it gives the same results each time.
175 -}
176 {-# NOINLINE unsafeDupablePerformIO #-}
177 unsafeDupablePerformIO :: IO a -> a
178 unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
179
180 -- Why do we NOINLINE unsafeDupablePerformIO? See the comment with
181 -- GHC.ST.runST. Essentially the issue is that the IO computation
182 -- inside unsafePerformIO must be atomic: it must either all run, or
183 -- not at all. If we let the compiler see the application of the IO
184 -- to realWorld#, it might float out part of the IO.
185
186 -- Why is there a call to 'lazy' in unsafeDupablePerformIO?
187 -- If we don't have it, the demand analyser discovers the following strictness
188 -- for unsafeDupablePerformIO: C(U(AV))
189 -- But then consider
190 -- unsafeDupablePerformIO (\s -> let r = f x in
191 -- case writeIORef v r s of (# s1, _ #) ->
192 -- (# s1, r #)
193 -- The strictness analyser will find that the binding for r is strict,
194 -- (becuase of uPIO's strictness sig), and so it'll evaluate it before
195 -- doing the writeIORef. This actually makes tests/lib/should_run/memo002
196 -- get a deadlock!
197 --
198 -- Solution: don't expose the strictness of unsafeDupablePerformIO,
199 -- by hiding it with 'lazy'
200
201 {-|
202 'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
203 When passed a value of type @IO a@, the 'IO' will only be performed
204 when the value of the @a@ is demanded. This is used to implement lazy
205 file reading, see 'System.IO.hGetContents'.
206 -}
207 {-# INLINE unsafeInterleaveIO #-}
208 unsafeInterleaveIO :: IO a -> IO a
209 unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
210
211 -- We used to believe that INLINE on unsafeInterleaveIO was safe,
212 -- because the state from this IO thread is passed explicitly to the
213 -- interleaved IO, so it cannot be floated out and shared.
214 --
215 -- HOWEVER, if the compiler figures out that r is used strictly here,
216 -- then it will eliminate the thunk and the side effects in m will no
217 -- longer be shared in the way the programmer was probably expecting,
218 -- but can be performed many times. In #5943, this broke our
219 -- definition of fixIO, which contains
220 --
221 -- ans <- unsafeInterleaveIO (takeMVar m)
222 --
223 -- after inlining, we lose the sharing of the takeMVar, so the second
224 -- time 'ans' was demanded we got a deadlock. We could fix this with
225 -- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes
226 -- share and sometimes not (plus it probably breaks the noDuplicate).
227 -- So now, we do not inline unsafeDupableInterleaveIO.
228
229 {-# NOINLINE unsafeDupableInterleaveIO #-}
230 unsafeDupableInterleaveIO :: IO a -> IO a
231 unsafeDupableInterleaveIO (IO m)
232 = IO ( \ s -> let
233 r = case m s of (# _, res #) -> res
234 in
235 (# s, r #))
236
237 {-|
238 Ensures that the suspensions under evaluation by the current thread
239 are unique; that is, the current thread is not evaluating anything
240 that is also under evaluation by another thread that has also executed
241 'noDuplicate'.
242
243 This operation is used in the definition of 'unsafePerformIO' to
244 prevent the IO action from being executed multiple times, which is usually
245 undesirable.
246 -}
247 noDuplicate :: IO ()
248 noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
249
250 -- -----------------------------------------------------------------------------
251 -- | File and directory names are values of type 'String', whose precise
252 -- meaning is operating system dependent. Files can be opened, yielding a
253 -- handle which can then be used to operate on the contents of that file.
254
255 type FilePath = String
256
257 -- -----------------------------------------------------------------------------
258 -- Primitive catch and throwIO
259
260 {-
261 catchException used to handle the passing around of the state to the
262 action and the handler. This turned out to be a bad idea - it meant
263 that we had to wrap both arguments in thunks so they could be entered
264 as normal (remember IO returns an unboxed pair...).
265
266 Now catch# has type
267
268 catch# :: IO a -> (b -> IO a) -> IO a
269
270 (well almost; the compiler doesn't know about the IO newtype so we
271 have to work around that in the definition of catchException below).
272 -}
273
274 catchException :: Exception e => IO a -> (e -> IO a) -> IO a
275 catchException (IO io) handler = IO $ catch# io handler'
276 where handler' e = case fromException e of
277 Just e' -> unIO (handler e')
278 Nothing -> raiseIO# e
279
280 catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
281 catchAny (IO io) handler = IO $ catch# io handler'
282 where handler' (SomeException e) = unIO (handler e)
283
284 -- | A variant of 'throw' that can only be used within the 'IO' monad.
285 --
286 -- Although 'throwIO' has a type that is an instance of the type of 'throw', the
287 -- two functions are subtly different:
288 --
289 -- > throw e `seq` x ===> throw e
290 -- > throwIO e `seq` x ===> x
291 --
292 -- The first example will cause the exception @e@ to be raised,
293 -- whereas the second one won\'t. In fact, 'throwIO' will only cause
294 -- an exception to be raised when it is used within the 'IO' monad.
295 -- The 'throwIO' variant should be used in preference to 'throw' to
296 -- raise an exception within the 'IO' monad because it guarantees
297 -- ordering with respect to other 'IO' operations, whereas 'throw'
298 -- does not.
299 throwIO :: Exception e => e -> IO a
300 throwIO e = IO (raiseIO# (toException e))
301
302 -- -----------------------------------------------------------------------------
303 -- Controlling asynchronous exception delivery
304
305 {-# DEPRECATED block "use Control.Exception.mask instead" #-}
306 -- | Note: this function is deprecated, please use 'mask' instead.
307 --
308 -- Applying 'block' to a computation will
309 -- execute that computation with asynchronous exceptions
310 -- /blocked/. That is, any thread which
311 -- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
312 -- blocked until asynchronous exceptions are unblocked again. There\'s
313 -- no need to worry about re-enabling asynchronous exceptions; that is
314 -- done automatically on exiting the scope of
315 -- 'block'.
316 --
317 -- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
318 -- state from the parent; that is, to start a thread in blocked mode,
319 -- use @block $ forkIO ...@. This is particularly useful if you need to
320 -- establish an exception handler in the forked thread before any
321 -- asynchronous exceptions are received.
322 block :: IO a -> IO a
323 block (IO io) = IO $ maskAsyncExceptions# io
324
325 {-# DEPRECATED unblock "use Control.Exception.mask instead" #-}
326 -- | Note: this function is deprecated, please use 'mask' instead.
327 --
328 -- To re-enable asynchronous exceptions inside the scope of
329 -- 'block', 'unblock' can be
330 -- used. It scopes in exactly the same way, so on exit from
331 -- 'unblock' asynchronous exception delivery will
332 -- be disabled again.
333 unblock :: IO a -> IO a
334 unblock = unsafeUnmask
335
336 unsafeUnmask :: IO a -> IO a
337 unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io
338
339 blockUninterruptible :: IO a -> IO a
340 blockUninterruptible (IO io) = IO $ maskUninterruptible# io
341
342 -- | Describes the behaviour of a thread when an asynchronous
343 -- exception is received.
344 data MaskingState
345 = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
346 | MaskedInterruptible
347 -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
348 | MaskedUninterruptible
349 -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
350 deriving (Eq,Show)
351
352 -- | Returns the 'MaskingState' for the current thread.
353 getMaskingState :: IO MaskingState
354 getMaskingState = IO $ \s ->
355 case getMaskingState# s of
356 (# s', i #) -> (# s', case i of
357 0# -> Unmasked
358 1# -> MaskedUninterruptible
359 _ -> MaskedInterruptible #)
360
361 {-# DEPRECATED blocked "use Control.Exception.getMaskingState instead" #-}
362 -- | returns True if asynchronous exceptions are blocked in the
363 -- current thread.
364 blocked :: IO Bool
365 blocked = fmap (/= Unmasked) getMaskingState
366
367 onException :: IO a -> IO b -> IO a
368 onException io what = io `catchException` \e -> do _ <- what
369 throwIO (e :: SomeException)
370
371 -- | Executes an IO computation with asynchronous
372 -- exceptions /masked/. That is, any thread which attempts to raise
373 -- an exception in the current thread with 'Control.Exception.throwTo'
374 -- will be blocked until asynchronous exceptions are unmasked again.
375 --
376 -- The argument passed to 'mask' is a function that takes as its
377 -- argument another function, which can be used to restore the
378 -- prevailing masking state within the context of the masked
379 -- computation. For example, a common way to use 'mask' is to protect
380 -- the acquisition of a resource:
381 --
382 -- > mask $ \restore -> do
383 -- > x <- acquire
384 -- > restore (do_something_with x) `onException` release
385 -- > release
386 --
387 -- This code guarantees that @acquire@ is paired with @release@, by masking
388 -- asynchronous exceptions for the critical parts. (Rather than write
389 -- this code yourself, it would be better to use
390 -- 'Control.Exception.bracket' which abstracts the general pattern).
391 --
392 -- Note that the @restore@ action passed to the argument to 'mask'
393 -- does not necessarily unmask asynchronous exceptions, it just
394 -- restores the masking state to that of the enclosing context. Thus
395 -- if asynchronous exceptions are already masked, 'mask' cannot be used
396 -- to unmask exceptions again. This is so that if you call a library function
397 -- with exceptions masked, you can be sure that the library call will not be
398 -- able to unmask exceptions again. If you are writing library code and need
399 -- to use asynchronous exceptions, the only way is to create a new thread;
400 -- see 'Control.Concurrent.forkIOWithUnmask'.
401 --
402 -- Asynchronous exceptions may still be received while in the masked
403 -- state if the masked thread /blocks/ in certain ways; see
404 -- "Control.Exception#interruptible".
405 --
406 -- Threads created by 'Control.Concurrent.forkIO' inherit the masked
407 -- state from the parent; that is, to start a thread in blocked mode,
408 -- use @mask_ $ forkIO ...@. This is particularly useful if you need
409 -- to establish an exception handler in the forked thread before any
410 -- asynchronous exceptions are received. To create a a new thread in
411 -- an unmasked state use 'Control.Concurrent.forkIOUnmasked'.
412 --
413 mask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
414
415 -- | Like 'mask', but does not pass a @restore@ action to the argument.
416 mask_ :: IO a -> IO a
417
418 -- | Like 'mask', but the masked computation is not interruptible (see
419 -- "Control.Exception#interruptible"). THIS SHOULD BE USED WITH
420 -- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
421 -- blocks for any reason, then the thread (and possibly the program,
422 -- if this is the main thread) will be unresponsive and unkillable.
423 -- This function should only be necessary if you need to mask
424 -- exceptions around an interruptible operation, and you can guarantee
425 -- that the interruptible operation will only block for a short period
426 -- of time.
427 --
428 uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b
429
430 -- | Like 'uninterruptibleMask', but does not pass a @restore@ action
431 -- to the argument.
432 uninterruptibleMask_ :: IO a -> IO a
433
434 mask_ io = mask $ \_ -> io
435
436 mask io = do
437 b <- getMaskingState
438 case b of
439 Unmasked -> block $ io unblock
440 _ -> io id
441
442 uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io
443
444 uninterruptibleMask io = do
445 b <- getMaskingState
446 case b of
447 Unmasked -> blockUninterruptible $ io unblock
448 MaskedInterruptible -> blockUninterruptible $ io block
449 MaskedUninterruptible -> io id
450
451 bracket
452 :: IO a -- ^ computation to run first (\"acquire resource\")
453 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
454 -> (a -> IO c) -- ^ computation to run in-between
455 -> IO c -- returns the value from the in-between computation
456 bracket before after thing =
457 mask $ \restore -> do
458 a <- before
459 r <- restore (thing a) `onException` after a
460 _ <- after a
461 return r
462
463 finally :: IO a -- ^ computation to run first
464 -> IO b -- ^ computation to run afterward (even if an exception
465 -- was raised)
466 -> IO a -- returns the value from the first computation
467 a `finally` sequel =
468 mask $ \restore -> do
469 r <- restore a `onException` sequel
470 _ <- sequel
471 return r
472
473 -- | Forces its argument to be evaluated to weak head normal form when
474 -- the resultant 'IO' action is executed. It can be used to order
475 -- evaluation with respect to other 'IO' operations; its semantics are
476 -- given by
477 --
478 -- > evaluate x `seq` y ==> y
479 -- > evaluate x `catch` f ==> (return $! x) `catch` f
480 -- > evaluate x >>= f ==> (return $! x) >>= f
481 --
482 -- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the
483 -- same as @(return $! x)@. A correct definition is
484 --
485 -- > evaluate x = (return $! x) >>= return
486 --
487 evaluate :: a -> IO a
488 evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129
489