ghc/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, GHC version "
 124                  ++ cProjectVersion ++ "):\n\t"
 125                  ++ s ++ "\n\n"
 126                  ++ "Please report this as a compiler bug.  See:\n"
 127                  ++ "  http://www.haskell.org/ghc/reportabug\n")
 128
 129 #if __GLASGOW_HASKELL__ < 603
 130 myMkTyConApp = mkAppTy
 131 #else
 132 myMkTyConApp = mkTyConApp
 133 #endif
 134
 135 ghcExceptionTc = mkTyCon "GhcException"
 136 {-# NOINLINE ghcExceptionTc #-}
 137 instance Typeable GhcException where
 138   typeOf _ = myMkTyConApp ghcExceptionTc []
 139 \end{code}
 140
 141 Panics and asserts.
 142
 143 \begin{code}
 144 panic, pgmError :: String -> a
 145 panic    x = Exception.throwDyn (Panic x)
 146 pgmError x = Exception.throwDyn (ProgramError x)
 147
 148 --  #-versions because panic can't return an unboxed int, and that's
 149 -- what TAG_ is with GHC at the moment.  Ugh. (Simon)
 150 -- No, man -- Too Beautiful! (Will)
 151
 152 panic# :: String -> FastInt
 153 panic# s = case (panic s) of () -> _ILIT 0
 154
 155 assertPanic :: String -> Int -> a
 156 assertPanic file line =
 157   Exception.throw (Exception.AssertionFailed
 158            ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
 159 \end{code}
 160
 161 \begin{code}
 162 -- | tryMost is like try, but passes through Interrupted and Panic
 163 -- exceptions.  Used when we want soft failures when reading interface
 164 -- files, for example.
 165
 166 tryMost :: IO a -> IO (Either Exception.Exception a)
 167 tryMost action = do r <- try action; filter r
 168   where
 169    filter (Left e@(Exception.DynException d))
 170             | Just ghc_ex <- fromDynamic d
 171                 = case ghc_ex of
 172                     Interrupted -> Exception.throw e
 173                     Panic _     -> Exception.throw e
 174                     _other      -> return (Left e)
 175    filter other
 176      = return other
 177
 178 -- | tryUser is like try, but catches only UserErrors.
 179 -- These are the ones that are thrown by the TcRn monad
 180 -- to signal an error in the program being compiled
 181 tryUser :: IO a -> IO (Either Exception.Exception a)
 182 tryUser action = tryJust tc_errors action
 183   where
 184 #if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
 185         tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
 186 #elif __GLASGOW_HASKELL__ == 502
 187         tc_errors e@(UserError _) = Just e
 188 #else
 189         tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
 190 #endif
 191         tc_errors _other = Nothing
 192 \end{code}
 193
 194 Compatibility stuff:
 195
 196 \begin{code}
 197 #if __GLASGOW_HASKELL__ <= 408
 198 try = Exception.tryAllIO
 199 #else
 200 try = Exception.try
 201 #endif
 202
 203 #if __GLASGOW_HASKELL__ <= 408
 204 catchJust = Exception.catchIO
 205 tryJust   = Exception.tryIO
 206 ioErrors  = Exception.justIoErrors
 207 throwTo   = Exception.raiseInThread
 208 #endif
 209 \end{code}
 210
 211 Standard signal handlers for catching ^C, which just throw an
 212 exception in the target thread.  The current target thread is
 213 the thread at the head of the list in the MVar passed to
 214 installSignalHandlers.
 215
 216 \begin{code}
 217 installSignalHandlers :: IO ()
 218 installSignalHandlers = do
 219   let
 220       interrupt_exn = Exception.DynException (toDyn Interrupted)
 221
 222       interrupt = do
 223         withMVar interruptTargetThread $ \targets ->
 224           case targets of
 225            [] -> return ()
 226            (thread:_) -> throwTo thread interrupt_exn
 227   --
 228 #if !defined(mingw32_HOST_OS)
 229   installHandler sigQUIT (Catch interrupt) Nothing
 230   installHandler sigINT  (Catch interrupt) Nothing
 231   return ()
 232 #elif __GLASGOW_HASKELL__ >= 603
 233   -- GHC 6.3+ has support for console events on Windows
 234   -- NOTE: running GHCi under a bash shell for some reason requires
 235   -- you to press Ctrl-Break rather than Ctrl-C to provoke
 236   -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
 237   -- why --SDM 17/12/2004
 238   let sig_handler ControlC = interrupt
 239       sig_handler Break    = interrupt
 240       sig_handler _        = return ()
 241
 242   installHandler (Catch sig_handler)
 243   return ()
 244 #else
 245   return () -- nothing
 246 #endif
 247
 248 {-# NOINLINE interruptTargetThread #-}
 249 interruptTargetThread :: MVar [ThreadId]
 250 interruptTargetThread = unsafePerformIO newEmptyMVar
 251 \end{code}