diff options
Diffstat (limited to 'libraries/base/GHC/Exception.hs')
-rw-r--r-- | libraries/base/GHC/Exception.hs | 188 |
1 files changed, 188 insertions, 0 deletions
diff --git a/libraries/base/GHC/Exception.hs b/libraries/base/GHC/Exception.hs new file mode 100644 index 0000000000..7a7c8c20fa --- /dev/null +++ b/libraries/base/GHC/Exception.hs @@ -0,0 +1,188 @@ +{-# LANGUAGE Trustworthy #-} +{-# LANGUAGE NoImplicitPrelude + , ExistentialQuantification + , MagicHash + , DeriveDataTypeable + #-} +{-# OPTIONS_HADDOCK hide #-} + +----------------------------------------------------------------------------- +-- | +-- Module : GHC.Exception +-- Copyright : (c) The University of Glasgow, 1998-2002 +-- License : see libraries/base/LICENSE +-- +-- Maintainer : cvs-ghc@haskell.org +-- Stability : internal +-- Portability : non-portable (GHC extensions) +-- +-- Exceptions and exception-handling functions. +-- +----------------------------------------------------------------------------- + +module GHC.Exception + ( Exception(..) -- Class + , throw + , SomeException(..), ErrorCall(..), ArithException(..) + , divZeroException, overflowException, ratioZeroDenomException + , errorCallException + ) where + +import Data.Maybe +import Data.Typeable (Typeable, cast) + -- loop: Data.Typeable -> GHC.Err -> GHC.Exception +import GHC.Base +import GHC.Show + +{- | +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 + deriving Typeable + +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, Typeable) +> +> 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 +> deriving Typeable +> +> 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 +> deriving Typeable +> +> 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 (Typeable, 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 + +instance Exception SomeException where + toException se = se + fromException = Just + +-- | 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 e = raise# (toException e) + +-- |This is thrown when the user calls 'error'. The @String@ is the +-- argument given to 'error'. +newtype ErrorCall = ErrorCall String + deriving (Eq, Ord, Typeable) + +instance Exception ErrorCall + +instance Show ErrorCall where + showsPrec _ (ErrorCall err) = showString err + +errorCallException :: String -> SomeException +errorCallException s = toException (ErrorCall s) + +-- |Arithmetic exceptions. +data ArithException + = Overflow + | Underflow + | LossOfPrecision + | DivideByZero + | Denormal + | RatioZeroDenominator -- ^ /Since: 4.6.0.0/ + deriving (Eq, Ord, Typeable) + +divZeroException, overflowException, ratioZeroDenomException :: SomeException +divZeroException = toException DivideByZero +overflowException = toException Overflow +ratioZeroDenomException = toException RatioZeroDenominator + +instance Exception ArithException + +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" |