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, sorry, panicFastInt, assertPanic, trace,
20 Exception.Exception(..), showException, try, tryMost, throwTo,
22 installSignalHandlers, interruptTargetThread
25 #include "HsVersions.h"
30 #ifndef mingw32_HOST_OS
31 import System.Posix.Signals
32 #endif /* mingw32_HOST_OS */
34 #if defined(mingw32_HOST_OS)
35 import GHC.ConsoleHandler
39 import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar, modifyMVar_,
42 import Debug.Trace ( trace )
43 import System.IO.Unsafe ( unsafePerformIO )
45 import System.Environment
48 GHC's own exception type.
51 ghcError :: GhcException -> a
52 ghcError e = Exception.throw e
54 -- error messages all take the form
56 -- <location>: <error>
58 -- If the location is on the command line, or in GHC itself, then
59 -- <location>="ghc". All of the error types below correspond to
60 -- a <location> of "ghc", except for ProgramError (where the string is
61 -- assumed to contain a location already, so we don't print one).
64 = PhaseFailed String -- name of phase
65 ExitCode -- an external phase (eg. cpp) failed
66 | Signal Int -- some other fatal signal (SIGHUP,SIGTERM)
67 | UsageError String -- prints the short usage msg after the error
68 | CmdLineError String -- cmdline prob, but doesn't print usage
69 | Panic String -- the `impossible' happened
70 | Sorry String -- the user tickled something that's known not to work yet,
71 -- and we're not counting it as a bug.
72 | InstallationError String -- an installation problem
73 | ProgramError String -- error in the user's code, probably
76 instance Exception GhcException
79 progName = unsafePerformIO (getProgName)
80 {-# NOINLINE progName #-}
83 short_usage = "Usage: For basic information, try the `--help' option."
85 showException :: Exception e => e -> String
88 instance Show GhcException where
89 showsPrec _ e@(ProgramError _) = showGhcException e
90 showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
91 showsPrec _ e = showString progName . showString ": " . showGhcException e
93 showGhcException :: GhcException -> String -> String
94 showGhcException (UsageError str)
95 = showString str . showChar '\n' . showString short_usage
96 showGhcException (PhaseFailed phase code)
97 = showString "phase `" . showString phase .
98 showString "' failed (exitcode = " . shows int_code .
103 ExitSuccess -> (0::Int)
105 showGhcException (CmdLineError str)
107 showGhcException (ProgramError str)
109 showGhcException (InstallationError str)
111 showGhcException (Signal n)
112 = showString "signal: " . shows n
113 showGhcException (Panic s)
114 = showString ("panic! (the 'impossible' happened)\n"
115 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
117 ++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
118 showGhcException (Sorry s)
119 = showString ("sorry! (this is work in progress)\n"
120 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
124 throwGhcException :: GhcException -> a
125 throwGhcException = Exception.throw
127 handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
128 handleGhcException = ghandle
130 ghcExceptionTc :: TyCon
131 ghcExceptionTc = mkTyCon "GhcException"
132 {-# NOINLINE ghcExceptionTc #-}
133 instance Typeable GhcException where
134 typeOf _ = mkTyConApp ghcExceptionTc []
140 panic, sorry, pgmError :: String -> a
141 panic x = throwGhcException (Panic x)
142 sorry x = throwGhcException (Sorry x)
143 pgmError x = throwGhcException (ProgramError x)
145 -- #-versions because panic can't return an unboxed int, and that's
146 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
147 -- No, man -- Too Beautiful! (Will)
149 panicFastInt :: String -> FastInt
150 panicFastInt s = case (panic s) of () -> _ILIT(0)
152 assertPanic :: String -> Int -> a
153 assertPanic file line =
154 Exception.throw (Exception.AssertionFailed
155 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
159 -- | tryMost is like try, but passes through UserInterrupt and Panic
160 -- exceptions. Used when we want soft failures when reading interface
161 -- files, for example.
163 -- XXX I'm not entirely sure if this is catching what we really want to catch
164 tryMost :: IO a -> IO (Either SomeException a)
165 tryMost action = do r <- try action
168 case fromException se of
169 -- Some GhcException's we rethrow,
170 Just (Signal _) -> throwIO se
171 Just (Panic _) -> throwIO se
173 Just _ -> return (Left se)
175 case fromException se of
176 -- All IOExceptions are returned
177 Just (_ :: IOException) ->
179 -- Anything else is rethrown
180 Nothing -> throwIO se
181 Right v -> return (Right v)
184 Standard signal handlers for catching ^C, which just throw an
185 exception in the target thread. The current target thread is
186 the thread at the head of the list in the MVar passed to
187 installSignalHandlers.
190 installSignalHandlers :: IO ()
191 installSignalHandlers = do
192 main_thread <- myThreadId
193 modifyMVar_ interruptTargetThread (return . (main_thread :))
196 interrupt_exn = (toException UserInterrupt)
199 withMVar interruptTargetThread $ \targets ->
202 (thread:_) -> throwTo thread interrupt_exn
205 #if !defined(mingw32_HOST_OS)
206 _ <- installHandler sigQUIT (Catch interrupt) Nothing
207 _ <- installHandler sigINT (Catch interrupt) Nothing
208 -- see #3656; in the future we should install these automatically for
209 -- all Haskell programs in the same way that we install a ^C handler.
210 let fatal_signal n = throwTo main_thread (Signal (fromIntegral n))
211 _ <- installHandler sigHUP (Catch (fatal_signal sigHUP)) Nothing
212 _ <- installHandler sigTERM (Catch (fatal_signal sigTERM)) Nothing
215 -- GHC 6.3+ has support for console events on Windows
216 -- NOTE: running GHCi under a bash shell for some reason requires
217 -- you to press Ctrl-Break rather than Ctrl-C to provoke
218 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
219 -- why --SDM 17/12/2004
220 let sig_handler ControlC = interrupt
221 sig_handler Break = interrupt
222 sig_handler _ = return ()
224 _ <- installHandler (Catch sig_handler)
228 {-# NOINLINE interruptTargetThread #-}
229 interruptTargetThread :: MVar [ThreadId]
230 interruptTargetThread = unsafePerformIO (newMVar [])