Commit 2f4e210f authored by benl@ouroborus.net's avatar benl@ouroborus.net
Browse files

Cleanup comments and formatting only

parent 3a7e2b3a
......@@ -2,15 +2,13 @@
% (c) The University of Glasgow 2006
% (c) The GRASP Project, Glasgow University, 1992-2000
%
Defines basic funtions for printing error messages.
Defines basic functions for printing error messages.
It's hard to put these functions anywhere else without causing
some unnecessary loops in the module dependency graph.
\begin{code}
module Panic
(
module Panic (
GhcException(..), showGhcException, throwGhcException, handleGhcException,
ghcError, progName,
pgmError,
......@@ -20,106 +18,134 @@ module Panic
Exception.Exception(..), showException, try, tryMost, throwTo,
installSignalHandlers, interruptTargetThread
) where
) where
#include "HsVersions.h"
import Config
import FastTypes
#ifndef mingw32_HOST_OS
import System.Posix.Signals
#endif /* mingw32_HOST_OS */
#if defined(mingw32_HOST_OS)
import GHC.ConsoleHandler
#endif
import Exception
import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar, modifyMVar_,
myThreadId )
import Data.Dynamic
import Debug.Trace ( trace )
import System.IO.Unsafe ( unsafePerformIO )
import Debug.Trace ( trace )
import System.IO.Unsafe ( unsafePerformIO )
import System.Exit
import System.Environment
\end{code}
GHC's own exception type.
#ifndef mingw32_HOST_OS
import System.Posix.Signals
#endif
#if defined(mingw32_HOST_OS)
import GHC.ConsoleHandler
#endif
\begin{code}
ghcError :: GhcException -> a
ghcError e = Exception.throw e
-- error messages all take the form
-- | GHC's own exception type
-- error messages all take the form:
--
-- @
-- <location>: <error>
--
-- If the location is on the command line, or in GHC itself, then
-- <location>="ghc". All of the error types below correspond to
-- a <location> of "ghc", except for ProgramError (where the string is
-- assumed to contain a location already, so we don't print one).
-- @
--
-- If the location is on the command line, or in GHC itself, then
-- <location>="ghc". All of the error types below correspond to
-- a <location> of "ghc", except for ProgramError (where the string is
-- assumed to contain a location already, so we don't print one).
data GhcException
= PhaseFailed String -- name of phase
ExitCode -- an external phase (eg. cpp) failed
| Signal Int -- some other fatal signal (SIGHUP,SIGTERM)
| UsageError String -- prints the short usage msg after the error
| CmdLineError String -- cmdline prob, but doesn't print usage
| Panic String -- the `impossible' happened
| Sorry String -- the user tickled something that's known not to work yet,
-- and we're not counting it as a bug.
| InstallationError String -- an installation problem
| ProgramError String -- error in the user's code, probably
-- | Some other fatal signal (SIGHUP,SIGTERM)
| Signal Int
-- | Prints the short usage msg after the error
| UsageError String
-- | A problem with the command line arguments, but don't print usage.
| CmdLineError String
-- | The 'impossible' happened.
| Panic String
-- | The user tickled something that's known not to work yet,
-- but we're not counting it as a bug.
| Sorry String
-- | An installation problem.
| InstallationError String
-- | An error in the user's code, probably.
| ProgramError String
deriving Eq
instance Exception GhcException
instance Show GhcException where
showsPrec _ e@(ProgramError _) = showGhcException e
showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
showsPrec _ e = showString progName . showString ": " . showGhcException e
instance Typeable GhcException where
typeOf _ = mkTyConApp ghcExceptionTc []
-- | The name of this GHC.
progName :: String
progName = unsafePerformIO (getProgName)
{-# NOINLINE progName #-}
-- | Short usage information to display when we are given the wrong cmd line arguments.
short_usage :: String
short_usage = "Usage: For basic information, try the `--help' option."
-- | Show an exception as a string.
showException :: Exception e => e -> String
showException = show
instance Show GhcException where
showsPrec _ e@(ProgramError _) = showGhcException e
showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
showsPrec _ e = showString progName . showString ": " . showGhcException e
-- | Append a description of the given exception to this string.
showGhcException :: GhcException -> String -> String
showGhcException (UsageError str)
= showString str . showChar '\n' . showString short_usage
showGhcException (PhaseFailed phase code)
= showString "phase `" . showString phase .
showString "' failed (exitcode = " . shows int_code .
showString ")"
where
int_code =
case code of
ExitSuccess -> (0::Int)
ExitFailure x -> x
showGhcException (CmdLineError str)
= showString str
showGhcException (ProgramError str)
= showString str
showGhcException (InstallationError str)
= showString str
showGhcException (Signal n)
= showString "signal: " . shows n
showGhcException (Panic s)
= showString ("panic! (the 'impossible' happened)\n"
++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
++ s ++ "\n\n"
++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
showGhcException (Sorry s)
= showString ("sorry! (this is work in progress)\n"
showGhcException exception
= case exception of
UsageError str
-> showString str . showChar '\n' . showString short_usage
PhaseFailed phase code
-> showString "phase `" . showString phase .
showString "' failed (exitcode = " . shows (int_code code) .
showString ")"
CmdLineError str -> showString str
ProgramError str -> showString str
InstallationError str -> showString str
Signal n -> showString "signal: " . shows n
Panic s
-> showString $
"panic! (the 'impossible' happened)\n"
++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
++ s ++ "\n\n"
++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n"
Sorry s
-> showString $
"sorry! (this is work in progress)\n"
++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
++ s ++ "\n")
++ s ++ "\n"
where int_code code =
case code of
ExitSuccess -> (0::Int)
ExitFailure x -> x
-- | Alias for `throwGhcException`
ghcError :: GhcException -> a
ghcError e = Exception.throw e
throwGhcException :: GhcException -> a
throwGhcException = Exception.throw
......@@ -127,40 +153,36 @@ throwGhcException = Exception.throw
handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
handleGhcException = ghandle
ghcExceptionTc :: TyCon
ghcExceptionTc = mkTyCon "GhcException"
{-# NOINLINE ghcExceptionTc #-}
instance Typeable GhcException where
typeOf _ = mkTyConApp ghcExceptionTc []
\end{code}
Panics and asserts.
\begin{code}
-- | Panics and asserts.
panic, sorry, pgmError :: String -> a
panic x = throwGhcException (Panic x)
sorry x = throwGhcException (Sorry x)
pgmError x = throwGhcException (ProgramError x)
-- #-versions because panic can't return an unboxed int, and that's
-- what TAG_ is with GHC at the moment. Ugh. (Simon)
-- No, man -- Too Beautiful! (Will)
-- | Panic while pretending to return an unboxed int.
-- You can't use the regular panic functions in expressions
-- producing unboxed ints because they have the wrong kind.
panicFastInt :: String -> FastInt
panicFastInt s = case (panic s) of () -> _ILIT(0)
-- | Throw an failed assertion exception for a given filename and line number.
assertPanic :: String -> Int -> a
assertPanic file line =
Exception.throw (Exception.AssertionFailed
("ASSERT failed! file " ++ file ++ ", line " ++ show line))
\end{code}
\begin{code}
-- | tryMost is like try, but passes through UserInterrupt and Panic
-- exceptions. Used when we want soft failures when reading interface
-- files, for example.
-- XXX I'm not entirely sure if this is catching what we really want to catch
-- | Like try, but pass through UserInterrupt and Panic exceptions.
-- Used when we want soft failures when reading interface files, for example.
-- TODO: I'm not entirely sure if this is catching what we really want to catch
tryMost :: IO a -> IO (Either SomeException a)
tryMost action = do r <- try action
case r of
......@@ -179,14 +201,12 @@ tryMost action = do r <- try action
-- Anything else is rethrown
Nothing -> throwIO se
Right v -> return (Right v)
\end{code}
Standard signal handlers for catching ^C, which just throw an
exception in the target thread. The current target thread is
the thread at the head of the list in the MVar passed to
installSignalHandlers.
\begin{code}
-- | Install standard signal handlers for catching ^C, which just throw an
-- exception in the target thread. The current target thread is the
-- thread at the head of the list in the MVar passed to
-- installSignalHandlers.
installSignalHandlers :: IO ()
installSignalHandlers = do
main_thread <- myThreadId
......@@ -228,4 +248,5 @@ installSignalHandlers = do
{-# NOINLINE interruptTargetThread #-}
interruptTargetThread :: MVar [ThreadId]
interruptTargetThread = unsafePerformIO (newMVar [])
\end{code}
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment