X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FException.lhs;h=5822ea8f2bbd0846b4f0089edfeab8c2ce70ae55;hb=4b3c3095c201e03ffedda6f24a363f68d40dab0e;hp=7979d4dd90b67f951a2d80fe4ed52bbf5d2fdb0c;hpb=b706340c451952adf230b5b8daecad8a1f34d714;p=ghc-base.git diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs index 7979d4d..5822ea8 100644 --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -109,17 +109,27 @@ bracket_ before after m = do %********************************************************* \begin{code} -#ifndef __HUGS__ +-- | Applying 'block' to a computation will +-- execute that computation with asynchronous exceptions +-- /blocked/. That is, any thread which +-- attempts to raise an exception in the current thread will be +-- blocked until asynchronous exceptions are enabled again. There\'s +-- no need to worry about re-enabling asynchronous exceptions; that is +-- done automatically on exiting the scope of +-- 'block'. block :: IO a -> IO a -block (IO io) = IO $ blockAsyncExceptions# io +-- | To re-enable asynchronous exceptions inside the scope of +-- 'block', 'unblock' can be +-- used. It scopes in exactly the same way, so on exit from +-- 'unblock' asynchronous exception delivery will +-- be disabled again. unblock :: IO a -> IO a + +#ifndef __HUGS__ +block (IO io) = IO $ blockAsyncExceptions# io unblock (IO io) = IO $ unblockAsyncExceptions# io #else --- Not implemented yet in Hugs. -block :: IO a -> IO a -block (IO io) = IO io - unblock :: IO a -> IO a unblock (IO io) = IO io #endif