2 % (c) The GRASP Project, Glasgow University, 1992-2000
4 \section{Panic error messages}
6 Defines basic funtions for printing error messages.
8 It's hard to put these functions anywhere else without causing
9 some unnecessary loops in the module dependency graph.
14 GhcException(..), showGhcException, ghcError, progName,
17 panic, panic#, assertPanic, trace,
19 Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
20 catchJust, ioErrors, throwTo,
22 installSignalHandlers,
25 #include "HsVersions.h"
30 #ifndef mingw32_HOST_OS
31 # if __GLASGOW_HASKELL__ > 504
32 import System.Posix.Signals
34 import Posix ( Handler(Catch), installHandler, sigINT, sigQUIT )
35 # endif /* GHC > 504 */
36 #endif /* mingw32_HOST_OS */
38 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
39 import GHC.ConsoleHandler
42 # if __GLASGOW_HASKELL__ < 500
43 import EXCEPTION ( raiseInThread )
45 import EXCEPTION ( throwTo )
46 # endif /* GHC < 500 */
48 #if __GLASGOW_HASKELL__ > 408
49 import EXCEPTION ( catchJust, tryJust, ioErrors )
52 import CONCURRENT ( myThreadId )
54 import qualified EXCEPTION as Exception
55 import TRACE ( trace )
56 import UNSAFE_IO ( unsafePerformIO )
57 import IO ( isUserError )
62 GHC's own exception type.
65 ghcError :: GhcException -> a
66 ghcError e = Exception.throwDyn e
68 -- error messages all take the form
70 -- <location>: <error>
72 -- If the location is on the command line, or in GHC itself, then
73 -- <location>="ghc". All of the error types below correspond to
74 -- a <location> of "ghc", except for ProgramError (where the string is
75 -- assumed to contain a location already, so we don't print one).
78 = PhaseFailed String -- name of phase
79 ExitCode -- an external phase (eg. cpp) failed
80 | Interrupted -- someone pressed ^C
81 | UsageError String -- prints the short usage msg after the error
82 | CmdLineError String -- cmdline prob, but doesn't print usage
83 | Panic String -- the `impossible' happened
84 | InstallationError String -- an installation problem
85 | ProgramError String -- error in the user's code, probably
88 progName = unsafePerformIO (getProgName)
89 {-# NOINLINE progName #-}
91 short_usage = "Usage: For basic information, try the `--help' option."
93 showException :: Exception.Exception -> String
94 -- Show expected dynamic exceptions specially
95 showException (Exception.DynException d) | Just e <- fromDynamic d
96 = show (e::GhcException)
97 showException other_exn = show other_exn
99 instance Show GhcException where
100 showsPrec _ e@(ProgramError _) = showGhcException e
101 showsPrec _ e = showString progName . showString ": " . showGhcException e
103 showGhcException (UsageError str)
104 = showString str . showChar '\n' . showString short_usage
105 showGhcException (PhaseFailed phase code)
106 = showString "phase `" . showString phase .
107 showString "' failed (exitcode = " . shows int_code .
112 ExitSuccess -> (0::Int)
114 showGhcException (CmdLineError str)
116 showGhcException (ProgramError str)
118 showGhcException (InstallationError str)
120 showGhcException (Interrupted)
121 = showString "interrupted"
122 showGhcException (Panic s)
123 = showString ("panic! (the `impossible' happened, GHC version "
124 ++ cProjectVersion ++ "):\n\t"
126 ++ "Please report this as a compiler bug. See:\n"
127 ++ " http://www.haskell.org/ghc/reportabug\n")
129 #if __GLASGOW_HASKELL__ < 603
130 myMkTyConApp = mkAppTy
132 myMkTyConApp = mkTyConApp
135 ghcExceptionTc = mkTyCon "GhcException"
136 {-# NOINLINE ghcExceptionTc #-}
137 instance Typeable GhcException where
138 typeOf _ = myMkTyConApp ghcExceptionTc []
144 panic, pgmError :: String -> a
145 panic x = Exception.throwDyn (Panic x)
146 pgmError x = Exception.throwDyn (ProgramError x)
148 -- #-versions because panic can't return an unboxed int, and that's
149 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
150 -- No, man -- Too Beautiful! (Will)
152 panic# :: String -> FastInt
153 panic# s = case (panic s) of () -> _ILIT 0
155 assertPanic :: String -> Int -> a
156 assertPanic file line =
157 Exception.throw (Exception.AssertionFailed
158 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
162 -- | tryMost is like try, but passes through Interrupted and Panic
163 -- exceptions. Used when we want soft failures when reading interface
164 -- files, for example.
166 tryMost :: IO a -> IO (Either Exception.Exception a)
167 tryMost action = do r <- try action; filter r
169 filter (Left e@(Exception.DynException d))
170 | Just ghc_ex <- fromDynamic d
172 Interrupted -> Exception.throw e
173 Panic _ -> Exception.throw e
174 _other -> return (Left e)
178 -- | tryUser is like try, but catches only UserErrors.
179 -- These are the ones that are thrown by the TcRn monad
180 -- to signal an error in the program being compiled
181 tryUser :: IO a -> IO (Either Exception.Exception a)
182 tryUser action = tryJust tc_errors action
184 #if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
185 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
186 #elif __GLASGOW_HASKELL__ == 502
187 tc_errors e@(UserError _) = Just e
189 tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
191 tc_errors _other = Nothing
197 #if __GLASGOW_HASKELL__ <= 408
198 try = Exception.tryAllIO
203 #if __GLASGOW_HASKELL__ <= 408
204 catchJust = Exception.catchIO
205 tryJust = Exception.tryIO
206 ioErrors = Exception.justIoErrors
207 throwTo = Exception.raiseInThread
211 Standard signal handlers for catching ^C, which just throw an
212 exception in the main thread. NOTE: must be called from the main
216 installSignalHandlers :: IO ()
217 installSignalHandlers = do
218 main_thread <- myThreadId
220 interrupt_exn = Exception.DynException (toDyn Interrupted)
221 interrupt = throwTo main_thread interrupt_exn
223 #if !defined(mingw32_HOST_OS)
224 installHandler sigQUIT (Catch interrupt) Nothing
225 installHandler sigINT (Catch interrupt) Nothing
227 #elif __GLASGOW_HASKELL__ >= 603
228 -- GHC 6.3+ has support for console events on Windows
229 -- NOTE: running GHCi under a bash shell for some reason requires
230 -- you to press Ctrl-Break rather than Ctrl-C to provoke
231 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
232 -- why --SDM 17/12/2004
233 let sig_handler ControlC = interrupt
234 sig_handler Break = interrupt
235 sig_handler _ = return ()
237 installHandler (Catch sig_handler)