ghc/lib/std/PrelException.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelException.lhs,v 1.9 1999/11/11 15:18:00 simonmar Exp $
   3 %
   4 % (c) The GRAP/AQUA Project, Glasgow University, 1998
   5 %
   6
   7 Exceptions and exception-handling functions.
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 #ifndef __HUGS__
  13 module PrelException where
  14
  15 import PrelBase
  16 import PrelShow
  17 import PrelIOBase
  18 import PrelST           ( STret(..) )
  19 import PrelDynamic
  20 import PrelGHC
  21 #endif
  22 \end{code}
  23
  24 -----------------------------------------------------------------------------
  25 Exception datatype and operations.
  26
  27 \begin{code}
  28 data Exception
  29   = IOException         IOError         -- IO exceptions (from 'ioError')
  30   | ArithException      ArithException  -- Arithmetic exceptions
  31   | ErrorCall           String          -- Calls to 'error'
  32   | NoMethodError       String          -- A non-existent method was invoked
  33   | PatternMatchFail    String          -- A pattern match failed
  34   | NonExhaustiveGuards String          -- A guard match failed
  35   | RecSelError         String          -- Selecting a non-existent field
  36   | RecConError         String          -- Field missing in record construction
  37   | RecUpdError         String          -- Record doesn't contain updated field
  38   | AssertionFailed     String          -- Assertions
  39   | DynException        Dynamic         -- Dynamic exceptions
  40   | AsyncException      AsyncException  -- Externally generated errors
  41   | ArrayException      ArrayException  -- Array-related exceptions
  42   | NonTermination
  43
  44 data ArithException
  45   = Overflow
  46   | Underflow
  47   | LossOfPrecision
  48   | DivideByZero
  49   | Denormal
  50   deriving (Eq, Ord)
  51
  52 data AsyncException
  53   = StackOverflow
  54   | HeapOverflow
  55   | ThreadKilled
  56   deriving (Eq, Ord)
  57
  58 data ArrayException
  59   = IndexOutOfBounds String
  60   | UndefinedElement String
  61   deriving (Eq, Ord)
  62
  63 stackOverflow, heapOverflow :: Exception -- for the RTS
  64 stackOverflow = AsyncException StackOverflow
  65 heapOverflow  = AsyncException HeapOverflow
  66
  67 instance Show ArithException where
  68   showsPrec _ Overflow        = showString "arithmetic overflow"
  69   showsPrec _ Underflow       = showString "arithmetic underflow"
  70   showsPrec _ LossOfPrecision = showString "loss of precision"
  71   showsPrec _ DivideByZero    = showString "divide by zero"
  72   showsPrec _ Denormal        = showString "denormal"
  73
  74 instance Show AsyncException where
  75   showsPrec _ StackOverflow   = showString "stack overflow"
  76   showsPrec _ HeapOverflow    = showString "heap overflow"
  77   showsPrec _ ThreadKilled    = showString "thread killed"
  78
  79 instance Show ArrayException where
  80   showsPrec _ (IndexOutOfBounds s) = showString "array index out of bounds: "
  81                                    . showString s
  82   showsPrec _ (UndefinedElement s) = showString "undefined array element: "
  83                                    . showString s
  84
  85 instance Show Exception where
  86   showsPrec _ (IOException err)          = shows err
  87   showsPrec _ (ArithException err)       = shows err
  88   showsPrec _ (ErrorCall err)            = showString err
  89   showsPrec _ (NoMethodError err)        = showString err
  90   showsPrec _ (PatternMatchFail err)     = showString err
  91   showsPrec _ (NonExhaustiveGuards err)  = showString err
  92   showsPrec _ (RecSelError err)          = showString err
  93   showsPrec _ (RecConError err)          = showString err
  94   showsPrec _ (RecUpdError err)          = showString err
  95   showsPrec _ (AssertionFailed err)      = showString err
  96   showsPrec _ (AsyncException e)         = shows e
  97   showsPrec _ (DynException _err)        = showString "unknown exception"
  98   showsPrec _ (NonTermination)           = showString "<<loop>>"
  99
 100 -- Primitives:
 101
 102 throw :: Exception -> a
 103
 104 #ifdef __HUGS__
 105 throw = primRaise
 106 #else
 107 throw exception = raise# exception
 108 #endif
 109 \end{code}
 110
 111 catch handles the passing around of the state in the IO monad; if we
 112 don't actually apply (and hence run) an IO computation, we don't get
 113 any exceptions!  Hence a large mantrap to watch out for is
 114
 115         catch# (m :: IO ()) (handler :: NDSet Exception -> IO ())
 116
 117 since the computation 'm' won't actually be performed in the context
 118 of the 'catch#'.  In fact, don't use catch# at all.
 119
 120 \begin{code}
 121 catchException :: IO a -> (Exception -> IO a) -> IO a
 122 #ifdef __HUGS__
 123 catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
 124 #else
 125 catchException m k =  IO $ \s -> case catch# (liftIO m s) (\exs -> liftIO (k exs) s)
 126                           of STret s1 r -> (# s1, r #)
 127 #endif
 128
 129 catch           :: IO a -> (IOError -> IO a) -> IO a
 130 catch m k       =  catchException m handler
 131   where handler (IOException err) = k err
 132         handler other             = throw other
 133
 134 catchNonIO      :: IO a -> (Exception -> IO a) -> IO a
 135 catchNonIO m k  =  catchException m handler
 136   where handler (IOException err) = ioError err
 137         handler other             = k other
 138 \end{code}
 139
 140
 141 Why is this stuff here?  To avoid recursive module dependencies of
 142 course.
 143
 144 \begin{code}
 145 ioError         :: IOError -> IO a
 146 ioError err     =  throw (IOException err)
 147 \end{code}
 148