X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Control%2FException.hs;h=c650682ed188446f4d1d571083169b86079076c1;hb=7a97ec4b12e1fbec5505f82032cf4dc435b5a60c;hp=529d364d136b9525c5b1cd1c12cf0d38f8f3591a;hpb=260e7f2ed9a43c6ecf5a556d77817f39ed2893ab;p=ghc-base.git diff --git a/Control/Exception.hs b/Control/Exception.hs index 529d364..c650682 100644 --- a/Control/Exception.hs +++ b/Control/Exception.hs @@ -1,232 +1,404 @@ +{-# LANGUAGE CPP, NoImplicitPrelude, ExistentialQuantification #-} + ----------------------------------------------------------------------------- --- +-- | -- Module : Control.Exception -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) --- +-- License : BSD-style (see the file libraries/base/LICENSE) +-- -- 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/. -- --- $Id: Exception.hs,v 1.5 2001/12/21 15:07:21 simonmar Exp $ +-- * /Asynchronous exceptions in Haskell/, by Simon Marlow, Simon Peyton +-- Jones, Andy Moran and John Reppy, in /PLDI'01/. -- --- The External API for exceptions. The functions provided in this --- module allow catching of exceptions in the IO monad. +-- * /An Extensible Dynamically-Typed Hierarchy of Exceptions/, +-- by Simon Marlow, in /Haskell '06/. -- ----------------------------------------------------------------------------- module Control.Exception ( - Exception(..), -- instance Eq, Ord, Show, Typeable - IOException, -- instance Eq, Ord, Show, Typeable - ArithException(..), -- instance Eq, Ord, Show, Typeable - ArrayException(..), -- instance Eq, Ord, Show, Typeable - AsyncException(..), -- instance Eq, Ord, Show, Typeable + -- * The Exception type +#ifdef __HUGS__ + SomeException, +#else + SomeException(..), +#endif + Exception(..), -- class + IOException, -- instance Eq, Ord, Show, Typeable, Exception + ArithException(..), -- instance Eq, Ord, Show, Typeable, Exception + ArrayException(..), -- instance Eq, Ord, Show, Typeable, Exception + AssertionFailed(..), + AsyncException(..), -- instance Eq, Ord, Show, Typeable, Exception + +#if __GLASGOW_HASKELL__ || __HUGS__ + NonTermination(..), + NestedAtomically(..), +#endif +#ifdef __NHC__ + System.ExitCode(), -- instance Exception +#endif - try, -- :: IO a -> IO (Either Exception a) - tryJust, -- :: (Exception -> Maybe b) -> a -> IO (Either b a) + BlockedIndefinitelyOnMVar(..), + BlockedIndefinitelyOnSTM(..), + Deadlock(..), + NoMethodError(..), + PatternMatchFail(..), + RecConError(..), + RecSelError(..), + RecUpdError(..), + ErrorCall(..), + + -- * Throwing exceptions + throw, + throwIO, + ioError, +#ifdef __GLASGOW_HASKELL__ + throwTo, +#endif - catch, -- :: IO a -> (Exception -> IO a) -> IO a - catchJust, -- :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a + -- * Catching Exceptions - handle, -- :: (Exception -> IO a) -> IO a -> IO a - handleJust,-- :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a + -- $catching - evaluate, -- :: a -> IO a + -- ** Catching all exceptions - -- Exception predicates (for tryJust, catchJust, handleJust) + -- $catchall - ioErrors, -- :: Exception -> Maybe IOError - arithExceptions, -- :: Exception -> Maybe ArithException - errorCalls, -- :: Exception -> Maybe String - dynExceptions, -- :: Exception -> Maybe Dynamic - assertions, -- :: Exception -> Maybe String - asyncExceptions, -- :: Exception -> Maybe AsyncException - userErrors, -- :: Exception -> Maybe String + -- ** The @catch@ functions + catch, + catches, Handler(..), + catchJust, - -- Throwing exceptions + -- ** The @handle@ functions + handle, + handleJust, - throw, -- :: Exception -> a - throwTo, -- :: ThreadId -> Exception -> a + -- ** The @try@ functions + try, + tryJust, - -- Dynamic exceptions + -- ** The @evaluate@ function + evaluate, - throwDyn, -- :: Typeable ex => ex -> b - throwDynTo, -- :: Typeable ex => ThreadId -> ex -> b - catchDyn, -- :: Typeable ex => IO a -> (ex -> IO a) -> IO a - - -- Async exception control + -- ** The @mapException@ function + mapException, - block, -- :: IO a -> IO a - unblock, -- :: IO a -> IO a + -- * Asynchronous Exceptions - -- Assertions + -- $async - -- for now - assert, -- :: Bool -> a -> a + -- ** Asynchronous exception control - -- Utilities + -- |The following functions allow a thread to control delivery of + -- asynchronous exceptions during a critical region. - finally, -- :: IO a -> IO b -> IO b + mask, +#ifndef __NHC__ + mask_, + uninterruptibleMask, + uninterruptibleMask_, + MaskingState(..), + getMaskingState, + allowInterrupt, +#endif - bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO () - bracket_, -- :: IO a -> IO b -> IO c -> IO () + -- ** (deprecated) Asynchronous exception control - ) where + block, + unblock, + blocked, -#ifdef __GLASGOW_HASKELL__ -import Prelude hiding (catch) -import GHC.Base ( assert ) -import GHC.Exception hiding (try, catch, bracket, bracket_) -import GHC.Conc ( throwTo, ThreadId ) -import GHC.IOBase ( IO(..) ) -#endif + -- *** Applying @mask@ to an exception handler -#ifdef __HUGS__ -import Prelude hiding ( catch ) -import PrelPrim ( catchException - , Exception(..) - , throw - , ArithException(..) - , AsyncException(..) - , assert - ) -#endif + -- $block_handler -import Data.Dynamic + -- *** Interruptible operations -#include "Dynamic.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") + -- $interruptible ------------------------------------------------------------------------------ --- Catching exceptions + -- * Assertions --- GHC.Exception defines 'catchException' for us. + assert, -catch :: IO a -> (Exception -> IO a) -> IO a -catch = catchException + -- * Utilities -catchJust :: (Exception -> Maybe b) -> IO a -> (b -> IO a) -> IO a -catchJust p a handler = catch a handler' - where handler' e = case p e of - Nothing -> throw e - Just b -> handler b + bracket, + bracket_, + bracketOnError, -handle :: (Exception -> IO a) -> IO a -> IO a -handle = flip catch + finally, + onException, -handleJust :: (Exception -> Maybe b) -> (b -> IO a) -> IO a -> IO a -handleJust p = flip (catchJust p) + ) where ------------------------------------------------------------------------------ --- evaluate +import Control.Exception.Base -evaluate :: a -> IO a -evaluate a = a `seq` return a +#ifdef __GLASGOW_HASKELL__ +import GHC.Base +import GHC.IO (unsafeUnmask) +import Data.Maybe +#else +import Prelude hiding (catch) +#endif ------------------------------------------------------------------------------ --- 'try' and variations. +#ifdef __NHC__ +import System (ExitCode()) +#endif -try :: IO a -> IO (Either Exception a) -try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e)) +-- | You need this when using 'catches'. +data Handler a = forall e . Exception e => Handler (e -> IO a) -tryJust :: (Exception -> Maybe b) -> IO a -> IO (Either b a) -tryJust p a = do - r <- try a - case r of - Right v -> return (Right v) - Left e -> case p e of - Nothing -> throw e - Just b -> return (Left b) +{- | +Sometimes you want to catch two different sorts of exception. You could +do something like ------------------------------------------------------------------------------ --- Dynamic exception types. Since one of the possible kinds of exception --- is a dynamically typed value, we can effectively have polymorphic --- exceptions. +> f = expr `catch` \ (ex :: ArithException) -> handleArith ex +> `catch` \ (ex :: IOException) -> handleIO ex --- throwDyn will raise any value as an exception, provided it is in the --- Typeable class (see Dynamic.lhs). +However, there are a couple of problems with this approach. The first is +that having two exception handlers is inefficient. However, the more +serious issue is that the second exception handler will catch exceptions +in the first, e.g. in the example above, if @handleArith@ throws an +@IOException@ then the second exception handler will catch it. --- catchDyn will catch any exception of a given type (determined by the --- handler function). Any raised exceptions that don't match are --- re-raised. +Instead, we provide a function 'catches', which would be used thus: -throwDyn :: Typeable exception => exception -> b -throwDyn exception = throw (DynException (toDyn exception)) +> f = expr `catches` [Handler (\ (ex :: ArithException) -> handleArith ex), +> Handler (\ (ex :: IOException) -> handleIO ex)] +-} +catches :: IO a -> [Handler a] -> IO a +catches io handlers = io `catch` catchesHandler handlers -throwDynTo :: Typeable exception => ThreadId -> exception -> IO () -throwDynTo t exception = throwTo t (DynException (toDyn exception)) +catchesHandler :: [Handler a] -> SomeException -> IO a +catchesHandler handlers e = foldr tryHandler (throw e) handlers + where tryHandler (Handler handler) res + = case fromException e of + Just e' -> handler e' + Nothing -> res -catchDyn :: Typeable exception => IO a -> (exception -> IO a) -> IO a -catchDyn m k = catchException m handle - where handle ex = case ex of - (DynException dyn) -> - case fromDynamic dyn of - Just exception -> k exception - Nothing -> throw ex - _ -> throw ex +-- ----------------------------------------------------------------------------- +-- Catching exceptions ------------------------------------------------------------------------------ --- Exception Predicates +{- $catching -ioErrors :: Exception -> Maybe IOError -arithExceptions :: Exception -> Maybe ArithException -errorCalls :: Exception -> Maybe String -dynExceptions :: Exception -> Maybe Dynamic -assertions :: Exception -> Maybe String -asyncExceptions :: Exception -> Maybe AsyncException -userErrors :: Exception -> Maybe String +There are several functions for catching and examining +exceptions; all of them may only be used from within the +'IO' monad. -ioErrors e@(IOException _) = Just e -ioErrors _ = Nothing +Here's a rule of thumb for deciding which catch-style function to +use: -arithExceptions (ArithException e) = Just e -arithExceptions _ = Nothing + * If you want to do some cleanup in the event that an exception + is raised, use 'finally', 'bracket' or 'onException'. -errorCalls (ErrorCall e) = Just e -errorCalls _ = Nothing + * To recover after an exception and do something else, the best + choice is to use one of the 'try' family. -assertions (AssertionFailed e) = Just e -assertions _ = Nothing + * ... unless you are recovering from an asynchronous exception, in which + case use 'catch' or 'catchJust'. -dynExceptions (DynException e) = Just e -dynExceptions _ = Nothing +The difference between using 'try' and 'catch' for recovery is that in +'catch' the handler is inside an implicit 'block' (see \"Asynchronous +Exceptions\") which is important when catching asynchronous +exceptions, but when catching other kinds of exception it is +unnecessary. Furthermore it is possible to accidentally stay inside +the implicit 'block' by tail-calling rather than returning from the +handler, which is why we recommend using 'try' rather than 'catch' for +ordinary exception recovery. -asyncExceptions (AsyncException e) = Just e -asyncExceptions _ = Nothing +A typical use of 'tryJust' for recovery looks like this: -userErrors (UserError e) = Just e -userErrors _ = Nothing +> do r <- tryJust (guard . isDoesNotExistError) $ getEnv "HOME" +> case r of +> Left e -> ... +> Right home -> ... + +-} + +-- ----------------------------------------------------------------------------- +-- Asynchronous exceptions + +-- | When invoked inside 'mask', this function allows a blocked +-- asynchronous exception to be raised, if one exists. It is +-- equivalent to performing an interruptible operation (see +-- #interruptible#), but does not involve any actual blocking. +-- +-- When called outside 'mask', or inside 'uninterruptibleMask', this +-- function has no effect. +allowInterrupt :: IO () +allowInterrupt = unsafeUnmask $ return () + +{- $async + + #AsynchronousExceptions# Asynchronous exceptions are so-called because they arise due to +external influences, and can be raised at any point during execution. +'StackOverflow' and 'HeapOverflow' are two examples of +system-generated asynchronous exceptions. + +The primary source of asynchronous exceptions, however, is +'throwTo': + +> throwTo :: ThreadId -> Exception -> IO () + +'throwTo' (also 'Control.Concurrent.killThread') allows one +running thread to raise an arbitrary exception in another thread. The +exception is therefore asynchronous with respect to the target thread, +which could be doing anything at the time it receives the exception. +Great care should be taken with asynchronous exceptions; it is all too +easy to introduce race conditions by the over zealous use of +'throwTo'. +-} + +{- $block_handler +There\'s an implied 'mask' around every exception handler in a call +to one of the 'catch' family of functions. This is because that is +what you want most of the time - it eliminates a common race condition +in starting an exception handler, because there may be no exception +handler on the stack to handle another exception if one arrives +immediately. If asynchronous exceptions are masked on entering the +handler, though, we have time to install a new exception handler +before being interrupted. If this weren\'t the default, one would have +to write something like + +> mask $ \restore -> +> catch (restore (...)) +> (\e -> handler) + +If you need to unblock asynchronous exceptions again in the exception +handler, 'restore' can be used there too. + +Note that 'try' and friends /do not/ have a similar default, because +there is no exception handler in this case. Don't use 'try' for +recovering from an asynchronous exception. +-} + +{- $interruptible + + #interruptible# +Some operations are /interruptible/, which means that they can receive +asynchronous exceptions even in the scope of a 'mask'. Any function +which may itself block is defined as interruptible; this includes +'Control.Concurrent.MVar.takeMVar' +(but not 'Control.Concurrent.MVar.tryTakeMVar'), +and most operations which perform +some I\/O with the outside world. The reason for having +interruptible operations is so that we can write things like + +> mask $ \restore -> do +> a <- takeMVar m +> catch (restore (...)) +> (\e -> ...) + +if the 'Control.Concurrent.MVar.takeMVar' was not interruptible, +then this particular +combination could lead to deadlock, because the thread itself would be +blocked in a state where it can\'t receive any asynchronous exceptions. +With 'Control.Concurrent.MVar.takeMVar' interruptible, however, we can be +safe in the knowledge that the thread can receive exceptions right up +until the point when the 'Control.Concurrent.MVar.takeMVar' succeeds. +Similar arguments apply for other interruptible operations like +'System.IO.openFile'. + +It is useful to think of 'mask' not as a way to completely prevent +asynchronous exceptions, but as a way to switch from asynchronous mode +to polling mode. The main difficulty with asynchronous +exceptions is that they normally can occur anywhere, but within a +'mask' an asynchronous exception is only raised by operations that are +interruptible (or call other interruptible operations). In many cases +these operations may themselves raise exceptions, such as I\/O errors, +so the caller will usually be prepared to handle exceptions arising from the +operation anyway. To perfom an explicit poll for asynchronous exceptions +inside 'mask', use 'allowInterrupt'. + +Sometimes it is too onerous to handle exceptions in the middle of a +critical piece of stateful code. There are three ways to handle this +kind of situation: + + * Use STM. Since a transaction is always either completely executed + or not at all, transactions are a good way to maintain invariants + over state in the presence of asynchronous (and indeed synchronous) + exceptions. + + * Use 'mask', and avoid interruptible operations. In order to do + this, we have to know which operations are interruptible. It is + impossible to know for any given library function whether it might + invoke an interruptible operation internally; so instead we give a + list of guaranteed-not-to-be-interruptible operations below. + + * Use 'uninterruptibleMask'. This is generally not recommended, + unless you can guarantee that any interruptible operations invoked + during the scope of 'uninterruptibleMask' can only ever block for + a short time. Otherwise, 'uninterruptibleMask' is a good way to + make your program deadlock and be unresponsive to user interrupts. + +The following operations are guaranteed not to be interruptible: + + * operations on 'IORef' from "Data.IORef" + * STM transactions that do not use 'retry' + * everything from the @Foreign@ modules + * everything from @Control.Exception@ + * @tryTakeMVar@, @tryPutMVar@, @isEmptyMVar@ + * @takeMVar@ if the @MVar@ is definitely full, and conversely @putMVar@ if the @MVar@ is definitely empty + * @newEmptyMVar@, @newMVar@ + * @forkIO@, @forkIOUnmasked@, @myThreadId@ + +-} + +{- $catchall + +It is possible to catch all exceptions, by using the type 'SomeException': + +> catch f (\e -> ... (e :: SomeException) ...) + +HOWEVER, this is normally not what you want to do! + +For example, suppose you want to read a file, but if it doesn't exist +then continue as if it contained \"\". You might be tempted to just +catch all exceptions and return \"\" in the handler. However, this has +all sorts of undesirable consequences. For example, if the user +presses control-C at just the right moment then the 'UserInterrupt' +exception will be caught, and the program will continue running under +the belief that the file contains \"\". Similarly, if another thread +tries to kill the thread reading the file then the 'ThreadKilled' +exception will be ignored. + +Instead, you should only catch exactly the exceptions that you really +want. In this case, this would likely be more specific than even +\"any IO exception\"; a permissions error would likely also want to be +handled differently. Instead, you would probably want something like: + +> e <- tryJust (guard . isDoesNotExistError) (readFile f) +> let str = either (const "") id e + +There are occassions when you really do need to catch any sort of +exception. However, in most cases this is just so you can do some +cleaning up; you aren't actually interested in the exception itself. +For example, if you open a file then you want to close it again, +whether processing the file executes normally or throws an exception. +However, in these cases you can use functions like 'bracket', 'finally' +and 'onException', which never actually pass you the exception, but +just call the cleanup functions at the appropriate points. + +But sometimes you really do need to catch any exception, and actually +see what the exception is. One example is at the very top-level of a +program, you may wish to catch any exception, print it to a logfile or +the screen, and then exit gracefully. For these cases, you can use +'catch' (or one of the other exception-catching functions) with the +'SomeException' type. +-} ------------------------------------------------------------------------------ --- Some Useful Functions - -bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c -bracket before after thing = - block (do - a <- before - r <- catch - (unblock (thing a)) - (\e -> do { after a; throw e }) - after a - return r - ) - --- finally is an instance of bracket, but it's quite common --- so we give the specialised version for efficiency. -finally :: IO a -> IO b -> IO a -a `finally` sequel = - block (do - r <- catch - (unblock a) - (\e -> do { sequel; throw e }) - sequel - return r - ) - -bracket_ :: IO a -> IO b -> IO c -> IO c -bracket_ before after thing = bracket before (const after) (const thing)