compiler/utils/Panic.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP Project, Glasgow University, 1992-2000
   4 %
   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(..), showGhcException, ghcError, progName,
  15      pgmError,
  16
  17      panic, panicFastInt, assertPanic, trace,
  18
  19      Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
  20      catchJust, ioErrors, throwTo,
  21
  22      installSignalHandlers, interruptTargetThread
  23    ) where
  24
  25 #include "HsVersions.h"
  26
  27 import Config
  28 import FastTypes
  29
  30 #ifndef mingw32_HOST_OS
  31 import System.Posix.Signals
  32 #endif /* mingw32_HOST_OS */
  33
  34 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
  35 import GHC.ConsoleHandler
  36 #endif
  37
  38 import Control.Exception
  39 import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
  40 import Data.Dynamic
  41 import qualified Control.Exception as Exception
  42 import Debug.Trace      ( trace )
  43 import System.IO.Unsafe ( unsafePerformIO )
  44 import System.IO.Error  ( isUserError )
  45 import System.Exit
  46 import System.Environment
  47 \end{code}
  48
  49 GHC's own exception type.
  50
  51 \begin{code}
  52 ghcError :: GhcException -> a
  53 ghcError e = Exception.throwDyn e
  54
  55 -- error messages all take the form
  56 --
  57 --      <location>: <error>
  58 --
  59 -- If the location is on the command line, or in GHC itself, then
  60 -- <location>="ghc".  All of the error types below correspond to
  61 -- a <location> of "ghc", except for ProgramError (where the string is
  62 -- assumed to contain a location already, so we don't print one).
  63
  64 data GhcException
  65   = PhaseFailed String          -- name of phase
  66                 ExitCode        -- an external phase (eg. cpp) failed
  67   | Interrupted                 -- someone pressed ^C
  68   | UsageError String           -- prints the short usage msg after the error
  69   | CmdLineError String         -- cmdline prob, but doesn't print usage
  70   | Panic String                -- the `impossible' happened
  71   | InstallationError String    -- an installation problem
  72   | ProgramError String         -- error in the user's code, probably
  73   deriving Eq
  74
  75 progName :: String
  76 progName = unsafePerformIO (getProgName)
  77 {-# NOINLINE progName #-}
  78
  79 short_usage :: String
  80 short_usage = "Usage: For basic information, try the `--help' option."
  81
  82 showException :: Exception.Exception -> String
  83 -- Show expected dynamic exceptions specially
  84 showException (Exception.DynException d) | Just e <- fromDynamic d
  85                                          = show (e::GhcException)
  86 showException other_exn                  = show other_exn
  87
  88 instance Show GhcException where
  89   showsPrec _ e@(ProgramError _) = showGhcException e
  90   showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
  91   showsPrec _ e = showString progName . showString ": " . showGhcException e
  92
  93 showGhcException :: GhcException -> String -> String
  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)\n"
 115                  ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
 116                  ++ s ++ "\n\n"
 117                  ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n")
 118
 119 myMkTyConApp :: TyCon -> [TypeRep] -> TypeRep
 120 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 603
 121 myMkTyConApp = mkAppTy
 122 #else
 123 myMkTyConApp = mkTyConApp
 124 #endif
 125
 126 ghcExceptionTc :: TyCon
 127 ghcExceptionTc = mkTyCon "GhcException"
 128 {-# NOINLINE ghcExceptionTc #-}
 129 instance Typeable GhcException where
 130   typeOf _ = myMkTyConApp ghcExceptionTc []
 131 \end{code}
 132
 133 Panics and asserts.
 134
 135 \begin{code}
 136 panic, pgmError :: String -> a
 137 panic    x = Exception.throwDyn (Panic x)
 138 pgmError x = Exception.throwDyn (ProgramError x)
 139
 140 --  #-versions because panic can't return an unboxed int, and that's
 141 -- what TAG_ is with GHC at the moment.  Ugh. (Simon)
 142 -- No, man -- Too Beautiful! (Will)
 143
 144 panicFastInt :: String -> FastInt
 145 panicFastInt s = case (panic s) of () -> _ILIT(0)
 146
 147 assertPanic :: String -> Int -> a
 148 assertPanic file line =
 149   Exception.throw (Exception.AssertionFailed
 150            ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
 151 \end{code}
 152
 153 \begin{code}
 154 -- | tryMost is like try, but passes through Interrupted and Panic
 155 -- exceptions.  Used when we want soft failures when reading interface
 156 -- files, for example.
 157
 158 tryMost :: IO a -> IO (Either Exception.Exception a)
 159 tryMost action = do r <- try action; filter r
 160   where
 161    filter (Left e@(Exception.DynException d))
 162             | Just ghc_ex <- fromDynamic d
 163                 = case ghc_ex of
 164                     Interrupted -> Exception.throw e
 165                     Panic _     -> Exception.throw e
 166                     _other      -> return (Left e)
 167    filter other
 168      = return other
 169
 170 -- | tryUser is like try, but catches only UserErrors.
 171 -- These are the ones that are thrown by the TcRn monad
 172 -- to signal an error in the program being compiled
 173 tryUser :: IO a -> IO (Either Exception.Exception a)
 174 tryUser action = tryJust tc_errors action
 175   where
 176         tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
 177         tc_errors _other = Nothing
 178 \end{code}
 179
 180 Standard signal handlers for catching ^C, which just throw an
 181 exception in the target thread.  The current target thread is
 182 the thread at the head of the list in the MVar passed to
 183 installSignalHandlers.
 184
 185 \begin{code}
 186 installSignalHandlers :: IO ()
 187 installSignalHandlers = do
 188   let
 189       interrupt_exn = Exception.DynException (toDyn Interrupted)
 190
 191       interrupt = do
 192         withMVar interruptTargetThread $ \targets ->
 193           case targets of
 194            [] -> return ()
 195            (thread:_) -> throwTo thread interrupt_exn
 196   --
 197 #if !defined(mingw32_HOST_OS)
 198   installHandler sigQUIT (Catch interrupt) Nothing
 199   installHandler sigINT  (Catch interrupt) Nothing
 200   return ()
 201 #elif __GLASGOW_HASKELL__ >= 603
 202   -- GHC 6.3+ has support for console events on Windows
 203   -- NOTE: running GHCi under a bash shell for some reason requires
 204   -- you to press Ctrl-Break rather than Ctrl-C to provoke
 205   -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
 206   -- why --SDM 17/12/2004
 207   let sig_handler ControlC = interrupt
 208       sig_handler Break    = interrupt
 209       sig_handler _        = return ()
 210
 211   installHandler (Catch sig_handler)
 212   return ()
 213 #else
 214   return () -- nothing
 215 #endif
 216
 217 {-# NOINLINE interruptTargetThread #-}
 218 interruptTargetThread :: MVar [ThreadId]
 219 interruptTargetThread = unsafePerformIO (newMVar [])
 220 \end{code}