GHC/IO.hs

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