2 % (c) The University of Glasgow 2006
3 % (c) The GRASP Project, Glasgow University, 1992-2000
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, throwGhcException, handleGhcException,
18 panic, panicFastInt, assertPanic, trace,
20 Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
23 installSignalHandlers, interruptTargetThread
26 #include "HsVersions.h"
31 #ifndef mingw32_HOST_OS
32 import System.Posix.Signals
33 #endif /* mingw32_HOST_OS */
35 #if defined(mingw32_HOST_OS)
36 import GHC.ConsoleHandler
40 import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
42 import Debug.Trace ( trace )
43 import System.IO.Unsafe ( unsafePerformIO )
44 import System.IO.Error hiding ( try )
46 import System.Environment
49 GHC's own exception type.
52 ghcError :: GhcException -> a
53 #if __GLASGOW_HASKELL__ >= 609
54 ghcError e = Exception.throw e
56 ghcError e = Exception.throwDyn e
59 -- error messages all take the form
61 -- <location>: <error>
63 -- If the location is on the command line, or in GHC itself, then
64 -- <location>="ghc". All of the error types below correspond to
65 -- a <location> of "ghc", except for ProgramError (where the string is
66 -- assumed to contain a location already, so we don't print one).
69 = PhaseFailed String -- name of phase
70 ExitCode -- an external phase (eg. cpp) failed
71 | Interrupted -- someone pressed ^C
72 | UsageError String -- prints the short usage msg after the error
73 | CmdLineError String -- cmdline prob, but doesn't print usage
74 | Panic String -- the `impossible' happened
75 | InstallationError String -- an installation problem
76 | ProgramError String -- error in the user's code, probably
79 #if __GLASGOW_HASKELL__ >= 609
80 instance Exception GhcException
84 progName = unsafePerformIO (getProgName)
85 {-# NOINLINE progName #-}
88 short_usage = "Usage: For basic information, try the `--help' option."
90 #if __GLASGOW_HASKELL__ < 609
91 showException :: Exception.Exception -> String
92 -- Show expected dynamic exceptions specially
93 showException (Exception.DynException d) | Just e <- fromDynamic d
94 = show (e::GhcException)
95 showException other_exn = show other_exn
97 showException :: Exception e => e -> String
101 instance Show GhcException where
102 showsPrec _ e@(ProgramError _) = showGhcException e
103 showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
104 showsPrec _ e = showString progName . showString ": " . showGhcException e
106 showGhcException :: GhcException -> String -> String
107 showGhcException (UsageError str)
108 = showString str . showChar '\n' . showString short_usage
109 showGhcException (PhaseFailed phase code)
110 = showString "phase `" . showString phase .
111 showString "' failed (exitcode = " . shows int_code .
116 ExitSuccess -> (0::Int)
118 showGhcException (CmdLineError str)
120 showGhcException (ProgramError str)
122 showGhcException (InstallationError str)
124 showGhcException (Interrupted)
125 = showString "interrupted"
126 showGhcException (Panic s)
127 = showString ("panic! (the 'impossible' happened)\n"
128 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
130 ++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
132 throwGhcException :: GhcException -> a
133 #if __GLASGOW_HASKELL__ < 609
134 throwGhcException = Exception.throwDyn
136 throwGhcException = Exception.throw
139 handleGhcException :: (GhcException -> IO a) -> IO a -> IO a
140 #if __GLASGOW_HASKELL__ < 609
141 handleGhcException = flip Exception.catchDyn
143 handleGhcException = Exception.handle
146 ghcExceptionTc :: TyCon
147 ghcExceptionTc = mkTyCon "GhcException"
148 {-# NOINLINE ghcExceptionTc #-}
149 instance Typeable GhcException where
150 typeOf _ = mkTyConApp ghcExceptionTc []
156 panic, pgmError :: String -> a
157 panic x = throwGhcException (Panic x)
158 pgmError x = throwGhcException (ProgramError x)
160 -- #-versions because panic can't return an unboxed int, and that's
161 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
162 -- No, man -- Too Beautiful! (Will)
164 panicFastInt :: String -> FastInt
165 panicFastInt s = case (panic s) of () -> _ILIT(0)
167 assertPanic :: String -> Int -> a
168 assertPanic file line =
169 Exception.throw (Exception.AssertionFailed
170 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
174 -- | tryMost is like try, but passes through Interrupted and Panic
175 -- exceptions. Used when we want soft failures when reading interface
176 -- files, for example.
178 #if __GLASGOW_HASKELL__ < 609
179 tryMost :: IO a -> IO (Either Exception.Exception a)
180 tryMost action = do r <- try action; filter r
182 filter (Left e@(Exception.DynException d))
183 | Just ghc_ex <- fromDynamic d
185 Interrupted -> Exception.throw e
186 Panic _ -> Exception.throw e
187 _other -> return (Left e)
191 -- XXX I'm not entirely sure if this is catching what we really want to catch
192 tryMost :: IO a -> IO (Either SomeException a)
193 tryMost action = do r <- try action
195 Left se@(SomeException e) ->
197 -- Some GhcException's we rethrow,
198 Just Interrupted -> throwIO se
199 Just (Panic _) -> throwIO se
201 Just _ -> return (Left se)
204 -- All IOExceptions are returned
205 Just (_ :: IOException) ->
207 -- Anything else is rethrown
208 Nothing -> throwIO se
209 Right v -> return (Right v)
212 -- | tryUser is like try, but catches only UserErrors.
213 -- These are the ones that are thrown by the TcRn monad
214 -- to signal an error in the program being compiled
215 #if __GLASGOW_HASKELL__ < 609
216 tryUser :: IO a -> IO (Either Exception.Exception a)
217 tryUser action = tryJust tc_errors action
219 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
220 tc_errors _other = Nothing
222 tryUser :: IO a -> IO (Either ErrorCall a)
226 Right v -> return (Right v)
227 Left se@(SomeException ex) ->
229 -- Look for good old fashioned ErrorCall's
230 Just errorCall -> return (Left errorCall)
233 -- And also for user errors in IO errors.
237 return (Left (ErrorCall (ioeGetErrorString ioe)))
242 Standard signal handlers for catching ^C, which just throw an
243 exception in the target thread. The current target thread is
244 the thread at the head of the list in the MVar passed to
245 installSignalHandlers.
248 installSignalHandlers :: IO ()
249 installSignalHandlers = do
251 #if __GLASGOW_HASKELL__ < 609
252 interrupt_exn = Exception.DynException (toDyn Interrupted)
254 interrupt_exn = (toException Interrupted)
258 withMVar interruptTargetThread $ \targets ->
261 (thread:_) -> throwTo thread interrupt_exn
263 #if !defined(mingw32_HOST_OS)
264 installHandler sigQUIT (Catch interrupt) Nothing
265 installHandler sigINT (Catch interrupt) Nothing
268 -- GHC 6.3+ has support for console events on Windows
269 -- NOTE: running GHCi under a bash shell for some reason requires
270 -- you to press Ctrl-Break rather than Ctrl-C to provoke
271 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
272 -- why --SDM 17/12/2004
273 let sig_handler ControlC = interrupt
274 sig_handler Break = interrupt
275 sig_handler _ = return ()
277 installHandler (Catch sig_handler)
281 {-# NOINLINE interruptTargetThread #-}
282 interruptTargetThread :: MVar [ThreadId]
283 interruptTargetThread = unsafePerformIO (newMVar [])