X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException.hs;h=1a407809548f6c659329bd9e6522473d89253cad;hb=74bc2d04fdbae494bcf4839c4ec5e6ec1d0bf600;hp=dd6b6fdf9e8c7b8d2ce8b2b63800bbf50e46d8e9;hpb=e6593a2d027bf4beb737b6760a1a6e024bc74982;p=haskell-directory.git diff --git a/Control/Exception.hs b/Control/Exception.hs index dd6b6fd..1a40780 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 @@ -117,7 +130,7 @@ import GHC.Base ( assert ) import GHC.Exception as ExceptionBase hiding (catch) import GHC.Conc ( throwTo, ThreadId ) import Data.IORef ( IORef, newIORef, readIORef, writeIORef ) -import Foreign.C.String ( CString, withCStringLen ) +import Foreign.C.String ( CString, withCString ) import System.IO ( stdout, hFlush ) #endif @@ -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 @@ -146,7 +152,7 @@ INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException") -- argument. Otherwise, the result is returned as normal. For example: -- -- > catch (openFile f ReadMode) --- > (\e -> hPutStr stderr (\"Couldn\'t open \"++f++\": \" ++ show e)) +-- > (\e -> hPutStr stderr ("Couldn't open "++f++": " ++ show e)) -- -- For catching exceptions in pure (non-'IO') expressions, see the -- function 'evaluate'. @@ -169,15 +175,22 @@ 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 'Prelude.catch' which has the same type as --- 'Control.Exception.catch', the difference being 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 --- 'Prelude.catch' when importing --- "Control.Exception", or importing --- "Control.Exception" qualified, to avoid name-clashes. +-- 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 'Prelude.catch' +-- when importing "Control.Exception": +-- +-- > import Prelude hiding (catch) +-- +-- or importing "Control.Exception" qualified, to avoid name-clashes: +-- +-- > import qualified Control.Exception as C +-- +-- and then using @C.catch@ +-- catch :: IO a -- ^ The computation to run -> (Exception -> IO a) -- ^ Handler to invoke if an exception is raised @@ -238,12 +251,17 @@ mapException f v = unsafePerformIO (catch (evaluate v) -- @('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) +-- > try a = catch (Right `liftM` a) (return . Left) -- -- Note: as with 'catch', it is only polite to use this variant if you intend -- 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)) @@ -354,7 +372,7 @@ userErrors _ = Nothing -- The arguments to 'bracket' are in this order so that we can partially apply -- it, e.g.: -- --- > withFile name = bracket (openFile name) hClose +-- > withFile name mode = bracket (openFile name mode) hClose -- bracket :: IO a -- ^ computation to run first (\"acquire resource\") @@ -393,6 +411,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 @@ -470,23 +503,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 @@ -506,10 +522,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