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