From f19c1c38568beb6d7c9080a8174083913e47849f Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Sun, 30 Aug 2009 15:28:50 +0000 Subject: [PATCH 1/1] Address #3310 - Rename BlockedOnDeadMVar -> BlockedIndefinitelyOnMVar - Rename BlockedIndefinitely -> BlockedIndefinitelyOnSTM - instance Show BlockedIndefinitelyOnMVar is now "blocked indefinitely in an MVar operation" - instance Show BlockedIndefinitelyOnSTM is now "blocked indefinitely in an STM transaction" clients using Control.OldException will be unaffected (the new exceptions are mapped to the old names). However, for base4-compat we'll need to make a version of catch/try that does a similar mapping. --- Control/Exception.hs | 4 ++-- Control/Exception/Base.hs | 20 ++++++++++---------- Control/OldException.hs | 12 ++++++------ GHC/Conc.lhs | 4 ++-- GHC/IO/Exception.hs | 28 ++++++++++++++-------------- GHC/IOBase.hs | 27 +++++++++++++++++++++++++++ 6 files changed, 61 insertions(+), 34 deletions(-) diff --git a/Control/Exception.hs b/Control/Exception.hs index 9824fb0..47bb057 100644 --- a/Control/Exception.hs +++ b/Control/Exception.hs @@ -53,8 +53,8 @@ module Control.Exception ( System.ExitCode(), -- instance Exception #endif - BlockedOnDeadMVar(..), - BlockedIndefinitely(..), + BlockedIndefinitelyOnMVar(..), + BlockedIndefinitelyOnSTM(..), Deadlock(..), NoMethodError(..), PatternMatchFail(..), diff --git a/Control/Exception/Base.hs b/Control/Exception/Base.hs index 4b314ed..2bb41d9 100644 --- a/Control/Exception/Base.hs +++ b/Control/Exception/Base.hs @@ -37,8 +37,8 @@ module Control.Exception.Base ( NestedAtomically(..), #endif - BlockedOnDeadMVar(..), - BlockedIndefinitely(..), + BlockedIndefinitelyOnMVar(..), + BlockedIndefinitelyOnSTM(..), Deadlock(..), NoMethodError(..), PatternMatchFail(..), @@ -189,8 +189,8 @@ instance Show AssertionFailed 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 @@ -234,8 +234,8 @@ INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode") 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 @@ -272,8 +272,8 @@ instance Exception ErrorCall 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 @@ -283,8 +283,8 @@ 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" diff --git a/Control/OldException.hs b/Control/OldException.hs index 48f1bbb..f215432 100644 --- a/Control/OldException.hs +++ b/Control/OldException.hs @@ -716,8 +716,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 +741,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 +776,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 diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs index b68cd63..7f7d585 100644 --- a/GHC/Conc.lhs +++ b/GHC/Conc.lhs @@ -265,9 +265,9 @@ real_handler :: SomeException -> IO () real_handler se@(SomeException ex) = -- ignore thread GC and killThread exceptions: case cast ex of - Just BlockedOnDeadMVar -> return () + Just BlockedIndefinitelyOnMVar -> return () _ -> case cast ex of - Just BlockedIndefinitely -> return () + Just BlockedIndefinitelyOnSTM -> return () _ -> case cast ex of Just ThreadKilled -> return () _ -> case cast ex of diff --git a/GHC/IO/Exception.hs b/GHC/IO/Exception.hs index 032b8bf..ce05a54 100644 --- a/GHC/IO/Exception.hs +++ b/GHC/IO/Exception.hs @@ -15,8 +15,8 @@ ----------------------------------------------------------------------------- module GHC.IO.Exception ( - BlockedOnDeadMVar(..), blockedOnDeadMVar, - BlockedIndefinitely(..), blockedIndefinitely, + BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar, + BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM, Deadlock(..), AssertionFailed(..), AsyncException(..), stackOverflow, heapOverflow, @@ -51,31 +51,31 @@ import Data.Typeable ( Typeable ) -- |The thread is blocked on an @MVar@, but there are no other references -- to the @MVar@ so it can't ever continue. -data BlockedOnDeadMVar = BlockedOnDeadMVar +data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar deriving Typeable -instance Exception BlockedOnDeadMVar +instance Exception BlockedIndefinitelyOnMVar -instance Show BlockedOnDeadMVar where - showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely" +instance Show BlockedIndefinitelyOnMVar where + showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation" -blockedOnDeadMVar :: SomeException -- for the RTS -blockedOnDeadMVar = toException BlockedOnDeadMVar +blockedIndefinitelyOnMVar :: SomeException -- for the RTS +blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar ----- -- |The thread is awiting to retry an STM transaction, but there are no -- other references to any @TVar@s involved, so it can't ever continue. -data BlockedIndefinitely = BlockedIndefinitely +data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM deriving Typeable -instance Exception BlockedIndefinitely +instance Exception BlockedIndefinitelyOnSTM -instance Show BlockedIndefinitely where - showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely" +instance Show BlockedIndefinitelyOnSTM where + showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction" -blockedIndefinitely :: SomeException -- for the RTS -blockedIndefinitely = toException BlockedIndefinitely +blockedIndefinitelyOnSTM :: SomeException -- for the RTS +blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM ----- diff --git a/GHC/IOBase.hs b/GHC/IOBase.hs index dca72c0..c80756a 100644 --- a/GHC/IOBase.hs +++ b/GHC/IOBase.hs @@ -60,5 +60,32 @@ import GHC.IOArray import GHC.IORef import GHC.MVar import Foreign.C.Types +import GHC.Show +import Data.Typeable type FD = CInt + +-- Backwards compat: this was renamed to BlockedIndefinitelyOnMVar +data BlockedOnDeadMVar = BlockedOnDeadMVar + deriving Typeable + +instance Exception BlockedOnDeadMVar + +instance Show BlockedOnDeadMVar where + showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely" + +blockedOnDeadMVar :: SomeException -- for the RTS +blockedOnDeadMVar = toException BlockedOnDeadMVar + + +-- Backwards compat: this was renamed to BlockedIndefinitelyOnSTM +data BlockedIndefinitely = BlockedIndefinitely + deriving Typeable + +instance Exception BlockedIndefinitely + +instance Show BlockedIndefinitely where + showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely" + +blockedIndefinitely :: SomeException -- for the RTS +blockedIndefinitely = toException BlockedIndefinitely -- 1.7.10.4