[project @ 2001-06-28 14:15:04 by simonmar]
[packages/old-time.git] / GHC / Exception.lhs
1 % ------------------------------------------------------------------------------
2 % $Id: Exception.lhs,v 1.1 2001/06/28 14:15:03 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 GHC.Base
21 import GHC.Maybe
22 import GHC.IOBase
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 err@(UserError   _) = k err
57         handler other               = throw other
58 \end{code}
59
60
61 %*********************************************************
62 %*                                                      *
63 \subsection{Try and bracket}
64 %*                                                      *
65 %*********************************************************
66
67 The construct @try comp@ exposes errors which occur within a
68 computation, and which are not fully handled.  It always succeeds.
69
70 These are the IO-only try/bracket.  For the full exception try/bracket
71 see hslibs/lang/Exception.lhs.
72
73 \begin{code}
74 try            :: IO a -> IO (Either Exception a)
75 try f          =  catch (do r <- f
76                             return (Right r))
77                         (return . Left)
78
79 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
80 bracket before after m = do
81         x  <- before
82         rs <- try (m x)
83         after x
84         case rs of
85            Right r -> return r
86            Left  e -> ioError e
87
88 -- variant of the above where middle computation doesn't want x
89 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
90 bracket_ before after m = do
91          x  <- before
92          rs <- try m
93          after x
94          case rs of
95             Right r -> return r
96             Left  e -> ioError e
97 \end{code}
98
99
100 %*********************************************************
101 %*                                                      *
102 \subsection{Controlling asynchronous exception delivery}
103 %*                                                      *
104 %*********************************************************
105
106 \begin{code}
107 #ifndef __HUGS__
108 block :: IO a -> IO a
109 block (IO io) = IO $ blockAsyncExceptions# io
110
111 unblock :: IO a -> IO a
112 unblock (IO io) = IO $ unblockAsyncExceptions# io
113 #else
114 -- Not implemented yet in Hugs.
115 block :: IO a -> IO a
116 block (IO io) = IO io
117
118 unblock :: IO a -> IO a
119 unblock (IO io) = IO io
120 #endif
121 \end{code}
122
123