[project @ 1999-01-14 18:12:47 by sof]
[ghc-hetmet.git] / ghc / lib / std / PrelException.lhs
1 % -----------------------------------------------------------------------------
2 % $Id: PrelException.lhs,v 1.4 1999/01/14 18:12:57 sof 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 PrelIOBase
17 import PrelST           ( STret(..) )
18 import PrelDynamic
19 import PrelGHC
20 #endif
21 \end{code}
22
23 -----------------------------------------------------------------------------
24 Exception datatype and operations.
25
26 \begin{code}
27 data Exception
28   = IOException         IOError         -- IO exceptions (from 'ioError')
29   | ArithException      ArithException  -- Arithmetic exceptions
30   | ErrorCall           String          -- Calls to 'error'
31   | NoMethodError       String          -- A non-existent method was invoked
32   | PatternMatchFail    String          -- A pattern match failed
33   | NonExhaustiveGuards String          -- A guard match failed
34   | RecSelError         String          -- Selecting a non-existent field
35   | RecConError         String          -- Field missing in record construction
36   | RecUpdError         String          -- Record doesn't contain updated field
37   | AssertionFailed     String          -- Assertions
38   | DynException        Dynamic         -- Dynamic exceptions
39   | AsyncException      AsyncException  -- Externally generated errors
40
41 data ArithException
42   = Overflow
43   | Underflow
44   | LossOfPrecision
45   | DivideByZero
46   | Denormal
47   deriving (Eq, Ord)
48
49 data AsyncException
50   = StackOverflow
51   | HeapOverflow
52   | ThreadKilled
53   deriving (Eq, Ord)
54
55 instance Show ArithException where
56   showsPrec _ Overflow        = showString "arithmetic overflow"
57   showsPrec _ Underflow       = showString "arithmetic underflow"
58   showsPrec _ LossOfPrecision = showString "loss of precision"
59   showsPrec _ DivideByZero    = showString "divide by zero"
60   showsPrec _ Denormal        = showString "denormal"
61
62 instance Show AsyncException where
63   showsPrec _ StackOverflow   = showString "stack overflow"
64   showsPrec _ HeapOverflow    = showString "heap overflow"
65   showsPrec _ ThreadKilled    = showString "thread killed"
66
67 instance Show Exception where
68   showsPrec _ (IOException err)          = shows err
69   showsPrec _ (ArithException err)       = shows err
70   showsPrec _ (ErrorCall err)            = showString err
71   showsPrec _ (NoMethodError err)        = showString err
72   showsPrec _ (PatternMatchFail err)     = showString err
73   showsPrec _ (NonExhaustiveGuards err)  = showString err
74   showsPrec _ (RecSelError err)          = showString err
75   showsPrec _ (RecConError err)          = showString err
76   showsPrec _ (RecUpdError err)          = showString err
77   showsPrec _ (AssertionFailed err)      = showString err
78   showsPrec _ (AsyncException e)         = shows e
79   showsPrec _ (DynException _err)        = showString "unknown exception"
80
81 -- Primitives:
82
83 throw :: Exception -> a
84
85 #ifdef __HUGS__
86 throw = primRaise
87 #else
88 throw exception = raise# exception
89 #endif
90 \end{code}
91
92 catch handles the passing around of the state in the IO monad; if we
93 don't actually apply (and hence run) an IO computation, we don't get
94 any exceptions!  Hence a large mantrap to watch out for is
95
96         catch# (m :: IO ()) (handler :: NDSet Exception -> IO ())
97
98 since the computation 'm' won't actually be performed in the context
99 of the 'catch#'.  In fact, don't use catch# at all.
100
101 \begin{code}
102 catchException :: IO a -> (Exception -> IO a) -> IO a
103 #ifdef __HUGS__
104 catchException m k =  ST (\s -> unST m s `primCatch'` \ err -> unST (k err) s)
105 #else
106 catchException m k =  IO $ \s -> case catch# (liftIO m s) (\exs -> liftIO (k exs) s)
107                           of STret s1 r -> (# s1, r #)
108 #endif
109
110 catch           :: IO a -> (IOError -> IO a) -> IO a 
111 catch m k       =  catchException m handler
112   where handler (IOException err) = k err
113         handler other             = throw other
114 \end{code}
115
116 Why is this stuff here?  To avoid recursive module dependencies of
117 course.
118
119 \begin{code}
120 ioError         :: IOError -> IO a 
121 ioError err     =  throw (IOException err)
122 \end{code}
123