compiler/utils/Panic.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-2000
   3 %
   4 \section{Panic error messages}
   5
   6 Defines basic funtions for printing error messages.
   7
   8 It's hard to put these functions anywhere else without causing
   9 some unnecessary loops in the module dependency graph.
  10
  11 \begin{code}
  12 module Panic
  13    (
  14      GhcException(..), showGhcException, ghcError, progName,
  15      pgmError,
  16
  17      panic, panic#, assertPanic, trace,
  18
  19      Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
  20      catchJust, ioErrors, throwTo,
  21
  22      installSignalHandlers, interruptTargetThread
  23    ) where
  24
  25 #include "HsVersions.h"
  26
  27 import Config
  28 import FastTypes
  29
  30 #ifndef mingw32_HOST_OS
  31 # if __GLASGOW_HASKELL__ > 504
  32 import System.Posix.Signals
  33 # else
  34 import Posix            ( Handler(Catch), installHandler, sigINT, sigQUIT )
  35 # endif /* GHC > 504 */
  36 #endif /* mingw32_HOST_OS */
  37
  38 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
  39 import GHC.ConsoleHandler
  40 #endif
  41
  42 # if __GLASGOW_HASKELL__ < 500
  43 import EXCEPTION        ( raiseInThread )
  44 # else
  45 import EXCEPTION        ( throwTo )
  46 # endif /* GHC < 500 */
  47
  48 #if __GLASGOW_HASKELL__ > 408
  49 import EXCEPTION        ( catchJust, tryJust, ioErrors )
  50 #endif
  51
  52 import CONCURRENT       ( myThreadId, MVar, ThreadId, withMVar, newEmptyMVar )
  53 import DYNAMIC
  54 import qualified EXCEPTION as Exception
  55 import TRACE            ( trace )
  56 import UNSAFE_IO        ( unsafePerformIO )
  57 import IO               ( isUserError )
  58
  59 import System
  60 \end{code}
  61
  62 GHC's own exception type.
  63
  64 \begin{code}
  65 ghcError :: GhcException -> a
  66 ghcError e = Exception.throwDyn e
  67
  68 -- error messages all take the form
  69 --
  70 --      <location>: <error>
  71 --
  72 -- If the location is on the command line, or in GHC itself, then
  73 -- <location>="ghc".  All of the error types below correspond to
  74 -- a <location> of "ghc", except for ProgramError (where the string is
  75 -- assumed to contain a location already, so we don't print one).
  76
  77 data GhcException
  78   = PhaseFailed String          -- name of phase
  79                 ExitCode        -- an external phase (eg. cpp) failed
  80   | Interrupted                 -- someone pressed ^C
  81   | UsageError String           -- prints the short usage msg after the error
  82   | CmdLineError String         -- cmdline prob, but doesn't print usage
  83   | Panic String                -- the `impossible' happened
  84   | InstallationError String    -- an installation problem
  85   | ProgramError String         -- error in the user's code, probably
  86   deriving Eq
  87
  88 progName = unsafePerformIO (getProgName)
  89 {-# NOINLINE progName #-}
  90
  91 short_usage = "Usage: For basic information, try the `--help' option."
  92
  93 showException :: Exception.Exception -> String
  94 -- Show expected dynamic exceptions specially
  95 showException (Exception.DynException d) | Just e <- fromDynamic d
  96                                          = show (e::GhcException)
  97 showException other_exn                  = show other_exn
  98
  99 instance Show GhcException where
 100   showsPrec _ e@(ProgramError _) = showGhcException e
 101   showsPrec _ e = showString progName . showString ": " . showGhcException e
 102
 103 showGhcException (UsageError str)
 104    = showString str . showChar '\n' . showString short_usage
 105 showGhcException (PhaseFailed phase code)
 106    = showString "phase `" . showString phase .
 107      showString "' failed (exitcode = " . shows int_code .
 108      showString ")"
 109   where
 110     int_code =
 111       case code of
 112         ExitSuccess   -> (0::Int)
 113         ExitFailure x -> x
 114 showGhcException (CmdLineError str)
 115    = showString str
 116 showGhcException (ProgramError str)
 117    = showString str
 118 showGhcException (InstallationError str)
 119    = showString str
 120 showGhcException (Interrupted)
 121    = showString "interrupted"
 122 showGhcException (Panic s)
 123    = showString ("panic! (the 'impossible' happened)\n"
 124                  ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
 125                  ++ s ++ "\n\n"
 126                  ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n")
 127
 128 #if __GLASGOW_HASKELL__ < 603
 129 myMkTyConApp = mkAppTy
 130 #else
 131 myMkTyConApp = mkTyConApp
 132 #endif
 133
 134 ghcExceptionTc = mkTyCon "GhcException"
 135 {-# NOINLINE ghcExceptionTc #-}
 136 instance Typeable GhcException where
 137   typeOf _ = myMkTyConApp ghcExceptionTc []
 138 \end{code}
 139
 140 Panics and asserts.
 141
 142 \begin{code}
 143 panic, pgmError :: String -> a
 144 panic    x = Exception.throwDyn (Panic x)
 145 pgmError x = Exception.throwDyn (ProgramError x)
 146
 147 --  #-versions because panic can't return an unboxed int, and that's
 148 -- what TAG_ is with GHC at the moment.  Ugh. (Simon)
 149 -- No, man -- Too Beautiful! (Will)
 150
 151 panic# :: String -> FastInt
 152 panic# s = case (panic s) of () -> _ILIT 0
 153
 154 assertPanic :: String -> Int -> a
 155 assertPanic file line =
 156   Exception.throw (Exception.AssertionFailed
 157            ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
 158 \end{code}
 159
 160 \begin{code}
 161 -- | tryMost is like try, but passes through Interrupted and Panic
 162 -- exceptions.  Used when we want soft failures when reading interface
 163 -- files, for example.
 164
 165 tryMost :: IO a -> IO (Either Exception.Exception a)
 166 tryMost action = do r <- try action; filter r
 167   where
 168    filter (Left e@(Exception.DynException d))
 169             | Just ghc_ex <- fromDynamic d
 170                 = case ghc_ex of
 171                     Interrupted -> Exception.throw e
 172                     Panic _     -> Exception.throw e
 173                     _other      -> return (Left e)
 174    filter other
 175      = return other
 176
 177 -- | tryUser is like try, but catches only UserErrors.
 178 -- These are the ones that are thrown by the TcRn monad
 179 -- to signal an error in the program being compiled
 180 tryUser :: IO a -> IO (Either Exception.Exception a)
 181 tryUser action = tryJust tc_errors action
 182   where
 183 #if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
 184         tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
 185 #elif __GLASGOW_HASKELL__ == 502
 186         tc_errors e@(UserError _) = Just e
 187 #else
 188         tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
 189 #endif
 190         tc_errors _other = Nothing
 191 \end{code}
 192
 193 Compatibility stuff:
 194
 195 \begin{code}
 196 #if __GLASGOW_HASKELL__ <= 408
 197 try = Exception.tryAllIO
 198 #else
 199 try = Exception.try
 200 #endif
 201
 202 #if __GLASGOW_HASKELL__ <= 408
 203 catchJust = Exception.catchIO
 204 tryJust   = Exception.tryIO
 205 ioErrors  = Exception.justIoErrors
 206 throwTo   = Exception.raiseInThread
 207 #endif
 208 \end{code}
 209
 210 Standard signal handlers for catching ^C, which just throw an
 211 exception in the target thread.  The current target thread is
 212 the thread at the head of the list in the MVar passed to
 213 installSignalHandlers.
 214
 215 \begin{code}
 216 installSignalHandlers :: IO ()
 217 installSignalHandlers = do
 218   let
 219       interrupt_exn = Exception.DynException (toDyn Interrupted)
 220
 221       interrupt = do
 222         withMVar interruptTargetThread $ \targets ->
 223           case targets of
 224            [] -> return ()
 225            (thread:_) -> throwTo thread interrupt_exn
 226   --
 227 #if !defined(mingw32_HOST_OS)
 228   installHandler sigQUIT (Catch interrupt) Nothing
 229   installHandler sigINT  (Catch interrupt) Nothing
 230   return ()
 231 #elif __GLASGOW_HASKELL__ >= 603
 232   -- GHC 6.3+ has support for console events on Windows
 233   -- NOTE: running GHCi under a bash shell for some reason requires
 234   -- you to press Ctrl-Break rather than Ctrl-C to provoke
 235   -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
 236   -- why --SDM 17/12/2004
 237   let sig_handler ControlC = interrupt
 238       sig_handler Break    = interrupt
 239       sig_handler _        = return ()
 240
 241   installHandler (Catch sig_handler)
 242   return ()
 243 #else
 244   return () -- nothing
 245 #endif
 246
 247 {-# NOINLINE interruptTargetThread #-}
 248 interruptTargetThread :: MVar [ThreadId]
 249 interruptTargetThread = unsafePerformIO newEmptyMVar
 250 \end{code}