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 {-# OPTIONS_GHC -w #-}
  13 -- The above warning supression flag is a temporary kludge.
  14 -- While working on this module you are encouraged to remove it and fix
  15 -- any warnings in the module. See
  16 --     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
  17 -- for details
  18
  19 module Panic
  20    (
  21      GhcException(..), showGhcException, ghcError, progName,
  22      pgmError,
  23
  24      panic, panic#, assertPanic, trace,
  25
  26      Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
  27      catchJust, ioErrors, throwTo,
  28
  29      installSignalHandlers, interruptTargetThread
  30    ) where
  31
  32 #include "HsVersions.h"
  33
  34 import Config
  35 import FastTypes
  36
  37 #ifndef mingw32_HOST_OS
  38 import System.Posix.Signals
  39 #endif /* mingw32_HOST_OS */
  40
  41 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
  42 import GHC.ConsoleHandler
  43 #endif
  44
  45 import Control.Exception
  46 import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
  47 import Data.Dynamic
  48 import qualified Control.Exception as Exception
  49 import Debug.Trace      ( trace )
  50 import System.IO.Unsafe ( unsafePerformIO )
  51 import System.IO.Error  ( isUserError )
  52 import System.Exit
  53 import System.Environment
  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)\n"
 118                  ++ "  (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
 119                  ++ s ++ "\n\n"
 120                  ++ "Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n")
 121
 122 #if __GLASGOW_HASKELL__ < 603
 123 myMkTyConApp = mkAppTy
 124 #else
 125 myMkTyConApp = mkTyConApp
 126 #endif
 127
 128 ghcExceptionTc = mkTyCon "GhcException"
 129 {-# NOINLINE ghcExceptionTc #-}
 130 instance Typeable GhcException where
 131   typeOf _ = myMkTyConApp ghcExceptionTc []
 132 \end{code}
 133
 134 Panics and asserts.
 135
 136 \begin{code}
 137 panic, pgmError :: String -> a
 138 panic    x = Exception.throwDyn (Panic x)
 139 pgmError x = Exception.throwDyn (ProgramError x)
 140
 141 --  #-versions because panic can't return an unboxed int, and that's
 142 -- what TAG_ is with GHC at the moment.  Ugh. (Simon)
 143 -- No, man -- Too Beautiful! (Will)
 144
 145 panic# :: String -> FastInt
 146 panic# s = case (panic s) of () -> _ILIT 0
 147
 148 assertPanic :: String -> Int -> a
 149 assertPanic file line =
 150   Exception.throw (Exception.AssertionFailed
 151            ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
 152 \end{code}
 153
 154 \begin{code}
 155 -- | tryMost is like try, but passes through Interrupted and Panic
 156 -- exceptions.  Used when we want soft failures when reading interface
 157 -- files, for example.
 158
 159 tryMost :: IO a -> IO (Either Exception.Exception a)
 160 tryMost action = do r <- try action; filter r
 161   where
 162    filter (Left e@(Exception.DynException d))
 163             | Just ghc_ex <- fromDynamic d
 164                 = case ghc_ex of
 165                     Interrupted -> Exception.throw e
 166                     Panic _     -> Exception.throw e
 167                     _other      -> return (Left e)
 168    filter other
 169      = return other
 170
 171 -- | tryUser is like try, but catches only UserErrors.
 172 -- These are the ones that are thrown by the TcRn monad
 173 -- to signal an error in the program being compiled
 174 tryUser :: IO a -> IO (Either Exception.Exception a)
 175 tryUser action = tryJust tc_errors action
 176   where
 177         tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
 178         tc_errors _other = Nothing
 179 \end{code}
 180
 181 Standard signal handlers for catching ^C, which just throw an
 182 exception in the target thread.  The current target thread is
 183 the thread at the head of the list in the MVar passed to
 184 installSignalHandlers.
 185
 186 \begin{code}
 187 installSignalHandlers :: IO ()
 188 installSignalHandlers = do
 189   let
 190       interrupt_exn = Exception.DynException (toDyn Interrupted)
 191
 192       interrupt = do
 193         withMVar interruptTargetThread $ \targets ->
 194           case targets of
 195            [] -> return ()
 196            (thread:_) -> throwTo thread interrupt_exn
 197   --
 198 #if !defined(mingw32_HOST_OS)
 199   installHandler sigQUIT (Catch interrupt) Nothing
 200   installHandler sigINT  (Catch interrupt) Nothing
 201   return ()
 202 #elif __GLASGOW_HASKELL__ >= 603
 203   -- GHC 6.3+ has support for console events on Windows
 204   -- NOTE: running GHCi under a bash shell for some reason requires
 205   -- you to press Ctrl-Break rather than Ctrl-C to provoke
 206   -- an interrupt.  Ctrl-C is getting blocked somewhere, I don't know
 207   -- why --SDM 17/12/2004
 208   let sig_handler ControlC = interrupt
 209       sig_handler Break    = interrupt
 210       sig_handler _        = return ()
 211
 212   installHandler (Catch sig_handler)
 213   return ()
 214 #else
 215   return () -- nothing
 216 #endif
 217
 218 {-# NOINLINE interruptTargetThread #-}
 219 interruptTargetThread :: MVar [ThreadId]
 220 interruptTargetThread = unsafePerformIO (newMVar [])
 221 \end{code}