[project @ 1999-07-14 08:33:38 by simonmar]

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

diff --git a/ghc/lib/std/PrelException.lhs b/ghc/lib/std/PrelException.lhs
index ef3c227..56d116e 100644 (file)
--- a/ghc/lib/std/PrelException.lhs
+++ b/ghc/lib/std/PrelException.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelException.lhs,v 1.2 1998/12/02 13:27:01 simonm Exp $
+% $Id: PrelException.lhs,v 1.8 1999/07/14 08:33:38 simonmar Exp $
 %
 % (c) The GRAP/AQUA Project, Glasgow University, 1998
 %
@@ -13,6 +13,7 @@ Exceptions and exception-handling functions.
 module PrelException where
 
 import PrelBase
+import PrelShow
 import PrelIOBase
 import PrelST          ( STret(..) )
 import PrelDynamic
@@ -25,8 +26,8 @@ Exception datatype and operations.
 
 \begin{code}
 data Exception
-  = IOException        IOError         -- IO exceptions (from 'fail')
-  | ArithException     ArithError      -- Arithmetic exceptions
+  = 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
@@ -36,9 +37,10 @@ data Exception
   | RecUpdError                String          -- Record doesn't contain updated field
   | AssertionFailed    String          -- Assertions
   | DynException       Dynamic         -- Dynamic exceptions
-  | ExternalException   ExtError        -- External exceptions
+  | AsyncException     AsyncException  -- Externally generated errors
+  | NonTermination
 
-data ArithError
+data ArithException
   = Overflow
   | Underflow
   | LossOfPrecision
@@ -46,20 +48,24 @@ data ArithError
   | Denormal
   deriving (Eq, Ord)
 
-data ExtError
+data AsyncException
   = StackOverflow
   | HeapOverflow
   | ThreadKilled
   deriving (Eq, Ord)
 
-instance Show ArithError where
+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 ExtError where
+instance Show AsyncException where
   showsPrec _ StackOverflow   = showString "stack overflow"
   showsPrec _ HeapOverflow    = showString "heap overflow"
   showsPrec _ ThreadKilled    = showString "thread killed"
@@ -75,7 +81,9 @@ instance Show Exception where
   showsPrec _ (RecConError err)                 = showString err
   showsPrec _ (RecUpdError err)                 = showString err
   showsPrec _ (AssertionFailed err)      = showString err
-  showsPrec _ (DynException err)         = showString "unknown exception"
+  showsPrec _ (AsyncException e)        = shows e
+  showsPrec _ (DynException _err)        = showString "unknown exception"
+  showsPrec _ (NonTermination)           = showString "<<loop>>"
 
 -- Primitives:
 
@@ -103,20 +111,26 @@ catchException :: IO a -> (Exception -> IO a) -> IO a
 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 s r -> (# s, r #)
+                         of STret s1 r -> (# s1, r #)
 #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}
-fail            :: IOError -> IO a 
-fail err       =  throw (IOException err)
+ioError         :: IOError -> IO a 
+ioError err    =  throw (IOException err)
 \end{code}