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, 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 )
41 import Debug.Trace ( trace )
42 import System.IO.Unsafe ( unsafePerformIO )
44 import System.Environment
47 GHC's own exception type.
50 ghcError :: GhcException -> a
51 ghcError e = Exception.throw e
53 -- error messages all take the form
55 -- <location>: <error>
57 -- If the location is on the command line, or in GHC itself, then
58 -- <location>="ghc". All of the error types below correspond to
59 -- a <location> of "ghc", except for ProgramError (where the string is
60 -- assumed to contain a location already, so we don't print one).
63 = PhaseFailed String -- name of phase
64 ExitCode -- an external phase (eg. cpp) failed
65 | Interrupted -- someone pressed ^C
66 | UsageError String -- prints the short usage msg after the error
67 | CmdLineError String -- cmdline prob, but doesn't print usage
68 | Panic String -- the `impossible' happened
69 | InstallationError String -- an installation problem
70 | ProgramError String -- error in the user's code, probably
73 instance Exception GhcException
76 progName = unsafePerformIO (getProgName)
77 {-# NOINLINE progName #-}
80 short_usage = "Usage: For basic information, try the `--help' option."
82 showException :: Exception e => e -> String
85 instance Show GhcException where
86 showsPrec _ e@(ProgramError _) = showGhcException e
87 showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
88 showsPrec _ e = showString progName . showString ": " . showGhcException e
90 showGhcException :: GhcException -> String -> String
91 showGhcException (UsageError str)
92 = showString str . showChar '\n' . showString short_usage
93 showGhcException (PhaseFailed phase code)
94 = showString "phase `" . showString phase .
95 showString "' failed (exitcode = " . shows int_code .
100 ExitSuccess -> (0::Int)
102 showGhcException (CmdLineError str)
104 showGhcException (ProgramError str)
106 showGhcException (InstallationError str)
108 showGhcException (Interrupted)
109 = showString "interrupted"
110 showGhcException (Panic s)
111 = showString ("panic! (the 'impossible' happened)\n"
112 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
114 ++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
116 throwGhcException :: GhcException -> a
117 throwGhcException = Exception.throw
119 handleGhcException :: ExceptionMonad m => (GhcException -> m a) -> m a -> m a
120 handleGhcException = ghandle
122 ghcExceptionTc :: TyCon
123 ghcExceptionTc = mkTyCon "GhcException"
124 {-# NOINLINE ghcExceptionTc #-}
125 instance Typeable GhcException where
126 typeOf _ = mkTyConApp ghcExceptionTc []
132 panic, pgmError :: String -> a
133 panic x = throwGhcException (Panic x)
134 pgmError x = throwGhcException (ProgramError x)
136 -- #-versions because panic can't return an unboxed int, and that's
137 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
138 -- No, man -- Too Beautiful! (Will)
140 panicFastInt :: String -> FastInt
141 panicFastInt s = case (panic s) of () -> _ILIT(0)
143 assertPanic :: String -> Int -> a
144 assertPanic file line =
145 Exception.throw (Exception.AssertionFailed
146 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
150 -- | tryMost is like try, but passes through Interrupted and Panic
151 -- exceptions. Used when we want soft failures when reading interface
152 -- files, for example.
154 -- XXX I'm not entirely sure if this is catching what we really want to catch
155 tryMost :: IO a -> IO (Either SomeException a)
156 tryMost action = do r <- try action
159 case fromException se of
160 -- Some GhcException's we rethrow,
161 Just Interrupted -> throwIO se
162 Just (Panic _) -> throwIO se
164 Just _ -> return (Left se)
166 case fromException se of
167 -- All IOExceptions are returned
168 Just (_ :: IOException) ->
170 -- Anything else is rethrown
171 Nothing -> throwIO se
172 Right v -> return (Right v)
175 Standard signal handlers for catching ^C, which just throw an
176 exception in the target thread. The current target thread is
177 the thread at the head of the list in the MVar passed to
178 installSignalHandlers.
181 installSignalHandlers :: IO ()
182 installSignalHandlers = do
184 interrupt_exn = (toException Interrupted)
187 withMVar interruptTargetThread $ \targets ->
190 (thread:_) -> throwTo thread interrupt_exn
192 #if !defined(mingw32_HOST_OS)
193 installHandler sigQUIT (Catch interrupt) Nothing
194 installHandler sigINT (Catch interrupt) Nothing
197 -- GHC 6.3+ has support for console events on Windows
198 -- NOTE: running GHCi under a bash shell for some reason requires
199 -- you to press Ctrl-Break rather than Ctrl-C to provoke
200 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
201 -- why --SDM 17/12/2004
202 let sig_handler ControlC = interrupt
203 sig_handler Break = interrupt
204 sig_handler _ = return ()
206 installHandler (Catch sig_handler)
210 {-# NOINLINE interruptTargetThread #-}
211 interruptTargetThread :: MVar [ThreadId]
212 interruptTargetThread = unsafePerformIO (newMVar [])