f966b3fd5e6931c74f22b199b4adba023ef1e3e8
[ghc.git] / libraries / base / GHC / Exception.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE NoImplicitPrelude
3 , ExistentialQuantification
4 , MagicHash
5 , RecordWildCards
6 , PatternSynonyms
7 #-}
8 {-# LANGUAGE TypeInType #-}
9 {-# OPTIONS_HADDOCK hide #-}
10
11 -----------------------------------------------------------------------------
12 -- |
13 -- Module : GHC.Exception
14 -- Copyright : (c) The University of Glasgow, 1998-2002
15 -- License : see libraries/base/LICENSE
16 --
17 -- Maintainer : cvs-ghc@haskell.org
18 -- Stability : internal
19 -- Portability : non-portable (GHC extensions)
20 --
21 -- Exceptions and exception-handling functions.
22 --
23 -----------------------------------------------------------------------------
24
25 module GHC.Exception
26 ( Exception(..) -- Class
27 , throw
28 , SomeException(..), ErrorCall(..,ErrorCall), ArithException(..)
29 , divZeroException, overflowException, ratioZeroDenomException
30 , underflowException
31 , errorCallException, errorCallWithCallStackException
32 -- re-export CallStack and SrcLoc from GHC.Types
33 , CallStack, fromCallSiteList, getCallStack, prettyCallStack
34 , prettyCallStackLines, showCCSStack
35 , SrcLoc(..), prettySrcLoc
36 ) where
37
38 import Data.Maybe
39 import Data.Typeable (Typeable, cast)
40 -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
41 import GHC.Base
42 import GHC.Show
43 import GHC.Stack.Types
44 import GHC.OldList
45 import GHC.Prim
46 import GHC.IO.Unsafe
47 import {-# SOURCE #-} GHC.Stack.CCS
48
49 {- |
50 The @SomeException@ type is the root of the exception type hierarchy.
51 When an exception of type @e@ is thrown, behind the scenes it is
52 encapsulated in a @SomeException@.
53 -}
54 data SomeException = forall e . Exception e => SomeException e
55
56 -- | @since 3.0
57 instance Show SomeException where
58 showsPrec p (SomeException e) = showsPrec p e
59
60 {- |
61 Any type that you wish to throw or catch as an exception must be an
62 instance of the @Exception@ class. The simplest case is a new exception
63 type directly below the root:
64
65 > data MyException = ThisException | ThatException
66 > deriving Show
67 >
68 > instance Exception MyException
69
70 The default method definitions in the @Exception@ class do what we need
71 in this case. You can now throw and catch @ThisException@ and
72 @ThatException@ as exceptions:
73
74 @
75 *Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))
76 Caught ThisException
77 @
78
79 In more complicated examples, you may wish to define a whole hierarchy
80 of exceptions:
81
82 > ---------------------------------------------------------------------
83 > -- Make the root exception type for all the exceptions in a compiler
84 >
85 > data SomeCompilerException = forall e . Exception e => SomeCompilerException e
86 >
87 > instance Show SomeCompilerException where
88 > show (SomeCompilerException e) = show e
89 >
90 > instance Exception SomeCompilerException
91 >
92 > compilerExceptionToException :: Exception e => e -> SomeException
93 > compilerExceptionToException = toException . SomeCompilerException
94 >
95 > compilerExceptionFromException :: Exception e => SomeException -> Maybe e
96 > compilerExceptionFromException x = do
97 > SomeCompilerException a <- fromException x
98 > cast a
99 >
100 > ---------------------------------------------------------------------
101 > -- Make a subhierarchy for exceptions in the frontend of the compiler
102 >
103 > data SomeFrontendException = forall e . Exception e => SomeFrontendException e
104 >
105 > instance Show SomeFrontendException where
106 > show (SomeFrontendException e) = show e
107 >
108 > instance Exception SomeFrontendException where
109 > toException = compilerExceptionToException
110 > fromException = compilerExceptionFromException
111 >
112 > frontendExceptionToException :: Exception e => e -> SomeException
113 > frontendExceptionToException = toException . SomeFrontendException
114 >
115 > frontendExceptionFromException :: Exception e => SomeException -> Maybe e
116 > frontendExceptionFromException x = do
117 > SomeFrontendException a <- fromException x
118 > cast a
119 >
120 > ---------------------------------------------------------------------
121 > -- Make an exception type for a particular frontend compiler exception
122 >
123 > data MismatchedParentheses = MismatchedParentheses
124 > deriving Show
125 >
126 > instance Exception MismatchedParentheses where
127 > toException = frontendExceptionToException
128 > fromException = frontendExceptionFromException
129
130 We can now catch a @MismatchedParentheses@ exception as
131 @MismatchedParentheses@, @SomeFrontendException@ or
132 @SomeCompilerException@, but not other types, e.g. @IOException@:
133
134 @
135 *Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))
136 Caught MismatchedParentheses
137 *Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))
138 Caught MismatchedParentheses
139 *Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))
140 Caught MismatchedParentheses
141 *Main> throw MismatchedParentheses \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: IOException))
142 *** Exception: MismatchedParentheses
143 @
144
145 -}
146 class (Typeable e, Show e) => Exception e where
147 toException :: e -> SomeException
148 fromException :: SomeException -> Maybe e
149
150 toException = SomeException
151 fromException (SomeException e) = cast e
152
153 -- | Render this exception value in a human-friendly manner.
154 --
155 -- Default implementation: @'show'@.
156 --
157 -- @since 4.8.0.0
158 displayException :: e -> String
159 displayException = show
160
161 -- | @since 3.0
162 instance Exception SomeException where
163 toException se = se
164 fromException = Just
165 displayException (SomeException e) = displayException e
166
167 -- | Throw an exception. Exceptions may be thrown from purely
168 -- functional code, but may only be caught within the 'IO' monad.
169 throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.
170 Exception e => e -> a
171 throw e = raise# (toException e)
172
173 -- | This is thrown when the user calls 'error'. The first @String@ is the
174 -- argument given to 'error', second @String@ is the location.
175 data ErrorCall = ErrorCallWithLocation String String
176 deriving ( Eq -- ^ @since 4.7.0.0
177 , Ord -- ^ @since 4.7.0.0
178 )
179
180 pattern ErrorCall :: String -> ErrorCall
181 pattern ErrorCall err <- ErrorCallWithLocation err _ where
182 ErrorCall err = ErrorCallWithLocation err ""
183
184 {-# COMPLETE ErrorCall #-}
185
186 -- | @since 4.0.0.0
187 instance Exception ErrorCall
188
189 -- | @since 4.0.0.0
190 instance Show ErrorCall where
191 showsPrec _ (ErrorCallWithLocation err "") = showString err
192 showsPrec _ (ErrorCallWithLocation err loc) =
193 showString err . showChar '\n' . showString loc
194
195 errorCallException :: String -> SomeException
196 errorCallException s = toException (ErrorCall s)
197
198 errorCallWithCallStackException :: String -> CallStack -> SomeException
199 errorCallWithCallStackException s stk = unsafeDupablePerformIO $ do
200 ccsStack <- currentCallStack
201 let
202 implicitParamCallStack = prettyCallStackLines stk
203 ccsCallStack = showCCSStack ccsStack
204 stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
205 return $ toException (ErrorCallWithLocation s stack)
206
207 showCCSStack :: [String] -> [String]
208 showCCSStack [] = []
209 showCCSStack stk = "CallStack (from -prof):" : map (" " ++) (reverse stk)
210
211 -- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
212 -- files. See Note [Definition of CallStack]
213
214 -- | Pretty print a 'SrcLoc'.
215 --
216 -- @since 4.9.0.0
217 prettySrcLoc :: SrcLoc -> String
218 prettySrcLoc SrcLoc {..}
219 = foldr (++) ""
220 [ srcLocFile, ":"
221 , show srcLocStartLine, ":"
222 , show srcLocStartCol, " in "
223 , srcLocPackage, ":", srcLocModule
224 ]
225
226 -- | Pretty print a 'CallStack'.
227 --
228 -- @since 4.9.0.0
229 prettyCallStack :: CallStack -> String
230 prettyCallStack = intercalate "\n" . prettyCallStackLines
231
232 prettyCallStackLines :: CallStack -> [String]
233 prettyCallStackLines cs = case getCallStack cs of
234 [] -> []
235 stk -> "CallStack (from HasCallStack):"
236 : map ((" " ++) . prettyCallSite) stk
237 where
238 prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc
239
240 -- |Arithmetic exceptions.
241 data ArithException
242 = Overflow
243 | Underflow
244 | LossOfPrecision
245 | DivideByZero
246 | Denormal
247 | RatioZeroDenominator -- ^ @since 4.6.0.0
248 deriving ( Eq -- ^ @since 3.0
249 , Ord -- ^ @since 3.0
250 )
251
252 divZeroException, overflowException, ratioZeroDenomException, underflowException :: SomeException
253 divZeroException = toException DivideByZero
254 overflowException = toException Overflow
255 ratioZeroDenomException = toException RatioZeroDenominator
256 underflowException = toException Underflow
257
258 -- | @since 4.0.0.0
259 instance Exception ArithException
260
261 -- | @since 4.0.0.0
262 instance Show ArithException where
263 showsPrec _ Overflow = showString "arithmetic overflow"
264 showsPrec _ Underflow = showString "arithmetic underflow"
265 showsPrec _ LossOfPrecision = showString "loss of precision"
266 showsPrec _ DivideByZero = showString "divide by zero"
267 showsPrec _ Denormal = showString "denormal"
268 showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"