add unsafeLocalState from Haskell 2010, and docs

[ghc-base.git] / Control / Exception / Base.hs

diff --git a/Control/Exception/Base.hs b/Control/Exception/Base.hs
index 4b314ed..525dc6a 100644 (file)
--- a/Control/Exception/Base.hs
+++ b/Control/Exception/Base.hs
@@ -1,5 +1,4 @@
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 #include "Typeable.h"
 
@@ -37,8 +36,8 @@ module Control.Exception.Base (
         NestedAtomically(..),
 #endif
 
-        BlockedOnDeadMVar(..),
-        BlockedIndefinitely(..),
+        BlockedIndefinitelyOnMVar(..),
+        BlockedIndefinitelyOnSTM(..),
         Deadlock(..),
         NoMethodError(..),
         PatternMatchFail(..),
@@ -79,6 +78,16 @@ module Control.Exception.Base (
         -- * Asynchronous Exceptions
 
         -- ** Asynchronous exception control
+        mask,
+#ifndef __NHC__
+        mask_,
+        uninterruptibleMask,
+        uninterruptibleMask_,
+        MaskingState(..),
+        getMaskingState,
+#endif
+
+        -- ** (deprecated) Asynchronous exception control
 
         block,
         unblock,
@@ -176,8 +185,8 @@ data AssertionFailed
 data PatternMatchFail
 data NoMethodError
 data Deadlock
-data BlockedOnDeadMVar
-data BlockedIndefinitely
+data BlockedIndefinitelyOnMVar
+data BlockedIndefinitelyOnSTM
 data ErrorCall
 data RecConError
 data RecSelError
@@ -189,8 +198,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
@@ -215,6 +224,10 @@ assert :: Bool -> a -> a
 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__
@@ -234,8 +247,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 +285,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 +296,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"
@@ -340,8 +353,8 @@ blocked  = return False
 --
 -- 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'.
@@ -506,12 +519,11 @@ 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 <- unblock (thing a) `onException` 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
@@ -522,11 +534,10 @@ finally :: IO a         -- ^ computation to run first
                         -- was raised)
         -> IO a         -- returns the value from the first computation
 a `finally` sequel =
-  block (do
-    r <- unblock a `onException` 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.
@@ -541,10 +552,9 @@ 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
-    unblock (thing a) `onException` after a
-  )
+    restore (thing a) `onException` after a
 
 #if !(__GLASGOW_HASKELL__ || __NHC__)
 assert :: Bool -> a -> a