GHC/Exception.lhs

   1 % ------------------------------------------------------------------------------
   2 % $Id: Exception.lhs,v 1.2 2001/07/03 14:13:32 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1998-2000
   5 %
   6
   7 Exceptions and exception-handling functions.
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 #ifndef __HUGS__
  13 module GHC.Exception
  14         ( module GHC.Exception,
  15           Exception(..), AsyncException(..),
  16           IOException(..), ArithException(..), ArrayException(..),
  17           throw, ioError )
  18   where
  19
  20 import Data.Either
  21
  22 import GHC.Base
  23 import GHC.IOBase
  24
  25 #endif
  26 \end{code}
  27
  28 %*********************************************************
  29 %*                                                      *
  30 \subsection{Primitive catch}
  31 %*                                                      *
  32 %*********************************************************
  33
  34 catchException used to handle the passing around of the state to the
  35 action and the handler.  This turned out to be a bad idea - it meant
  36 that we had to wrap both arguments in thunks so they could be entered
  37 as normal (remember IO returns an unboxed pair...).
  38
  39 Now catch# has type
  40
  41     catch# :: IO a -> (b -> IO a) -> IO a
  42
  43 (well almost; the compiler doesn't know about the IO newtype so we
  44 have to work around that in the definition of catchException below).
  45
  46 \begin{code}
  47 catchException :: IO a -> (Exception -> IO a) -> IO a
  48 #ifdef __HUGS__
  49 catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
  50 #else
  51 catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
  52 #endif
  53
  54 catch           :: IO a -> (Exception -> IO a) -> IO a
  55 catch m k       =  catchException m handler
  56   where handler err@(IOException _) = k err
  57         handler err@(UserError   _) = k err
  58         handler other               = throw other
  59 \end{code}
  60
  61
  62 %*********************************************************
  63 %*                                                      *
  64 \subsection{Try and bracket}
  65 %*                                                      *
  66 %*********************************************************
  67
  68 The construct @try comp@ exposes errors which occur within a
  69 computation, and which are not fully handled.  It always succeeds.
  70
  71 These are the IO-only try/bracket.  For the full exception try/bracket
  72 see hslibs/lang/Exception.lhs.
  73
  74 \begin{code}
  75 try            :: IO a -> IO (Either Exception a)
  76 try f          =  catch (do r <- f
  77                             return (Right r))
  78                         (return . Left)
  79
  80 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
  81 bracket before after m = do
  82         x  <- before
  83         rs <- try (m x)
  84         after x
  85         case rs of
  86            Right r -> return r
  87            Left  e -> ioError e
  88
  89 -- variant of the above where middle computation doesn't want x
  90 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
  91 bracket_ before after m = do
  92          x  <- before
  93          rs <- try m
  94          after x
  95          case rs of
  96             Right r -> return r
  97             Left  e -> ioError e
  98 \end{code}
  99
 100
 101 %*********************************************************
 102 %*                                                      *
 103 \subsection{Controlling asynchronous exception delivery}
 104 %*                                                      *
 105 %*********************************************************
 106
 107 \begin{code}
 108 #ifndef __HUGS__
 109 block :: IO a -> IO a
 110 block (IO io) = IO $ blockAsyncExceptions# io
 111
 112 unblock :: IO a -> IO a
 113 unblock (IO io) = IO $ unblockAsyncExceptions# io
 114 #else
 115 -- Not implemented yet in Hugs.
 116 block :: IO a -> IO a
 117 block (IO io) = IO io
 118
 119 unblock :: IO a -> IO a
 120 unblock (IO io) = IO io
 121 #endif
 122 \end{code}
 123
 124