Warning police: Make some prototypes from the RTS known

[ghc-base.git] / Control / Exception.hs

diff --git a/Control/Exception.hs b/Control/Exception.hs
index cb4ba3e..38ead58 100644 (file)
--- a/Control/Exception.hs
+++ b/Control/Exception.hs
@@ -6,11 +6,23 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable
+-- Portability :  non-portable (extended exceptions)
 --
 -- This module provides support for raising and catching both built-in
 -- and user-defined exceptions.
 --
+-- In addition to exceptions thrown by 'IO' operations, exceptions may
+-- be thrown by pure code (imprecise exceptions) or by external events
+-- (asynchronous exceptions), but may only be caught in the 'IO' monad.
+-- For more details, see:
+--
+--  * /A semantics for imprecise exceptions/, by Simon Peyton Jones,
+--    Alastair Reid, Tony Hoare, Simon Marlow, Fergus Henderson,
+--    in /PLDI'99/.
+--
+--  * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton
+--    Jones, Andy Moran and John Reppy, in /PLDI'01/.
+--
 -----------------------------------------------------------------------------
 
 module Control.Exception (
@@ -103,6 +115,7 @@ module Control.Exception (
 
        bracket,        -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO ()
        bracket_,       -- :: IO a -> IO b -> IO c -> IO ()
+       bracketOnError,
 
        finally,        -- :: IO a -> IO b -> IO a
        
@@ -390,6 +403,21 @@ a `finally` sequel =
 bracket_ :: IO a -> IO b -> IO c -> IO c
 bracket_ before after thing = bracket before (const after) (const thing)
 
+-- | Like bracket, but only performs the final action if there was an 
+-- exception raised by the in-between computation.
+bracketOnError
+       :: IO a         -- ^ computation to run first (\"acquire resource\")
+       -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
+       -> (a -> IO c)  -- ^ computation to run in-between
+       -> IO c         -- returns the value from the in-between computation
+bracketOnError before after thing =
+  block (do
+    a <- before 
+    catch 
+       (unblock (thing a))
+       (\e -> do { after a; throw e })
+ )
+
 -- -----------------------------------------------------------------------------
 -- Asynchronous exceptions
 
@@ -490,7 +518,8 @@ uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler)
           withCString msg $ \cmsg ->
             errorBelch cfmt cmsg
 
-foreign import ccall unsafe errorBelch :: CString -> CString -> IO ()
+foreign import ccall unsafe "RtsMessages.h errorBelch"
+   errorBelch :: CString -> CString -> IO ()
 
 setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO ()
 setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler