X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Flib%2Fstd%2FPrelException.lhs;h=21d6b0bf24db327fa2f9e195cba2535cc8f20f73;hb=50027272414438955dbc41696541cbd25da55883;hp=1f317aa06dc08cff9942c76ebde2ed88b92cf9fd;hpb=bb864806cef069b0bba9fbaa92b4135f99041dcd;p=ghc-hetmet.git

diff --git a/ghc/lib/std/PrelException.lhs b/ghc/lib/std/PrelException.lhs
index 1f317aa..21d6b0b 100644
--- a/ghc/lib/std/PrelException.lhs
+++ b/ghc/lib/std/PrelException.lhs
@@ -1,7 +1,7 @@
-% -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.15 2000/04/10 13:18:13 simonpj Exp $
+% ------------------------------------------------------------------------------
+% $Id: PrelException.lhs,v 1.24 2000/09/14 14:24:02 simonmar Exp $
 %
-% (c) The GRAP/AQUA Project, Glasgow University, 1998
+% (c) The University of Glasgow, 1998-2000
 %
 
 Exceptions and exception-handling functions.
@@ -10,107 +10,26 @@ Exceptions and exception-handling functions.
 {-# OPTIONS -fno-implicit-prelude #-}
 
 #ifndef __HUGS__
-module PrelException where
+module PrelException 
+	( module PrelException, 
+	  Exception(..), AsyncException(..), 
+	  IOException(..), ArithException(..), ArrayException(..),
+	  throw, ioError ) 
+  where
 
 import PrelBase
 import PrelMaybe
-import PrelShow
 import PrelIOBase
-import PrelST 		( STret(..) )
-import PrelDynamic
-import PrelGHC
-#endif
-\end{code}
-
-%*********************************************************
-%*							*
-\subsection{Exception datatype and operations}
-%*							*
-%*********************************************************
 
-\begin{code}
-data Exception
-  = IOException 	IOError		-- IO exceptions (from 'ioError')
-  | ArithException  	ArithException	-- Arithmetic 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
-  | RecSelError		String		-- Selecting a non-existent field
-  | RecConError		String		-- Field missing in record construction
-  | RecUpdError		String		-- Record doesn't contain updated field
-  | 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
-  | Underflow
-  | LossOfPrecision
-  | DivideByZero
-  | Denormal
-  deriving (Eq, Ord)
-
-data AsyncException
-  = StackOverflow
-  | HeapOverflow
-  | 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 _ LossOfPrecision = showString "loss of precision"
-  showsPrec _ DivideByZero    = showString "divide by zero"
-  showsPrec _ Denormal        = showString "denormal"
-
-instance Show AsyncException where
-  showsPrec _ StackOverflow   = showString "stack overflow"
-  showsPrec _ HeapOverflow    = showString "heap overflow"
-  showsPrec _ ThreadKilled    = showString "thread killed"
-
-instance Show Exception where
-  showsPrec _ (IOException err)	         = shows err
-  showsPrec _ (ArithException err)       = shows err
-  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
-  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>>"
+#endif
 \end{code}
 
-
 %*********************************************************
 %*							*
-\subsection{Primitive catch and throw}
+\subsection{Primitive catch}
 %*							*
 %*********************************************************
 
-\begin{code}
-throw :: Exception -> a
-
-#ifdef __HUGS__
-throw = primRaise
-#else
-throw exception = raise# exception
-#endif
-\end{code}
-
 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
@@ -131,15 +50,11 @@ catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
 catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
 #endif
 
-catch           :: IO a -> (IOError -> IO a) -> IO a 
+catch           :: IO a -> (Exception -> 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
+  where handler err@(IOException _) = k err
+        handler err@(UserError   _) = k err
+	handler other               = throw other
 \end{code}
 
 
@@ -152,8 +67,11 @@ catchNonIO m k	=  catchException m handler
 The construct @try comp@ exposes errors which occur within a
 computation, and which are not fully handled.  It always succeeds.
 
+These are the IO-only try/bracket.  For the full exception try/bracket
+see hslibs/lang/Exception.lhs.
+
 \begin{code}
-try            :: IO a -> IO (Either IOError a)
+try            :: IO a -> IO (Either Exception a)
 try f          =  catch (do r <- f
                             return (Right r))
                         (return . Left)
@@ -181,17 +99,25 @@ bracket_ before after m = do
 
 %*********************************************************
 %*							*
-\subsection{ioError}
+\subsection{Controlling asynchronous exception delivery}
 %*							*
 %*********************************************************
 
-Why is this stuff here?  To avoid recursive module dependencies of
-course.
-
 \begin{code}
-ioError         :: IOError -> IO a 
-ioError err	=  IO $ \s -> throw (IOException err) s
-	-- (ioError e) isn't an exception; we only throw
-	-- the exception when applied to a world
+#ifndef __HUGS__
+block :: IO a -> IO a
+block (IO io) = IO $ blockAsyncExceptions# io
+
+unblock :: IO a -> IO a
+unblock (IO io) = IO $ unblockAsyncExceptions# io
+#else
+-- Not implemented yet in Hugs.
+block :: IO a -> IO a
+block (IO io) = IO io
+
+unblock :: IO a -> IO a
+unblock (IO io) = IO io
+#endif
 \end{code}
 
+