-- * 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
bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
bracket_, -- :: IO a -> IO b -> IO c -> IO ()
- finally, -- :: IO a -> IO b -> IO b
+ finally, -- :: IO a -> IO b -> IO a
) 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"
+#include "Typeable.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.
--
-- Also note that The "Prelude" also exports a
-- function called 'catch' which has the same type as
--- 'Exception.catch', the difference being that the
+-- 'Control.Exception.catch', the difference being 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
-- > 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
> throwTo :: ThreadId -> Exception -> IO ()
-'throwTo' (also 'throwDynTo' and 'Concurrent.killThread') allows one
+'throwTo' (also 'throwDynTo' and 'Control.Concurrent.killThread') allows one
running thread to raise an arbitrary exception in another thread. The
exception is therefore asynchronous with respect to the target thread,
which could be doing anything at the time it receives the exception.
safe in the knowledge that the thread can receive exceptions right up
until the point when the 'takeMVar' succeeds.
Similar arguments apply for other interruptible operations like
-'IO.openFile'.
+'GHC.Handle.openFile'.
-}
-- -----------------------------------------------------------------------------
#ifndef __GLASGOW_HASKELL__
assert :: Bool -> a -> a
assert True x = x
-assert False _ = error "Assertion failure"
+assert False _ = throw (AssertionFailed "")
#endif
projects / ghc-base.git / blobdiff