ghc/lib/std/PrelException.lhs

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