-- * The Exception type
Exception(..), -- instance Eq, Ord, Show, Typeable
-#ifdef __GLASGOW_HASKELL__
IOException, -- instance Eq, Ord, Show, Typeable
ArithException(..), -- instance Eq, Ord, Show, Typeable
ArrayException(..), -- instance Eq, Ord, Show, Typeable
AsyncException(..), -- instance Eq, Ord, Show, Typeable
-#endif
-- * Throwing exceptions
-#ifndef __HUGS__
+ throwIO, -- :: Exception -> IO a
throw, -- :: Exception -> a
-#endif
- ioError, -- :: Exception -> IO a
-#ifndef __HUGS__
+ ioError, -- :: IOError -> IO a
+#ifdef __GLASGOW_HASKELL__
throwTo, -- :: ThreadId -> Exception -> a
#endif
-- ** The @evaluate@ function
evaluate, -- :: a -> IO a
+ -- ** The @mapException@ function
+ mapException, -- :: (Exception -> Exception) -> a -> a
+
-- ** Exception predicates
-- $preds
ioErrors, -- :: Exception -> Maybe IOError
-#ifndef __HUGS__
arithExceptions, -- :: Exception -> Maybe ArithException
errorCalls, -- :: Exception -> Maybe String
dynExceptions, -- :: Exception -> Maybe Dynamic
assertions, -- :: Exception -> Maybe String
asyncExceptions, -- :: Exception -> Maybe AsyncException
-#endif /* __HUGS__ */
userErrors, -- :: Exception -> Maybe String
-#ifdef __GLASGOW_HASKELL__
-- * Dynamic exceptions
-- $dynamic
throwDyn, -- :: Typeable ex => ex -> b
+#ifdef __GLASGOW_HASKELL__
throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b
- catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
#endif
+ catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a
-- * Asynchronous Exceptions
) where
#ifdef __GLASGOW_HASKELL__
-import Prelude hiding (catch)
import GHC.Base ( assert )
-import GHC.Exception as ExceptionBase hiding (try, catch, bracket, bracket_)
+import GHC.Exception as ExceptionBase hiding (catch)
import GHC.Conc ( throwTo, ThreadId )
import GHC.IOBase ( IO(..) )
#endif
#ifdef __HUGS__
-import Prelude hiding ( catch, ioError )
-import Hugs.Exception hiding ( evaluate )
-import qualified Hugs.Exception as ExceptionBase
+import Hugs.Exception as ExceptionBase
#endif
-import System.IO.Error
+import Prelude hiding ( catch )
+import System.IO.Error hiding ( catch, try )
+import System.IO.Unsafe (unsafePerformIO)
import Data.Dynamic
#include "Dynamic.h"
INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception")
-#ifdef __GLASGOW_HASKELL__
INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException")
INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
-#endif
-
-#ifdef __HUGS__
--- This is as close as Hugs gets to providing throw
-throw :: Exception -> IO a
-throw = ioError
-#endif
-----------------------------------------------------------------------------
-- Catching exceptions
--
-- Note that 'catch' catches all types of exceptions, and is generally
-- used for \"cleaning up\" before passing on the exception using
--- 'ioError'. It is not good practice to discard the exception and
+-- '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.
-- > catch (evaluate undefined) (\e -> return ()) ==> return ()
--
-- NOTE: @(evaluate a)@ is /not/ the same as @(a \`seq\` return a)@.
+#ifdef __GLASGOW_HASKELL__
evaluate :: a -> IO a
-#if defined(__GLASGOW_HASKELL__)
evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #)
-- NB. can't write
-- a `seq` (# s, a #)
-- because we can't have an unboxed tuple as a function argument
-#elif defined(__HUGS__)
-evaluate = ExceptionBase.evaluate
#endif
-----------------------------------------------------------------------------
+-- '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.
+
+mapException :: (Exception -> Exception) -> a -> a
+mapException f v = unsafePerformIO (catch (evaluate v)
+ (\x -> throw (f x)))
+
+-----------------------------------------------------------------------------
-- 'try' and variations.
-- | Similar to 'catch', but returns an 'Either' result which is
Nothing -> throw e
Just b -> return (Left b)
-#ifdef __GLASGOW_HASKELL__
-----------------------------------------------------------------------------
-- Dynamic exceptions
throwDyn :: Typeable exception => exception -> b
throwDyn exception = throw (DynException (toDyn exception))
+#ifdef __GLASGOW_HASKELL__
-- | A variant of 'throwDyn' that throws the dynamic exception to an
--- arbitrary thread (c.f. 'throwTo').
+-- 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
Just exception -> k exception
Nothing -> throw ex
_ -> throw ex
-#endif /* __GLASGOW_HASKELL__ */
-----------------------------------------------------------------------------
-- Exception Predicates
-- classes of exceptions.
ioErrors :: Exception -> Maybe IOError
-#ifdef __GLASGOW_HASKELL__
arithExceptions :: Exception -> Maybe ArithException
errorCalls :: Exception -> Maybe String
-dynExceptions :: Exception -> Maybe Dynamic
assertions :: Exception -> Maybe String
+dynExceptions :: Exception -> Maybe Dynamic
asyncExceptions :: Exception -> Maybe AsyncException
-#endif /* __GLASGOW_HASKELL__ */
userErrors :: Exception -> Maybe String
-#ifdef __HUGS__
-ioErrors = justIoErrors
-userErrors = justUserErrors
-#endif
-
-#ifdef __GLASGOW_HASKELL__
-ioErrors e@(IOException _) = Just e
+ioErrors (IOException e) = Just e
ioErrors _ = Nothing
arithExceptions (ArithException e) = Just e
asyncExceptions (AsyncException e) = Just e
asyncExceptions _ = Nothing
-userErrors e@IOException{} | isUserError e = Just (ioeGetErrorString e)
+userErrors (IOException e) | isUserError e = Just (ioeGetErrorString e)
userErrors _ = Nothing
-#endif /* __GLASGOW_HASKELL__ */
-----------------------------------------------------------------------------
-- Some Useful Functions
#ifndef __GLASGOW_HASKELL__
assert :: Bool -> a -> a
assert True x = x
-assert False _ = error "Assertion failure"
+assert False _ = throw (AssertionFailed "")
#endif