X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException.hs;h=bbcc490032bea2339cef084211cc47c9024596b1;hb=4c29f6f110d23b890567b8696a964bb212eba52e;hp=e52f674725efcb47d4cd03b323b79bff0316523a;hpb=26d2805a6e58822d246cf9601fb226b0861e7f65;p=ghc-base.git diff --git a/Control/Exception.hs b/Control/Exception.hs index e52f674..bbcc490 100644 --- a/Control/Exception.hs +++ b/Control/Exception.hs @@ -1,9 +1,11 @@ +{-# OPTIONS_GHC -XNoImplicitPrelude #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Exception -- Copyright : (c) The University of Glasgow 2001 -- License : BSD-style (see the file libraries/base/LICENSE) --- +-- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : non-portable (extended exceptions) @@ -23,463 +25,206 @@ -- * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton -- Jones, Andy Moran and John Reppy, in /PLDI'01/. -- +-- * /An Extensible Dynamically-Typed Hierarchy of Exceptions/, +-- by Simon Marlow, in /Haskell '06/. +-- ----------------------------------------------------------------------------- module Control.Exception ( - -- * The Exception type - Exception(..), -- instance Eq, Ord, Show, Typeable - IOException, -- instance Eq, Ord, Show, Typeable - ArithException(..), -- instance Eq, Ord, Show, Typeable - ArrayException(..), -- instance Eq, Ord, Show, Typeable - AsyncException(..), -- instance Eq, Ord, Show, Typeable - - -- * Throwing exceptions - throwIO, -- :: Exception -> IO a - throw, -- :: Exception -> a - ioError, -- :: IOError -> IO a + -- * The Exception type +#ifdef __HUGS__ + SomeException, +#else + SomeException(..), +#endif + Exception(..), -- class + IOException, -- instance Eq, Ord, Show, Typeable, Exception + ArithException(..), -- instance Eq, Ord, Show, Typeable, Exception + ArrayException(..), -- instance Eq, Ord, Show, Typeable, Exception + AssertionFailed(..), + AsyncException(..), -- instance Eq, Ord, Show, Typeable, Exception + +#if __GLASGOW_HASKELL__ || __HUGS__ + NonTermination(..), + NestedAtomically(..), +#endif +#ifdef __NHC__ + System.ExitCode(), -- instance Exception +#endif + + BlockedIndefinitelyOnMVar(..), + BlockedIndefinitelyOnSTM(..), + Deadlock(..), + NoMethodError(..), + PatternMatchFail(..), + RecConError(..), + RecSelError(..), + RecUpdError(..), + ErrorCall(..), + + -- * Throwing exceptions + throw, + throwIO, + ioError, #ifdef __GLASGOW_HASKELL__ - throwTo, -- :: ThreadId -> Exception -> a + throwTo, #endif - -- * Catching Exceptions + -- * Catching Exceptions - -- |There are several functions for catching and examining - -- exceptions; all of them may only be used from within the - -- 'IO' monad. + -- $catching - -- ** The @catch@ functions - catch, -- :: IO a -> (Exception -> IO a) -> IO a - catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a + -- ** Catching all exceptions - -- ** The @handle@ functions - handle, -- :: (Exception -> IO a) -> IO a -> IO a - handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a + -- $catchall - -- ** The @try@ functions - try, -- :: IO a -> IO (Either Exception a) - tryJust, -- :: (Exception -> Maybe b) -> a -> IO (Either b a) + -- ** The @catch@ functions + catch, + catches, Handler(..), + catchJust, - -- ** The @evaluate@ function - evaluate, -- :: a -> IO a + -- ** The @handle@ functions + handle, + handleJust, - -- ** The @mapException@ function - mapException, -- :: (Exception -> Exception) -> a -> a + -- ** The @try@ functions + try, + tryJust, - -- ** Exception predicates - - -- $preds + -- ** The @evaluate@ function + evaluate, - ioErrors, -- :: Exception -> Maybe IOError - arithExceptions, -- :: Exception -> Maybe ArithException - errorCalls, -- :: Exception -> Maybe String - dynExceptions, -- :: Exception -> Maybe Dynamic - assertions, -- :: Exception -> Maybe String - asyncExceptions, -- :: Exception -> Maybe AsyncException - userErrors, -- :: Exception -> Maybe String + -- ** The @mapException@ function + mapException, - -- * Dynamic exceptions + -- * Asynchronous Exceptions - -- $dynamic - throwDyn, -- :: Typeable ex => ex -> b -#ifdef __GLASGOW_HASKELL__ - throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b -#endif - catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a - - -- * Asynchronous Exceptions + -- $async - -- $async + -- ** Asynchronous exception control - -- ** Asynchronous exception control + -- |The following functions allow a thread to control delivery of + -- asynchronous exceptions during a critical region. - -- |The following two functions allow a thread to control delivery of - -- asynchronous exceptions during a critical region. + mask, + mask_, + uninterruptibleMask, + uninterruptibleMask_, + MaskingState(..), + getMaskingState, - block, -- :: IO a -> IO a - unblock, -- :: IO a -> IO a + -- ** (deprecated) Asynchronous exception control - -- *** Applying @block@ to an exception handler + block, + unblock, + blocked, - -- $block_handler + -- *** Applying @block@ to an exception handler - -- *** Interruptible operations + -- $block_handler - -- $interruptible + -- *** Interruptible operations - -- * Assertions + -- $interruptible - assert, -- :: Bool -> a -> a + -- * Assertions - -- * Utilities + assert, - bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO () - bracket_, -- :: IO a -> IO b -> IO c -> IO () - bracketOnError, + -- * Utilities - finally, -- :: IO a -> IO b -> IO a - -#ifdef __GLASGOW_HASKELL__ - setUncaughtExceptionHandler, -- :: (Exception -> IO ()) -> IO () - getUncaughtExceptionHandler -- :: IO (Exception -> IO ()) -#endif - ) where + bracket, + bracket_, + bracketOnError, -#ifdef __GLASGOW_HASKELL__ -import GHC.Base ( assert ) -import GHC.Exception as ExceptionBase hiding (catch) -import GHC.Conc ( throwTo, ThreadId ) -import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) -import Foreign.C.String ( CString, withCString ) -import System.IO ( stdout, hFlush ) -#endif + finally, + onException, -#ifdef __HUGS__ -import Hugs.Exception as ExceptionBase -#endif + ) where -import Prelude hiding ( catch ) -import System.IO.Error hiding ( catch, try ) -import System.IO.Unsafe (unsafePerformIO) -import Data.Dynamic +import Control.Exception.Base -#ifdef __NHC__ -import System.IO.Error (catch, ioError) -import IO (bracket) -import DIOError -- defn of IOError type - --- minimum needed for nhc98 to pretend it has Exceptions -type Exception = IOError -type IOException = IOError -data ArithException -data ArrayException -data AsyncException - -throwIO :: Exception -> IO a -throwIO = ioError -throw :: Exception -> a -throw = unsafePerformIO . throwIO - -evaluate :: a -> IO a -evaluate x = x `seq` return x - -ioErrors :: Exception -> Maybe IOError -ioErrors e = Just e -arithExceptions :: Exception -> Maybe ArithException -arithExceptions = const Nothing -errorCalls :: Exception -> Maybe String -errorCalls = const Nothing -dynExceptions :: Exception -> Maybe Dynamic -dynExceptions = const Nothing -assertions :: Exception -> Maybe String -assertions = const Nothing -asyncExceptions :: Exception -> Maybe AsyncException -asyncExceptions = const Nothing -userErrors :: Exception -> Maybe String -userErrors (UserError _ s) = Just s -userErrors _ = Nothing - -block :: IO a -> IO a -block = id -unblock :: IO a -> IO a -unblock = id - -assert :: Bool -> a -> a -assert True x = x -assert False _ = throw (UserError "" "Assertion failed") +#ifdef __GLASGOW_HASKELL__ +import GHC.Base +import Data.Maybe +#else +import Prelude hiding (catch) #endif ------------------------------------------------------------------------------ --- Catching exceptions - --- |This is the simplest of the exception-catching functions. It --- takes a single argument, runs it, and if an exception is raised --- the \"handler\" is executed, with the value of the exception passed as an --- argument. Otherwise, the result is returned as normal. For example: --- --- > catch (openFile f ReadMode) --- > (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e)) --- --- For catching exceptions in pure (non-'IO') expressions, see the --- function 'evaluate'. --- --- Note that due to Haskell\'s unspecified evaluation order, an --- expression may return one of several possible exceptions: consider --- the expression @error \"urk\" + 1 \`div\` 0@. Does --- 'catch' execute the handler passing --- @ErrorCall \"urk\"@, or @ArithError DivideByZero@? --- --- The answer is \"either\": 'catch' makes a --- non-deterministic choice about which exception to catch. If you --- call it again, you might get a different exception back. This is --- ok, because 'catch' is an 'IO' computation. --- --- Note that 'catch' catches all types of exceptions, and is generally --- used for \"cleaning up\" before passing on the exception using --- 'throwIO'. It is not good practice to discard the exception and --- continue, without first checking the type of the exception (it --- might be a 'ThreadKilled', for example). In this case it is usually better --- to use 'catchJust' and select the kinds of exceptions to catch. --- --- Also note that the "Prelude" also exports a function called --- 'Prelude.catch' with a similar type to 'Control.Exception.catch', --- except that the "Prelude" version only catches the IO and user --- families of exceptions (as required by Haskell 98). --- --- We recommend either hiding the "Prelude" version of 'Prelude.catch' --- when importing "Control.Exception": --- --- > import Prelude hiding (catch) --- --- or importing "Control.Exception" qualified, to avoid name-clashes: --- --- > import qualified Control.Exception as C --- --- and then using @C.catch@ --- -#ifndef __NHC__ -catch :: IO a -- ^ The computation to run - -> (Exception -> IO a) -- ^ Handler to invoke if an exception is raised - -> IO a -catch = ExceptionBase.catchException +#ifdef __NHC__ +import System (ExitCode()) #endif --- | The function 'catchJust' is like 'catch', but it takes an extra --- argument which is an /exception predicate/, a function which --- selects which type of exceptions we\'re interested in. There are --- some predefined exception predicates for useful subsets of --- exceptions: 'ioErrors', 'arithExceptions', and so on. For example, --- to catch just calls to the 'error' function, we could use --- --- > result <- catchJust errorCalls thing_to_try handler --- --- Any other exceptions which are not matched by the predicate --- are re-raised, and may be caught by an enclosing --- 'catch' or 'catchJust'. -catchJust - :: (Exception -> Maybe b) -- ^ Predicate to select exceptions - -> IO a -- ^ Computation to run - -> (b -> IO a) -- ^ Handler - -> IO a -catchJust p a handler = catch a handler' - where handler' e = case p e of - Nothing -> throw e - Just b -> handler b - --- | A version of 'catch' with the arguments swapped around; useful in --- situations where the code for the handler is shorter. For example: --- --- > do handle (\e -> exitWith (ExitFailure 1)) $ --- > ... -handle :: (Exception -> IO a) -> IO a -> IO a -handle = flip catch - --- | A version of 'catchJust' with the arguments swapped around (see --- 'handle'). -handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a -handleJust p = flip (catchJust p) - ------------------------------------------------------------------------------ --- 'mapException' - --- | This function maps one exception into another as proposed in the --- paper \"A semantics for imprecise exceptions\". --- Notice that the usage of 'unsafePerformIO' is safe here. +-- | You need this when using 'catches'. +data Handler a = forall e . Exception e => Handler (e -> IO a) -mapException :: (Exception -> Exception) -> a -> a -mapException f v = unsafePerformIO (catch (evaluate v) - (\x -> throw (f x))) +{- | +Sometimes you want to catch two different sorts of exception. You could +do something like ------------------------------------------------------------------------------ --- 'try' and variations. +> f = expr `catch` \ (ex :: ArithException) -> handleArith ex +> `catch` \ (ex :: IOException) -> handleIO ex --- | Similar to 'catch', but returns an 'Either' result which is --- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an --- exception was raised and its value is @e@. --- --- > try a = catch (Right `liftM` a) (return . Left) --- --- Note: as with 'catch', it is only polite to use this variant if you intend --- to re-throw the exception after performing whatever cleanup is needed. --- Otherwise, 'tryJust' is generally considered to be better. --- --- Also note that "System.IO.Error" also exports a function called --- 'System.IO.Error.try' with a similar type to 'Control.Exception.try', --- except that it catches only the IO and user families of exceptions --- (as required by the Haskell 98 @IO@ module). - -try :: IO a -> IO (Either Exception a) -try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) - --- | A variant of 'try' that takes an exception predicate to select --- which exceptions are caught (c.f. 'catchJust'). If the exception --- does not match the predicate, it is re-thrown. -tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a) -tryJust p a = do - r <- try a - case r of - Right v -> return (Right v) - Left e -> case p e of - Nothing -> throw e - Just b -> return (Left b) +However, there are a couple of problems with this approach. The first is +that having two exception handlers is inefficient. However, the more +serious issue is that the second exception handler will catch exceptions +in the first, e.g. in the example above, if @handleArith@ throws an +@IOException@ then the second exception handler will catch it. ------------------------------------------------------------------------------ --- Dynamic exceptions +Instead, we provide a function 'catches', which would be used thus: --- $dynamic --- #DynamicExceptions# Because the 'Exception' datatype is not extensible, there is an --- interface for throwing and catching exceptions of type 'Dynamic' --- (see "Data.Dynamic") which allows exception values of any type in --- the 'Typeable' class to be thrown and caught. +> f = expr `catches` [Handler (\ (ex :: ArithException) -> handleArith ex), +> Handler (\ (ex :: IOException) -> handleIO ex)] +-} +catches :: IO a -> [Handler a] -> IO a +catches io handlers = io `catch` catchesHandler handlers --- | Raise any value as an exception, provided it is in the --- 'Typeable' class. -throwDyn :: Typeable exception => exception -> b -#ifdef __NHC__ -throwDyn exception = throw (UserError "" "dynamic exception") -#else -throwDyn exception = throw (DynException (toDyn exception)) -#endif +catchesHandler :: [Handler a] -> SomeException -> IO a +catchesHandler handlers e = foldr tryHandler (throw e) handlers + where tryHandler (Handler handler) res + = case fromException e of + Just e' -> handler e' + Nothing -> res -#ifdef __GLASGOW_HASKELL__ --- | A variant of 'throwDyn' that throws the dynamic exception to an --- arbitrary thread (GHC only: c.f. 'throwTo'). -throwDynTo :: Typeable exception => ThreadId -> exception -> IO () -throwDynTo t exception = throwTo t (DynException (toDyn exception)) -#endif /* __GLASGOW_HASKELL__ */ - --- | Catch dynamic exceptions of the required type. All other --- exceptions are re-thrown, including dynamic exceptions of the wrong --- type. --- --- When using dynamic exceptions it is advisable to define a new --- datatype to use for your exception type, to avoid possible clashes --- with dynamic exceptions used in other libraries. --- -catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a -#ifdef __NHC__ -catchDyn m k = m -- can't catch dyn exceptions in nhc98 -#else -catchDyn m k = catchException m handle - where handle ex = case ex of - (DynException dyn) -> - case fromDynamic dyn of - Just exception -> k exception - Nothing -> throw ex - _ -> throw ex -#endif +-- ----------------------------------------------------------------------------- +-- Catching exceptions ------------------------------------------------------------------------------ --- Exception Predicates +{- $catching --- $preds --- These pre-defined predicates may be used as the first argument to --- 'catchJust', 'tryJust', or 'handleJust' to select certain common --- classes of exceptions. -#ifndef __NHC__ -ioErrors :: Exception -> Maybe IOError -arithExceptions :: Exception -> Maybe ArithException -errorCalls :: Exception -> Maybe String -assertions :: Exception -> Maybe String -dynExceptions :: Exception -> Maybe Dynamic -asyncExceptions :: Exception -> Maybe AsyncException -userErrors :: Exception -> Maybe String +There are several functions for catching and examining +exceptions; all of them may only be used from within the +'IO' monad. -ioErrors (IOException e) = Just e -ioErrors _ = Nothing +Here's a rule of thumb for deciding which catch-style function to +use: -arithExceptions (ArithException e) = Just e -arithExceptions _ = Nothing + * If you want to do some cleanup in the event that an exception + is raised, use 'finally', 'bracket' or 'onException'. -errorCalls (ErrorCall e) = Just e -errorCalls _ = Nothing + * To recover after an exception and do something else, the best + choice is to use one of the 'try' family. -assertions (AssertionFailed e) = Just e -assertions _ = Nothing + * ... unless you are recovering from an asynchronous exception, in which + case use 'catch' or 'catchJust'. -dynExceptions (DynException e) = Just e -dynExceptions _ = Nothing +The difference between using 'try' and 'catch' for recovery is that in +'catch' the handler is inside an implicit 'block' (see \"Asynchronous +Exceptions\") which is important when catching asynchronous +exceptions, but when catching other kinds of exception it is +unnecessary. Furthermore it is possible to accidentally stay inside +the implicit 'block' by tail-calling rather than returning from the +handler, which is why we recommend using 'try' rather than 'catch' for +ordinary exception recovery. -asyncExceptions (AsyncException e) = Just e -asyncExceptions _ = Nothing +A typical use of 'tryJust' for recovery looks like this: -userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e) -userErrors _ = Nothing -#endif ------------------------------------------------------------------------------ --- Some Useful Functions - --- | When you want to acquire a resource, do some work with it, and --- then release the resource, it is a good idea to use 'bracket', --- because 'bracket' will install the necessary exception handler to --- release the resource in the event that an exception is raised --- during the computation. If an exception is raised, then 'bracket' will --- re-raise the exception (after performing the release). --- --- A common example is opening a file: --- --- > bracket --- > (openFile "filename" ReadMode) --- > (hClose) --- > (\handle -> do { ... }) --- --- The arguments to 'bracket' are in this order so that we can partially apply --- it, e.g.: --- --- > withFile name mode = bracket (openFile name mode) hClose --- -#ifndef __NHC__ -bracket - :: IO a -- ^ computation to run first (\"acquire resource\") - -> (a -> IO b) -- ^ computation to run last (\"release resource\") - -> (a -> IO c) -- ^ computation to run in-between - -> IO c -- returns the value from the in-between computation -bracket before after thing = - block (do - a <- before - r <- catch - (unblock (thing a)) - (\e -> do { after a; throw e }) - after a - return r - ) -#endif +> do r <- tryJust (guard . isDoesNotExistError) $ getEnv "HOME" +> case r of +> Left e -> ... +> Right home -> ... --- | A specialised variant of 'bracket' with just a computation to run --- afterward. --- -finally :: IO a -- ^ computation to run first - -> IO b -- ^ computation to run afterward (even if an exception - -- was raised) - -> IO a -- returns the value from the first computation -a `finally` sequel = - block (do - r <- catch - (unblock a) - (\e -> do { sequel; throw e }) - sequel - return r - ) - --- | A variant of 'bracket' where the return value from the first computation --- is not required. -bracket_ :: IO a -> IO b -> IO c -> IO c -bracket_ before after thing = bracket before (const after) (const thing) - --- | Like bracket, but only performs the final action if there was an --- exception raised by the in-between computation. -bracketOnError - :: IO a -- ^ computation to run first (\"acquire resource\") - -> (a -> IO b) -- ^ computation to run last (\"release resource\") - -> (a -> IO c) -- ^ computation to run in-between - -> IO c -- returns the value from the in-between computation -bracketOnError before after thing = - block (do - a <- before - catch - (unblock (thing a)) - (\e -> do { after a; throw e }) - ) +-} -- ----------------------------------------------------------------------------- -- Asynchronous exceptions @@ -506,7 +251,7 @@ easy to introduce race conditions by the over zealous use of -} {- $block_handler -There\'s an implied 'block' around every exception handler in a call +There\'s an implied 'mask' around every exception handler in a call to one of the 'catch' family of functions. This is because that is what you want most of the time - it eliminates a common race condition in starting an exception handler, because there may be no exception @@ -516,22 +261,21 @@ handler, though, we have time to install a new exception handler before being interrupted. If this weren\'t the default, one would have to write something like -> block ( -> catch (unblock (...)) -> (\e -> handler) -> ) +> block $ \restore -> +> catch (restore (...)) +> (\e -> handler) If you need to unblock asynchronous exceptions again in the exception handler, just use 'unblock' as normal. Note that 'try' and friends /do not/ have a similar default, because -there is no exception handler in this case. If you want to use 'try' -in an asynchronous-exception-safe way, you will need to use -'block'. +there is no exception handler in this case. Don't use 'try' for +recovering from an asynchronous exception. -} {- $interruptible + #interruptible# Some operations are /interruptible/, which means that they can receive asynchronous exceptions even in the scope of a 'block'. Any function which may itself block is defined as interruptible; this includes @@ -541,11 +285,10 @@ and most operations which perform some I\/O with the outside world. The reason for having interruptible operations is so that we can write things like -> block ( +> mask $ \restore -> do > a <- takeMVar m -> catch (unblock (...)) +> catch (restore (...)) > (\e -> ...) -> ) if the 'Control.Concurrent.MVar.takeMVar' was not interruptible, then this particular @@ -558,35 +301,46 @@ Similar arguments apply for other interruptible operations like 'System.IO.openFile'. -} -#if !(__GLASGOW_HASKELL__ || __NHC__) -assert :: Bool -> a -> a -assert True x = x -assert False _ = throw (AssertionFailed "") -#endif - +{- $catchall + +It is possible to catch all exceptions, by using the type 'SomeException': + +> catch f (\e -> ... (e :: SomeException) ...) + +HOWEVER, this is normally not what you want to do! + +For example, suppose you want to read a file, but if it doesn't exist +then continue as if it contained \"\". You might be tempted to just +catch all exceptions and return \"\" in the handler. However, this has +all sorts of undesirable consequences. For example, if the user +presses control-C at just the right moment then the 'UserInterrupt' +exception will be caught, and the program will continue running under +the belief that the file contains \"\". Similarly, if another thread +tries to kill the thread reading the file then the 'ThreadKilled' +exception will be ignored. + +Instead, you should only catch exactly the exceptions that you really +want. In this case, this would likely be more specific than even +\"any IO exception\"; a permissions error would likely also want to be +handled differently. Instead, you would probably want something like: + +> e <- tryJust (guard . isDoesNotExistError) (readFile f) +> let str = either (const "") id e + +There are occassions when you really do need to catch any sort of +exception. However, in most cases this is just so you can do some +cleaning up; you aren't actually interested in the exception itself. +For example, if you open a file then you want to close it again, +whether processing the file executes normally or throws an exception. +However, in these cases you can use functions like 'bracket', 'finally' +and 'onException', which never actually pass you the exception, but +just call the cleanup functions at the appropriate points. + +But sometimes you really do need to catch any exception, and actually +see what the exception is. One example is at the very top-level of a +program, you may wish to catch any exception, print it to a logfile or +the screen, and then exit gracefully. For these cases, you can use +'catch' (or one of the other exception-catching functions) with the +'SomeException' type. +-} -#ifdef __GLASGOW_HASKELL__ -{-# NOINLINE uncaughtExceptionHandler #-} -uncaughtExceptionHandler :: IORef (Exception -> IO ()) -uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler) - where - defaultHandler :: Exception -> IO () - defaultHandler ex = do - (hFlush stdout) `catchException` (\ _ -> return ()) - let msg = case ex of - Deadlock -> "no threads to run: infinite loop or deadlock?" - ErrorCall s -> s - other -> showsPrec 0 other "\n" - withCString "%s" $ \cfmt -> - withCString msg $ \cmsg -> - errorBelch cfmt cmsg - -foreign import ccall unsafe "RtsMessages.h errorBelch" - errorBelch :: CString -> CString -> IO () - -setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO () -setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler - -getUncaughtExceptionHandler :: IO (Exception -> IO ()) -getUncaughtExceptionHandler = readIORef uncaughtExceptionHandler -#endif