Adjust behaviour of gcd
[ghc-base.git] / Control / Exception.hs
index 529d364..c650682 100644 (file)
+{-# 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)