ghc-6.12.2: The GHC APISource codeContentsIndex
Panic
Synopsis
data GhcException
= PhaseFailed String ExitCode
| Interrupted
| Signal Int
| UsageError String
| CmdLineError String
| Panic String
| InstallationError String
| ProgramError String
showGhcException :: GhcException -> String -> String
throwGhcException :: GhcException -> a
handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
ghcError :: GhcException -> a
progName :: String
pgmError :: String -> a
panic :: String -> a
panicFastInt :: String -> FastInt
assertPanic :: String -> Int -> a
trace :: String -> a -> a
class (Typeable e, Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
showException :: Exception e => e -> String
try :: Exception e => IO a -> IO (Either e a)
tryMost :: IO a -> IO (Either SomeException a)
throwTo :: Exception e => ThreadId -> e -> IO ()
installSignalHandlers :: IO ()
interruptTargetThread :: MVar [ThreadId]
Documentation
data GhcException Source
Constructors
PhaseFailed String ExitCode
Interrupted
Signal Int
UsageError String
CmdLineError String
Panic String
InstallationError String
ProgramError String
show/hide Instances
showGhcException :: GhcException -> String -> StringSource
throwGhcException :: GhcException -> aSource
handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m aSource
ghcError :: GhcException -> aSource
progName :: StringSource
pgmError :: String -> aSource
panic :: String -> aSource
panicFastInt :: String -> FastIntSource
assertPanic :: String -> Int -> aSource
trace :: String -> a -> aSource
When called, trace outputs the string in its first argument, before returning the second argument as its result. The trace function is not referentially transparent, and should only be used for debugging, or for monitoring execution. Some implementations of trace may decorate the string that's output to indicate that you're tracing. The function is implemented on top of putTraceMsg.
class (Typeable e, Show e) => Exception e whereSource

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
Methods
toException :: e -> SomeExceptionSource
fromException :: SomeException -> Maybe eSource
show/hide Instances
showException :: Exception e => e -> StringSource
try :: Exception e => IO a -> IO (Either e a)Source

Similar to catch, but returns an Either result which is (Right a) if no exception of type e was raised, or (Left ex) if an exception of type e was raised and its value is ex. If any other type of exception is raised than it will be propogated up to the next enclosing exception handler.

try a = catch (Right `liftM` a) (return . Left)

Note that System.IO.Error also exports a function called System.IO.Error.try with a similar type to Control.Exception.try, except that it catches only the IO and user families of exceptions (as required by the Haskell 98 IO module).

tryMost :: IO a -> IO (Either SomeException a)Source
tryMost is like try, but passes through Interrupted and Panic exceptions. Used when we want soft failures when reading interface files, for example.
throwTo :: Exception e => ThreadId -> e -> IO ()Source

throwTo raises an arbitrary exception in the target thread (GHC only).

throwTo does not return until the exception has been raised in the target thread. The calling thread can thus be certain that the target thread has received the exception. This is a useful property to know when dealing with race conditions: eg. if there are two threads that can kill each other, it is guaranteed that only one of the threads will get to kill the other.

If the target thread is currently making a foreign call, then the exception will not be raised (and hence throwTo will not return) until the call has completed. This is the case regardless of whether the call is inside a block or not.

Important note: the behaviour of throwTo differs from that described in the paper "Asynchronous exceptions in Haskell" (http://research.microsoft.com/~simonpj/Papers/asynch-exns.htm). In the paper, throwTo is non-blocking; but the library implementation adopts a more synchronous design in which throwTo does not return until the exception is received by the target thread. The trade-off is discussed in Section 9 of the paper. Like any blocking operation, throwTo is therefore interruptible (see Section 5.3 of the paper).

There is currently no guarantee that the exception delivered by throwTo will be delivered at the first possible opportunity. In particular, a thread may unblock and then re-block exceptions (using unblock and block) without receiving a pending throwTo. This is arguably undesirable behaviour.

installSignalHandlers :: IO ()Source
interruptTargetThread :: MVar [ThreadId]Source
Produced by Haddock version 2.6.1