From 4407eb3b5cdcb6310ed8ab5f7d55ba313b40a927 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Wed, 9 Jul 2008 13:31:39 +0000 Subject: [PATCH] Add Control.Exception.blocked :: IO Bool Tells you whether async exceptions are currently blocked or not. --- Control/Exception.hs | 3 +++ GHC/Exception.lhs | 6 ++++++ 2 files changed, 9 insertions(+) diff --git a/Control/Exception.hs b/Control/Exception.hs index 14bdef1..bd997b1 100644 --- 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 --- 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} -- 1.7.10.4