X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException.hs;h=ec06bf4f4e22f52da10876eb286eca036240f06f;hb=30464c0cb915c2ae900909568fa8677bba341e45;hp=aed144b55335948113d9cbe5eb921ddfe8e3c6c7;hpb=19de173b1bd4fa8cf1854cfefa619565910137f3;p=haskell-directory.git diff --git a/Control/Exception.hs b/Control/Exception.hs index aed144b..ec06bf4 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 @@ -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. @@ -235,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) @@ -244,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)) @@ -393,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 @@ -470,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 @@ -506,10 +514,11 @@ 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 errorBelch :: CString -> CString -> IO () setUncaughtExceptionHandler :: (Exception -> IO ()) -> IO () setUncaughtExceptionHandler = writeIORef uncaughtExceptionHandler