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