summaryrefslogtreecommitdiff
path: root/libraries/base/GHC/Exception.hs
diff options
context:
space:
mode:
Diffstat (limited to 'libraries/base/GHC/Exception.hs')
-rw-r--r--libraries/base/GHC/Exception.hs175
1 files changed, 16 insertions, 159 deletions
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs
index 6a77e6e50b..3b32e230e8 100644
--- a/libraries/base/GHC/Exception.hs
+++ b/libraries/base/GHC/Exception.hs
@@ -5,6 +5,7 @@
, RecordWildCards
, PatternSynonyms
#-}
+{-# LANGUAGE TypeInType #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
@@ -22,155 +23,38 @@
-----------------------------------------------------------------------------
module GHC.Exception
- ( Exception(..) -- Class
+ ( module GHC.Exception.Type
, throw
- , SomeException(..), ErrorCall(..,ErrorCall), ArithException(..)
- , divZeroException, overflowException, ratioZeroDenomException
- , underflowException
- , errorCallException, errorCallWithCallStackException
+ , ErrorCall(..,ErrorCall)
+ , errorCallException
+ , errorCallWithCallStackException
-- re-export CallStack and SrcLoc from GHC.Types
, CallStack, fromCallSiteList, getCallStack, prettyCallStack
, prettyCallStackLines, showCCSStack
, SrcLoc(..), prettySrcLoc
) where
-import Data.Maybe
-import Data.Typeable (Typeable, cast)
- -- loop: Data.Typeable -> GHC.Err -> GHC.Exception
import GHC.Base
import GHC.Show
import GHC.Stack.Types
import GHC.OldList
+import GHC.Prim
import GHC.IO.Unsafe
import {-# SOURCE #-} GHC.Stack.CCS
-
-{- |
-The @SomeException@ type is the root of the exception type hierarchy.
-When an exception of type @e@ is thrown, behind the scenes it is
-encapsulated in a @SomeException@.
--}
-data SomeException = forall e . Exception e => SomeException e
-
--- | @since 3.0
-instance Show SomeException where
- showsPrec p (SomeException e) = showsPrec p e
-
-{- |
-Any type that you wish to throw or catch as an exception must be an
-instance of the @Exception@ class. The simplest case is a new exception
-type directly below the root:
-
-> data MyException = ThisException | ThatException
-> deriving Show
->
-> instance Exception MyException
-
-The default method definitions in the @Exception@ class do what we need
-in this case. You can now throw and catch @ThisException@ and
-@ThatException@ as exceptions:
-
-@
-*Main> throw ThisException \`catch\` \\e -> putStrLn (\"Caught \" ++ show (e :: MyException))
-Caught ThisException
-@
-
-In more complicated examples, you may wish to define a whole hierarchy
-of exceptions:
-
-> ---------------------------------------------------------------------
-> -- Make the root exception type for all the exceptions in a compiler
->
-> data SomeCompilerException = forall e . Exception e => SomeCompilerException e
->
-> instance Show SomeCompilerException where
-> show (SomeCompilerException e) = show e
->
-> instance Exception SomeCompilerException
->
-> compilerExceptionToException :: Exception e => e -> SomeException
-> compilerExceptionToException = toException . SomeCompilerException
->
-> compilerExceptionFromException :: Exception e => SomeException -> Maybe e
-> compilerExceptionFromException x = do
-> SomeCompilerException a <- fromException x
-> cast a
->
-> ---------------------------------------------------------------------
-> -- Make a subhierarchy for exceptions in the frontend of the compiler
->
-> data SomeFrontendException = forall e . Exception e => SomeFrontendException e
->
-> instance Show SomeFrontendException where
-> show (SomeFrontendException e) = show e
->
-> instance Exception SomeFrontendException where
-> toException = compilerExceptionToException
-> fromException = compilerExceptionFromException
->
-> frontendExceptionToException :: Exception e => e -> SomeException
-> frontendExceptionToException = toException . SomeFrontendException
->
-> frontendExceptionFromException :: Exception e => SomeException -> Maybe e
-> frontendExceptionFromException x = do
-> SomeFrontendException a <- fromException x
-> cast a
->
-> ---------------------------------------------------------------------
-> -- Make an exception type for a particular frontend compiler exception
->
-> data MismatchedParentheses = MismatchedParentheses
-> deriving Show
->
-> instance Exception MismatchedParentheses where
-> toException = frontendExceptionToException
-> fromException = frontendExceptionFromException
-
-We can now catch a @MismatchedParentheses@ exception as
-@MismatchedParentheses@, @SomeFrontendException@ or
-@SomeCompilerException@, but not other types, e.g. @IOException@:
-
-@
-*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: MismatchedParentheses))
-Caught MismatchedParentheses
-*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: SomeFrontendException))
-Caught MismatchedParentheses
-*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: SomeCompilerException))
-Caught MismatchedParentheses
-*Main> throw MismatchedParentheses `catch` \e -> putStrLn (\"Caught \" ++ show (e :: IOException))
-*** Exception: MismatchedParentheses
-@
-
--}
-class (Typeable e, Show e) => Exception e where
- toException :: e -> SomeException
- fromException :: SomeException -> Maybe e
-
- toException = SomeException
- fromException (SomeException e) = cast e
-
- -- | Render this exception value in a human-friendly manner.
- --
- -- Default implementation: @'show'@.
- --
- -- @since 4.8.0.0
- displayException :: e -> String
- displayException = show
-
--- | @since 3.0
-instance Exception SomeException where
- toException se = se
- fromException = Just
- displayException (SomeException e) = displayException e
+import GHC.Exception.Type
-- | Throw an exception. Exceptions may be thrown from purely
-- functional code, but may only be caught within the 'IO' monad.
-throw :: Exception e => e -> a
+throw :: forall (r :: RuntimeRep). forall (a :: TYPE r). forall e.
+ Exception e => e -> a
throw e = raise# (toException e)
--- |This is thrown when the user calls 'error'. The @String@ is the
--- argument given to 'error'.
+-- | This is thrown when the user calls 'error'. The first @String@ is the
+-- argument given to 'error', second @String@ is the location.
data ErrorCall = ErrorCallWithLocation String String
- deriving (Eq, Ord)
+ deriving ( Eq -- ^ @since 4.7.0.0
+ , Ord -- ^ @since 4.7.0.0
+ )
pattern ErrorCall :: String -> ErrorCall
pattern ErrorCall err <- ErrorCallWithLocation err _ where
@@ -184,7 +68,8 @@ instance Exception ErrorCall
-- | @since 4.0.0.0
instance Show ErrorCall where
showsPrec _ (ErrorCallWithLocation err "") = showString err
- showsPrec _ (ErrorCallWithLocation err loc) = showString (err ++ '\n' : loc)
+ showsPrec _ (ErrorCallWithLocation err loc) =
+ showString err . showChar '\n' . showString loc
errorCallException :: String -> SomeException
errorCallException s = toException (ErrorCall s)
@@ -230,31 +115,3 @@ prettyCallStackLines cs = case getCallStack cs of
: map ((" " ++) . prettyCallSite) stk
where
prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc
-
--- |Arithmetic exceptions.
-data ArithException
- = Overflow
- | Underflow
- | LossOfPrecision
- | DivideByZero
- | Denormal
- | RatioZeroDenominator -- ^ @since 4.6.0.0
- deriving (Eq, Ord)
-
-divZeroException, overflowException, ratioZeroDenomException, underflowException :: SomeException
-divZeroException = toException DivideByZero
-overflowException = toException Overflow
-ratioZeroDenomException = toException RatioZeroDenominator
-underflowException = toException Underflow
-
--- | @since 4.0.0.0
-instance Exception ArithException
-
--- | @since 4.0.0.0
-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"
- showsPrec _ RatioZeroDenominator = showString "Ratio has zero denominator"
View Lorry Controller Status