Control/OldException.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
   2
   3 #include "Typeable.h"
   4
   5 -----------------------------------------------------------------------------
   6 -- |
   7 -- Module      :  Control.OldException
   8 -- Copyright   :  (c) The University of Glasgow 2001
   9 -- License     :  BSD-style (see the file libraries/base/LICENSE)
  10 --
  11 -- Maintainer  :  libraries@haskell.org
  12 -- Stability   :  experimental
  13 -- Portability :  non-portable (extended exceptions)
  14 --
  15 -- This module provides support for raising and catching both built-in
  16 -- and user-defined exceptions.
  17 --
  18 -- In addition to exceptions thrown by 'IO' operations, exceptions may
  19 -- be thrown by pure code (imprecise exceptions) or by external events
  20 -- (asynchronous exceptions), but may only be caught in the 'IO' monad.
  21 -- For more details, see:
  22 --
  23 --  * /A semantics for imprecise exceptions/, by Simon Peyton Jones,
  24 --    Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,
  25 --    in /PLDI'99/.
  26 --
  27 --  * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton
  28 --    Jones, Andy Moran and John Reppy, in /PLDI'01/.
  29 --
  30 -----------------------------------------------------------------------------
  31
  32 module Control.OldException (
  33
  34         -- * The Exception type
  35         Exception(..),          -- instance Eq, Ord, Show, Typeable
  36         New.IOException,        -- instance Eq, Ord, Show, Typeable
  37         New.ArithException(..), -- instance Eq, Ord, Show, Typeable
  38         New.ArrayException(..), -- instance Eq, Ord, Show, Typeable
  39         New.AsyncException(..), -- instance Eq, Ord, Show, Typeable
  40
  41         -- * Throwing exceptions
  42         throwIO,        -- :: Exception -> IO a
  43         throw,          -- :: Exception -> a
  44         ioError,        -- :: IOError -> IO a
  45 #ifdef __GLASGOW_HASKELL__
  46         -- XXX Need to restrict the type of this:
  47         New.throwTo,        -- :: ThreadId -> Exception -> a
  48 #endif
  49
  50         -- * Catching Exceptions
  51
  52         -- |There are several functions for catching and examining
  53         -- exceptions; all of them may only be used from within the
  54         -- 'IO' monad.
  55
  56         -- ** The @catch@ functions
  57         catch,     -- :: IO a -> (Exception -> IO a) -> IO a
  58         catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a
  59
  60         -- ** The @handle@ functions
  61         handle,    -- :: (Exception -> IO a) -> IO a -> IO a
  62         handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
  63
  64         -- ** The @try@ functions
  65         try,       -- :: IO a -> IO (Either Exception a)
  66         tryJust,   -- :: (Exception -> Maybe b) -> a    -> IO (Either b a)
  67
  68         -- ** The @evaluate@ function
  69         evaluate,  -- :: a -> IO a
  70
  71         -- ** The @mapException@ function
  72         mapException,           -- :: (Exception -> Exception) -> a -> a
  73
  74         -- ** Exception predicates
  75
  76         -- $preds
  77
  78         ioErrors,               -- :: Exception -> Maybe IOError
  79         arithExceptions,        -- :: Exception -> Maybe ArithException
  80         errorCalls,             -- :: Exception -> Maybe String
  81         dynExceptions,          -- :: Exception -> Maybe Dynamic
  82         assertions,             -- :: Exception -> Maybe String
  83         asyncExceptions,        -- :: Exception -> Maybe AsyncException
  84         userErrors,             -- :: Exception -> Maybe String
  85
  86         -- * Dynamic exceptions
  87
  88         -- $dynamic
  89         throwDyn,       -- :: Typeable ex => ex -> b
  90 #ifdef __GLASGOW_HASKELL__
  91         throwDynTo,     -- :: Typeable ex => ThreadId -> ex -> b
  92 #endif
  93         catchDyn,       -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
  94
  95         -- * Asynchronous Exceptions
  96
  97         -- $async
  98
  99         -- ** Asynchronous exception control
 100
 101         -- |The following two functions allow a thread to control delivery of
 102         -- asynchronous exceptions during a critical region.
 103
 104         block,          -- :: IO a -> IO a
 105         unblock,        -- :: IO a -> IO a
 106
 107         -- *** Applying @block@ to an exception handler
 108
 109         -- $block_handler
 110
 111         -- *** Interruptible operations
 112
 113         -- $interruptible
 114
 115         -- * Assertions
 116
 117         assert,         -- :: Bool -> a -> a
 118
 119         -- * Utilities
 120
 121         bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
 122         bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
 123         bracketOnError,
 124
 125         finally,        -- :: IO a -> IO b -> IO a
 126
 127 #ifdef __GLASGOW_HASKELL__
 128         setUncaughtExceptionHandler,      -- :: (Exception -> IO ()) -> IO ()
 129         getUncaughtExceptionHandler       -- :: IO (Exception -> IO ())
 130 #endif
 131   ) where
 132
 133 #ifdef __GLASGOW_HASKELL__
 134 import GHC.Base
 135 import GHC.Num
 136 import GHC.Show
 137 import GHC.IOBase ( IO )
 138 import GHC.IOBase (block, unblock, evaluate, catchException, throwIO)
 139 import qualified GHC.IOBase as ExceptionBase
 140 import qualified GHC.IOBase as New
 141 import GHC.Exception hiding ( Exception )
 142 import {-# SOURCE #-} GHC.Conc
 143 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
 144 import Foreign.C.String ( CString, withCString )
 145 import {-# SOURCE #-} GHC.Handle       ( stdout, hFlush )
 146 #endif
 147
 148 #ifdef __HUGS__
 149 import Hugs.Exception   as ExceptionBase
 150 #endif
 151
 152 import qualified Control.Exception as New
 153 import System.IO.Error  hiding ( catch, try )
 154 import System.IO.Unsafe (unsafePerformIO)
 155 import Data.Dynamic
 156 import Data.Either
 157 import Data.Maybe
 158
 159 #ifdef __NHC__
 160 import System.IO.Error (catch, ioError)
 161 import IO              (bracket)
 162 import DIOError         -- defn of IOError type
 163
 164 -- minimum needed for nhc98 to pretend it has Exceptions
 165 type Exception   = IOError
 166 type IOException = IOError
 167 data ArithException
 168 data ArrayException
 169 data AsyncException
 170
 171 throwIO  :: Exception -> IO a
 172 throwIO   = ioError
 173 throw    :: Exception -> a
 174 throw     = unsafePerformIO . throwIO
 175
 176 evaluate :: a -> IO a
 177 evaluate x = x `seq` return x
 178
 179 ioErrors        :: Exception -> Maybe IOError
 180 ioErrors e       = Just e
 181 arithExceptions :: Exception -> Maybe ArithException
 182 arithExceptions  = const Nothing
 183 errorCalls      :: Exception -> Maybe String
 184 errorCalls       = const Nothing
 185 dynExceptions   :: Exception -> Maybe Dynamic
 186 dynExceptions    = const Nothing
 187 assertions      :: Exception -> Maybe String
 188 assertions       = const Nothing
 189 asyncExceptions :: Exception -> Maybe AsyncException
 190 asyncExceptions  = const Nothing
 191 userErrors      :: Exception -> Maybe String
 192 userErrors (UserError _ s) = Just s
 193 userErrors  _              = Nothing
 194
 195 block   :: IO a -> IO a
 196 block    = id
 197 unblock :: IO a -> IO a
 198 unblock  = id
 199
 200 assert :: Bool -> a -> a
 201 assert True  x = x
 202 assert False _ = throw (UserError "" "Assertion failed")
 203 #endif
 204
 205 -----------------------------------------------------------------------------
 206 -- Catching exceptions
 207
 208 -- |This is the simplest of the exception-catching functions.  It
 209 -- takes a single argument, runs it, and if an exception is raised
 210 -- the \"handler\" is executed, with the value of the exception passed as an
 211 -- argument.  Otherwise, the result is returned as normal.  For example:
 212 --
 213 -- >   catch (openFile f ReadMode)
 214 -- >       (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e))
 215 --
 216 -- For catching exceptions in pure (non-'IO') expressions, see the
 217 -- function 'evaluate'.
 218 --
 219 -- Note that due to Haskell\'s unspecified evaluation order, an
 220 -- expression may return one of several possible exceptions: consider
 221 -- the expression @error \"urk\" + 1 \`div\` 0@.  Does
 222 -- 'catch' execute the handler passing
 223 -- @ErrorCall \"urk\"@, or @ArithError DivideByZero@?
 224 --
 225 -- The answer is \"either\": 'catch' makes a
 226 -- non-deterministic choice about which exception to catch.  If you
 227 -- call it again, you might get a different exception back.  This is
 228 -- ok, because 'catch' is an 'IO' computation.
 229 --
 230 -- Note that 'catch' catches all types of exceptions, and is generally
 231 -- used for \"cleaning up\" before passing on the exception using
 232 -- 'throwIO'.  It is not good practice to discard the exception and
 233 -- continue, without first checking the type of the exception (it
 234 -- might be a 'ThreadKilled', for example).  In this case it is usually better
 235 -- to use 'catchJust' and select the kinds of exceptions to catch.
 236 --
 237 -- Also note that the "Prelude" also exports a function called
 238 -- 'Prelude.catch' with a similar type to 'Control.OldException.catch',
 239 -- except that the "Prelude" version only catches the IO and user
 240 -- families of exceptions (as required by Haskell 98).
 241 --
 242 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
 243 -- when importing "Control.OldException":
 244 --
 245 -- > import Prelude hiding (catch)
 246 --
 247 -- or importing "Control.OldException" qualified, to avoid name-clashes:
 248 --
 249 -- > import qualified Control.OldException as C
 250 --
 251 -- and then using @C.catch@
 252 --
 253
 254 catch   :: IO a                 -- ^ The computation to run
 255         -> (Exception -> IO a)  -- ^ Handler to invoke if an exception is raised
 256         -> IO a
 257 catch io handler =
 258     -- We need to catch all the sorts of exceptions that used to be
 259     -- bundled up into the Exception type, and rebundle them for the
 260     -- legacy handler we've been given.
 261     io `New.catches`
 262         [New.Handler (\e -> handler e),
 263          New.Handler (\exc -> handler (ArithException exc)),
 264          New.Handler (\exc -> handler (ArrayException exc)),
 265          New.Handler (\(New.AssertionFailed err) -> handler (AssertionFailed err)),
 266          New.Handler (\exc -> handler (AsyncException exc)),
 267          New.Handler (\New.BlockedOnDeadMVar -> handler BlockedOnDeadMVar),
 268          New.Handler (\New.BlockedIndefinitely -> handler BlockedIndefinitely),
 269          New.Handler (\New.NestedAtomically -> handler NestedAtomically),
 270          New.Handler (\New.Deadlock -> handler Deadlock),
 271          New.Handler (\exc -> handler (DynException exc)),
 272          New.Handler (\(New.ErrorCall err) -> handler (ErrorCall err)),
 273          New.Handler (\exc -> handler (ExitException exc)),
 274          New.Handler (\exc -> handler (IOException exc)),
 275          New.Handler (\(New.NoMethodError err) -> handler (NoMethodError err)),
 276          New.Handler (\New.NonTermination -> handler NonTermination),
 277          New.Handler (\(New.PatternMatchFail err) -> handler (PatternMatchFail err)),
 278          New.Handler (\(New.RecConError err) -> handler (RecConError err)),
 279          New.Handler (\(New.RecSelError err) -> handler (RecSelError err)),
 280          New.Handler (\(New.RecUpdError err) -> handler (RecUpdError err))]
 281
 282 -- | The function 'catchJust' is like 'catch', but it takes an extra
 283 -- argument which is an /exception predicate/, a function which
 284 -- selects which type of exceptions we\'re interested in.  There are
 285 -- some predefined exception predicates for useful subsets of
 286 -- exceptions: 'ioErrors', 'arithExceptions', and so on.  For example,
 287 -- to catch just calls to the 'error' function, we could use
 288 --
 289 -- >   result <- catchJust errorCalls thing_to_try handler
 290 --
 291 -- Any other exceptions which are not matched by the predicate
 292 -- are re-raised, and may be caught by an enclosing
 293 -- 'catch' or 'catchJust'.
 294 catchJust
 295         :: (Exception -> Maybe b) -- ^ Predicate to select exceptions
 296         -> IO a                   -- ^ Computation to run
 297         -> (b -> IO a)            -- ^ Handler
 298         -> IO a
 299 catchJust p a handler = catch a handler'
 300   where handler' e = case p e of
 301                         Nothing -> throw e
 302                         Just b  -> handler b
 303
 304 -- | A version of 'catch' with the arguments swapped around; useful in
 305 -- situations where the code for the handler is shorter.  For example:
 306 --
 307 -- >   do handle (\e -> exitWith (ExitFailure 1)) $
 308 -- >      ...
 309 handle     :: (Exception -> IO a) -> IO a -> IO a
 310 handle     =  flip catch
 311
 312 -- | A version of 'catchJust' with the arguments swapped around (see
 313 -- 'handle').
 314 handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
 315 handleJust p =  flip (catchJust p)
 316
 317 -----------------------------------------------------------------------------
 318 -- 'mapException'
 319
 320 -- | This function maps one exception into another as proposed in the
 321 -- paper \"A semantics for imprecise exceptions\".
 322
 323 -- Notice that the usage of 'unsafePerformIO' is safe here.
 324
 325 mapException :: (Exception -> Exception) -> a -> a
 326 mapException f v = unsafePerformIO (catch (evaluate v)
 327                                           (\x -> throw (f x)))
 328
 329 -----------------------------------------------------------------------------
 330 -- 'try' and variations.
 331
 332 -- | Similar to 'catch', but returns an 'Either' result which is
 333 -- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an
 334 -- exception was raised and its value is @e@.
 335 --
 336 -- >  try a = catch (Right `liftM` a) (return . Left)
 337 --
 338 -- Note: as with 'catch', it is only polite to use this variant if you intend
 339 -- to re-throw the exception after performing whatever cleanup is needed.
 340 -- Otherwise, 'tryJust' is generally considered to be better.
 341 --
 342 -- Also note that "System.IO.Error" also exports a function called
 343 -- 'System.IO.Error.try' with a similar type to 'Control.OldException.try',
 344 -- except that it catches only the IO and user families of exceptions
 345 -- (as required by the Haskell 98 @IO@ module).
 346
 347 try :: IO a -> IO (Either Exception a)
 348 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
 349
 350 -- | A variant of 'try' that takes an exception predicate to select
 351 -- which exceptions are caught (c.f. 'catchJust').  If the exception
 352 -- does not match the predicate, it is re-thrown.
 353 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
 354 tryJust p a = do
 355   r <- try a
 356   case r of
 357         Right v -> return (Right v)
 358         Left  e -> case p e of
 359                         Nothing -> throw e
 360                         Just b  -> return (Left b)
 361
 362 -----------------------------------------------------------------------------
 363 -- Dynamic exceptions
 364
 365 -- $dynamic
 366 --  #DynamicExceptions# Because the 'Exception' datatype is not extensible, there is an
 367 -- interface for throwing and catching exceptions of type 'Dynamic'
 368 -- (see "Data.Dynamic") which allows exception values of any type in
 369 -- the 'Typeable' class to be thrown and caught.
 370
 371 -- | Raise any value as an exception, provided it is in the
 372 -- 'Typeable' class.
 373 throwDyn :: Typeable exception => exception -> b
 374 #ifdef __NHC__
 375 throwDyn exception = throw (UserError "" "dynamic exception")
 376 #else
 377 throwDyn exception = throw (DynException (toDyn exception))
 378 #endif
 379
 380 #ifdef __GLASGOW_HASKELL__
 381 -- | A variant of 'throwDyn' that throws the dynamic exception to an
 382 -- arbitrary thread (GHC only: c.f. 'throwTo').
 383 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
 384 throwDynTo t exception = New.throwTo t (DynException (toDyn exception))
 385 #endif /* __GLASGOW_HASKELL__ */
 386
 387 -- | Catch dynamic exceptions of the required type.  All other
 388 -- exceptions are re-thrown, including dynamic exceptions of the wrong
 389 -- type.
 390 --
 391 -- When using dynamic exceptions it is advisable to define a new
 392 -- datatype to use for your exception type, to avoid possible clashes
 393 -- with dynamic exceptions used in other libraries.
 394 --
 395 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
 396 #ifdef __NHC__
 397 catchDyn m k = m        -- can't catch dyn exceptions in nhc98
 398 #else
 399 catchDyn m k = catchException m handle
 400   where handle ex = case ex of
 401                            (DynException dyn) ->
 402                                 case fromDynamic dyn of
 403                                     Just exception  -> k exception
 404                                     Nothing -> throw ex
 405                            _ -> throw ex
 406 #endif
 407
 408 -----------------------------------------------------------------------------
 409 -- Exception Predicates
 410
 411 -- $preds
 412 -- These pre-defined predicates may be used as the first argument to
 413 -- 'catchJust', 'tryJust', or 'handleJust' to select certain common
 414 -- classes of exceptions.
 415 #ifndef __NHC__
 416 ioErrors                :: Exception -> Maybe IOError
 417 arithExceptions         :: Exception -> Maybe New.ArithException
 418 errorCalls              :: Exception -> Maybe String
 419 assertions              :: Exception -> Maybe String
 420 dynExceptions           :: Exception -> Maybe Dynamic
 421 asyncExceptions         :: Exception -> Maybe New.AsyncException
 422 userErrors              :: Exception -> Maybe String
 423
 424 ioErrors (IOException e) = Just e
 425 ioErrors _ = Nothing
 426
 427 arithExceptions (ArithException e) = Just e
 428 arithExceptions _ = Nothing
 429
 430 errorCalls (ErrorCall e) = Just e
 431 errorCalls _ = Nothing
 432
 433 assertions (AssertionFailed e) = Just e
 434 assertions _ = Nothing
 435
 436 dynExceptions (DynException e) = Just e
 437 dynExceptions _ = Nothing
 438
 439 asyncExceptions (AsyncException e) = Just e
 440 asyncExceptions _ = Nothing
 441
 442 userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e)
 443 userErrors _ = Nothing
 444 #endif
 445 -----------------------------------------------------------------------------
 446 -- Some Useful Functions
 447
 448 -- | When you want to acquire a resource, do some work with it, and
 449 -- then release the resource, it is a good idea to use 'bracket',
 450 -- because 'bracket' will install the necessary exception handler to
 451 -- release the resource in the event that an exception is raised
 452 -- during the computation.  If an exception is raised, then 'bracket' will
 453 -- re-raise the exception (after performing the release).
 454 --
 455 -- A common example is opening a file:
 456 --
 457 -- > bracket
 458 -- >   (openFile "filename" ReadMode)
 459 -- >   (hClose)
 460 -- >   (\handle -> do { ... })
 461 --
 462 -- The arguments to 'bracket' are in this order so that we can partially apply
 463 -- it, e.g.:
 464 --
 465 -- > withFile name mode = bracket (openFile name mode) hClose
 466 --
 467 #ifndef __NHC__
 468 bracket
 469         :: IO a         -- ^ computation to run first (\"acquire resource\")
 470         -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
 471         -> (a -> IO c)  -- ^ computation to run in-between
 472         -> IO c         -- returns the value from the in-between computation
 473 bracket before after thing =
 474   block (do
 475     a <- before
 476     r <- catch
 477            (unblock (thing a))
 478            (\e -> do { after a; throw e })
 479     after a
 480     return r
 481  )
 482 #endif
 483
 484 -- | A specialised variant of 'bracket' with just a computation to run
 485 -- afterward.
 486 --
 487 finally :: IO a         -- ^ computation to run first
 488         -> IO b         -- ^ computation to run afterward (even if an exception
 489                         -- was raised)
 490         -> IO a         -- returns the value from the first computation
 491 a `finally` sequel =
 492   block (do
 493     r <- catch
 494              (unblock a)
 495              (\e -> do { sequel; throw e })
 496     sequel
 497     return r
 498   )
 499
 500 -- | A variant of 'bracket' where the return value from the first computation
 501 -- is not required.
 502 bracket_ :: IO a -> IO b -> IO c -> IO c
 503 bracket_ before after thing = bracket before (const after) (const thing)
 504
 505 -- | Like bracket, but only performs the final action if there was an
 506 -- exception raised by the in-between computation.
 507 bracketOnError
 508         :: IO a         -- ^ computation to run first (\"acquire resource\")
 509         -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
 510         -> (a -> IO c)  -- ^ computation to run in-between
 511         -> IO c         -- returns the value from the in-between computation
 512 bracketOnError before after thing =
 513   block (do
 514     a <- before
 515     catch
 516         (unblock (thing a))
 517         (\e -> do { after a; throw e })
 518  )
 519
 520 -- -----------------------------------------------------------------------------
 521 -- Asynchronous exceptions
 522
 523 {- $async
 524
 525  #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to
 526 external influences, and can be raised at any point during execution.
 527 'StackOverflow' and 'HeapOverflow' are two examples of
 528 system-generated asynchronous exceptions.
 529
 530 The primary source of asynchronous exceptions, however, is
 531 'throwTo':
 532
 533 >  throwTo :: ThreadId -> Exception -> IO ()
 534
 535 'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one
 536 running thread to raise an arbitrary exception in another thread.  The
 537 exception is therefore asynchronous with respect to the target thread,
 538 which could be doing anything at the time it receives the exception.
 539 Great care should be taken with asynchronous exceptions; it is all too
 540 easy to introduce race conditions by the over zealous use of
 541 'throwTo'.
 542 -}
 543
 544 {- $block_handler
 545 There\'s an implied 'block' around every exception handler in a call
 546 to one of the 'catch' family of functions.  This is because that is
 547 what you want most of the time - it eliminates a common race condition
 548 in starting an exception handler, because there may be no exception
 549 handler on the stack to handle another exception if one arrives
 550 immediately.  If asynchronous exceptions are blocked on entering the
 551 handler, though, we have time to install a new exception handler
 552 before being interrupted.  If this weren\'t the default, one would have
 553 to write something like
 554
 555 >      block (
 556 >           catch (unblock (...))
 557 >                      (\e -> handler)
 558 >      )
 559
 560 If you need to unblock asynchronous exceptions again in the exception
 561 handler, just use 'unblock' as normal.
 562
 563 Note that 'try' and friends /do not/ have a similar default, because
 564 there is no exception handler in this case.  If you want to use 'try'
 565 in an asynchronous-exception-safe way, you will need to use
 566 'block'.
 567 -}
 568
 569 {- $interruptible
 570
 571 Some operations are /interruptible/, which means that they can receive
 572 asynchronous exceptions even in the scope of a 'block'.  Any function
 573 which may itself block is defined as interruptible; this includes
 574 'Control.Concurrent.MVar.takeMVar'
 575 (but not 'Control.Concurrent.MVar.tryTakeMVar'),
 576 and most operations which perform
 577 some I\/O with the outside world.  The reason for having
 578 interruptible operations is so that we can write things like
 579
 580 >      block (
 581 >         a <- takeMVar m
 582 >         catch (unblock (...))
 583 >               (\e -> ...)
 584 >      )
 585
 586 if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
 587 then this particular
 588 combination could lead to deadlock, because the thread itself would be
 589 blocked in a state where it can\'t receive any asynchronous exceptions.
 590 With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be
 591 safe in the knowledge that the thread can receive exceptions right up
 592 until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds.
 593 Similar arguments apply for other interruptible operations like
 594 'System.IO.openFile'.
 595 -}
 596
 597 #if !(__GLASGOW_HASKELL__ || __NHC__)
 598 assert :: Bool -> a -> a
 599 assert True x = x
 600 assert False _ = throw (AssertionFailed "")
 601 #endif
 602
 603
 604 #ifdef __GLASGOW_HASKELL__
 605 {-# NOINLINE uncaughtExceptionHandler #-}
 606 uncaughtExceptionHandler :: IORef (Exception -> IO ())
 607 uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)
 608    where
 609       defaultHandler :: Exception -> IO ()
 610       defaultHandler ex = do
 611          (hFlush stdout) `New.catchAny` (\ _ -> return ())
 612          let msg = case ex of
 613                Deadlock    -> "no threads to run:  infinite loop or deadlock?"
 614                ErrorCall s -> s
 615                other       -> showsPrec 0 other ""
 616          withCString "%s" $ \cfmt ->
 617           withCString msg $ \cmsg ->
 618             errorBelch cfmt cmsg
 619
 620 -- don't use errorBelch() directly, because we cannot call varargs functions
 621 -- using the FFI.
 622 foreign import ccall unsafe "HsBase.h errorBelch2"
 623    errorBelch :: CString -> CString -> IO ()
 624
 625 setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO ()
 626 setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler
 627
 628 getUncaughtExceptionHandler :: IO (Exception -> IO ())
 629 getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler
 630 #endif
 631
 632 -- ------------------------------------------------------------------------
 633 -- Exception datatype and operations
 634
 635 -- |The type of exceptions.  Every kind of system-generated exception
 636 -- has a constructor in the 'Exception' type, and values of other
 637 -- types may be injected into 'Exception' by coercing them to
 638 -- 'Data.Dynamic.Dynamic' (see the section on Dynamic Exceptions:
 639 -- "Control.OldException\#DynamicExceptions").
 640 data Exception
 641   = ArithException      New.ArithException
 642         -- ^Exceptions raised by arithmetic
 643         -- operations.  (NOTE: GHC currently does not throw
 644         -- 'ArithException's except for 'DivideByZero').
 645   | ArrayException      New.ArrayException
 646         -- ^Exceptions raised by array-related
 647         -- operations.  (NOTE: GHC currently does not throw
 648         -- 'ArrayException's).
 649   | AssertionFailed     String
 650         -- ^This exception is thrown by the
 651         -- 'assert' operation when the condition
 652         -- fails.  The 'String' argument contains the
 653         -- location of the assertion in the source program.
 654   | AsyncException      New.AsyncException
 655         -- ^Asynchronous exceptions (see section on Asynchronous Exceptions: "Control.OldException\#AsynchronousExceptions").
 656   | BlockedOnDeadMVar
 657         -- ^The current thread was executing a call to
 658         -- 'Control.Concurrent.MVar.takeMVar' that could never return,
 659         -- because there are no other references to this 'MVar'.
 660   | BlockedIndefinitely
 661         -- ^The current thread was waiting to retry an atomic memory transaction
 662         -- that could never become possible to complete because there are no other
 663         -- threads referring to any of the TVars involved.
 664   | NestedAtomically
 665         -- ^The runtime detected an attempt to nest one STM transaction
 666         -- inside another one, presumably due to the use of
 667         -- 'unsafePeformIO' with 'atomically'.
 668   | Deadlock
 669         -- ^There are no runnable threads, so the program is
 670         -- deadlocked.  The 'Deadlock' exception is
 671         -- raised in the main thread only (see also: "Control.Concurrent").
 672   | DynException        Dynamic
 673         -- ^Dynamically typed exceptions (see section on Dynamic Exceptions: "Control.OldException\#DynamicExceptions").
 674   | ErrorCall           String
 675         -- ^The 'ErrorCall' exception is thrown by 'error'.  The 'String'
 676         -- argument of 'ErrorCall' is the string passed to 'error' when it was
 677         -- called.
 678   | ExitException       New.ExitCode
 679         -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and
 680         -- 'System.Exit.exitFailure').  The 'ExitCode' argument is the value passed
 681         -- to 'System.Exit.exitWith'.  An unhandled 'ExitException' exception in the
 682         -- main thread will cause the program to be terminated with the given
 683         -- exit code.
 684   | IOException         New.IOException
 685         -- ^These are the standard IO exceptions generated by
 686         -- Haskell\'s @IO@ operations.  See also "System.IO.Error".
 687   | NoMethodError       String
 688         -- ^An attempt was made to invoke a class method which has
 689         -- no definition in this instance, and there was no default
 690         -- definition given in the class declaration.  GHC issues a
 691         -- warning when you compile an instance which has missing
 692         -- methods.
 693   | NonTermination
 694         -- ^The current thread is stuck in an infinite loop.  This
 695         -- exception may or may not be thrown when the program is
 696         -- non-terminating.
 697   | PatternMatchFail    String
 698         -- ^A pattern matching failure.  The 'String' argument should contain a
 699         -- descriptive message including the function name, source file
 700         -- and line number.
 701   | RecConError         String
 702         -- ^An attempt was made to evaluate a field of a record
 703         -- for which no value was given at construction time.  The
 704         -- 'String' argument gives the location of the
 705         -- record construction in the source program.
 706   | RecSelError         String
 707         -- ^A field selection was attempted on a constructor that
 708         -- doesn\'t have the requested field.  This can happen with
 709         -- multi-constructor records when one or more fields are
 710         -- missing from some of the constructors.  The
 711         -- 'String' argument gives the location of the
 712         -- record selection in the source program.
 713   | RecUpdError         String
 714         -- ^An attempt was made to update a field in a record,
 715         -- where the record doesn\'t have the requested field.  This can
 716         -- only occur with multi-constructor records, when one or more
 717         -- fields are missing from some of the constructors.  The
 718         -- 'String' argument gives the location of the
 719         -- record update in the source program.
 720 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
 721
 722 nonTermination :: SomeException
 723 nonTermination = toException NonTermination
 724
 725 -- For now at least, make the monolithic Exception type an instance of
 726 -- the Exception class
 727 instance ExceptionBase.Exception Exception
 728
 729 instance Show Exception where
 730   showsPrec _ (IOException err)          = shows err
 731   showsPrec _ (ArithException err)       = shows err
 732   showsPrec _ (ArrayException err)       = shows err
 733   showsPrec _ (ErrorCall err)            = showString err
 734   showsPrec _ (ExitException err)        = showString "exit: " . shows err
 735   showsPrec _ (NoMethodError err)        = showString err
 736   showsPrec _ (PatternMatchFail err)     = showString err
 737   showsPrec _ (RecSelError err)          = showString err
 738   showsPrec _ (RecConError err)          = showString err
 739   showsPrec _ (RecUpdError err)          = showString err
 740   showsPrec _ (AssertionFailed err)      = showString err
 741   showsPrec _ (DynException err)         = showString "exception :: " . showsTypeRep (dynTypeRep err)
 742   showsPrec _ (AsyncException e)         = shows e
 743   showsPrec p BlockedOnDeadMVar          = showsPrec p New.BlockedOnDeadMVar
 744   showsPrec p BlockedIndefinitely        = showsPrec p New.BlockedIndefinitely
 745   showsPrec p NestedAtomically           = showsPrec p New.NestedAtomically
 746   showsPrec p NonTermination             = showsPrec p New.NonTermination
 747   showsPrec p Deadlock                   = showsPrec p New.Deadlock
 748
 749 instance Eq Exception where
 750   IOException e1      == IOException e2      = e1 == e2
 751   ArithException e1   == ArithException e2   = e1 == e2
 752   ArrayException e1   == ArrayException e2   = e1 == e2
 753   ErrorCall e1        == ErrorCall e2        = e1 == e2
 754   ExitException e1    == ExitException e2    = e1 == e2
 755   NoMethodError e1    == NoMethodError e2    = e1 == e2
 756   PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
 757   RecSelError e1      == RecSelError e2      = e1 == e2
 758   RecConError e1      == RecConError e2      = e1 == e2
 759   RecUpdError e1      == RecUpdError e2      = e1 == e2
 760   AssertionFailed e1  == AssertionFailed e2  = e1 == e2
 761   DynException _      == DynException _      = False -- incomparable
 762   AsyncException e1   == AsyncException e2   = e1 == e2
 763   BlockedOnDeadMVar   == BlockedOnDeadMVar   = True
 764   NonTermination      == NonTermination      = True
 765   NestedAtomically    == NestedAtomically    = True
 766   Deadlock            == Deadlock            = True
 767   _                   == _                   = False
 768