GHC/Exception.lhs

   1 \begin{code}
   2 {-# OPTIONS -fno-implicit-prelude #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  GHC.Exception
   6 -- Copyright   :  (c) The University of Glasgow, 1998-2002
   7 -- License     :  see libraries/base/LICENSE
   8 --
   9 -- Maintainer  :  cvs-ghc@haskell.org
  10 -- Stability   :  internal
  11 -- Portability :  non-portable (GHC extensions)
  12 --
  13 -- Exceptions and exception-handling functions.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 #ifndef __HUGS__
  18 module GHC.Exception
  19         ( module GHC.Exception,
  20           Exception(..), AsyncException(..),
  21           IOException(..), ArithException(..), ArrayException(..),
  22           throw, throwIO, ioError )
  23   where
  24
  25 import GHC.Base
  26 import GHC.IOBase
  27
  28 #endif
  29 \end{code}
  30
  31 %*********************************************************
  32 %*                                                      *
  33 \subsection{Primitive catch}
  34 %*                                                      *
  35 %*********************************************************
  36
  37 catchException used to handle the passing around of the state to the
  38 action and the handler.  This turned out to be a bad idea - it meant
  39 that we had to wrap both arguments in thunks so they could be entered
  40 as normal (remember IO returns an unboxed pair...).
  41
  42 Now catch# has type
  43
  44     catch# :: IO a -> (b -> IO a) -> IO a
  45
  46 (well almost; the compiler doesn't know about the IO newtype so we
  47 have to work around that in the definition of catchException below).
  48
  49 \begin{code}
  50 catchException :: IO a -> (Exception -> IO a) -> IO a
  51 #ifdef __HUGS__
  52 catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
  53 #else
  54 catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
  55 #endif
  56
  57 catch           :: IO a -> (IOError -> IO a) -> IO a
  58 catch m k       =  catchException m handler
  59   where handler (IOException err)   = k err
  60         handler other               = throw other
  61 \end{code}
  62
  63
  64 %*********************************************************
  65 %*                                                      *
  66 \subsection{Controlling asynchronous exception delivery}
  67 %*                                                      *
  68 %*********************************************************
  69
  70 \begin{code}
  71 -- | Applying 'block' to a computation will
  72 -- execute that computation with asynchronous exceptions
  73 -- /blocked/.  That is, any thread which
  74 -- attempts to raise an exception in the current thread will be
  75 -- blocked until asynchronous exceptions are enabled again.  There\'s
  76 -- no need to worry about re-enabling asynchronous exceptions; that is
  77 -- done automatically on exiting the scope of
  78 -- 'block'.
  79 block :: IO a -> IO a
  80
  81 -- | To re-enable asynchronous exceptions inside the scope of
  82 -- 'block', 'unblock' can be
  83 -- used.  It scopes in exactly the same way, so on exit from
  84 -- 'unblock' asynchronous exception delivery will
  85 -- be disabled again.
  86 unblock :: IO a -> IO a
  87
  88 #ifndef __HUGS__
  89 block (IO io) = IO $ blockAsyncExceptions# io
  90 unblock (IO io) = IO $ unblockAsyncExceptions# io
  91 #else
  92 unblock :: IO a -> IO a
  93 unblock (IO io) = IO io
  94 #endif
  95 \end{code}
  96
  97