Add Control.Exception.blocked :: IO Bool

Tells you whether async exceptions are currently blocked or not.

diff --git a/Control/Exception.hs b/Control/Exception.hs
index 14bdef1..bd997b1 100644 (file)
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -98,6 +98,7 @@ module Control.Exception (
 
         block,          -- :: IO a -> IO a
         unblock,        -- :: IO a -> IO a
+        blocked,        -- :: IO Bool
 
         -- *** Applying @block@ to an exception handler
 
@@ -183,6 +184,8 @@ block   :: IO a -> IO a
 block    = id
 unblock :: IO a -> IO a
 unblock  = id
+blocked :: IO Bool
+blocked  = False
 
 assert :: Bool -> a -> a
 assert True  x = x

diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs
index 5ec9bcc..a0bf8e8 100644 (file)
--- a/GHC/Exception.lhs
+++ b/GHC/Exception.lhs
@@ -106,6 +106,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}