1 % -----------------------------------------------------------------------------
2 % $Id: PrelException.lhs,v 1.19 2000/04/14 15:28:24 rrt Exp $
4 % (c) The GRAP/AQUA Project, Glasgow University, 1998
7 Exceptions and exception-handling functions.
10 {-# OPTIONS -fno-implicit-prelude #-}
13 module PrelException where
20 import PrelST ( STret(..) )
26 %*********************************************************
28 \subsection{Exception datatype and operations}
30 %*********************************************************
34 = IOException IOError -- IO exceptions (from 'ioError')
35 | ArithException ArithException -- Arithmetic exceptions
36 | ArrayException ArrayException -- Array-related exceptions
37 | ErrorCall String -- Calls to 'error'
38 | NoMethodError String -- A non-existent method was invoked
39 | PatternMatchFail String -- A pattern match failed
40 | NonExhaustiveGuards String -- A guard match failed
41 | RecSelError String -- Selecting a non-existent field
42 | RecConError String -- Field missing in record construction
43 | RecUpdError String -- Record doesn't contain updated field
44 | AssertionFailed String -- Assertions
45 | DynException Dynamic -- Dynamic exceptions
46 | AsyncException AsyncException -- Externally generated errors
47 | PutFullMVar -- Put on a full MVar
48 | BlockedOnDeadMVar -- Blocking on a dead MVar
66 = IndexOutOfBounds String -- out-of-range array access
67 | UndefinedElement String -- evaluating an undefined element
69 stackOverflow, heapOverflow :: Exception -- for the RTS
70 stackOverflow = AsyncException StackOverflow
71 heapOverflow = AsyncException HeapOverflow
73 instance Show ArithException where
74 showsPrec _ Overflow = showString "arithmetic overflow"
75 showsPrec _ Underflow = showString "arithmetic underflow"
76 showsPrec _ LossOfPrecision = showString "loss of precision"
77 showsPrec _ DivideByZero = showString "divide by zero"
78 showsPrec _ Denormal = showString "denormal"
80 instance Show AsyncException where
81 showsPrec _ StackOverflow = showString "stack overflow"
82 showsPrec _ HeapOverflow = showString "heap overflow"
83 showsPrec _ ThreadKilled = showString "thread killed"
85 instance Show ArrayException where
86 showsPrec _ (IndexOutOfBounds s)
87 = showString "array index out of range"
88 . (if not (null s) then showString ": " . showString s
90 showsPrec _ (UndefinedElement s)
91 = showString "undefined array element"
92 . (if not (null s) then showString ": " . showString s
95 instance Show Exception where
96 showsPrec _ (IOException err) = shows err
97 showsPrec _ (ArithException err) = shows err
98 showsPrec _ (ArrayException err) = shows err
99 showsPrec _ (ErrorCall err) = showString err
100 showsPrec _ (NoMethodError err) = showString err
101 showsPrec _ (PatternMatchFail err) = showString err
102 showsPrec _ (NonExhaustiveGuards err) = showString err
103 showsPrec _ (RecSelError err) = showString err
104 showsPrec _ (RecConError err) = showString err
105 showsPrec _ (RecUpdError err) = showString err
106 showsPrec _ (AssertionFailed err) = showString err
107 showsPrec _ (AsyncException e) = shows e
108 showsPrec _ (DynException _err) = showString "unknown exception"
109 showsPrec _ (PutFullMVar) = showString "putMVar: full MVar"
110 showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
111 showsPrec _ (NonTermination) = showString "<<loop>>"
114 %*********************************************************
116 \subsection{Primitive catch and throw}
118 %*********************************************************
121 throw :: Exception -> a
126 throw exception = raise# exception
130 catchException used to handle the passing around of the state to the
131 action and the handler. This turned out to be a bad idea - it meant
132 that we had to wrap both arguments in thunks so they could be entered
133 as normal (remember IO returns an unboxed pair...).
137 catch# :: IO a -> (b -> IO a) -> IO a
139 (well almost; the compiler doesn't know about the IO newtype so we
140 have to work around that in the definition of catchException below).
143 catchException :: IO a -> (Exception -> IO a) -> IO a
145 catchException m k = ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
147 catchException (IO m) k = IO $ \s -> catch# m (\ex -> unIO (k ex)) s
150 catch :: IO a -> (IOError -> IO a) -> IO a
151 catch m k = catchException m handler
152 where handler (IOException err) = k err
153 handler other = throw other
155 catchNonIO :: IO a -> (Exception -> IO a) -> IO a
156 catchNonIO m k = catchException m handler
157 where handler (IOException err) = ioError err
158 handler other = k other
162 %*********************************************************
164 \subsection{Try and bracket}
166 %*********************************************************
168 The construct @try comp@ exposes errors which occur within a
169 computation, and which are not fully handled. It always succeeds.
172 try :: IO a -> IO (Either IOError a)
173 try f = catch (do r <- f
177 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
178 bracket before after m = do
186 -- variant of the above where middle computation doesn't want x
187 bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
188 bracket_ before after m = do
198 %*********************************************************
202 %*********************************************************
204 Why is this stuff here? To avoid recursive module dependencies of
208 ioError :: IOError -> IO a
209 ioError err = IO $ \s -> throw (IOException err) s
210 -- (ioError e) isn't an exception; we only throw
211 -- the exception when applied to a world
214 %*********************************************************
216 \subsection{Controlling asynchronous exception delivery}
218 %*********************************************************
222 blockAsyncExceptions :: IO a -> IO a
223 blockAsyncExceptions (IO io) = IO $ blockAsyncExceptions# io
225 unblockAsyncExceptions :: IO a -> IO a
226 unblockAsyncExceptions (IO io) = IO $ unblockAsyncExceptions# io
228 -- Not implemented yet in Hugs.
229 blockAsyncExceptions :: IO a -> IO a
230 blockAsyncExceptions (IO io) = IO io
232 unblockAsyncExceptions :: IO a -> IO a
233 unblockAsyncExceptions (IO io) = IO io