X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FException.lhs;h=c5b967970db71915c5800caeda30fab428762313;hb=41e8fba828acbae1751628af50849f5352b27873;hp=0f9223d1ada1ec4d36c2be8fd0bdd16b19642986;hpb=d9a0d6f44a930da4ae49678908e37793d693467c;p=ghc-base.git diff --git a/GHC/Exception.lhs b/GHC/Exception.lhs index 0f9223d..c5b9679 100644 --- a/GHC/Exception.lhs +++ b/GHC/Exception.lhs @@ -1,5 +1,10 @@ \begin{code} -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# LANGUAGE NoImplicitPrelude + , ExistentialQuantification + , MagicHash + , DeriveDataTypeable + #-} +{-# OPTIONS_HADDOCK hide #-} ----------------------------------------------------------------------------- -- | -- Module : GHC.Exception @@ -15,104 +20,174 @@ ----------------------------------------------------------------------------- -- #hide -module GHC.Exception - ( module GHC.Exception, - Exception(..), AsyncException(..), - IOException(..), ArithException(..), ArrayException(..), - throw, throwIO, ioError ) - where +module GHC.Exception where +import Data.Maybe +import {-# SOURCE #-} Data.Typeable (Typeable, cast) import GHC.Base -import GHC.IOBase +import GHC.Show \end{code} %********************************************************* -%* * -\subsection{Primitive catch} -%* * +%* * +\subsection{Exceptions} +%* * %********************************************************* -catchException used to handle the passing around of the state to the -action and the handler. This turned out to be a bad idea - it meant -that we had to wrap both arguments in thunks so they could be entered -as normal (remember IO returns an unboxed pair...). +\begin{code} +{- | +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 -Now catch# has type +instance Show SomeException where + showsPrec p (SomeException e) = showsPrec p e - catch# :: IO a -> (b -> IO a) -> IO a +{- | +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: -(well almost; the compiler doesn't know about the IO newtype so we -have to work around that in the definition of catchException below). +> data MyException = ThisException | ThatException +> deriving (Show, Typeable) +> +> instance Exception MyException -\begin{code} -catchException :: IO a -> (Exception -> IO a) -> IO a -catchException (IO m) k = IO $ \s -> catch# m (\ex -> unIO (k ex)) s - --- | The 'catch' function establishes a handler that receives any 'IOError' --- raised in the action protected by 'catch'. An 'IOError' is caught by --- the most recent handler established by 'catch'. These handlers are --- not selective: all 'IOError's are caught. Exception propagation --- must be explicitly provided in a handler by re-raising any unwanted --- exceptions. For example, in --- --- > f = catch g (\e -> if IO.isEOFError e then return [] else ioError e) --- --- the function @f@ returns @[]@ when an end-of-file exception --- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the --- exception is propagated to the next outer handler. --- --- When an exception propagates outside the main program, the Haskell --- system prints the associated 'IOError' value and exits the program. --- --- Non-I\/O exceptions are not caught by this variant; to catch all --- exceptions, use 'Control.Exception.catch' from "Control.Exception". -catch :: IO a -> (IOError -> IO a) -> IO a -catch m k = catchException m handler - where handler (IOException err) = k err - handler other = throw other -\end{code} +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 +\end{code} %********************************************************* -%* * -\subsection{Controlling asynchronous exception delivery} -%* * +%* * +\subsection{Primitive throw} +%* * %********************************************************* \begin{code} --- | Applying 'block' to a computation will --- execute that computation with asynchronous exceptions --- /blocked/. That is, any thread which --- attempts to raise an exception in the current thread will be --- blocked until asynchronous exceptions are enabled again. There\'s --- no need to worry about re-enabling asynchronous exceptions; that is --- done automatically on exiting the scope of --- 'block'. -block :: IO a -> IO a - --- | To re-enable asynchronous exceptions inside the scope of --- 'block', 'unblock' can be --- used. It scopes in exactly the same way, so on exit from --- 'unblock' asynchronous exception delivery will --- be disabled again. -unblock :: IO a -> IO a - -block (IO io) = IO $ blockAsyncExceptions# io -unblock (IO io) = IO $ unblockAsyncExceptions# io +-- | 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) \end{code} \begin{code} --- | Forces its argument to be evaluated, and returns the result in --- the 'IO' monad. It can be used to order evaluation with respect to --- other 'IO' operations; its semantics are given by --- --- > evaluate undefined `seq` return () ==> return () --- > catch (evaluate undefined) (\e -> return ()) ==> return () --- --- NOTE: @(evaluate a)@ is /not/ the same as @(a \`seq\` return a)@. -evaluate :: a -> IO a -evaluate a = IO $ \s -> case a `seq` () of () -> (# s, a #) - -- NB. can't write - -- a `seq` (# s, a #) - -- because we can't have an unboxed tuple as a function argument +-- |This is thrown when the user calls 'error'. The @String@ is the +-- argument given to 'error'. +data ErrorCall = ErrorCall String + deriving Typeable + +instance Exception ErrorCall + +instance Show ErrorCall where + showsPrec _ (ErrorCall err) = showString err + +----- + +-- |Arithmetic exceptions. +data ArithException + = Overflow + | Underflow + | LossOfPrecision + | DivideByZero + | Denormal + deriving (Eq, Ord, Typeable) + +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" + \end{code}