% -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.4 1999/01/14 18:12:57 sof Exp $
+% $Id: PrelException.lhs,v 1.14 2000/03/23 17:45:31 simonpj Exp $
%
% (c) The GRAP/AQUA Project, Glasgow University, 1998
%
module PrelException where
import PrelBase
+import PrelShow
import PrelIOBase
import PrelST ( STret(..) )
import PrelDynamic
| AssertionFailed String -- Assertions
| DynException Dynamic -- Dynamic exceptions
| AsyncException AsyncException -- Externally generated errors
+ | PutFullMVar -- Put on a full MVar
+ | BlockedOnDeadMVar -- Blocking on a dead MVar
+ | NonTermination
data ArithException
= Overflow
| ThreadKilled
deriving (Eq, Ord)
+stackOverflow, heapOverflow :: Exception -- for the RTS
+stackOverflow = AsyncException StackOverflow
+heapOverflow = AsyncException HeapOverflow
+
instance Show ArithException where
showsPrec _ Overflow = showString "arithmetic overflow"
showsPrec _ Underflow = showString "arithmetic underflow"
showsPrec _ (AssertionFailed err) = showString err
showsPrec _ (AsyncException e) = shows e
showsPrec _ (DynException _err) = showString "unknown exception"
+ showsPrec _ (PutFullMVar) = showString "putMVar: full MVar"
+ showsPrec _ (BlockedOnDeadMVar) = showString "thread blocked indefinitely"
+ showsPrec _ (NonTermination) = showString "<<loop>>"
-- Primitives:
#endif
\end{code}
-catch handles the passing around of the state in the IO monad; if we
-don't actually apply (and hence run) an IO computation, we don't get
-any exceptions! Hence a large mantrap to watch out for is
+catchException used to handle the passing around of the state to the
+action and the handler. This turned out to be a bad idea - it meant
+that we had to wrap both arguments in thunks so they could be entered
+as normal (remember IO returns an unboxed pair...).
+
+Now catch# has type
- catch# (m :: IO ()) (handler :: NDSet Exception -> IO ())
+ catch# :: IO a -> (b -> IO a) -> IO a
-since the computation 'm' won't actually be performed in the context
-of the 'catch#'. In fact, don't use catch# at all.
+(well almost; the compiler doesn't know about the IO newtype so we
+have to work around that in the definition of catchException below).
\begin{code}
catchException :: IO a -> (Exception -> IO a) -> IO a
#ifdef __HUGS__
catchException m k = ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
#else
-catchException m k = IO $ \s -> case catch# (liftIO m s) (\exs -> liftIO (k exs) s)
- of STret s1 r -> (# s1, r #)
+catchException (IO m) k = IO $ \s -> catch# m (\ex -> unIO (k ex)) s
#endif
catch :: IO a -> (IOError -> IO a) -> IO a
catch m k = catchException m handler
where handler (IOException err) = k err
handler other = throw other
+
+catchNonIO :: IO a -> (Exception -> IO a) -> IO a
+catchNonIO m k = catchException m handler
+ where handler (IOException err) = ioError err
+ handler other = k other
\end{code}
+
Why is this stuff here? To avoid recursive module dependencies of
course.
\begin{code}
ioError :: IOError -> IO a
-ioError err = throw (IOException err)
+ioError err = IO $ \s -> throw (IOException err) s
+ -- (ioError e) isn't an exception; we only throw
+ -- the exception when applied to a world
\end{code}