X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException.hs;h=38ead5892a2d6d4db83df275836f6bfc17b01480;hb=09b9f955bd163776ec5e7f56f9302f55ca1f378c;hp=20105e8cdd31db9bdc98e7670e2f27c5ca996380;hpb=7dce20a482831cd7a8d8f7d1f6092102d2779504;p=ghc-base.git diff --git a/Control/Exception.hs b/Control/Exception.hs index 20105e8..38ead58 100644 --- 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 @@ -116,9 +129,9 @@ module Control.Exception ( import GHC.Base ( assert ) import GHC.Exception as ExceptionBase hiding (catch) import GHC.Conc ( throwTo, ThreadId ) -import GHC.IOBase ( IO(..), IORef(..), newIORef, readIORef, writeIORef ) -import GHC.Handle ( stdout, hFlush ) -import Foreign.C.String ( CString, withCStringLen ) +import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) +import Foreign.C.String ( CString, withCString ) +import System.IO ( stdout, hFlush ) #endif #ifdef __HUGS__ @@ -130,13 +143,6 @@ import System.IO.Error hiding ( catch, try ) import System.IO.Unsafe (unsafePerformIO) import Data.Dynamic -#include "Typeable.h" -INSTANCE_TYPEABLE0(Exception,exceptionTc,"Exception") -INSTANCE_TYPEABLE0(IOException,ioExceptionTc,"IOException") -INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException") -INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException") -INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException") - ----------------------------------------------------------------------------- -- Catching exceptions @@ -169,13 +175,12 @@ INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException") -- might be a 'ThreadKilled', for example). In this case it is usually better -- to use 'catchJust' and select the kinds of exceptions to catch. -- --- Also note that The "Prelude" also exports a --- function called 'catch' which has the same type as --- 'Control.Exception.catch', the difference being that the --- "Prelude" version only catches the IO and user +-- Also note that the "Prelude" also exports a function called +-- 'Prelude.catch' with a similar type to 'Control.Exception.catch', +-- except that the "Prelude" version only catches the IO and user -- families of exceptions (as required by Haskell 98). We recommend -- either hiding the "Prelude" version of --- 'catch' when importing +-- 'Prelude.catch' when importing -- "Control.Exception", or importing -- "Control.Exception" qualified, to avoid name-clashes. @@ -220,25 +225,6 @@ handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a handleJust p = flip (catchJust p) ----------------------------------------------------------------------------- --- evaluate - --- | Forces its argument to be evaluated, and returns the result in --- the 'IO' monad. It can be used to order evaluation with respect to --- other 'IO' operations; its semantics are given by --- --- > evaluate undefined `seq` return () ==> return () --- > catch (evaluate undefined) (\e -> return ()) ==> return () --- --- NOTE: @(evaluate a)@ is /not/ the same as @(a \`seq\` return a)@. -#ifdef __GLASGOW_HASKELL__ -evaluate :: a -> IO a -evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #) - -- NB. can't write - -- a `seq` (# s, a #) - -- because we can't have an unboxed tuple as a function argument -#endif - ------------------------------------------------------------------------------ -- 'mapException' -- | This function maps one exception into another as proposed in the @@ -254,7 +240,7 @@ mapException f v = unsafePerformIO (catch (evaluate v) -- 'try' and variations. -- | Similar to 'catch', but returns an 'Either' result which is --- @(Right a)@ if no exception was raised, or @(Left e)@ if an +-- @('Right' a)@ if no exception was raised, or @('Left' e)@ if an -- exception was raised and its value is @e@. -- -- > try a = catch (Right \`liftM\` a) (return . Left) @@ -263,6 +249,11 @@ mapException f v = unsafePerformIO (catch (evaluate v) -- to re-throw the exception after performing whatever cleanup is needed. -- Otherwise, 'tryJust' is generally considered to be better. -- +-- Also note that "System.IO.Error" also exports a function called +-- 'System.IO.Error.try' with a similar type to 'Control.Exception.try', +-- except that it catches only the IO and user families of exceptions +-- (as required by the Haskell 98 @IO@ module). + try :: IO a -> IO (Either Exception a) try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) @@ -412,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 @@ -489,23 +495,6 @@ Similar arguments apply for other interruptible operations like 'System.IO.openFile'. -} --- ----------------------------------------------------------------------------- --- Assert - -#ifdef __HADDOCK__ --- | If the first argument evaluates to 'True', then the result is the --- second argument. Otherwise an 'AssertionFailed' exception is raised, --- containing a 'String' with the source file and line number of the --- call to assert. --- --- Assertions can normally be turned on or off with a compiler flag --- (for GHC, assertions are normally on unless the @-fignore-asserts@ --- option is give). When assertions are turned off, the first --- argument to 'assert' is ignored, and the second argument is --- returned as the result. -assert :: Bool -> a -> a -#endif - #ifndef __GLASGOW_HASKELL__ assert :: Bool -> a -> a assert True x = x @@ -525,10 +514,12 @@ uncaughtExceptionHandler = unsafePerformIO (newIORef defaultHandler) Deadlock -> "no threads to run: infinite loop or deadlock?" ErrorCall s -> s other -> showsPrec 0 other "\n" - withCStringLen ("Fail: "++msg) $ \(cstr,len) -> writeErrString cstr len - -foreign import ccall unsafe "writeErrString__" - writeErrString :: CString -> Int -> IO () + withCString "%s" $ \cfmt -> + withCString msg $ \cmsg -> + errorBelch cfmt cmsg + +foreign import ccall unsafe "RtsMessages.h errorBelch" + errorBelch :: CString -> CString -> IO () setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO () setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler