Rejig the extensible exceptions so there is less circular importing
[ghc-base.git] / GHC / IOBase.lhs
index 3b82a52..ac7d0a4 100644 (file)
@@ -1,5 +1,6 @@
 \begin{code}
 \begin{code}
-{-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-}
+{-# OPTIONS_GHC -XNoImplicitPrelude -funbox-strict-fields #-}
+{-# OPTIONS_HADDOCK hide #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IOBase
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  GHC.IOBase
@@ -20,46 +21,52 @@ module GHC.IOBase(
     unsafePerformIO, unsafeInterleaveIO,
     unsafeDupablePerformIO, unsafeDupableInterleaveIO,
     noDuplicate,
     unsafePerformIO, unsafeInterleaveIO,
     unsafeDupablePerformIO, unsafeDupableInterleaveIO,
     noDuplicate,
-  
-       -- To and from from ST
+
+        -- To and from from ST
     stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
 
     stToIO, ioToST, unsafeIOToST, unsafeSTToIO,
 
-       -- References
+        -- References
     IORef(..), newIORef, readIORef, writeIORef, 
     IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,
     MVar(..),
 
     IORef(..), newIORef, readIORef, writeIORef, 
     IOArray(..), newIOArray, readIOArray, writeIOArray, unsafeReadIOArray, unsafeWriteIOArray,
     MVar(..),
 
-       -- Handles, file descriptors,
+        -- Handles, file descriptors,
     FilePath,  
     Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, 
     isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,
     FilePath,  
     Handle(..), Handle__(..), HandleType(..), IOMode(..), FD, 
     isReadableHandleType, isWritableHandleType, isReadWriteHandleType, showHandle,
-  
-       -- Buffers
+
+        -- Buffers
     Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),
     bufferIsWritable, bufferEmpty, bufferFull, 
 
     Buffer(..), RawBuffer, BufferState(..), BufferList(..), BufferMode(..),
     bufferIsWritable, bufferEmpty, bufferFull, 
 
-       -- Exceptions
+        -- Exceptions
     Exception(..), ArithException(..), AsyncException(..), ArrayException(..),
     Exception(..), ArithException(..), AsyncException(..), ArrayException(..),
-    stackOverflow, heapOverflow, throw, throwIO, ioException, 
+    stackOverflow, heapOverflow, ioException, 
     IOError, IOException(..), IOErrorType(..), ioError, userError,
     IOError, IOException(..), IOErrorType(..), ioError, userError,
-    ExitCode(..) 
+    ExitCode(..),
+    throwIO, block, unblock, catch, catchAny, catchException,
+    evaluate,
+    -- The RTS calls this
+    nonTermination,
   ) where
   ) where
-       
+
 import GHC.ST
 import GHC.ST
-import GHC.Arr -- to derive Ix class
+import GHC.Arr  -- to derive Ix class
 import GHC.Enum -- to derive Enum class
 import GHC.STRef
 import GHC.Base
 import GHC.Enum -- to derive Enum class
 import GHC.STRef
 import GHC.Base
---  import GHC.Num     -- To get fromInteger etc, needed because of -fno-implicit-prelude
+--  import GHC.Num      -- To get fromInteger etc, needed because of -XNoImplicitPrelude
 import Data.Maybe  ( Maybe(..) )
 import GHC.Show
 import GHC.List
 import GHC.Read
 import Foreign.C.Types (CInt)
 import Data.Maybe  ( Maybe(..) )
 import GHC.Show
 import GHC.List
 import GHC.Read
 import Foreign.C.Types (CInt)
+import GHC.Exception hiding (Exception)
+import qualified GHC.Exception as Exc
 
 #ifndef __HADDOCK__
 
 #ifndef __HADDOCK__
-import {-# SOURCE #-} Data.Typeable    ( showsTypeRep )
-import {-# SOURCE #-} Data.Dynamic     ( Dynamic, dynTypeRep )
+import {-# SOURCE #-} Data.Typeable     ( showsTypeRep )
+import {-# SOURCE #-} Data.Dynamic      ( Dynamic, dynTypeRep )
 #endif
 
 -- ---------------------------------------------------------------------------
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -75,13 +82,13 @@ system.  The following list may or may not be exhaustive:
 
 Compiler  - types of various primitives in PrimOp.lhs
 
 
 Compiler  - types of various primitives in PrimOp.lhs
 
-RTS      - forceIO (StgMiscClosures.hc)
-         - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast 
-           (Exceptions.hc)
-         - raiseAsync (Schedule.c)
+RTS       - forceIO (StgMiscClosures.hc)
+          - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast 
+            (Exceptions.hc)
+          - raiseAsync (Schedule.c)
 
 Prelude   - GHC.IOBase.lhs, and several other places including
 
 Prelude   - GHC.IOBase.lhs, and several other places including
-           GHC.Exception.lhs.
+            GHC.Exception.lhs.
 
 Libraries - parts of hslibs/lang.
 
 
 Libraries - parts of hslibs/lang.
 
@@ -114,10 +121,10 @@ instance  Monad IO  where
     {-# INLINE (>>)   #-}
     {-# INLINE (>>=)  #-}
     m >> k      =  m >>= \ _ -> k
     {-# INLINE (>>)   #-}
     {-# INLINE (>>=)  #-}
     m >> k      =  m >>= \ _ -> k
-    return x   = returnIO x
+    return x    = returnIO x
 
     m >>= k     = bindIO m k
 
     m >>= k     = bindIO m k
-    fail s     = failIO s
+    fail s      = failIO s
 
 failIO :: String -> IO a
 failIO s = ioError (userError s)
 
 failIO :: String -> IO a
 failIO s = ioError (userError s)
@@ -147,10 +154,10 @@ returnIO x = IO (\ s -> (# s, x #))
 -- monad.  The 'RealWorld' parameter indicates that the internal state
 -- used by the 'ST' computation is a special one supplied by the 'IO'
 -- monad, and thus distinct from those used by invocations of 'runST'.
 -- monad.  The 'RealWorld' parameter indicates that the internal state
 -- used by the 'ST' computation is a special one supplied by the 'IO'
 -- monad, and thus distinct from those used by invocations of 'runST'.
-stToIO       :: ST RealWorld a -> IO a
+stToIO        :: ST RealWorld a -> IO a
 stToIO (ST m) = IO m
 
 stToIO (ST m) = IO m
 
-ioToST       :: IO a -> ST RealWorld a
+ioToST        :: IO a -> ST RealWorld a
 ioToST (IO m) = (ST m)
 
 -- This relies on IO and ST having the same representation modulo the
 ioToST (IO m) = (ST m)
 
 -- This relies on IO and ST having the same representation modulo the
@@ -178,26 +185,26 @@ effects take place (relative to the main I\/O trunk, or other calls to
 writing and compiling modules that use 'unsafePerformIO':
 
   * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
 writing and compiling modules that use 'unsafePerformIO':
 
   * Use @{\-\# NOINLINE foo \#-\}@ as a pragma on any function @foo@
-       that calls 'unsafePerformIO'.  If the call is inlined,
-       the I\/O may be performed more than once.
+        that calls 'unsafePerformIO'.  If the call is inlined,
+        the I\/O may be performed more than once.
 
   * Use the compiler flag @-fno-cse@ to prevent common sub-expression
 
   * Use the compiler flag @-fno-cse@ to prevent common sub-expression
-       elimination being performed on the module, which might combine
-       two side effects that were meant to be separate.  A good example
-       is using multiple global variables (like @test@ in the example below).
+        elimination being performed on the module, which might combine
+        two side effects that were meant to be separate.  A good example
+        is using multiple global variables (like @test@ in the example below).
 
   * Make sure that the either you switch off let-floating, or that the 
 
   * Make sure that the either you switch off let-floating, or that the 
-       call to 'unsafePerformIO' cannot float outside a lambda.  For example, 
-       if you say:
-       @
-          f x = unsafePerformIO (newIORef [])
-       @
-       you may get only one reference cell shared between all calls to @f@.
-       Better would be
-       @
-          f x = unsafePerformIO (newIORef [x])
-       @
-       because now it can't float outside the lambda.
+        call to 'unsafePerformIO' cannot float outside a lambda.  For example, 
+        if you say:
+        @
+           f x = unsafePerformIO (newIORef [])
+        @
+        you may get only one reference cell shared between all calls to @f@.
+        Better would be
+        @
+           f x = unsafePerformIO (newIORef [x])
+        @
+        because now it can't float outside the lambda.
 
 It is less well known that
 'unsafePerformIO' is not type safe.  For example:
 
 It is less well known that
 'unsafePerformIO' is not type safe.  For example:
@@ -206,9 +213,9 @@ It is less well known that
 >     test = unsafePerformIO $ newIORef []
 >     
 >     main = do
 >     test = unsafePerformIO $ newIORef []
 >     
 >     main = do
->            writeIORef test [42]
->            bang <- readIORef test
->            print (bang :: [Char])
+>             writeIORef test [42]
+>             bang <- readIORef test
+>             print (bang :: [Char])
 
 This program will core dump.  This problem with polymorphic references
 is well known in the ML community, and does not arise with normal
 
 This program will core dump.  This problem with polymorphic references
 is well known in the ML community, and does not arise with normal
@@ -217,7 +224,7 @@ once you use 'unsafePerformIO'.  Indeed, it is
 possible to write @coerce :: a -> b@ with the
 help of 'unsafePerformIO'.  So be careful!
 -}
 possible to write @coerce :: a -> b@ with the
 help of 'unsafePerformIO'.  So be careful!
 -}
-unsafePerformIO        :: IO a -> a
+unsafePerformIO :: IO a -> a
 unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
 
 {-| 
 unsafePerformIO m = unsafeDupablePerformIO (noDuplicate >> m)
 
 {-| 
@@ -229,7 +236,7 @@ times (on a multiprocessor), and you should therefore ensure that
 it gives the same results each time.
 -}
 {-# NOINLINE unsafeDupablePerformIO #-}
 it gives the same results each time.
 -}
 {-# NOINLINE unsafeDupablePerformIO #-}
-unsafeDupablePerformIO :: IO a -> a
+unsafeDupablePerformIO  :: IO a -> a
 unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
 
 -- Why do we NOINLINE unsafeDupablePerformIO?  See the comment with
 unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
 
 -- Why do we NOINLINE unsafeDupablePerformIO?  See the comment with
@@ -242,16 +249,16 @@ unsafeDupablePerformIO (IO m) = lazy (case m realWorld# of (# _, r #) -> r)
 -- If we don't have it, the demand analyser discovers the following strictness
 -- for unsafeDupablePerformIO:  C(U(AV))
 -- But then consider
 -- If we don't have it, the demand analyser discovers the following strictness
 -- for unsafeDupablePerformIO:  C(U(AV))
 -- But then consider
---     unsafeDupablePerformIO (\s -> let r = f x in 
---                            case writeIORef v r s of (# s1, _ #) ->
---                            (# s1, r #)
+--      unsafeDupablePerformIO (\s -> let r = f x in 
+--                             case writeIORef v r s of (# s1, _ #) ->
+--                             (# s1, r #)
 -- The strictness analyser will find that the binding for r is strict,
 -- (becuase of uPIO's strictness sig), and so it'll evaluate it before 
 -- doing the writeIORef.  This actually makes tests/lib/should_run/memo002
 -- get a deadlock!  
 --
 -- Solution: don't expose the strictness of unsafeDupablePerformIO,
 -- The strictness analyser will find that the binding for r is strict,
 -- (becuase of uPIO's strictness sig), and so it'll evaluate it before 
 -- doing the writeIORef.  This actually makes tests/lib/should_run/memo002
 -- get a deadlock!  
 --
 -- Solution: don't expose the strictness of unsafeDupablePerformIO,
---          by hiding it with 'lazy'
+--           by hiding it with 'lazy'
 
 {-|
 'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
 
 {-|
 'unsafeInterleaveIO' allows 'IO' computation to be deferred lazily.
@@ -271,9 +278,9 @@ unsafeInterleaveIO m = unsafeDupableInterleaveIO (noDuplicate >> m)
 unsafeDupableInterleaveIO :: IO a -> IO a
 unsafeDupableInterleaveIO (IO m)
   = IO ( \ s -> let
 unsafeDupableInterleaveIO :: IO a -> IO a
 unsafeDupableInterleaveIO (IO m)
   = IO ( \ s -> let
-                  r = case m s of (# _, res #) -> res
-               in
-               (# s, r #))
+                   r = case m s of (# _, res #) -> res
+                in
+                (# s, r #))
 
 {-| 
 Ensures that the suspensions under evaluation by the current thread
 
 {-| 
 Ensures that the suspensions under evaluation by the current thread
@@ -300,7 +307,7 @@ as a a box, which may be empty or full.
 
 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
 instance Eq (MVar a) where
 
 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
 instance Eq (MVar a) where
-       (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
+        (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 
 --  A Handle is represented by (a reference to) a record 
 --  containing the state of the I/O port/device. We record
 
 --  A Handle is represented by (a reference to) a record 
 --  containing the state of the I/O port/device. We record
@@ -311,7 +318,7 @@ instance Eq (MVar a) where
 --    * buffering mode 
 --    * buffer, and spare buffers
 --    * user-friendly name (usually the
 --    * buffering mode 
 --    * buffer, and spare buffers
 --    * user-friendly name (usually the
---     FilePath used when IO.openFile was called)
+--      FilePath used when IO.openFile was called)
 
 -- Note: when a Handle is garbage collected, we want to flush its buffer
 -- and close the OS file handle, so as to free up a (precious) resource.
 
 -- Note: when a Handle is garbage collected, we want to flush its buffer
 -- and close the OS file handle, so as to free up a (precious) resource.
@@ -354,15 +361,15 @@ instance Eq (MVar a) where
 -- ensure that this doesn't happen.
 
 data Handle 
 -- ensure that this doesn't happen.
 
 data Handle 
-  = FileHandle                         -- A normal handle to a file
-       FilePath                        -- the file (invariant)
-       !(MVar Handle__)
+  = FileHandle                          -- A normal handle to a file
+        FilePath                        -- the file (invariant)
+        !(MVar Handle__)
 
 
-  | DuplexHandle                       -- A handle to a read/write stream
-       FilePath                        -- file for a FIFO, otherwise some
-                                       --   descriptive string.
-       !(MVar Handle__)                -- The read side
-       !(MVar Handle__)                -- The write side
+  | DuplexHandle                        -- A handle to a read/write stream
+        FilePath                        -- file for a FIFO, otherwise some
+                                        --   descriptive string.
+        !(MVar Handle__)                -- The read side
+        !(MVar Handle__)                -- The write side
 
 -- NOTES:
 --    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be
 
 -- NOTES:
 --    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be
@@ -377,16 +384,16 @@ type FD = CInt
 
 data Handle__
   = Handle__ {
 
 data Handle__
   = Handle__ {
-      haFD         :: !FD,                  -- file descriptor
-      haType        :: HandleType,          -- type (read/write/append etc.)
-      haIsBin       :: Bool,                -- binary mode?
-      haIsStream    :: Bool,                -- Windows : is this a socket?
+      haFD          :: !FD,                  -- file descriptor
+      haType        :: HandleType,           -- type (read/write/append etc.)
+      haIsBin       :: Bool,                 -- binary mode?
+      haIsStream    :: Bool,                 -- Windows : is this a socket?
                                              -- Unix    : is O_NONBLOCK set?
                                              -- Unix    : is O_NONBLOCK set?
-      haBufferMode  :: BufferMode,          -- buffer contains read/write data?
-      haBuffer     :: !(IORef Buffer),      -- the current buffer
+      haBufferMode  :: BufferMode,           -- buffer contains read/write data?
+      haBuffer      :: !(IORef Buffer),      -- the current buffer
       haBuffers     :: !(IORef BufferList),  -- spare buffers
       haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
       haBuffers     :: !(IORef BufferList),  -- spare buffers
       haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a 
-                                            -- duplex handle.
+                                             -- duplex handle.
     }
 
 -- ---------------------------------------------------------------------------
     }
 
 -- ---------------------------------------------------------------------------
@@ -426,11 +433,11 @@ type RawBuffer = MutableByteArray# RealWorld
 
 data Buffer 
   = Buffer {
 
 data Buffer 
   = Buffer {
-       bufBuf   :: RawBuffer,
-       bufRPtr  :: !Int,
-       bufWPtr  :: !Int,
-       bufSize  :: !Int,
-       bufState :: BufferState
+        bufBuf   :: RawBuffer,
+        bufRPtr  :: !Int,
+        bufWPtr  :: !Int,
+        bufSize  :: !Int,
+        bufState :: BufferState
   }
 
 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
   }
 
 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
@@ -467,12 +474,12 @@ data HandleType
 
 isReadableHandleType ReadHandle         = True
 isReadableHandleType ReadWriteHandle    = True
 
 isReadableHandleType ReadHandle         = True
 isReadableHandleType ReadWriteHandle    = True
-isReadableHandleType _                 = False
+isReadableHandleType _                  = False
 
 isWritableHandleType AppendHandle    = True
 isWritableHandleType WriteHandle     = True
 isWritableHandleType ReadWriteHandle = True
 
 isWritableHandleType AppendHandle    = True
 isWritableHandleType WriteHandle     = True
 isWritableHandleType ReadWriteHandle = True
-isWritableHandleType _              = False
+isWritableHandleType _               = False
 
 isReadWriteHandleType ReadWriteHandle{} = True
 isReadWriteHandleType _                 = False
 
 isReadWriteHandleType ReadWriteHandle{} = True
 isReadWriteHandleType _                 = False
@@ -527,13 +534,13 @@ type FilePath = String
 -- and terminals will normally be line-buffered.
 
 data BufferMode  
 -- and terminals will normally be line-buffered.
 
 data BufferMode  
- = NoBuffering -- ^ buffering is disabled if possible.
+ = NoBuffering  -- ^ buffering is disabled if possible.
  | LineBuffering
  | LineBuffering
-               -- ^ line-buffering should be enabled if possible.
+                -- ^ line-buffering should be enabled if possible.
  | BlockBuffering (Maybe Int)
  | BlockBuffering (Maybe Int)
-               -- ^ block-buffering should be enabled if possible.
-               -- The size of the buffer is @n@ items if the argument
-               -- is 'Just' @n@ and is otherwise implementation-dependent.
+                -- ^ block-buffering should be enabled if possible.
+                -- The size of the buffer is @n@ items if the argument
+                -- is 'Just' @n@ and is otherwise implementation-dependent.
    deriving (Eq, Ord, Read, Show)
 
 -- ---------------------------------------------------------------------------
    deriving (Eq, Ord, Read, Show)
 
 -- ---------------------------------------------------------------------------
@@ -630,85 +637,92 @@ showHandle file = showString "{handle: " . showString file . showString "}"
 -- 'Data.Dynamic.Dynamic' (see the section on Dynamic Exceptions:
 -- "Control.Exception\#DynamicExceptions").
 data Exception
 -- 'Data.Dynamic.Dynamic' (see the section on Dynamic Exceptions:
 -- "Control.Exception\#DynamicExceptions").
 data Exception
-  = ArithException     ArithException
-       -- ^Exceptions raised by arithmetic
-       -- operations.  (NOTE: GHC currently does not throw
-       -- 'ArithException's except for 'DivideByZero').
-  | ArrayException     ArrayException
-       -- ^Exceptions raised by array-related
-       -- operations.  (NOTE: GHC currently does not throw
-       -- 'ArrayException's).
-  | AssertionFailed    String
-       -- ^This exception is thrown by the
-       -- 'assert' operation when the condition
-       -- fails.  The 'String' argument contains the
-       -- location of the assertion in the source program.
-  | AsyncException     AsyncException
-       -- ^Asynchronous exceptions (see section on Asynchronous Exceptions: "Control.Exception\#AsynchronousExceptions").
+  = ArithException      ArithException
+        -- ^Exceptions raised by arithmetic
+        -- operations.  (NOTE: GHC currently does not throw
+        -- 'ArithException's except for 'DivideByZero').
+  | ArrayException      ArrayException
+        -- ^Exceptions raised by array-related
+        -- operations.  (NOTE: GHC currently does not throw
+        -- 'ArrayException's).
+  | AssertionFailed     String
+        -- ^This exception is thrown by the
+        -- 'assert' operation when the condition
+        -- fails.  The 'String' argument contains the
+        -- location of the assertion in the source program.
+  | AsyncException      AsyncException
+        -- ^Asynchronous exceptions (see section on Asynchronous Exceptions: "Control.Exception\#AsynchronousExceptions").
   | BlockedOnDeadMVar
   | BlockedOnDeadMVar
-       -- ^The current thread was executing a call to
-       -- 'Control.Concurrent.MVar.takeMVar' that could never return,
-       -- because there are no other references to this 'MVar'.
+        -- ^The current thread was executing a call to
+        -- 'Control.Concurrent.MVar.takeMVar' that could never return,
+        -- because there are no other references to this 'MVar'.
   | BlockedIndefinitely
   | BlockedIndefinitely
-       -- ^The current thread was waiting to retry an atomic memory transaction
-       -- that could never become possible to complete because there are no other
-       -- threads referring to any of the TVars involved.
+        -- ^The current thread was waiting to retry an atomic memory transaction
+        -- that could never become possible to complete because there are no other
+        -- threads referring to any of the TVars involved.
   | NestedAtomically
   | NestedAtomically
-       -- ^The runtime detected an attempt to nest one STM transaction
-       -- inside another one, presumably due to the use of 
-       -- 'unsafePeformIO' with 'atomically'.
+        -- ^The runtime detected an attempt to nest one STM transaction
+        -- inside another one, presumably due to the use of 
+        -- 'unsafePeformIO' with 'atomically'.
   | Deadlock
   | Deadlock
-       -- ^There are no runnable threads, so the program is
-       -- deadlocked.  The 'Deadlock' exception is
-       -- raised in the main thread only (see also: "Control.Concurrent").
-  | DynException       Dynamic
-       -- ^Dynamically typed exceptions (see section on Dynamic Exceptions: "Control.Exception\#DynamicExceptions").
-  | ErrorCall          String
-       -- ^The 'ErrorCall' exception is thrown by 'error'.  The 'String'
-       -- argument of 'ErrorCall' is the string passed to 'error' when it was
-       -- called.
-  | ExitException      ExitCode
-       -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and
-       -- 'System.Exit.exitFailure').  The 'ExitCode' argument is the value passed 
-       -- to 'System.Exit.exitWith'.  An unhandled 'ExitException' exception in the
-       -- main thread will cause the program to be terminated with the given 
-       -- exit code.
-  | IOException        IOException
-       -- ^These are the standard IO exceptions generated by
-       -- Haskell\'s @IO@ operations.  See also "System.IO.Error".
+        -- ^There are no runnable threads, so the program is
+        -- deadlocked.  The 'Deadlock' exception is
+        -- raised in the main thread only (see also: "Control.Concurrent").
+  | DynException        Dynamic
+        -- ^Dynamically typed exceptions (see section on Dynamic Exceptions: "Control.Exception\#DynamicExceptions").
+  | ErrorCall           String
+        -- ^The 'ErrorCall' exception is thrown by 'error'.  The 'String'
+        -- argument of 'ErrorCall' is the string passed to 'error' when it was
+        -- called.
+  | ExitException       ExitCode
+        -- ^The 'ExitException' exception is thrown by 'System.Exit.exitWith' (and
+        -- 'System.Exit.exitFailure').  The 'ExitCode' argument is the value passed 
+        -- to 'System.Exit.exitWith'.  An unhandled 'ExitException' exception in the
+        -- main thread will cause the program to be terminated with the given 
+        -- exit code.
+  | IOException         IOException
+        -- ^These are the standard IO exceptions generated by
+        -- Haskell\'s @IO@ operations.  See also "System.IO.Error".
   | NoMethodError       String
   | NoMethodError       String
-       -- ^An attempt was made to invoke a class method which has
-       -- no definition in this instance, and there was no default
-       -- definition given in the class declaration.  GHC issues a
-       -- warning when you compile an instance which has missing
-       -- methods.
+        -- ^An attempt was made to invoke a class method which has
+        -- no definition in this instance, and there was no default
+        -- definition given in the class declaration.  GHC issues a
+        -- warning when you compile an instance which has missing
+        -- methods.
   | NonTermination
   | NonTermination
-       -- ^The current thread is stuck in an infinite loop.  This
-       -- exception may or may not be thrown when the program is
-       -- non-terminating.
-  | PatternMatchFail   String
-       -- ^A pattern matching failure.  The 'String' argument should contain a
-       -- descriptive message including the function name, source file
-       -- and line number.
-  | RecConError                String
-       -- ^An attempt was made to evaluate a field of a record
-       -- for which no value was given at construction time.  The
-       -- 'String' argument gives the location of the
-       -- record construction in the source program.
-  | RecSelError                String
-       -- ^A field selection was attempted on a constructor that
-       -- doesn\'t have the requested field.  This can happen with
-       -- multi-constructor records when one or more fields are
-       -- missing from some of the constructors.  The
-       -- 'String' argument gives the location of the
-       -- record selection in the source program.
-  | RecUpdError                String
-       -- ^An attempt was made to update a field in a record,
-       -- where the record doesn\'t have the requested field.  This can
-       -- only occur with multi-constructor records, when one or more
-       -- fields are missing from some of the constructors.  The
-       -- 'String' argument gives the location of the
-       -- record update in the source program.
+        -- ^The current thread is stuck in an infinite loop.  This
+        -- exception may or may not be thrown when the program is
+        -- non-terminating.
+  | PatternMatchFail    String
+        -- ^A pattern matching failure.  The 'String' argument should contain a
+        -- descriptive message including the function name, source file
+        -- and line number.
+  | RecConError         String
+        -- ^An attempt was made to evaluate a field of a record
+        -- for which no value was given at construction time.  The
+        -- 'String' argument gives the location of the
+        -- record construction in the source program.
+  | RecSelError         String
+        -- ^A field selection was attempted on a constructor that
+        -- doesn\'t have the requested field.  This can happen with
+        -- multi-constructor records when one or more fields are
+        -- missing from some of the constructors.  The
+        -- 'String' argument gives the location of the
+        -- record selection in the source program.
+  | RecUpdError         String
+        -- ^An attempt was made to update a field in a record,
+        -- where the record doesn\'t have the requested field.  This can
+        -- only occur with multi-constructor records, when one or more
+        -- fields are missing from some of the constructors.  The
+        -- 'String' argument gives the location of the
+        -- record update in the source program.
+
+nonTermination :: SomeException
+nonTermination = toException NonTermination
+
+-- For now at least, make the monolithic Exception type an instance of
+-- the Exception class
+instance Exc.Exception Exception
 
 -- |The type of arithmetic exceptions
 data ArithException
 
 -- |The type of arithmetic exceptions
 data ArithException
@@ -723,34 +737,38 @@ data ArithException
 -- |Asynchronous exceptions
 data AsyncException
   = StackOverflow
 -- |Asynchronous exceptions
 data AsyncException
   = StackOverflow
-       -- ^The current thread\'s stack exceeded its limit.
-       -- Since an exception has been raised, the thread\'s stack
-       -- will certainly be below its limit again, but the
-       -- programmer should take remedial action
-       -- immediately.
+        -- ^The current thread\'s stack exceeded its limit.
+        -- Since an exception has been raised, the thread\'s stack
+        -- will certainly be below its limit again, but the
+        -- programmer should take remedial action
+        -- immediately.
   | HeapOverflow
   | HeapOverflow
-       -- ^The program\'s heap is reaching its limit, and
-       -- the program should take action to reduce the amount of
-       -- live data it has. Notes:
-       --
-       --      * It is undefined which thread receives this exception.
-       --
-       --      * GHC currently does not throw 'HeapOverflow' exceptions.
+        -- ^The program\'s heap is reaching its limit, and
+        -- the program should take action to reduce the amount of
+        -- live data it has. Notes:
+        --
+        --      * It is undefined which thread receives this exception.
+        --
+        --      * GHC currently does not throw 'HeapOverflow' exceptions.
   | ThreadKilled
   | ThreadKilled
-       -- ^This exception is raised by another thread
-       -- calling 'Control.Concurrent.killThread', or by the system
-       -- if it needs to terminate the thread for some
-       -- reason.
+        -- ^This exception is raised by another thread
+        -- calling 'Control.Concurrent.killThread', or by the system
+        -- if it needs to terminate the thread for some
+        -- reason.
+  | UserInterrupt
+        -- ^This exception is raised by default in the main thread of
+        -- the program when the user requests to terminate the program
+        -- via the usual mechanism(s) (e.g. Control-C in the console).
   deriving (Eq, Ord)
 
 -- | Exceptions generated by array operations
 data ArrayException
   deriving (Eq, Ord)
 
 -- | Exceptions generated by array operations
 data ArrayException
-  = IndexOutOfBounds   String
-       -- ^An attempt was made to index an array outside
-       -- its declared bounds.
-  | UndefinedElement   String
-       -- ^An attempt was made to evaluate an element of an
-       -- array that had not been initialized.
+  = IndexOutOfBounds    String
+        -- ^An attempt was made to index an array outside
+        -- its declared bounds.
+  | UndefinedElement    String
+        -- ^An attempt was made to evaluate an element of an
+        -- array that had not been initialized.
   deriving (Eq, Ord)
 
 stackOverflow, heapOverflow :: Exception -- for the RTS
   deriving (Eq, Ord)
 
 stackOverflow, heapOverflow :: Exception -- for the RTS
@@ -771,31 +789,31 @@ instance Show AsyncException where
 
 instance Show ArrayException where
   showsPrec _ (IndexOutOfBounds s)
 
 instance Show ArrayException where
   showsPrec _ (IndexOutOfBounds s)
-       = showString "array index out of range"
-       . (if not (null s) then showString ": " . showString s
-                          else id)
+        = showString "array index out of range"
+        . (if not (null s) then showString ": " . showString s
+                           else id)
   showsPrec _ (UndefinedElement s)
   showsPrec _ (UndefinedElement s)
-       = showString "undefined array element"
-       . (if not (null s) then showString ": " . showString s
-                          else id)
+        = showString "undefined array element"
+        . (if not (null s) then showString ": " . showString s
+                           else id)
 
 instance Show Exception where
 
 instance Show Exception where
-  showsPrec _ (IOException err)                 = shows err
+  showsPrec _ (IOException err)          = shows err
   showsPrec _ (ArithException err)       = shows err
   showsPrec _ (ArrayException err)       = shows err
   showsPrec _ (ArithException err)       = shows err
   showsPrec _ (ArrayException err)       = shows err
-  showsPrec _ (ErrorCall err)           = showString err
+  showsPrec _ (ErrorCall err)            = showString err
   showsPrec _ (ExitException err)        = showString "exit: " . shows err
   showsPrec _ (NoMethodError err)        = showString err
   showsPrec _ (PatternMatchFail err)     = showString err
   showsPrec _ (ExitException err)        = showString "exit: " . shows err
   showsPrec _ (NoMethodError err)        = showString err
   showsPrec _ (PatternMatchFail err)     = showString err
-  showsPrec _ (RecSelError err)                 = showString err
-  showsPrec _ (RecConError err)                 = showString err
-  showsPrec _ (RecUpdError err)                 = showString err
+  showsPrec _ (RecSelError err)          = showString err
+  showsPrec _ (RecConError err)          = showString err
+  showsPrec _ (RecUpdError err)          = showString err
   showsPrec _ (AssertionFailed err)      = showString err
   showsPrec _ (DynException err)         = showString "exception :: " . showsTypeRep (dynTypeRep err)
   showsPrec _ (AssertionFailed err)      = showString err
   showsPrec _ (DynException err)         = showString "exception :: " . showsTypeRep (dynTypeRep err)
-  showsPrec _ (AsyncException e)        = shows e
-  showsPrec _ (BlockedOnDeadMVar)       = showString "thread blocked indefinitely"
-  showsPrec _ (BlockedIndefinitely)     = showString "thread blocked indefinitely"
-  showsPrec _ (NestedAtomically)        = showString "Control.Concurrent.STM.atomically was nested"
+  showsPrec _ (AsyncException e)         = shows e
+  showsPrec _ (BlockedOnDeadMVar)        = showString "thread blocked indefinitely"
+  showsPrec _ (BlockedIndefinitely)      = showString "thread blocked indefinitely"
+  showsPrec _ (NestedAtomically)         = showString "Control.Concurrent.STM.atomically was nested"
   showsPrec _ (NonTermination)           = showString "<<loop>>"
   showsPrec _ (Deadlock)                 = showString "<<deadlock>>"
 
   showsPrec _ (NonTermination)           = showString "<<loop>>"
   showsPrec _ (Deadlock)                 = showString "<<deadlock>>"
 
@@ -803,8 +821,8 @@ instance Eq Exception where
   IOException e1      == IOException e2      = e1 == e2
   ArithException e1   == ArithException e2   = e1 == e2
   ArrayException e1   == ArrayException e2   = e1 == e2
   IOException e1      == IOException e2      = e1 == e2
   ArithException e1   == ArithException e2   = e1 == e2
   ArrayException e1   == ArrayException e2   = e1 == e2
-  ErrorCall e1        == ErrorCall e2       = e1 == e2
-  ExitException        e1    == ExitException e2    = e1 == e2
+  ErrorCall e1        == ErrorCall e2        = e1 == e2
+  ExitException e1    == ExitException e2    = e1 == e2
   NoMethodError e1    == NoMethodError e2    = e1 == e2
   PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
   RecSelError e1      == RecSelError e2      = e1 == e2
   NoMethodError e1    == NoMethodError e2    = e1 == e2
   PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
   RecSelError e1      == RecSelError e2      = e1 == e2
@@ -826,46 +844,20 @@ instance Eq Exception where
 -- Exception datatype (above).
 
 data ExitCode
 -- Exception datatype (above).
 
 data ExitCode
-  = ExitSuccess        -- ^ indicates successful termination;
+  = ExitSuccess -- ^ indicates successful termination;
   | ExitFailure Int
   | ExitFailure Int
-               -- ^ indicates program failure with an exit code.
-               -- The exact interpretation of the code is
-               -- operating-system dependent.  In particular, some values
-               -- may be prohibited (e.g. 0 on a POSIX-compliant system).
+                -- ^ indicates program failure with an exit code.
+                -- The exact interpretation of the code is
+                -- operating-system dependent.  In particular, some values
+                -- may be prohibited (e.g. 0 on a POSIX-compliant system).
   deriving (Eq, Ord, Read, Show)
 
   deriving (Eq, Ord, Read, Show)
 
--- --------------------------------------------------------------------------
--- Primitive throw
-
--- | Throw an exception.  Exceptions may be thrown from purely
--- functional code, but may only be caught within the 'IO' monad.
-throw :: Exception -> a
-throw exception = raise# exception
-
--- | A variant of 'throw' that can be used within the 'IO' monad.
---
--- Although 'throwIO' has a type that is an instance of the type of 'throw', the
--- two functions are subtly different:
---
--- > throw e   `seq` x  ===> throw e
--- > throwIO e `seq` x  ===> x
---
--- The first example will cause the exception @e@ to be raised,
--- whereas the second one won\'t.  In fact, 'throwIO' will only cause
--- an exception to be raised when it is used within the 'IO' monad.
--- The 'throwIO' variant should be used in preference to 'throw' to
--- raise an exception within the 'IO' monad because it guarantees
--- ordering with respect to other 'IO' operations, whereas 'throw'
--- does not.
-throwIO         :: Exception -> IO a
-throwIO err    =  IO $ raiseIO# err
-
-ioException    :: IOException -> IO a
-ioException err =  IO $ raiseIO# (IOException err)
+ioException     :: IOException -> IO a
+ioException err = throwIO (IOException err)
 
 -- | Raise an 'IOError' in the 'IO' monad.
 ioError         :: IOError -> IO a 
 
 -- | Raise an 'IOError' in the 'IO' monad.
 ioError         :: IOError -> IO a 
-ioError                =  ioException
+ioError         =  ioException
 
 -- ---------------------------------------------------------------------------
 -- IOError type
 
 -- ---------------------------------------------------------------------------
 -- IOError type
@@ -885,9 +877,9 @@ type IOError = IOException
 data IOException
  = IOError {
      ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging 
 data IOException
  = IOError {
      ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging 
-                                    -- the error.
+                                     -- the error.
      ioe_type     :: IOErrorType,    -- what it was.
      ioe_type     :: IOErrorType,    -- what it was.
-     ioe_location :: String,        -- location.
+     ioe_location :: String,         -- location.
      ioe_description :: String,      -- error type specific information.
      ioe_filename :: Maybe FilePath  -- filename the error is related to.
    }
      ioe_description :: String,      -- error type specific information.
      ioe_filename :: Maybe FilePath  -- filename the error is related to.
    }
@@ -931,22 +923,22 @@ instance Show IOErrorType where
   showsPrec _ e =
     showString $
     case e of
   showsPrec _ e =
     showString $
     case e of
-      AlreadyExists    -> "already exists"
+      AlreadyExists     -> "already exists"
       NoSuchThing       -> "does not exist"
       ResourceBusy      -> "resource busy"
       ResourceExhausted -> "resource exhausted"
       NoSuchThing       -> "does not exist"
       ResourceBusy      -> "resource busy"
       ResourceExhausted -> "resource exhausted"
-      EOF              -> "end of file"
-      IllegalOperation -> "illegal operation"
+      EOF               -> "end of file"
+      IllegalOperation  -> "illegal operation"
       PermissionDenied  -> "permission denied"
       PermissionDenied  -> "permission denied"
-      UserError                -> "user error"
-      HardwareFault    -> "hardware fault"
+      UserError         -> "user error"
+      HardwareFault     -> "hardware fault"
       InappropriateType -> "inappropriate type"
       Interrupted       -> "interrupted"
       InvalidArgument   -> "invalid argument"
       OtherError        -> "failed"
       ProtocolError     -> "protocol error"
       ResourceVanished  -> "resource vanished"
       InappropriateType -> "inappropriate type"
       Interrupted       -> "interrupted"
       InvalidArgument   -> "invalid argument"
       OtherError        -> "failed"
       ProtocolError     -> "protocol error"
       ResourceVanished  -> "resource vanished"
-      SystemError      -> "system error"
+      SystemError       -> "system error"
       TimeExpired       -> "timeout"
       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
       UnsupportedOperation -> "unsupported operation"
       TimeExpired       -> "timeout"
       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
       UnsupportedOperation -> "unsupported operation"
@@ -961,7 +953,7 @@ instance Show IOErrorType where
 -- >   fail s = ioError (userError s)
 --
 userError       :: String  -> IOError
 -- >   fail s = ioError (userError s)
 --
 userError       :: String  -> IOError
-userError str  =  IOError Nothing UserError "" str Nothing
+userError str   =  IOError Nothing UserError "" str Nothing
 
 -- ---------------------------------------------------------------------------
 -- Showing IOErrors
 
 -- ---------------------------------------------------------------------------
 -- Showing IOErrors
@@ -969,17 +961,17 @@ userError str     =  IOError Nothing UserError "" str Nothing
 instance Show IOException where
     showsPrec p (IOError hdl iot loc s fn) =
       (case fn of
 instance Show IOException where
     showsPrec p (IOError hdl iot loc s fn) =
       (case fn of
-        Nothing -> case hdl of
-                       Nothing -> id
-                       Just h  -> showsPrec p h . showString ": "
-        Just name -> showString name . showString ": ") .
+         Nothing -> case hdl of
+                        Nothing -> id
+                        Just h  -> showsPrec p h . showString ": "
+         Just name -> showString name . showString ": ") .
       (case loc of
          "" -> id
       (case loc of
          "" -> id
-        _  -> showString loc . showString ": ") .
+         _  -> showString loc . showString ": ") .
       showsPrec p iot . 
       (case s of
       showsPrec p iot . 
       (case s of
-        "" -> id
-        _  -> showString " (" . showString s . showString ")")
+         "" -> id
+         _  -> showString " (" . showString s . showString ")")
 
 -- -----------------------------------------------------------------------------
 -- IOMode type
 
 -- -----------------------------------------------------------------------------
 -- IOMode type
@@ -987,3 +979,108 @@ instance Show IOException where
 data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 \end{code}
 data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 \end{code}
+
+%*********************************************************
+%*                                                      *
+\subsection{Primitive catch and throwIO}
+%*                                                      *
+%*********************************************************
+
+catchException used to handle the passing around of the state to the
+action and the handler.  This turned out to be a bad idea - it meant
+that we had to wrap both arguments in thunks so they could be entered
+as normal (remember IO returns an unboxed pair...).
+
+Now catch# has type
+
+    catch# :: IO a -> (b -> IO a) -> IO a
+
+(well almost; the compiler doesn't know about the IO newtype so we
+have to work around that in the definition of catchException below).
+
+\begin{code} 
+catchException :: Exception e => IO a -> (e -> IO a) -> IO a
+catchException (IO io) handler = IO $ catch# io handler'
+    where handler' e = case fromException e of
+                       Just e' -> unIO (handler e')
+                       Nothing -> raise# e
+
+catchAny :: IO a -> (forall e . Exception e => e -> IO a) -> IO a
+catchAny (IO io) handler = IO $ catch# io handler'
+    where handler' (SomeException e) = unIO (handler e)
+
+-- | A variant of 'throw' that can be used within the 'IO' monad.
+--
+-- Although 'throwIO' has a type that is an instance of the type of 'throw', the
+-- two functions are subtly different:
+--
+-- > throw e   `seq` x  ===> throw e
+-- > throwIO e `seq` x  ===> x
+--
+-- The first example will cause the exception @e@ to be raised,
+-- whereas the second one won\'t.  In fact, 'throwIO' will only cause
+-- an exception to be raised when it is used within the 'IO' monad.
+-- The 'throwIO' variant should be used in preference to 'throw' to
+-- raise an exception within the 'IO' monad because it guarantees
+-- ordering with respect to other 'IO' operations, whereas 'throw'
+-- does not.
+throwIO :: Exception e => e -> IO a
+throwIO e = IO (raiseIO# (toException e))
+\end{code}
+
+
+%*********************************************************
+%*                                                      *
+\subsection{Controlling asynchronous exception delivery}
+%*                                                      *
+%*********************************************************
+
+\begin{code}
+-- | Applying 'block' to a computation will
+-- execute that computation with asynchronous exceptions
+-- /blocked/.  That is, any thread which
+-- attempts to raise an exception in the current thread with 'Control.Exception.throwTo' will be
+-- blocked until asynchronous exceptions are enabled again.  There\'s
+-- no need to worry about re-enabling asynchronous exceptions; that is
+-- done automatically on exiting the scope of
+-- 'block'.
+--
+-- Threads created by 'Control.Concurrent.forkIO' inherit the blocked
+-- state from the parent; that is, to start a thread in blocked mode,
+-- use @block $ forkIO ...@.  This is particularly useful if you need to
+-- establish an exception handler in the forked thread before any
+-- asynchronous exceptions are received.
+block :: IO a -> IO a
+
+-- | To re-enable asynchronous exceptions inside the scope of
+-- 'block', 'unblock' can be
+-- used.  It scopes in exactly the same way, so on exit from
+-- 'unblock' asynchronous exception delivery will
+-- be disabled again.
+unblock :: IO a -> IO a
+
+block (IO io) = IO $ blockAsyncExceptions# io
+unblock (IO io) = IO $ unblockAsyncExceptions# io
+\end{code}
+
+\begin{code}
+-- | Forces its argument to be evaluated when the resultant 'IO' action
+-- is executed.  It can be used to order evaluation with respect to
+-- other 'IO' operations; its semantics are given by
+--
+-- >   evaluate x `seq` y    ==>  y
+-- >   evaluate x `catch` f  ==>  (return $! x) `catch` f
+-- >   evaluate x >>= f      ==>  (return $! x) >>= f
+--
+-- /Note:/ the first equation implies that @(evaluate x)@ is /not/ the
+-- same as @(return $! x)@.  A correct definition is
+--
+-- >   evaluate x = (return $! x) >>= return
+--
+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
+\end{code}
+