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 it as a compiler bug "
127 ++ "to glasgow-haskell-bugs@haskell.org,\n"
128 ++ "or http://sourceforge.net/projects/ghc/.\n\n")
130 #if __GLASGOW_HASKELL__ < 603
131 myMkTyConApp = mkAppTy
133 myMkTyConApp = mkTyConApp
136 ghcExceptionTc = mkTyCon "GhcException"
137 {-# NOINLINE ghcExceptionTc #-}
138 instance Typeable GhcException where
139 typeOf _ = myMkTyConApp ghcExceptionTc []
145 panic, pgmError :: String -> a
146 panic x = Exception.throwDyn (Panic x)
147 pgmError x = Exception.throwDyn (ProgramError x)
149 -- #-versions because panic can't return an unboxed int, and that's
150 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
151 -- No, man -- Too Beautiful! (Will)
153 panic# :: String -> FastInt
154 panic# s = case (panic s) of () -> _ILIT 0
156 assertPanic :: String -> Int -> a
157 assertPanic file line =
158 Exception.throw (Exception.AssertionFailed
159 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
163 -- | tryMost is like try, but passes through Interrupted and Panic
164 -- exceptions. Used when we want soft failures when reading interface
165 -- files, for example.
167 tryMost :: IO a -> IO (Either Exception.Exception a)
168 tryMost action = do r <- try action; filter r
170 filter (Left e@(Exception.DynException d))
171 | Just ghc_ex <- fromDynamic d
173 Interrupted -> Exception.throw e
174 Panic _ -> Exception.throw e
175 _other -> return (Left e)
179 -- | tryUser is like try, but catches only UserErrors.
180 -- These are the ones that are thrown by the TcRn monad
181 -- to signal an error in the program being compiled
182 tryUser :: IO a -> IO (Either Exception.Exception a)
183 tryUser action = tryJust tc_errors action
185 #if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
186 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
187 #elif __GLASGOW_HASKELL__ == 502
188 tc_errors e@(UserError _) = Just e
190 tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
192 tc_errors _other = Nothing
198 #if __GLASGOW_HASKELL__ <= 408
199 try = Exception.tryAllIO
204 #if __GLASGOW_HASKELL__ <= 408
205 catchJust = Exception.catchIO
206 tryJust = Exception.tryIO
207 ioErrors = Exception.justIoErrors
208 throwTo = Exception.raiseInThread
212 Standard signal handlers for catching ^C, which just throw an
213 exception in the main thread. NOTE: must be called from the main
217 installSignalHandlers :: IO ()
218 installSignalHandlers = do
219 main_thread <- myThreadId
221 interrupt_exn = Exception.DynException (toDyn Interrupted)
222 interrupt = throwTo main_thread interrupt_exn
224 #if !defined(mingw32_HOST_OS)
225 installHandler sigQUIT (Catch interrupt) Nothing
226 installHandler sigINT (Catch interrupt) Nothing
228 #elif __GLASGOW_HASKELL__ >= 603
229 -- GHC 6.3+ has support for console events on Windows
230 -- NOTE: running GHCi under a bash shell for some reason requires
231 -- you to press Ctrl-Break rather than Ctrl-C to provoke
232 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
233 -- why --SDM 17/12/2004
234 let sig_handler ControlC = interrupt
235 sig_handler Break = interrupt
236 sig_handler _ = return ()
238 installHandler (Catch sig_handler)