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, interruptTargetThread
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, MVar, ThreadId, withMVar, newEmptyMVar )
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)\n"
124 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
126 ++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
128 #if __GLASGOW_HASKELL__ < 603
129 myMkTyConApp = mkAppTy
131 myMkTyConApp = mkTyConApp
134 ghcExceptionTc = mkTyCon "GhcException"
135 {-# NOINLINE ghcExceptionTc #-}
136 instance Typeable GhcException where
137 typeOf _ = myMkTyConApp ghcExceptionTc []
143 panic, pgmError :: String -> a
144 panic x = Exception.throwDyn (Panic x)
145 pgmError x = Exception.throwDyn (ProgramError x)
147 -- #-versions because panic can't return an unboxed int, and that's
148 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
149 -- No, man -- Too Beautiful! (Will)
151 panic# :: String -> FastInt
152 panic# s = case (panic s) of () -> _ILIT 0
154 assertPanic :: String -> Int -> a
155 assertPanic file line =
156 Exception.throw (Exception.AssertionFailed
157 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
161 -- | tryMost is like try, but passes through Interrupted and Panic
162 -- exceptions. Used when we want soft failures when reading interface
163 -- files, for example.
165 tryMost :: IO a -> IO (Either Exception.Exception a)
166 tryMost action = do r <- try action; filter r
168 filter (Left e@(Exception.DynException d))
169 | Just ghc_ex <- fromDynamic d
171 Interrupted -> Exception.throw e
172 Panic _ -> Exception.throw e
173 _other -> return (Left e)
177 -- | tryUser is like try, but catches only UserErrors.
178 -- These are the ones that are thrown by the TcRn monad
179 -- to signal an error in the program being compiled
180 tryUser :: IO a -> IO (Either Exception.Exception a)
181 tryUser action = tryJust tc_errors action
183 #if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
184 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
185 #elif __GLASGOW_HASKELL__ == 502
186 tc_errors e@(UserError _) = Just e
188 tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
190 tc_errors _other = Nothing
196 #if __GLASGOW_HASKELL__ <= 408
197 try = Exception.tryAllIO
202 #if __GLASGOW_HASKELL__ <= 408
203 catchJust = Exception.catchIO
204 tryJust = Exception.tryIO
205 ioErrors = Exception.justIoErrors
206 throwTo = Exception.raiseInThread
210 Standard signal handlers for catching ^C, which just throw an
211 exception in the target thread. The current target thread is
212 the thread at the head of the list in the MVar passed to
213 installSignalHandlers.
216 installSignalHandlers :: IO ()
217 installSignalHandlers = do
219 interrupt_exn = Exception.DynException (toDyn Interrupted)
222 withMVar interruptTargetThread $ \targets ->
225 (thread:_) -> throwTo thread interrupt_exn
227 #if !defined(mingw32_HOST_OS)
228 installHandler sigQUIT (Catch interrupt) Nothing
229 installHandler sigINT (Catch interrupt) Nothing
231 #elif __GLASGOW_HASKELL__ >= 603
232 -- GHC 6.3+ has support for console events on Windows
233 -- NOTE: running GHCi under a bash shell for some reason requires
234 -- you to press Ctrl-Break rather than Ctrl-C to provoke
235 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
236 -- why --SDM 17/12/2004
237 let sig_handler ControlC = interrupt
238 sig_handler Break = interrupt
239 sig_handler _ = return ()
241 installHandler (Catch sig_handler)
247 {-# NOINLINE interruptTargetThread #-}
248 interruptTargetThread :: MVar [ThreadId]
249 interruptTargetThread = unsafePerformIO newEmptyMVar