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