GHC/IO.hs

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