Add Control.Exception.blocked :: IO Bool

[ghc-base.git] / GHC / Exception.lhs

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}