1 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
5 -----------------------------------------------------------------------------
7 -- Module : Control.OldException
8 -- Copyright : (c) The University of Glasgow 2001
9 -- License : BSD-style (see the file libraries/base/LICENSE)
11 -- Maintainer : libraries@haskell.org
12 -- Stability : experimental
13 -- Portability : non-portable (extended exceptions)
15 -- This module provides support for raising and catching both built-in
16 -- and user-defined exceptions.
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:
23 -- * /A semantics for imprecise exceptions/, by Simon Peyton Jones,
24 -- Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,
27 -- * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton
28 -- Jones, Andy Moran and John Reppy, in /PLDI'01/.
30 -----------------------------------------------------------------------------
32 module Control.OldException (
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
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
50 -- * Catching Exceptions
52 -- |There are several functions for catching and examining
53 -- exceptions; all of them may only be used from within the
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
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
64 -- ** The @try@ functions
65 try, -- :: IO a -> IO (Either Exception a)
66 tryJust, -- :: (Exception -> Maybe b) -> a -> IO (Either b a)
68 -- ** The @evaluate@ function
69 evaluate, -- :: a -> IO a
71 -- ** The @mapException@ function
72 mapException, -- :: (Exception -> Exception) -> a -> a
74 -- ** Exception predicates
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
86 -- * Dynamic exceptions
89 throwDyn, -- :: Typeable ex => ex -> b
90 #ifdef __GLASGOW_HASKELL__
91 throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b
93 catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
95 -- * Asynchronous Exceptions
99 -- ** Asynchronous exception control
101 -- |The following two functions allow a thread to control delivery of
102 -- asynchronous exceptions during a critical region.
104 block, -- :: IO a -> IO a
105 unblock, -- :: IO a -> IO a
107 -- *** Applying @block@ to an exception handler
111 -- *** Interruptible operations
117 assert, -- :: Bool -> a -> a
121 bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
122 bracket_, -- :: IO a -> IO b -> IO c -> IO ()
125 finally, -- :: IO a -> IO b -> IO a
127 #ifdef __GLASGOW_HASKELL__
128 setUncaughtExceptionHandler, -- :: (Exception -> IO ()) -> IO ()
129 getUncaughtExceptionHandler -- :: IO (Exception -> IO ())
133 #ifdef __GLASGOW_HASKELL__
137 import GHC.IOBase ( IO )
138 import qualified GHC.IOBase as New
139 import GHC.Conc hiding (setUncaughtExceptionHandler,
140 getUncaughtExceptionHandler)
141 import Data.IORef ( IORef, newIORef, readIORef, writeIORef )
142 import Foreign.C.String ( CString, withCString )
143 import GHC.Handle ( stdout, hFlush )
147 import Prelude hiding (catch)
148 import Hugs.Prelude as New (ExitCode(..))
151 import qualified Control.Exception as New
152 import Control.Exception ( toException, fromException, throw, block, unblock, evaluate, throwIO )
153 import System.IO.Error hiding ( catch, try )
154 import System.IO.Unsafe (unsafePerformIO)
160 import System.IO.Error (catch, ioError)
162 import DIOError -- defn of IOError type
164 -- minimum needed for nhc98 to pretend it has Exceptions
165 type Exception = IOError
166 type IOException = IOError
171 throwIO :: Exception -> IO a
173 throw :: Exception -> a
174 throw = unsafePerformIO . throwIO
176 evaluate :: a -> IO a
177 evaluate x = x `seq` return x
179 ioErrors :: Exception -> Maybe IOError
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
195 block :: IO a -> IO a
197 unblock :: IO a -> IO a
200 assert :: Bool -> a -> a
202 assert False _ = throw (UserError "" "Assertion failed")
205 -----------------------------------------------------------------------------
206 -- Catching exceptions
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:
213 -- > catch (openFile f ReadMode)
214 -- > (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e))
216 -- For catching exceptions in pure (non-'IO') expressions, see the
217 -- function 'evaluate'.
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@?
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.
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.
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).
242 -- We recommend either hiding the "Prelude" version of 'Prelude.catch'
243 -- when importing "Control.OldException":
245 -- > import Prelude hiding (catch)
247 -- or importing "Control.OldException" qualified, to avoid name-clashes:
249 -- > import qualified Control.OldException as C
251 -- and then using @C.catch@
254 catch :: IO a -- ^ The computation to run
255 -> (Exception -> IO a) -- ^ Handler to invoke if an exception is raised
257 -- note: bundling the exceptions is done in the New.Exception
258 -- instance of Exception; see below.
261 -- | The function 'catchJust' is like 'catch', but it takes an extra
262 -- argument which is an /exception predicate/, a function which
263 -- selects which type of exceptions we\'re interested in. There are
264 -- some predefined exception predicates for useful subsets of
265 -- exceptions: 'ioErrors', 'arithExceptions', and so on. For example,
266 -- to catch just calls to the 'error' function, we could use
268 -- > result <- catchJust errorCalls thing_to_try handler
270 -- Any other exceptions which are not matched by the predicate
271 -- are re-raised, and may be caught by an enclosing
272 -- 'catch' or 'catchJust'.
274 :: (Exception -> Maybe b) -- ^ Predicate to select exceptions
275 -> IO a -- ^ Computation to run
276 -> (b -> IO a) -- ^ Handler
278 catchJust p a handler = catch a handler'
279 where handler' e = case p e of
283 -- | A version of 'catch' with the arguments swapped around; useful in
284 -- situations where the code for the handler is shorter. For example:
286 -- > do handle (\e -> exitWith (ExitFailure 1)) $
288 handle :: (Exception -> IO a) -> IO a -> IO a
291 -- | A version of 'catchJust' with the arguments swapped around (see
293 handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a
294 handleJust p = flip (catchJust p)
296 -----------------------------------------------------------------------------
299 -- | This function maps one exception into another as proposed in the
300 -- paper \"A semantics for imprecise exceptions\".
302 -- Notice that the usage of 'unsafePerformIO' is safe here.
304 mapException :: (Exception -> Exception) -> a -> a
305 mapException f v = unsafePerformIO (catch (evaluate v)
308 -----------------------------------------------------------------------------
309 -- 'try' and variations.
311 -- | Similar to 'catch', but returns an 'Either' result which is
312 -- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an
313 -- exception was raised and its value is @e@.
315 -- > try a = catch (Right `liftM` a) (return . Left)
317 -- Note: as with 'catch', it is only polite to use this variant if you intend
318 -- to re-throw the exception after performing whatever cleanup is needed.
319 -- Otherwise, 'tryJust' is generally considered to be better.
321 -- Also note that "System.IO.Error" also exports a function called
322 -- 'System.IO.Error.try' with a similar type to 'Control.OldException.try',
323 -- except that it catches only the IO and user families of exceptions
324 -- (as required by the Haskell 98 @IO@ module).
326 try :: IO a -> IO (Either Exception a)
327 try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
329 -- | A variant of 'try' that takes an exception predicate to select
330 -- which exceptions are caught (c.f. 'catchJust'). If the exception
331 -- does not match the predicate, it is re-thrown.
332 tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a)
336 Right v -> return (Right v)
337 Left e -> case p e of
339 Just b -> return (Left b)
341 -----------------------------------------------------------------------------
342 -- Dynamic exceptions
345 -- #DynamicExceptions# Because the 'Exception' datatype is not extensible, there is an
346 -- interface for throwing and catching exceptions of type 'Dynamic'
347 -- (see "Data.Dynamic") which allows exception values of any type in
348 -- the 'Typeable' class to be thrown and caught.
350 -- | Raise any value as an exception, provided it is in the
352 throwDyn :: Typeable exception => exception -> b
354 throwDyn exception = throw (UserError "" "dynamic exception")
356 throwDyn exception = throw (DynException (toDyn exception))
359 #ifdef __GLASGOW_HASKELL__
360 -- | A variant of 'throwDyn' that throws the dynamic exception to an
361 -- arbitrary thread (GHC only: c.f. 'throwTo').
362 throwDynTo :: Typeable exception => ThreadId -> exception -> IO ()
363 throwDynTo t exception = New.throwTo t (DynException (toDyn exception))
364 #endif /* __GLASGOW_HASKELL__ */
366 -- | Catch dynamic exceptions of the required type. All other
367 -- exceptions are re-thrown, including dynamic exceptions of the wrong
370 -- When using dynamic exceptions it is advisable to define a new
371 -- datatype to use for your exception type, to avoid possible clashes
372 -- with dynamic exceptions used in other libraries.
374 catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a
376 catchDyn m k = m -- can't catch dyn exceptions in nhc98
378 catchDyn m k = New.catch m handler
379 where handler ex = case ex of
380 (DynException dyn) ->
381 case fromDynamic dyn of
382 Just exception -> k exception
387 -----------------------------------------------------------------------------
388 -- Exception Predicates
391 -- These pre-defined predicates may be used as the first argument to
392 -- 'catchJust', 'tryJust', or 'handleJust' to select certain common
393 -- classes of exceptions.
395 ioErrors :: Exception -> Maybe IOError
396 arithExceptions :: Exception -> Maybe New.ArithException
397 errorCalls :: Exception -> Maybe String
398 assertions :: Exception -> Maybe String
399 dynExceptions :: Exception -> Maybe Dynamic
400 asyncExceptions :: Exception -> Maybe New.AsyncException
401 userErrors :: Exception -> Maybe String
403 ioErrors (IOException e) = Just e
406 arithExceptions (ArithException e) = Just e
407 arithExceptions _ = Nothing
409 errorCalls (ErrorCall e) = Just e
410 errorCalls _ = Nothing
412 assertions (AssertionFailed e) = Just e
413 assertions _ = Nothing
415 dynExceptions (DynException e) = Just e
416 dynExceptions _ = Nothing
418 asyncExceptions (AsyncException e) = Just e
419 asyncExceptions _ = Nothing
421 userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e)
422 userErrors _ = Nothing
424 -----------------------------------------------------------------------------
425 -- Some Useful Functions
427 -- | When you want to acquire a resource, do some work with it, and
428 -- then release the resource, it is a good idea to use 'bracket',
429 -- because 'bracket' will install the necessary exception handler to
430 -- release the resource in the event that an exception is raised
431 -- during the computation. If an exception is raised, then 'bracket' will
432 -- re-raise the exception (after performing the release).
434 -- A common example is opening a file:
437 -- > (openFile "filename" ReadMode)
439 -- > (\handle -> do { ... })
441 -- The arguments to 'bracket' are in this order so that we can partially apply
444 -- > withFile name mode = bracket (openFile name mode) hClose
448 :: IO a -- ^ computation to run first (\"acquire resource\")
449 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
450 -> (a -> IO c) -- ^ computation to run in-between
451 -> IO c -- returns the value from the in-between computation
452 bracket before after thing =
457 (\e -> do { after a; throw e })
463 -- | A specialised variant of 'bracket' with just a computation to run
466 finally :: IO a -- ^ computation to run first
467 -> IO b -- ^ computation to run afterward (even if an exception
469 -> IO a -- returns the value from the first computation
474 (\e -> do { sequel; throw e })
479 -- | A variant of 'bracket' where the return value from the first computation
481 bracket_ :: IO a -> IO b -> IO c -> IO c
482 bracket_ before after thing = bracket before (const after) (const thing)
484 -- | Like bracket, but only performs the final action if there was an
485 -- exception raised by the in-between computation.
487 :: IO a -- ^ computation to run first (\"acquire resource\")
488 -> (a -> IO b) -- ^ computation to run last (\"release resource\")
489 -> (a -> IO c) -- ^ computation to run in-between
490 -> IO c -- returns the value from the in-between computation
491 bracketOnError before after thing =
496 (\e -> do { after a; throw e })
499 -- -----------------------------------------------------------------------------
500 -- Asynchronous exceptions
504 #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to
505 external influences, and can be raised at any point during execution.
506 'StackOverflow' and 'HeapOverflow' are two examples of
507 system-generated asynchronous exceptions.
509 The primary source of asynchronous exceptions, however, is
512 > throwTo :: ThreadId -> Exception -> IO ()
514 'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one
515 running thread to raise an arbitrary exception in another thread. The
516 exception is therefore asynchronous with respect to the target thread,
517 which could be doing anything at the time it receives the exception.
518 Great care should be taken with asynchronous exceptions; it is all too
519 easy to introduce race conditions by the over zealous use of
524 There\'s an implied 'block' around every exception handler in a call
525 to one of the 'catch' family of functions. This is because that is
526 what you want most of the time - it eliminates a common race condition
527 in starting an exception handler, because there may be no exception
528 handler on the stack to handle another exception if one arrives
529 immediately. If asynchronous exceptions are blocked on entering the
530 handler, though, we have time to install a new exception handler
531 before being interrupted. If this weren\'t the default, one would have
532 to write something like
535 > catch (unblock (...))
539 If you need to unblock asynchronous exceptions again in the exception
540 handler, just use 'unblock' as normal.
542 Note that 'try' and friends /do not/ have a similar default, because
543 there is no exception handler in this case. If you want to use 'try'
544 in an asynchronous-exception-safe way, you will need to use
550 Some operations are /interruptible/, which means that they can receive
551 asynchronous exceptions even in the scope of a 'block'. Any function
552 which may itself block is defined as interruptible; this includes
553 'Control.Concurrent.MVar.takeMVar'
554 (but not 'Control.Concurrent.MVar.tryTakeMVar'),
555 and most operations which perform
556 some I\/O with the outside world. The reason for having
557 interruptible operations is so that we can write things like
561 > catch (unblock (...))
565 if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
567 combination could lead to deadlock, because the thread itself would be
568 blocked in a state where it can\'t receive any asynchronous exceptions.
569 With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be
570 safe in the knowledge that the thread can receive exceptions right up
571 until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds.
572 Similar arguments apply for other interruptible operations like
573 'System.IO.openFile'.
576 #if !(__GLASGOW_HASKELL__ || __NHC__)
577 assert :: Bool -> a -> a
579 assert False _ = throw (AssertionFailed "")
583 #ifdef __GLASGOW_HASKELL__
584 {-# NOINLINE uncaughtExceptionHandler #-}
585 uncaughtExceptionHandler :: IORef (Exception -> IO ())
586 uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)
588 defaultHandler :: Exception -> IO ()
589 defaultHandler ex = do
590 (hFlush stdout) `New.catchAny` (\ _ -> return ())
592 Deadlock -> "no threads to run: infinite loop or deadlock?"
594 other -> showsPrec 0 other ""
595 withCString "%s" $ \cfmt ->
596 withCString msg $ \cmsg ->
599 -- don't use errorBelch() directly, because we cannot call varargs functions
601 foreign import ccall unsafe "HsBase.h errorBelch2"
602 errorBelch :: CString -> CString -> IO ()
604 setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO ()
605 setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler
607 getUncaughtExceptionHandler :: IO (Exception -> IO ())
608 getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler
611 -- ------------------------------------------------------------------------
612 -- Exception datatype and operations
614 -- |The type of exceptions. Every kind of system-generated exception
615 -- has a constructor in the 'Exception' type, and values of other
616 -- types may be injected into 'Exception' by coercing them to
617 -- 'Data.Dynamic.Dynamic' (see the section on Dynamic Exceptions:
618 -- "Control.OldException\#DynamicExceptions").
620 = ArithException New.ArithException
621 -- ^Exceptions raised by arithmetic
622 -- operations. (NOTE: GHC currently does not throw
623 -- 'ArithException's except for 'DivideByZero').
624 | ArrayException New.ArrayException
625 -- ^Exceptions raised by array-related
626 -- operations. (NOTE: GHC currently does not throw
627 -- 'ArrayException's).
628 | AssertionFailed String
629 -- ^This exception is thrown by the
630 -- 'assert' operation when the condition
631 -- fails. The 'String' argument contains the
632 -- location of the assertion in the source program.
633 | AsyncException New.AsyncException
634 -- ^Asynchronous exceptions (see section on Asynchronous Exceptions: "Control.OldException\#AsynchronousExceptions").
636 -- ^The current thread was executing a call to
637 -- 'Control.Concurrent.MVar.takeMVar' that could never return,
638 -- because there are no other references to this 'MVar'.
639 | BlockedIndefinitely
640 -- ^The current thread was waiting to retry an atomic memory transaction
641 -- that could never become possible to complete because there are no other
642 -- threads referring to any of the TVars involved.
644 -- ^The runtime detected an attempt to nest one STM transaction
645 -- inside another one, presumably due to the use of
646 -- 'unsafePeformIO' with 'atomically'.
648 -- ^There are no runnable threads, so the program is
649 -- deadlocked. The 'Deadlock' exception is
650 -- raised in the main thread only (see also: "Control.Concurrent").
651 | DynException Dynamic
652 -- ^Dynamically typed exceptions (see section on Dynamic Exceptions: "Control.OldException\#DynamicExceptions").
654 -- ^The 'ErrorCall' exception is thrown by 'error'. The 'String'
655 -- argument of 'ErrorCall' is the string passed to 'error' when it was
657 | ExitException New.ExitCode
658 -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and
659 -- 'System.Exit.exitFailure'). The 'ExitCode' argument is the value passed
660 -- to 'System.Exit.exitWith'. An unhandled 'ExitException' exception in the
661 -- main thread will cause the program to be terminated with the given
663 | IOException New.IOException
664 -- ^These are the standard IO exceptions generated by
665 -- Haskell\'s @IO@ operations. See also "System.IO.Error".
666 | NoMethodError String
667 -- ^An attempt was made to invoke a class method which has
668 -- no definition in this instance, and there was no default
669 -- definition given in the class declaration. GHC issues a
670 -- warning when you compile an instance which has missing
673 -- ^The current thread is stuck in an infinite loop. This
674 -- exception may or may not be thrown when the program is
676 | PatternMatchFail String
677 -- ^A pattern matching failure. The 'String' argument should contain a
678 -- descriptive message including the function name, source file
681 -- ^An attempt was made to evaluate a field of a record
682 -- for which no value was given at construction time. The
683 -- 'String' argument gives the location of the
684 -- record construction in the source program.
686 -- ^A field selection was attempted on a constructor that
687 -- doesn\'t have the requested field. This can happen with
688 -- multi-constructor records when one or more fields are
689 -- missing from some of the constructors. The
690 -- 'String' argument gives the location of the
691 -- record selection in the source program.
693 -- ^An attempt was made to update a field in a record,
694 -- where the record doesn\'t have the requested field. This can
695 -- only occur with multi-constructor records, when one or more
696 -- fields are missing from some of the constructors. The
697 -- 'String' argument gives the location of the
698 -- record update in the source program.
699 INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
701 -- helper type for simplifying the type casting logic below
702 data Caster = forall e . New.Exception e => Caster (e -> Exception)
704 instance New.Exception Exception where
705 -- We need to collect all the sorts of exceptions that used to be
706 -- bundled up into the Exception type, and rebundle them for
708 fromException exc0 = foldr tryCast Nothing casters where
709 tryCast (Caster f) e = case fromException exc0 of
710 Just exc -> Just (f exc)
713 [Caster (\exc -> ArithException exc),
714 Caster (\exc -> ArrayException exc),
715 Caster (\(New.AssertionFailed err) -> AssertionFailed err),
716 Caster (\exc -> AsyncException exc),
717 Caster (\New.BlockedOnDeadMVar -> BlockedOnDeadMVar),
718 Caster (\New.BlockedIndefinitely -> BlockedIndefinitely),
719 Caster (\New.NestedAtomically -> NestedAtomically),
720 Caster (\New.Deadlock -> Deadlock),
721 Caster (\exc -> DynException exc),
722 Caster (\(New.ErrorCall err) -> ErrorCall err),
723 Caster (\exc -> ExitException exc),
724 Caster (\exc -> IOException exc),
725 Caster (\(New.NoMethodError err) -> NoMethodError err),
726 Caster (\New.NonTermination -> NonTermination),
727 Caster (\(New.PatternMatchFail err) -> PatternMatchFail err),
728 Caster (\(New.RecConError err) -> RecConError err),
729 Caster (\(New.RecSelError err) -> RecSelError err),
730 Caster (\(New.RecUpdError err) -> RecUpdError err),
731 -- Anything else gets taken as a Dynamic exception. It's
732 -- important that we put all exceptions into the old Exception
733 -- type somehow, or throwing a new exception wouldn't cause
734 -- the cleanup code for bracket, finally etc to happen.
735 Caster (\exc -> DynException (toDyn (exc :: New.SomeException)))]
737 -- Unbundle exceptions.
738 toException (ArithException exc) = toException exc
739 toException (ArrayException exc) = toException exc
740 toException (AssertionFailed err) = toException (New.AssertionFailed err)
741 toException (AsyncException exc) = toException exc
742 toException BlockedOnDeadMVar = toException New.BlockedOnDeadMVar
743 toException BlockedIndefinitely = toException New.BlockedIndefinitely
744 toException NestedAtomically = toException New.NestedAtomically
745 toException Deadlock = toException New.Deadlock
746 -- If a dynamic exception is a SomeException then resurrect it, so
747 -- that bracket, catch+throw etc rethrow the same exception even
748 -- when the exception is in the new style.
749 -- If it's not a SomeException, then just throw the Dynamic.
750 toException (DynException exc) = case fromDynamic exc of
752 Nothing -> toException exc
753 toException (ErrorCall err) = toException (New.ErrorCall err)
754 toException (ExitException exc) = toException exc
755 toException (IOException exc) = toException exc
756 toException (NoMethodError err) = toException (New.NoMethodError err)
757 toException NonTermination = toException New.NonTermination
758 toException (PatternMatchFail err) = toException (New.PatternMatchFail err)
759 toException (RecConError err) = toException (New.RecConError err)
760 toException (RecSelError err) = toException (New.RecSelError err)
761 toException (RecUpdError err) = toException (New.RecUpdError err)
763 instance Show Exception where
764 showsPrec _ (IOException err) = shows err
765 showsPrec _ (ArithException err) = shows err
766 showsPrec _ (ArrayException err) = shows err
767 showsPrec _ (ErrorCall err) = showString err
768 showsPrec _ (ExitException err) = showString "exit: " . shows err
769 showsPrec _ (NoMethodError err) = showString err
770 showsPrec _ (PatternMatchFail err) = showString err
771 showsPrec _ (RecSelError err) = showString err
772 showsPrec _ (RecConError err) = showString err
773 showsPrec _ (RecUpdError err) = showString err
774 showsPrec _ (AssertionFailed err) = showString err
775 showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err)
776 showsPrec _ (AsyncException e) = shows e
777 showsPrec p BlockedOnDeadMVar = showsPrec p New.BlockedOnDeadMVar
778 showsPrec p BlockedIndefinitely = showsPrec p New.BlockedIndefinitely
779 showsPrec p NestedAtomically = showsPrec p New.NestedAtomically
780 showsPrec p NonTermination = showsPrec p New.NonTermination
781 showsPrec p Deadlock = showsPrec p New.Deadlock
783 instance Eq Exception where
784 IOException e1 == IOException e2 = e1 == e2
785 ArithException e1 == ArithException e2 = e1 == e2
786 ArrayException e1 == ArrayException e2 = e1 == e2
787 ErrorCall e1 == ErrorCall e2 = e1 == e2
788 ExitException e1 == ExitException e2 = e1 == e2
789 NoMethodError e1 == NoMethodError e2 = e1 == e2
790 PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
791 RecSelError e1 == RecSelError e2 = e1 == e2
792 RecConError e1 == RecConError e2 = e1 == e2
793 RecUpdError e1 == RecUpdError e2 = e1 == e2
794 AssertionFailed e1 == AssertionFailed e2 = e1 == e2
795 DynException _ == DynException _ = False -- incomparable
796 AsyncException e1 == AsyncException e2 = e1 == e2
797 BlockedOnDeadMVar == BlockedOnDeadMVar = True
798 NonTermination == NonTermination = True
799 NestedAtomically == NestedAtomically = True
800 Deadlock == Deadlock = True