X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FException.lhs;h=5822ea8f2bbd0846b4f0089edfeab8c2ce70ae55;hb=d7351a78329804dd5115b83184aec64136a5c8e2;hp=ac7237f612d98631593c9a7ced85d0998f28944c;hpb=d9e5fa673b75cdffbcd0e85cdcc98d706acbb29a;p=ghc-base.git diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs index ac7237f..5822ea8 100644 --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -1,13 +1,18 @@ -% ------------------------------------------------------------------------------ -% $Id: Exception.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $ -% -% (c) The University of Glasgow, 1998-2000 -% - -Exceptions and exception-handling functions. - \begin{code} {-# OPTIONS -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Exception +-- Copyright : (c) The University of Glasgow, 1998-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Exceptions and exception-handling functions. +-- +----------------------------------------------------------------------------- #ifndef __HUGS__ module GHC.Exception @@ -54,7 +59,6 @@ catchException (IO m) k = IO $ \s -> catch# m (\ex -> unIO (k ex)) s catch :: IO a -> (Exception -> IO a) -> IO a catch m k = catchException m handler where handler err@(IOException _) = k err - handler err@(UserError _) = k err handler other = throw other \end{code} @@ -105,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