projects
/
ghc-base.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
add ga_inl, ga_inr
[ghc-base.git]
/
Control
/
OldException.hs
diff --git
a/Control/OldException.hs
b/Control/OldException.hs
index
48f1bbb
..
6442d67
100644
(file)
--- a/
Control/OldException.hs
+++ b/
Control/OldException.hs
@@
-1,4
+1,11
@@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP
+ , NoImplicitPrelude
+ , ForeignFunctionInterface
+ , ExistentialQuantification
+ #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
#include "Typeable.h"
#include "Typeable.h"
@@
-132,7
+139,6
@@
module Control.OldException {-# DEPRECATED "Future versions of base will not sup
#ifdef __GLASGOW_HASKELL__
import GHC.Base
#ifdef __GLASGOW_HASKELL__
import GHC.Base
-import GHC.Num
import GHC.Show
-- import GHC.IO ( IO )
import GHC.IO.Handle.FD ( stdout )
import GHC.Show
-- import GHC.IO ( IO )
import GHC.IO.Handle.FD ( stdout )
@@
-151,7
+157,7
@@
import Hugs.Prelude as New (ExitCode(..))
#endif
import qualified Control.Exception as New
#endif
import qualified Control.Exception as New
-import Control.Exception ( toException, fromException, throw, block, unblock, evaluate, throwIO )
+import Control.Exception ( toException, fromException, throw, block, unblock, mask, evaluate, throwIO )
import System.IO.Error hiding ( catch, try )
import System.IO.Unsafe (unsafePerformIO)
import Data.Dynamic
import System.IO.Error hiding ( catch, try )
import System.IO.Unsafe (unsafePerformIO)
import Data.Dynamic
@@
-452,14
+458,13
@@
bracket
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracket before after thing =
-> (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 <- catch
a <- before
r <- catch
- (unblock (thing a))
+ (restore (thing a))
(\e -> do { _ <- after a; throw e })
_ <- after a
return r
(\e -> do { _ <- after a; throw e })
_ <- after a
return r
- )
#endif
-- | A specialised variant of 'bracket' with just a computation to run
#endif
-- | A specialised variant of 'bracket' with just a computation to run
@@
-470,13
+475,12
@@
finally :: IO a -- ^ computation to run first
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
-- was raised)
-> IO a -- returns the value from the first computation
a `finally` sequel =
- block (do
+ mask $ \restore -> do
r <- catch
r <- catch
- (unblock a)
+ (restore a)
(\e -> do { _ <- sequel; throw e })
_ <- sequel
return r
(\e -> do { _ <- sequel; throw e })
_ <- sequel
return r
- )
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
@@
-491,12
+495,11
@@
bracketOnError
-> (a -> IO c) -- ^ computation to run in-between
-> IO c -- returns the value from the in-between computation
bracketOnError before after thing =
-> (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
catch
a <- before
catch
- (unblock (thing a))
+ (restore (thing a))
(\e -> do { _ <- after a; throw e })
(\e -> do { _ <- after a; throw e })
- )
-- -----------------------------------------------------------------------------
-- Asynchronous exceptions
-- -----------------------------------------------------------------------------
-- Asynchronous exceptions
@@
-523,7
+526,7
@@
easy to introduce race conditions by the over zealous use of
-}
{- $block_handler
-}
{- $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
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
@@
-533,10
+536,9
@@
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
before being interrupted. If this weren\'t the default, one would have
to write something like
-> block (
-> catch (unblock (...))
+> mask $ \restore ->
+> catch (restore (...))
> (\e -> handler)
> (\e -> handler)
-> )
If you need to unblock asynchronous exceptions again in the exception
handler, just use 'unblock' as normal.
If you need to unblock asynchronous exceptions again in the exception
handler, just use 'unblock' as normal.
@@
-544,13
+546,13
@@
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
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'.
+'mask'.
-}
{- $interruptible
Some operations are /interruptible/, which means that they can receive
-}
{- $interruptible
Some operations are /interruptible/, which means that they can receive
-asynchronous exceptions even in the scope of a 'block'. Any function
+asynchronous exceptions even in the scope of a 'mask'. Any function
which may itself block is defined as interruptible; this includes
'Control.Concurrent.MVar.takeMVar'
(but not 'Control.Concurrent.MVar.tryTakeMVar'),
which may itself block is defined as interruptible; this includes
'Control.Concurrent.MVar.takeMVar'
(but not 'Control.Concurrent.MVar.tryTakeMVar'),
@@
-558,11
+560,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
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
> a <- takeMVar m
-> catch (unblock (...))
+> catch (restore (...))
> (\e -> ...)
> (\e -> ...)
-> )
if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
then this particular
if the 'Control.Concurrent.MVar.takeMVar' was not interruptible,
then this particular
@@
-716,8
+717,8
@@
instance New.Exception Exception where
Caster (\exc -> ArrayException exc),
Caster (\(New.AssertionFailed err) -> AssertionFailed err),
Caster (\exc -> AsyncException exc),
Caster (\exc -> ArrayException exc),
Caster (\(New.AssertionFailed err) -> AssertionFailed err),
Caster (\exc -> AsyncException exc),
- Caster (\New.BlockedOnDeadMVar -> BlockedOnDeadMVar),
- Caster (\New.BlockedIndefinitely -> BlockedIndefinitely),
+ Caster (\New.BlockedIndefinitelyOnMVar -> BlockedOnDeadMVar),
+ Caster (\New.BlockedIndefinitelyOnSTM -> BlockedIndefinitely),
Caster (\New.NestedAtomically -> NestedAtomically),
Caster (\New.Deadlock -> Deadlock),
Caster (\exc -> DynException exc),
Caster (\New.NestedAtomically -> NestedAtomically),
Caster (\New.Deadlock -> Deadlock),
Caster (\exc -> DynException exc),
@@
-741,8
+742,8
@@
instance New.Exception Exception where
toException (ArrayException exc) = toException exc
toException (AssertionFailed err) = toException (New.AssertionFailed err)
toException (AsyncException exc) = toException exc
toException (ArrayException exc) = toException exc
toException (AssertionFailed err) = toException (New.AssertionFailed err)
toException (AsyncException exc) = toException exc
- toException BlockedOnDeadMVar = toException New.BlockedOnDeadMVar
- toException BlockedIndefinitely = toException New.BlockedIndefinitely
+ toException BlockedOnDeadMVar = toException New.BlockedIndefinitelyOnMVar
+ toException BlockedIndefinitely = toException New.BlockedIndefinitelyOnSTM
toException NestedAtomically = toException New.NestedAtomically
toException Deadlock = toException New.Deadlock
-- If a dynamic exception is a SomeException then resurrect it, so
toException NestedAtomically = toException New.NestedAtomically
toException Deadlock = toException New.Deadlock
-- If a dynamic exception is a SomeException then resurrect it, so
@@
-776,8
+777,8
@@
instance Show Exception where
showsPrec _ (AssertionFailed err) = showString err
showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err)
showsPrec _ (AsyncException e) = shows e
showsPrec _ (AssertionFailed err) = showString err
showsPrec _ (DynException err) = showString "exception :: " . showsTypeRep (dynTypeRep err)
showsPrec _ (AsyncException e) = shows e
- showsPrec p BlockedOnDeadMVar = showsPrec p New.BlockedOnDeadMVar
- showsPrec p BlockedIndefinitely = showsPrec p New.BlockedIndefinitely
+ showsPrec p BlockedOnDeadMVar = showsPrec p New.BlockedIndefinitelyOnMVar
+ showsPrec p BlockedIndefinitely = showsPrec p New.BlockedIndefinitelyOnSTM
showsPrec p NestedAtomically = showsPrec p New.NestedAtomically
showsPrec p NonTermination = showsPrec p New.NonTermination
showsPrec p Deadlock = showsPrec p New.Deadlock
showsPrec p NestedAtomically = showsPrec p New.NestedAtomically
showsPrec p NonTermination = showsPrec p New.NonTermination
showsPrec p Deadlock = showsPrec p New.Deadlock