X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FOldException.hs;h=4fa787f7523f7dd05eb21ab25ecad6fa915b875f;hb=3aa288879627ae55480c919c1b23fb28ca09e536;hp=ae25fdc0ce2c6a76ce7fd13c728a4e3b76e2fa45;hpb=d2063b5b0be014545b21819172c87756efcb0b0c;p=ghc-base.git diff --git a/Control/OldException.hs b/Control/OldException.hs index ae25fdc..4fa787f 100644 --- a/Control/OldException.hs +++ b/Control/OldException.hs @@ -29,7 +29,7 @@ -- ----------------------------------------------------------------------------- -module Control.OldException ( +module Control.OldException {-# DEPRECATED "Future versions of base will not support the old exceptions style. Please switch to extensible exceptions." #-} ( -- * The Exception type Exception(..), -- instance Eq, Ord, Show, Typeable @@ -132,9 +132,8 @@ module Control.OldException ( #ifdef __GLASGOW_HASKELL__ import GHC.Base -import GHC.Num import GHC.Show -import GHC.IO ( IO ) +-- import GHC.IO ( IO ) import GHC.IO.Handle.FD ( stdout ) import qualified GHC.IO as New import qualified GHC.IO.Exception as New @@ -151,7 +150,7 @@ import Hugs.Prelude as New (ExitCode(..)) #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 @@ -452,14 +451,13 @@ bracket -> (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 - (unblock (thing a)) - (\e -> do { after a; throw e }) - after a + (restore (thing a)) + (\e -> do { _ <- after a; throw e }) + _ <- after a return r - ) #endif -- | A specialised variant of 'bracket' with just a computation to run @@ -470,13 +468,12 @@ finally :: IO a -- ^ computation to run first -- was raised) -> IO a -- returns the value from the first computation a `finally` sequel = - block (do + mask $ \restore -> do r <- catch - (unblock a) - (\e -> do { sequel; throw e }) - sequel + (restore a) + (\e -> do { _ <- sequel; throw e }) + _ <- sequel return r - ) -- | A variant of 'bracket' where the return value from the first computation -- is not required. @@ -491,12 +488,11 @@ bracketOnError -> (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 - (unblock (thing a)) - (\e -> do { after a; throw e }) - ) + (restore (thing a)) + (\e -> do { _ <- after a; throw e }) -- ----------------------------------------------------------------------------- -- Asynchronous exceptions @@ -523,7 +519,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 @@ -533,10 +529,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 -> block ( -> catch (unblock (...)) +> mask $ \restore -> +> catch (restore (...)) > (\e -> handler) -> ) If you need to unblock asynchronous exceptions again in the exception handler, just use 'unblock' as normal. @@ -544,13 +539,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 -'block'. +'mask'. -} {- $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'), @@ -558,11 +553,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 @@ -716,8 +710,8 @@ instance New.Exception Exception where 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), @@ -741,8 +735,8 @@ instance New.Exception Exception where 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 @@ -776,8 +770,8 @@ instance Show Exception where 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