X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelException.lhs;h=7b556eb2da3283c63f46097f7b43bffb5659a98f;hb=3ddfdc19e74af725239b7dfdec776d1d07847fc2;hp=8fa722812f91189a63cf4dde0da74d74f2ecff8c;hpb=c415cd35368f45739132fc180837fc07f0490921;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelException.lhs b/ghc/lib/std/PrelException.lhs
index 8fa7228..7b556eb 100644
--- a/ghc/lib/std/PrelException.lhs
+++ b/ghc/lib/std/PrelException.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.7 1999/05/18 14:59:16 simonpj Exp $
+% $Id: PrelException.lhs,v 1.13 2000/03/16 17:27:13 simonmar Exp $
 %
 % (c) The GRAP/AQUA Project, Glasgow University, 1998
 %
@@ -38,6 +38,9 @@ data Exception
   | 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
@@ -82,6 +85,9 @@ instance Show Exception where
   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:
 
@@ -94,22 +100,24 @@ throw exception = raise# exception
 #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...).
 
-	catch# (m :: IO ()) (handler :: NDSet Exception -> IO ())
+Now catch# has type
 
-since the computation 'm' won't actually be performed in the context
-of the 'catch#'.  In fact, don't use catch# at all.
+    catch# :: IO a -> (b -> IO a) -> IO a
+
+(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