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      panic, panic#, assertPanic, trace,
  16      showException, showGhcException, tryMost,
  17      installSignalHandlers,
  18
  19 #if __GLASGOW_HASKELL__ <= 408
  20      catchJust, ioErrors, throwTo,
  21 #endif
  22    ) where
  23
  24 #include "HsVersions.h"
  25 #include "config.h"
  26
  27 import Config
  28 import FastTypes
  29
  30 #ifndef mingw32_TARGET_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
  37 import CONCURRENT       ( myThreadId )
  38
  39 # if __GLASGOW_HASKELL__ < 500
  40 import EXCEPTION        ( raiseInThread )
  41 # else
  42 import EXCEPTION        ( throwTo )
  43 # endif /* GHC < 500 */
  44 #endif /* mingw32_TARGET_OS */
  45
  46 import DYNAMIC
  47 import qualified EXCEPTION as Exception
  48 import TRACE            ( trace )
  49 import UNSAFE_IO        ( unsafePerformIO )
  50
  51 import System
  52 \end{code}
  53
  54 GHC's own exception type.
  55
  56 \begin{code}
  57 ghcError :: GhcException -> a
  58 ghcError e = Exception.throwDyn e
  59
  60 -- error messages all take the form
  61 --
  62 --      <location>: <error>
  63 --
  64 -- If the location is on the command line, or in GHC itself, then
  65 -- <location>="ghc".  All of the error types below correspond to
  66 -- a <location> of "ghc", except for ProgramError (where the string is
  67 -- assumed to contain a location already, so we don't print one).
  68
  69 data GhcException
  70   = PhaseFailed String          -- name of phase
  71                 ExitCode        -- an external phase (eg. cpp) failed
  72   | Interrupted                 -- someone pressed ^C
  73   | UsageError String           -- prints the short usage msg after the error
  74   | CmdLineError String         -- cmdline prob, but doesn't print usage
  75   | Panic String                -- the `impossible' happened
  76   | InstallationError String    -- an installation problem
  77   | ProgramError String         -- error in the user's code, probably
  78   deriving Eq
  79
  80 progName = unsafePerformIO (getProgName)
  81 {-# NOINLINE progName #-}
  82
  83 short_usage = "Usage: For basic information, try the `--help' option."
  84
  85 showException :: Exception.Exception -> String
  86 -- Show expected dynamic exceptions specially
  87 showException (Exception.DynException d) | Just e <- fromDynamic d
  88                                          = show (e::GhcException)
  89 showException other_exn                  = show other_exn
  90
  91 instance Show GhcException where
  92   showsPrec _ e@(ProgramError _) = showGhcException e
  93   showsPrec _ e = showString progName . showString ": " . showGhcException e
  94
  95 showGhcException (UsageError str)
  96    = showString str . showChar '\n' . showString short_usage
  97 showGhcException (PhaseFailed phase code)
  98    = showString "phase `" . showString phase .
  99      showString "' failed (exitcode = " . shows int_code .
 100      showString ")"
 101   where
 102     int_code =
 103       case code of
 104         ExitSuccess   -> (0::Int)
 105         ExitFailure x -> x
 106 showGhcException (CmdLineError str)
 107    = showString str
 108 showGhcException (ProgramError str)
 109    = showString str
 110 showGhcException (InstallationError str)
 111    = showString str
 112 showGhcException (Interrupted)
 113    = showString "interrupted"
 114 showGhcException (Panic s)
 115    = showString ("panic! (the `impossible' happened, GHC version "
 116                  ++ cProjectVersion ++ "):\n\t"
 117                  ++ s ++ "\n\n"
 118                  ++ "Please report it as a compiler bug "
 119                  ++ "to glasgow-haskell-bugs@haskell.org,\n"
 120                  ++ "or http://sourceforge.net/projects/ghc/.\n\n")
 121
 122 ghcExceptionTc = mkTyCon "GhcException"
 123 {-# NOINLINE ghcExceptionTc #-}
 124 instance Typeable GhcException where
 125   typeOf _ = mkAppTy ghcExceptionTc []
 126 \end{code}
 127
 128 Panics and asserts.
 129
 130 \begin{code}
 131 panic :: String -> a
 132 panic x = Exception.throwDyn (Panic x)
 133
 134 -- #-versions because panic can't return an unboxed int, and that's
 135 -- what TAG_ is with GHC at the moment.  Ugh. (Simon)
 136 -- No, man -- Too Beautiful! (Will)
 137
 138 panic# :: String -> FastInt
 139 panic# s = case (panic s) of () -> _ILIT 0
 140
 141 assertPanic :: String -> Int -> a
 142 assertPanic file line =
 143   Exception.throw (Exception.AssertionFailed
 144            ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
 145 \end{code}
 146
 147 \begin{code}
 148 -- | tryMost is like try, but passes through Interrupted and Panic
 149 -- exceptions.  Used when we want soft failures when reading interface
 150 -- files, for example.
 151
 152 tryMost :: IO a -> IO (Either Exception.Exception a)
 153 tryMost action = do r <- myTry action; filter r
 154   where
 155    filter (Left e@(Exception.DynException d))
 156             | Just ghc_ex <- fromDynamic d
 157                 = case ghc_ex of
 158                     Interrupted -> Exception.throw e
 159                     Panic _     -> Exception.throw e
 160                     _other      -> return (Left e)
 161    filter other
 162      = return other
 163
 164 #if __GLASGOW_HASKELL__ <= 408
 165 myTry = Exception.tryAllIO
 166 #else
 167 myTry = Exception.try
 168 #endif
 169 \end{code}
 170
 171 Compatibility stuff:
 172
 173 \begin{code}
 174 #if __GLASGOW_HASKELL__ <= 408
 175 catchJust = Exception.catchIO
 176 ioErrors  = Exception.justIoErrors
 177 throwTo   = Exception.raiseInThread
 178 #endif
 179 \end{code}
 180
 181 Standard signal handlers for catching ^C, which just throw an
 182 exception in the main thread.  NOTE: must be called from the main
 183 thread.
 184
 185 \begin{code}
 186 installSignalHandlers :: IO ()
 187 installSignalHandlers = do
 188 #ifndef mingw32_TARGET_OS
 189   main_thread <- myThreadId
 190   let sig_handler = Catch (throwTo main_thread
 191                                 (Exception.DynException (toDyn Interrupted)))
 192   installHandler sigQUIT sig_handler Nothing
 193   installHandler sigINT  sig_handler Nothing
 194 #endif
 195   return ()
 196 \end{code}