ghc/lib/std/PrelException.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelException.lhs,v 1.14 2000/03/23 17:45:31 simonpj 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   | PutFullMVar                         -- Put on a full MVar
  42   | BlockedOnDeadMVar                   -- Blocking on a dead MVar
  43   | NonTermination
  44
  45 data ArithException
  46   = Overflow
  47   | Underflow
  48   | LossOfPrecision
  49   | DivideByZero
  50   | Denormal
  51   deriving (Eq, Ord)
  52
  53 data AsyncException
  54   = StackOverflow
  55   | HeapOverflow
  56   | ThreadKilled
  57   deriving (Eq, Ord)
  58
  59 stackOverflow, heapOverflow :: Exception -- for the RTS
  60 stackOverflow = AsyncException StackOverflow
  61 heapOverflow  = AsyncException HeapOverflow
  62
  63 instance Show ArithException where
  64   showsPrec _ Overflow        = showString "arithmetic overflow"
  65   showsPrec _ Underflow       = showString "arithmetic underflow"
  66   showsPrec _ LossOfPrecision = showString "loss of precision"
  67   showsPrec _ DivideByZero    = showString "divide by zero"
  68   showsPrec _ Denormal        = showString "denormal"
  69
  70 instance Show AsyncException where
  71   showsPrec _ StackOverflow   = showString "stack overflow"
  72   showsPrec _ HeapOverflow    = showString "heap overflow"
  73   showsPrec _ ThreadKilled    = showString "thread killed"
  74
  75 instance Show Exception where
  76   showsPrec _ (IOException err)          = shows err
  77   showsPrec _ (ArithException err)       = shows err
  78   showsPrec _ (ErrorCall err)            = showString err
  79   showsPrec _ (NoMethodError err)        = showString err
  80   showsPrec _ (PatternMatchFail err)     = showString err
  81   showsPrec _ (NonExhaustiveGuards err)  = showString err
  82   showsPrec _ (RecSelError err)          = showString err
  83   showsPrec _ (RecConError err)          = showString err
  84   showsPrec _ (RecUpdError err)          = showString err
  85   showsPrec _ (AssertionFailed err)      = showString err
  86   showsPrec _ (AsyncException e)         = shows e
  87   showsPrec _ (DynException _err)        = showString "unknown exception"
  88   showsPrec _ (PutFullMVar)              = showString "putMVar: full MVar"
  89   showsPrec _ (BlockedOnDeadMVar)        = showString "thread blocked indefinitely"
  90   showsPrec _ (NonTermination)           = showString "<<loop>>"
  91
  92 -- Primitives:
  93
  94 throw :: Exception -> a
  95
  96 #ifdef __HUGS__
  97 throw = primRaise
  98 #else
  99 throw exception = raise# exception
 100 #endif
 101 \end{code}
 102
 103 catchException used to handle the passing around of the state to the
 104 action and the handler.  This turned out to be a bad idea - it meant
 105 that we had to wrap both arguments in thunks so they could be entered
 106 as normal (remember IO returns an unboxed pair...).
 107
 108 Now catch# has type
 109
 110     catch# :: IO a -> (b -> IO a) -> IO a
 111
 112 (well almost; the compiler doesn't know about the IO newtype so we
 113 have to work around that in the definition of catchException below).
 114
 115 \begin{code}
 116 catchException :: IO a -> (Exception -> IO a) -> IO a
 117 #ifdef __HUGS__
 118 catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
 119 #else
 120 catchException (IO m) k =  IO $ \s -> catch# m (\ex -> unIO (k ex)) s
 121 #endif
 122
 123 catch           :: IO a -> (IOError -> IO a) -> IO a
 124 catch m k       =  catchException m handler
 125   where handler (IOException err) = k err
 126         handler other             = throw other
 127
 128 catchNonIO      :: IO a -> (Exception -> IO a) -> IO a
 129 catchNonIO m k  =  catchException m handler
 130   where handler (IOException err) = ioError err
 131         handler other             = k other
 132 \end{code}
 133
 134
 135 Why is this stuff here?  To avoid recursive module dependencies of
 136 course.
 137
 138 \begin{code}
 139 ioError         :: IOError -> IO a
 140 ioError err     =  IO $ \s -> throw (IOException err) s
 141         -- (ioError e) isn't an exception; we only throw
 142         -- the exception when applied to a world
 143 \end{code}
 144