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(..), ghcError, progName,
  15      pgmError,
  16      panic, panic#, assertPanic, trace,
  17      showException, showGhcException, tryMost,
  18      installSignalHandlers,
  19
  20      catchJust, tryJust, ioErrors, throwTo,
  21    ) where
  22
  23 #include "HsVersions.h"
  24 #include "../includes/ghcconfig.h"
  25
  26 import Config
  27 import FastTypes
  28
  29 #ifndef mingw32_HOST_OS
  30 # if __GLASGOW_HASKELL__ > 504
  31 import System.Posix.Signals
  32 # else
  33 import Posix            ( Handler(Catch), installHandler, sigINT, sigQUIT )
  34 # endif /* GHC > 504 */
  35 #endif /* mingw32_HOST_OS */
  36
  37 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
  38 import GHC.ConsoleHandler
  39 #endif
  40
  41 # if __GLASGOW_HASKELL__ < 500
  42 import EXCEPTION        ( raiseInThread )
  43 # else
  44 import EXCEPTION        ( throwTo )
  45 # endif /* GHC < 500 */
  46
  47 #if __GLASGOW_HASKELL__ > 408
  48 import EXCEPTION        ( catchJust, tryJust, ioErrors )
  49 #endif
  50
  51 import CONCURRENT       ( myThreadId )
  52 import DYNAMIC
  53 import qualified EXCEPTION as Exception
  54 import TRACE            ( trace )
  55 import UNSAFE_IO        ( unsafePerformIO )
  56
  57 import System
  58 \end{code}
  59
  60 GHC's own exception type.
  61
  62 \begin{code}
  63 ghcError :: GhcException -> a
  64 ghcError e = Exception.throwDyn e
  65
  66 -- error messages all take the form
  67 --
  68 --      <location>: <error>
  69 --
  70 -- If the location is on the command line, or in GHC itself, then
  71 -- <location>="ghc".  All of the error types below correspond to
  72 -- a <location> of "ghc", except for ProgramError (where the string is
  73 -- assumed to contain a location already, so we don't print one).
  74
  75 data GhcException
  76   = PhaseFailed String          -- name of phase
  77                 ExitCode        -- an external phase (eg. cpp) failed
  78   | Interrupted                 -- someone pressed ^C
  79   | UsageError String           -- prints the short usage msg after the error
  80   | CmdLineError String         -- cmdline prob, but doesn't print usage
  81   | Panic String                -- the `impossible' happened
  82   | InstallationError String    -- an installation problem
  83   | ProgramError String         -- error in the user's code, probably
  84   deriving Eq
  85
  86 progName = unsafePerformIO (getProgName)
  87 {-# NOINLINE progName #-}
  88
  89 short_usage = "Usage: For basic information, try the `--help' option."
  90
  91 showException :: Exception.Exception -> String
  92 -- Show expected dynamic exceptions specially
  93 showException (Exception.DynException d) | Just e <- fromDynamic d
  94                                          = show (e::GhcException)
  95 showException other_exn                  = show other_exn
  96
  97 instance Show GhcException where
  98   showsPrec _ e@(ProgramError _) = showGhcException e
  99   showsPrec _ e = showString progName . showString ": " . showGhcException e
 100
 101 showGhcException (UsageError str)
 102    = showString str . showChar '\n' . showString short_usage
 103 showGhcException (PhaseFailed phase code)
 104    = showString "phase `" . showString phase .
 105      showString "' failed (exitcode = " . shows int_code .
 106      showString ")"
 107   where
 108     int_code =
 109       case code of
 110         ExitSuccess   -> (0::Int)
 111         ExitFailure x -> x
 112 showGhcException (CmdLineError str)
 113    = showString str
 114 showGhcException (ProgramError str)
 115    = showString str
 116 showGhcException (InstallationError str)
 117    = showString str
 118 showGhcException (Interrupted)
 119    = showString "interrupted"
 120 showGhcException (Panic s)
 121    = showString ("panic! (the `impossible' happened, GHC version "
 122                  ++ cProjectVersion ++ "):\n\t"
 123                  ++ s ++ "\n\n"
 124                  ++ "Please report it as a compiler bug "
 125                  ++ "to glasgow-haskell-bugs@haskell.org,\n"
 126                  ++ "or http://sourceforge.net/projects/ghc/.\n\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 <- myTry 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 #if __GLASGOW_HASKELL__ <= 408
 178 myTry = Exception.tryAllIO
 179 #else
 180 myTry = Exception.try
 181 #endif
 182 \end{code}
 183
 184 Compatibility stuff:
 185
 186 \begin{code}
 187 #if __GLASGOW_HASKELL__ <= 408
 188 catchJust = Exception.catchIO
 189 tryJust   = Exception.tryIO
 190 ioErrors  = Exception.justIoErrors
 191 throwTo   = Exception.raiseInThread
 192 #endif
 193 \end{code}
 194
 195 Standard signal handlers for catching ^C, which just throw an
 196 exception in the main thread.  NOTE: must be called from the main
 197 thread.
 198
 199 \begin{code}
 200 installSignalHandlers :: IO ()
 201 installSignalHandlers = do
 202   main_thread <- myThreadId
 203   let
 204       interrupt_exn = Exception.DynException (toDyn Interrupted)
 205       interrupt = throwTo main_thread interrupt_exn
 206   --
 207 #if !defined(mingw32_HOST_OS)
 208   installHandler sigQUIT (Catch interrupt) Nothing
 209   installHandler sigINT  (Catch interrupt) Nothing
 210   return ()
 211 #elif __GLASGOW_HASKELL__ >= 603
 212   -- GHC 6.3+ has support for console events on Windows
 213   -- NOTE: running GHCi under a bash shell for some reason requires
 214   -- you to press Ctrl-Break rather than Ctrl-C to provoke
 215   -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
 216   -- why --SDM 17/12/2004
 217   let sig_handler ControlC = interrupt
 218       sig_handler Break    = interrupt
 219       sig_handler _        = return ()
 220
 221   installHandler (Catch sig_handler)
 222   return ()
 223 #else
 224   return () -- nothing
 225 #endif
 226 \end{code}