[project @ 2000-06-18 21:12:31 by panne]

[ghc-hetmet.git] / ghc / lib / std / PrelException.lhs

diff --git a/ghc/lib/std/PrelException.lhs b/ghc/lib/std/PrelException.lhs
index a04c66a..5dd4a4a 100644 (file)
--- a/ghc/lib/std/PrelException.lhs
+++ b/ghc/lib/std/PrelException.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.16 2000/04/10 13:35:45 simonmar Exp $
+% $Id: PrelException.lhs,v 1.21 2000/06/18 21:12:31 panne Exp $
 %
 % (c) The GRAP/AQUA Project, Glasgow University, 1998
 %
@@ -36,8 +36,7 @@ data Exception
   | ArrayException     ArrayException  -- Array-related exceptions
   | ErrorCall          String          -- Calls to 'error'
   | NoMethodError       String         -- A non-existent method was invoked
-  | PatternMatchFail   String          -- A pattern match failed
-  | NonExhaustiveGuards String         -- A guard match failed
+  | PatternMatchFail   String          -- A pattern match / guard failure
   | RecSelError                String          -- Selecting a non-existent field
   | RecConError                String          -- Field missing in record construction
   | RecUpdError                String          -- Record doesn't contain updated field
@@ -65,6 +64,7 @@ data AsyncException
 data ArrayException
   = IndexOutOfBounds   String          -- out-of-range array access
   | UndefinedElement   String          -- evaluating an undefined element
+  deriving (Eq, Ord)
 
 stackOverflow, heapOverflow :: Exception -- for the RTS
 stackOverflow = AsyncException StackOverflow
@@ -99,7 +99,6 @@ instance Show Exception where
   showsPrec _ (ErrorCall err)           = showString err
   showsPrec _ (NoMethodError err)        = showString err
   showsPrec _ (PatternMatchFail err)     = showString err
-  showsPrec _ (NonExhaustiveGuards err)  = showString err
   showsPrec _ (RecSelError err)                 = showString err
   showsPrec _ (RecConError err)                 = showString err
   showsPrec _ (RecUpdError err)                 = showString err
@@ -211,3 +210,26 @@ ioError err        =  IO $ \s -> throw (IOException err) s
        -- the exception when applied to a world
 \end{code}
 
+%*********************************************************
+%*                                                     *
+\subsection{Controlling asynchronous exception delivery}
+%*                                                     *
+%*********************************************************
+
+\begin{code}
+#ifndef __HUGS__
+blockAsyncExceptions :: IO a -> IO a
+blockAsyncExceptions (IO io) = IO $ blockAsyncExceptions# io
+
+unblockAsyncExceptions :: IO a -> IO a
+unblockAsyncExceptions (IO io) = IO $ unblockAsyncExceptions# io
+#else
+-- Not implemented yet in Hugs.
+blockAsyncExceptions :: IO a -> IO a
+blockAsyncExceptions (IO io) = IO io
+
+unblockAsyncExceptions :: IO a -> IO a
+unblockAsyncExceptions (IO io) = IO io
+#endif
+\end{code}
+