From 2f4e210fae842d3f0cb6cb01ee66805487c65c2e Mon Sep 17 00:00:00 2001 From: "benl@ouroborus.net" Date: Fri, 29 Oct 2010 06:58:37 +0000 Subject: [PATCH] Cleanup comments and formatting only --- compiler/utils/Panic.lhs | 195 +++++++++++++++++++++++++--------------------- 1 file changed, 108 insertions(+), 87 deletions(-) diff --git a/compiler/utils/Panic.lhs b/compiler/utils/Panic.lhs index 0e1b59d..c9e3551 100644 --- a/compiler/utils/Panic.lhs +++ b/compiler/utils/Panic.lhs @@ -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: -- +-- @ -- : --- --- If the location is on the command line, or in GHC itself, then --- ="ghc". All of the error types below correspond to --- a 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 +-- ="ghc". All of the error types below correspond to +-- a 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 ": " . 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 ": " . 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} -- 1.7.10.4