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, ioError )
  23   where
  24
  25 import Data.Either
  26
  27 import GHC.Base
  28 import GHC.IOBase
  29
  30 #endif
  31 \end{code}
  32
  33 %*********************************************************
  34 %*                                                      *
  35 \subsection{Primitive catch}
  36 %*                                                      *
  37 %*********************************************************
  38
  39 catchException used to handle the passing around of the state to the
  40 action and the handler.  This turned out to be a bad idea - it meant
  41 that we had to wrap both arguments in thunks so they could be entered
  42 as normal (remember IO returns an unboxed pair...).
  43
  44 Now catch# has type
  45
  46     catch# :: IO a -> (b -> IO a) -> IO a
  47
  48 (well almost; the compiler doesn't know about the IO newtype so we
  49 have to work around that in the definition of catchException below).
  50
  51 \begin{code}
  52 catchException :: IO a -> (Exception -> IO a) -> IO a
  53 #ifdef __HUGS__
  54 catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
  55 #else
  56 catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
  57 #endif
  58
  59 catch           :: IO a -> (Exception -> IO a) -> IO a
  60 catch m k       =  catchException m handler
  61   where handler err@(IOException _) = k err
  62         handler other               = throw other
  63 \end{code}
  64
  65
  66 %*********************************************************
  67 %*                                                      *
  68 \subsection{Try and bracket}
  69 %*                                                      *
  70 %*********************************************************
  71
  72 The construct @try comp@ exposes errors which occur within a
  73 computation, and which are not fully handled.  It always succeeds.
  74
  75 These are the IO-only try/bracket.  For the full exception try/bracket
  76 see hslibs/lang/Exception.lhs.
  77
  78 \begin{code}
  79 try            :: IO a -> IO (Either Exception a)
  80 try f          =  catch (do r <- f
  81                             return (Right r))
  82                         (return . Left)
  83
  84 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
  85 bracket before after m = do
  86         x  <- before
  87         rs <- try (m x)
  88         after x
  89         case rs of
  90            Right r -> return r
  91            Left  e -> ioError e
  92
  93 -- variant of the above where middle computation doesn't want x
  94 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
  95 bracket_ before after m = do
  96          x  <- before
  97          rs <- try m
  98          after x
  99          case rs of
 100             Right r -> return r
 101             Left  e -> ioError e
 102 \end{code}
 103
 104
 105 %*********************************************************
 106 %*                                                      *
 107 \subsection{Controlling asynchronous exception delivery}
 108 %*                                                      *
 109 %*********************************************************
 110
 111 \begin{code}
 112 -- | Applying 'block' to a computation will
 113 -- execute that computation with asynchronous exceptions
 114 -- /blocked/.  That is, any thread which
 115 -- attempts to raise an exception in the current thread will be
 116 -- blocked until asynchronous exceptions are enabled again.  There\'s
 117 -- no need to worry about re-enabling asynchronous exceptions; that is
 118 -- done automatically on exiting the scope of
 119 -- 'block'.
 120 block :: IO a -> IO a
 121
 122 -- | To re-enable asynchronous exceptions inside the scope of
 123 -- 'block', 'unblock' can be
 124 -- used.  It scopes in exactly the same way, so on exit from
 125 -- 'unblock' asynchronous exception delivery will
 126 -- be disabled again.
 127 unblock :: IO a -> IO a
 128
 129 #ifndef __HUGS__
 130 block (IO io) = IO $ blockAsyncExceptions# io
 131 unblock (IO io) = IO $ unblockAsyncExceptions# io
 132 #else
 133 unblock :: IO a -> IO a
 134 unblock (IO io) = IO io
 135 #endif
 136 \end{code}
 137
 138