{-# OPTIONS_GHC -XNoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
#include "Typeable.h"
NestedAtomically(..),
#endif
- BlockedOnDeadMVar(..),
- BlockedIndefinitely(..),
+ BlockedIndefinitelyOnMVar(..),
+ BlockedIndefinitelyOnSTM(..),
Deadlock(..),
NoMethodError(..),
PatternMatchFail(..),
-- * Asynchronous Exceptions
-- ** Asynchronous exception control
+ mask,
+#ifndef __NHC__
+ mask_,
+ uninterruptibleMask,
+ uninterruptibleMask_,
+ MaskingState(..),
+ getMaskingState,
+#endif
+
+ -- ** (deprecated) Asynchronous exception control
block,
unblock,
#ifdef __GLASGOW_HASKELL__
import GHC.Base
-import GHC.IOBase
+import GHC.IO hiding (finally,onException)
+import GHC.IO.Exception
+import GHC.Exception
import GHC.Show
-import GHC.IOBase
-import GHC.Exception hiding ( Exception )
+-- import GHC.Exception hiding ( Exception )
import GHC.Conc
#endif
data PatternMatchFail
data NoMethodError
data Deadlock
-data BlockedOnDeadMVar
-data BlockedIndefinitely
+data BlockedIndefinitelyOnMVar
+data BlockedIndefinitelyOnSTM
data ErrorCall
data RecConError
data RecSelError
instance Show PatternMatchFail
instance Show NoMethodError
instance Show Deadlock
-instance Show BlockedOnDeadMVar
-instance Show BlockedIndefinitely
+instance Show BlockedIndefinitelyOnMVar
+instance Show BlockedIndefinitelyOnSTM
instance Show ErrorCall
instance Show RecConError
instance Show RecSelError
assert True x = x
assert False _ = throw (toException (UserError "" "Assertion failed"))
+mask :: ((IO a-> IO a) -> IO a) -> IO a
+mask action = action restore
+ where restore act = act
+
#endif
#ifdef __HUGS__
INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
-INSTANCE_TYPEABLE0(BlockedOnDeadMVar,blockedOnDeadMVarTc,"BlockedOnDeadMVar")
-INSTANCE_TYPEABLE0(BlockedIndefinitely,blockedIndefinitelyTc,"BlockedIndefinitely")
+INSTANCE_TYPEABLE0(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")
+INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM")
INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
instance Exception SomeException where
fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
fromException _ = Nothing
-data BlockedOnDeadMVar = BlockedOnDeadMVar
-data BlockedIndefinitely = BlockedIndefinitely
+data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
+data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
data Deadlock = Deadlock
data AssertionFailed = AssertionFailed String
data AsyncException
| UserInterrupt
deriving (Eq, Ord)
-instance Show BlockedOnDeadMVar where
- showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
+instance Show BlockedIndefinitelyOnMVar where
+ showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely"
instance Show BlockedIndefinitely where
showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
--
-- Note that we have to give a type signature to @e@, or the program
-- will not typecheck as the type is ambiguous. While it is possible
--- to catch exceptions of any type, see $catchall for an explanation
--- of the problems with doing so.
+-- to catch exceptions of any type, see the previous section \"Catching all
+-- exceptions\" for an explanation of the problems with doing so.
--
-- For catching exceptions in pure (non-'IO') expressions, see the
-- function 'evaluate'.
-> (e -> IO a) -- ^ Handler to invoke if an exception is raised
-> IO a
#if __GLASGOW_HASKELL__
-catch = GHC.IOBase.catchException
+catch = GHC.IO.catchException
#elif __HUGS__
catch m h = Hugs.Exception.catchException m h'
where h' e = case fromException e of
-- | Like 'finally', but only performs the final action if there was an
-- exception raised by the computation.
onException :: IO a -> IO b -> IO a
-onException io what = io `catch` \e -> do what
+onException io what = io `catch` \e -> do _ <- what
throw (e :: SomeException)
-----------------------------------------------------------------------------
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracket before after thing =
- block (do
+ mask $ \restore -> do
a <- before
- r <- unblock (thing a) `onException` after a
- after a
+ r <- restore (thing a) `onException` after a
+ _ <- after a
return r
- )
#endif
-- | A specialised variant of 'bracket' with just a computation to run
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
- block (do
- r <- unblock a `onException` sequel
- sequel
+ mask $ \restore -> do
+ r <- restore a `onException` sequel
+ _ <- sequel
return r
- )
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
- block (do
+ mask $ \restore -> do
a <- before
- unblock (thing a) `onException` after a
- )
+ restore (thing a) `onException` after a
#if !(__GLASGOW_HASKELL__ || __NHC__)
assert :: Bool -> a -> a
-----
-instance Exception Dynamic
-
#endif /* __GLASGOW_HASKELL__ || __HUGS__ */
#ifdef __GLASGOW_HASKELL__