IO.hs 20.4 KB
Newer Older
1
{-# LANGUAGE Unsafe #-}
2 3 4 5 6 7
{-# LANGUAGE NoImplicitPrelude
           , BangPatterns
           , RankNTypes
           , MagicHash
           , UnboxedTuples
  #-}
8
{-# OPTIONS_GHC -funbox-strict-fields #-}
9
{-# OPTIONS_HADDOCK hide #-}
dterei's avatar
dterei committed
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
module GHC.IO (
26 27 28 29
        IO(..), unIO, failIO, liftIO,
        unsafePerformIO, unsafeInterleaveIO,
        unsafeDupablePerformIO, unsafeDupableInterleaveIO,
        noDuplicate,
30 31

        -- To and from from ST
32
        stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
33

34
        FilePath,
35

36
        catchException, catchAny, throwIO,
37
        mask, mask_, uninterruptibleMask, uninterruptibleMask_,
38
        MaskingState(..), getMaskingState,
39
        unsafeUnmask, interruptible,
40 41
        onException, bracket, finally, evaluate
    ) where
42 43

import GHC.Base
44 45
import GHC.ST
import GHC.Exception
46
import GHC.Show
47

48
import {-# SOURCE #-} GHC.IO.Exception ( userError )
49

50
-- ---------------------------------------------------------------------------
51
-- The IO Monad
52

53 54 55 56
{-
The IO Monad is just an instance of the ST monad, where the state is
the real world.  We use the exception mechanism (in GHC.Exception) to
implement IO exceptions.
57

58 59
NOTE: The IO representation is deeply wired in to various parts of the
system.  The following list may or may not be exhaustive:
60

61
Compiler  - types of various primitives in PrimOp.lhs
62

63
RTS       - forceIO (StgMiscClosures.hc)
64
          - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
65 66
            (Exceptions.hc)
          - raiseAsync (Schedule.c)
67

68 69
Prelude   - GHC.IO.lhs, and several other places including
            GHC.Exception.lhs.
70

71
Libraries - parts of hslibs/lang.
ross's avatar
ross committed
72

73 74
--SDM
-}
75

76 77 78 79 80
liftIO :: IO a -> State# RealWorld -> STret RealWorld a
liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r

failIO :: String -> IO a
failIO s = IO (raiseIO# (toException (userError s)))
81 82

-- ---------------------------------------------------------------------------
83
-- Coercions between IO and ST
84

85 86 87 88 89 90 91 92 93 94 95 96
-- | A monad transformer embedding strict state transformers in the 'IO'
-- monad.  The 'RealWorld' parameter indicates that the internal state
-- used by the 'ST' computation is a special one supplied by the 'IO'
-- monad, and thus distinct from those used by invocations of 'runST'.
stToIO        :: ST RealWorld a -> IO a
stToIO (ST m) = IO m

ioToST        :: IO a -> ST RealWorld a
ioToST (IO m) = (ST m)

-- This relies on IO and ST having the same representation modulo the
-- constraint on the type of the state
ross's avatar
ross committed
97
--
98 99 100 101 102
unsafeIOToST        :: IO a -> ST s a
unsafeIOToST (IO io) = ST $ \ s -> (unsafeCoerce# io) s

unsafeSTToIO :: ST s a -> IO a
unsafeSTToIO (ST m) = IO (unsafeCoerce# m)
103 104

-- ---------------------------------------------------------------------------
105 106 107 108 109 110 111 112
-- Unsafe IO operations

{-|
This is the \"back door\" into the 'IO' monad, allowing
'IO' computation to be performed at any time.  For
this to be safe, the 'IO' computation should be
free of side effects and independent of its environment.

113 114 115 116 117 118 119 120 121
If the I\/O computation wrapped in 'unsafePerformIO' performs side
effects, then the relative order in which those side effects take
place (relative to the main I\/O trunk, or other calls to
'unsafePerformIO') is indeterminate.  Furthermore, when using
'unsafePerformIO' to cause side-effects, you should take the following
precautions to ensure the side effects are performed as many times as
you expect them to be.  Note that these precautions are necessary for
GHC, but may not be sufficient, and other compilers may require
different precautions:
122 123 124 125 126 127 128 129 130 131

  * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
        that calls 'unsafePerformIO'.  If the call is inlined,
        the I\/O may be performed more than once.

  * Use the compiler flag @-fno-cse@ to prevent common sub-expression
        elimination being performed on the module, which might combine
        two side effects that were meant to be separate.  A good example
        is using multiple global variables (like @test@ in the example below).

132 133
  * Make sure that the either you switch off let-floating (@-fno-full-laziness@), or that the
        call to 'unsafePerformIO' cannot float outside a lambda.  For example,
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149
        if you say:
        @
           f x = unsafePerformIO (newIORef [])
        @
        you may get only one reference cell shared between all calls to @f@.
        Better would be
        @
           f x = unsafePerformIO (newIORef [x])
        @
        because now it can't float outside the lambda.

It is less well known that
'unsafePerformIO' is not type safe.  For example:

>     test :: IORef [a]
>     test = unsafePerformIO $ newIORef []
150
>
151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
>     main = do
>             writeIORef test [42]
>             bang <- readIORef test
>             print (bang :: [Char])

This program will core dump.  This problem with polymorphic references
is well known in the ML community, and does not arise with normal
monadic use of references.  There is no easy way to make it impossible
once you use 'unsafePerformIO'.  Indeed, it is
possible to write @coerce :: a -> b@ with the
help of 'unsafePerformIO'.  So be careful!
-}
unsafePerformIO :: IO a -> a
unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)

166
{-|
Simon Marlow's avatar
Simon Marlow committed
167
This version of 'unsafePerformIO' is more efficient
168
because it omits the check that the IO is only being performed by a
Simon Marlow's avatar
Simon Marlow committed
169
single thread.  Hence, when you use 'unsafeDupablePerformIO',
170 171
there is a possibility that the IO action may be performed multiple
times (on a multiprocessor), and you should therefore ensure that
172 173 174 175
it gives the same results each time. It may even happen that one
of the duplicated IO actions is only run partially, and then interrupted
in the middle without an exception being raised. Therefore, functions
like 'bracket' cannot be used safely within 'unsafeDupablePerformIO'.
176

177
@since 4.4.0.0
178 179
-}
{-# NOINLINE unsafeDupablePerformIO #-}
Simon Peyton Jones's avatar
Simon Peyton Jones committed
180
    -- See Note [unsafeDupablePerformIO is NOINLINE]
181 182
unsafeDupablePerformIO  :: IO a -> a
unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
183
     -- See Note [unsafeDupablePerformIO has a lazy RHS]
184

Simon Peyton Jones's avatar
Simon Peyton Jones committed
185 186
-- Note [unsafeDupablePerformIO is NOINLINE]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
187 188 189 190 191 192
-- Why do we NOINLINE unsafeDupablePerformIO?  See the comment with
-- GHC.ST.runST.  Essentially the issue is that the IO computation
-- inside unsafePerformIO must be atomic: it must either all run, or
-- not at all.  If we let the compiler see the application of the IO
-- to realWorld#, it might float out part of the IO.

Simon Peyton Jones's avatar
Simon Peyton Jones committed
193 194
-- Note [unsafeDupablePerformIO has a lazy RHS]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
195 196 197 198
-- Why is there a call to 'lazy' in unsafeDupablePerformIO?
-- If we don't have it, the demand analyser discovers the following strictness
-- for unsafeDupablePerformIO:  C(U(AV))
-- But then consider
Simon Peyton Jones's avatar
Simon Peyton Jones committed
199
--      unsafeDupablePerformIO (\s -> let r = f x in
200
--                             case writeIORef v r s of (# s1, _ #) ->
Simon Peyton Jones's avatar
Simon Peyton Jones committed
201
--                             (# s1, r #) )
202
-- The strictness analyser will find that the binding for r is strict,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
203 204 205 206
-- (because of uPIO's strictness sig), and so it'll evaluate it before
-- doing the writeIORef.  This actually makes libraries/base/tests/memo002
-- get a deadlock, where we specifically wanted to write a lazy thunk
-- into the ref cell.
207 208 209
--
-- Solution: don't expose the strictness of unsafeDupablePerformIO,
--           by hiding it with 'lazy'
Simon Peyton Jones's avatar
Simon Peyton Jones committed
210
-- But see discussion in Trac #9390 (comment:33)
211 212 213 214 215 216 217 218 219 220 221

{-|
'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
When passed a value of type @IO a@, the 'IO' will only be performed
when the value of the @a@ is demanded.  This is used to implement lazy
file reading, see 'System.IO.hGetContents'.
-}
{-# INLINE unsafeInterleaveIO #-}
unsafeInterleaveIO :: IO a -> IO a
unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)

222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
-- We used to believe that INLINE on unsafeInterleaveIO was safe,
-- because the state from this IO thread is passed explicitly to the
-- interleaved IO, so it cannot be floated out and shared.
--
-- HOWEVER, if the compiler figures out that r is used strictly here,
-- then it will eliminate the thunk and the side effects in m will no
-- longer be shared in the way the programmer was probably expecting,
-- but can be performed many times.  In #5943, this broke our
-- definition of fixIO, which contains
--
--    ans <- unsafeInterleaveIO (takeMVar m)
--
-- after inlining, we lose the sharing of the takeMVar, so the second
-- time 'ans' was demanded we got a deadlock.  We could fix this with
-- a readMVar, but it seems wrong for unsafeInterleaveIO to sometimes
-- share and sometimes not (plus it probably breaks the noDuplicate).
-- So now, we do not inline unsafeDupableInterleaveIO.
239

240
{-# NOINLINE unsafeDupableInterleaveIO #-}
241 242 243 244 245 246 247
unsafeDupableInterleaveIO :: IO a -> IO a
unsafeDupableInterleaveIO (IO m)
  = IO ( \ s -> let
                   r = case m s of (# _, res #) -> res
                in
                (# s, r #))

248
{-|
249 250 251 252 253 254 255 256 257 258 259
Ensures that the suspensions under evaluation by the current thread
are unique; that is, the current thread is not evaluating anything
that is also under evaluation by another thread that has also executed
'noDuplicate'.

This operation is used in the definition of 'unsafePerformIO' to
prevent the IO action from being executed multiple times, which is usually
undesirable.
-}
noDuplicate :: IO ()
noDuplicate = IO $ \s -> case noDuplicate# s of s' -> (# s', () #)
260

261 262 263 264
-- -----------------------------------------------------------------------------
-- | File and directory names are values of type 'String', whose precise
-- meaning is operating system dependent. Files can be opened, yielding a
-- handle which can then be used to operate on the contents of that file.
265

266
type FilePath = String
267 268

-- -----------------------------------------------------------------------------
269
-- Primitive catch and throwIO
270

271 272 273 274 275
{-
catchException used to handle the passing around of the state to the
action and the handler.  This turned out to be a bad idea - it meant
that we had to wrap both arguments in thunks so they could be entered
as normal (remember IO returns an unboxed pair...).
276

277
Now catch# has type
278

279
    catch# :: IO a -> (b -> IO a) -> IO a
280

281 282 283
(well almost; the compiler doesn't know about the IO newtype so we
have to work around that in the definition of catchException below).
-}
284

285 286 287 288
catchException :: Exception e => IO a -> (e -> IO a) -> IO a
catchException (IO io) handler = IO $ catch# io handler'
    where handler' e = case fromException e of
                       Just e' -> unIO (handler e')
289
                       Nothing -> raiseIO# e
290 291 292 293 294 295

catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
catchAny (IO io) handler = IO $ catch# io handler'
    where handler' (SomeException e) = unIO (handler e)

-- | A variant of 'throw' that can only be used within the 'IO' monad.
296
--
297 298
-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
-- two functions are subtly different:
299
--
300 301
-- > throw e   `seq` x  ===> throw e
-- > throwIO e `seq` x  ===> x
302
--
303 304 305 306 307 308 309 310 311
-- The first example will cause the exception @e@ to be raised,
-- whereas the second one won\'t.  In fact, 'throwIO' will only cause
-- an exception to be raised when it is used within the 'IO' monad.
-- The 'throwIO' variant should be used in preference to 'throw' to
-- raise an exception within the 'IO' monad because it guarantees
-- ordering with respect to other 'IO' operations, whereas 'throw'
-- does not.
throwIO :: Exception e => e -> IO a
throwIO e = IO (raiseIO# (toException e))
312

313 314 315
-- -----------------------------------------------------------------------------
-- Controlling asynchronous exception delivery

316
-- Applying 'block' to a computation will
317 318 319
-- execute that computation with asynchronous exceptions
-- /blocked/.  That is, any thread which
-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
320
-- blocked until asynchronous exceptions are unblocked again.  There\'s
321 322 323 324 325 326 327 328 329 330
-- no need to worry about re-enabling asynchronous exceptions; that is
-- done automatically on exiting the scope of
-- 'block'.
--
-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
-- state from the parent; that is, to start a thread in blocked mode,
-- use @block $ forkIO ...@.  This is particularly useful if you need to
-- establish an exception handler in the forked thread before any
-- asynchronous exceptions are received.
block :: IO a -> IO a
331
block (IO io) = IO $ maskAsyncExceptions# io
332

333
-- To re-enable asynchronous exceptions inside the scope of
334 335 336 337 338
-- 'block', 'unblock' can be
-- used.  It scopes in exactly the same way, so on exit from
-- 'unblock' asynchronous exception delivery will
-- be disabled again.
unblock :: IO a -> IO a
339 340 341 342 343
unblock = unsafeUnmask

unsafeUnmask :: IO a -> IO a
unsafeUnmask (IO io) = IO $ unmaskAsyncExceptions# io

344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
-- | Allow asynchronous exceptions to be raised even inside 'mask', making
-- the operation interruptible (see the discussion of "Interruptible operations"
-- in 'Control.Exception').
--
-- When called outside 'mask', or inside 'uninterruptibleMask', this
-- function has no effect.
--
-- /Since: 4.8.2.0/
interruptible :: IO a -> IO a
interruptible act = do
  st <- getMaskingState
  case st of
    Unmasked              -> act
    MaskedInterruptible   -> unsafeUnmask act
    MaskedUninterruptible -> act

360 361 362 363 364 365 366
blockUninterruptible :: IO a -> IO a
blockUninterruptible (IO io) = IO $ maskUninterruptible# io

-- | Describes the behaviour of a thread when an asynchronous
-- exception is received.
data MaskingState
  = Unmasked -- ^ asynchronous exceptions are unmasked (the normal state)
367
  | MaskedInterruptible
368 369 370 371 372 373 374
      -- ^ the state during 'mask': asynchronous exceptions are masked, but blocking operations may still be interrupted
  | MaskedUninterruptible
      -- ^ the state during 'uninterruptibleMask': asynchronous exceptions are masked, and blocking operations may not be interrupted
 deriving (Eq,Show)

-- | Returns the 'MaskingState' for the current thread.
getMaskingState :: IO MaskingState
375
getMaskingState  = IO $ \s ->
376 377 378 379 380
  case getMaskingState# s of
     (# s', i #) -> (# s', case i of
                             0# -> Unmasked
                             1# -> MaskedUninterruptible
                             _  -> MaskedInterruptible #)
381 382

onException :: IO a -> IO b -> IO a
383
onException io what = io `catchException` \e -> do _ <- what
384
                                                   throwIO (e :: SomeException)
385

386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414
-- | Executes an IO computation with asynchronous
-- exceptions /masked/.  That is, any thread which attempts to raise
-- an exception in the current thread with 'Control.Exception.throwTo'
-- will be blocked until asynchronous exceptions are unmasked again.
--
-- The argument passed to 'mask' is a function that takes as its
-- argument another function, which can be used to restore the
-- prevailing masking state within the context of the masked
-- computation.  For example, a common way to use 'mask' is to protect
-- the acquisition of a resource:
--
-- > mask $ \restore -> do
-- >     x <- acquire
-- >     restore (do_something_with x) `onException` release
-- >     release
--
-- This code guarantees that @acquire@ is paired with @release@, by masking
-- asynchronous exceptions for the critical parts. (Rather than write
-- this code yourself, it would be better to use
-- 'Control.Exception.bracket' which abstracts the general pattern).
--
-- Note that the @restore@ action passed to the argument to 'mask'
-- does not necessarily unmask asynchronous exceptions, it just
-- restores the masking state to that of the enclosing context.  Thus
-- if asynchronous exceptions are already masked, 'mask' cannot be used
-- to unmask exceptions again.  This is so that if you call a library function
-- with exceptions masked, you can be sure that the library call will not be
-- able to unmask exceptions again.  If you are writing library code and need
-- to use asynchronous exceptions, the only way is to create a new thread;
415
-- see 'Control.Concurrent.forkIOWithUnmask'.
416 417 418 419 420
--
-- Asynchronous exceptions may still be received while in the masked
-- state if the masked thread /blocks/ in certain ways; see
-- "Control.Exception#interruptible".
--
421 422 423
-- Threads created by 'Control.Concurrent.forkIO' inherit the
-- 'MaskingState' from the parent; that is, to start a thread in the
-- 'MaskedInterruptible' state,
424 425 426 427
-- use @mask_ $ forkIO ...@.  This is particularly useful if you need
-- to establish an exception handler in the forked thread before any
-- asynchronous exceptions are received.  To create a a new thread in
-- an unmasked state use 'Control.Concurrent.forkIOUnmasked'.
428
--
429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454
mask  :: ((forall a. IO a -> IO a) -> IO b) -> IO b

-- | Like 'mask', but does not pass a @restore@ action to the argument.
mask_ :: IO a -> IO a

-- | Like 'mask', but the masked computation is not interruptible (see
-- "Control.Exception#interruptible").  THIS SHOULD BE USED WITH
-- GREAT CARE, because if a thread executing in 'uninterruptibleMask'
-- blocks for any reason, then the thread (and possibly the program,
-- if this is the main thread) will be unresponsive and unkillable.
-- This function should only be necessary if you need to mask
-- exceptions around an interruptible operation, and you can guarantee
-- that the interruptible operation will only block for a short period
-- of time.
--
uninterruptibleMask :: ((forall a. IO a -> IO a) -> IO b) -> IO b

-- | Like 'uninterruptibleMask', but does not pass a @restore@ action
-- to the argument.
uninterruptibleMask_ :: IO a -> IO a

mask_ io = mask $ \_ -> io

mask io = do
  b <- getMaskingState
  case b of
455 456 457
    Unmasked              -> block $ io unblock
    MaskedInterruptible   -> io block
    MaskedUninterruptible -> io blockUninterruptible
458 459 460 461 462 463 464 465

uninterruptibleMask_ io = uninterruptibleMask $ \_ -> io

uninterruptibleMask io = do
  b <- getMaskingState
  case b of
    Unmasked              -> blockUninterruptible $ io unblock
    MaskedInterruptible   -> blockUninterruptible $ io block
466
    MaskedUninterruptible -> io blockUninterruptible
467

468 469 470 471 472 473 474 475 476 477 478 479
bracket
        :: IO a         -- ^ computation to run first (\"acquire resource\")
        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
        -> (a -> IO c)  -- ^ computation to run in-between
        -> IO c         -- returns the value from the in-between computation
bracket before after thing =
  mask $ \restore -> do
    a <- before
    r <- restore (thing a) `onException` after a
    _ <- after a
    return r

480 481 482 483 484
finally :: IO a         -- ^ computation to run first
        -> IO b         -- ^ computation to run afterward (even if an exception
                        -- was raised)
        -> IO a         -- returns the value from the first computation
a `finally` sequel =
485 486
  mask $ \restore -> do
    r <- restore a `onException` sequel
487
    _ <- sequel
488 489
    return r

490
-- | Evaluate the argument to weak head normal form.
491
--
492 493
-- 'evaluate' is typically used to uncover any exceptions that a lazy value
-- may contain, and possibly handle them.
494
--
495 496 497
-- 'evaluate' only evaluates to /weak head normal form/. If deeper
-- evaluation is needed, the @force@ function from @Control.DeepSeq@
-- may be handy:
498
--
499
-- > evaluate $ force x
500
--
501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523
-- There is a subtle difference between @'evaluate' x@ and @'return' '$!' x@,
-- analogous to the difference between 'throwIO' and 'throw'. If the lazy
-- value @x@ throws an exception, @'return' '$!' x@ will fail to return an
-- 'IO' action and will throw an exception instead. @'evaluate' x@, on the
-- other hand, always produces an 'IO' action; that action will throw an
-- exception upon /execution/ iff @x@ throws an exception upon /evaluation/.
--
-- The practical implication of this difference is that due to the
-- /imprecise exceptions/ semantics,
--
-- > (return $! error "foo") >> error "bar"
--
-- may throw either @"foo"@ or @"bar"@, depending on the optimizations
-- performed by the compiler. On the other hand,
--
-- > evaluate (error "foo") >> error "bar"
--
-- is guaranteed to throw @"foo"@.
--
-- The rule of thumb is to use 'evaluate' to force or handle exceptions in
-- lazy values. If, on the other hand, you are forcing a lazy value for
-- efficiency reasons only and do not care about exceptions, you may
-- use @'return' '$!' x@.
524
evaluate :: a -> IO a
525
evaluate a = IO $ \s -> seq# a s -- NB. see #2273, #5129