Re-add blocked; it got lost in the extensible exceptions patches

diff --git a/Control/Exception.hs b/Control/Exception.hs
index c49b6b8..cd71313 100644 (file)
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -127,6 +127,7 @@ module Control.Exception (
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
+import GHC.IOBase
 import {-# SOURCE #-} GHC.Handle
 import GHC.List
 import GHC.Num

diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index 93c4065..58e5ec3 100644 (file)
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -44,7 +44,7 @@ module GHC.IOBase(
     stackOverflow, heapOverflow, ioException, 
     IOError, IOException(..), IOErrorType(..), ioError, userError,
     ExitCode(..),
-    throwIO, block, unblock, catchAny, catchException,
+    throwIO, block, unblock, blocked, catchAny, catchException,
     evaluate,
     ErrorCall(..), ArithException(..), AsyncException(..),
     BlockedOnDeadMVar(..), BlockedIndefinitely(..),
@@ -967,6 +967,12 @@ unblock :: IO a -> IO a
 
 block (IO io) = IO $ blockAsyncExceptions# io
 unblock (IO io) = IO $ unblockAsyncExceptions# io
+
+-- | returns True if asynchronous exceptions are blocked in the
+-- current thread.
+blocked :: IO Bool
+blocked = IO $ \s -> case asyncExceptionsBlocked# s of
+                        (# s', i #) -> (# s', i /=# 0# #)
 \end{code}
 
 \begin{code}