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.

diff --git a/Control/Exception.hs b/Control/Exception.hs
index 9824fb0..47bb057 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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