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.
13 -- The above warning supression flag is a temporary kludge.
14 -- While working on this module you are encouraged to remove it and fix
15 -- any warnings in the module. See
16 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
21 GhcException(..), showGhcException, ghcError, progName,
24 panic, panic#, assertPanic, trace,
26 Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
27 catchJust, ioErrors, throwTo,
29 installSignalHandlers, interruptTargetThread
32 #include "HsVersions.h"
37 #ifndef mingw32_HOST_OS
38 import System.Posix.Signals
39 #endif /* mingw32_HOST_OS */
41 #if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
42 import GHC.ConsoleHandler
45 import Control.Exception
46 import Control.Concurrent ( MVar, ThreadId, withMVar, newMVar )
48 import qualified Control.Exception as Exception
49 import Debug.Trace ( trace )
50 import System.IO.Unsafe ( unsafePerformIO )
51 import System.IO.Error ( isUserError )
53 import System.Environment
56 GHC's own exception type.
59 ghcError :: GhcException -> a
60 ghcError e = Exception.throwDyn e
62 -- error messages all take the form
64 -- <location>: <error>
66 -- If the location is on the command line, or in GHC itself, then
67 -- <location>="ghc". All of the error types below correspond to
68 -- a <location> of "ghc", except for ProgramError (where the string is
69 -- assumed to contain a location already, so we don't print one).
72 = PhaseFailed String -- name of phase
73 ExitCode -- an external phase (eg. cpp) failed
74 | Interrupted -- someone pressed ^C
75 | UsageError String -- prints the short usage msg after the error
76 | CmdLineError String -- cmdline prob, but doesn't print usage
77 | Panic String -- the `impossible' happened
78 | InstallationError String -- an installation problem
79 | ProgramError String -- error in the user's code, probably
82 progName = unsafePerformIO (getProgName)
83 {-# NOINLINE progName #-}
85 short_usage = "Usage: For basic information, try the `--help' option."
87 showException :: Exception.Exception -> String
88 -- Show expected dynamic exceptions specially
89 showException (Exception.DynException d) | Just e <- fromDynamic d
90 = show (e::GhcException)
91 showException other_exn = show other_exn
93 instance Show GhcException where
94 showsPrec _ e@(ProgramError _) = showGhcException e
95 showsPrec _ e = showString progName . showString ": " . showGhcException e
97 showGhcException (UsageError str)
98 = showString str . showChar '\n' . showString short_usage
99 showGhcException (PhaseFailed phase code)
100 = showString "phase `" . showString phase .
101 showString "' failed (exitcode = " . shows int_code .
106 ExitSuccess -> (0::Int)
108 showGhcException (CmdLineError str)
110 showGhcException (ProgramError str)
112 showGhcException (InstallationError str)
114 showGhcException (Interrupted)
115 = showString "interrupted"
116 showGhcException (Panic s)
117 = showString ("panic! (the 'impossible' happened)\n"
118 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
120 ++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
122 #if __GLASGOW_HASKELL__ < 603
123 myMkTyConApp = mkAppTy
125 myMkTyConApp = mkTyConApp
128 ghcExceptionTc = mkTyCon "GhcException"
129 {-# NOINLINE ghcExceptionTc #-}
130 instance Typeable GhcException where
131 typeOf _ = myMkTyConApp ghcExceptionTc []
137 panic, pgmError :: String -> a
138 panic x = Exception.throwDyn (Panic x)
139 pgmError x = Exception.throwDyn (ProgramError x)
141 -- #-versions because panic can't return an unboxed int, and that's
142 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
143 -- No, man -- Too Beautiful! (Will)
145 panic# :: String -> FastInt
146 panic# s = case (panic s) of () -> _ILIT 0
148 assertPanic :: String -> Int -> a
149 assertPanic file line =
150 Exception.throw (Exception.AssertionFailed
151 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
155 -- | tryMost is like try, but passes through Interrupted and Panic
156 -- exceptions. Used when we want soft failures when reading interface
157 -- files, for example.
159 tryMost :: IO a -> IO (Either Exception.Exception a)
160 tryMost action = do r <- try action; filter r
162 filter (Left e@(Exception.DynException d))
163 | Just ghc_ex <- fromDynamic d
165 Interrupted -> Exception.throw e
166 Panic _ -> Exception.throw e
167 _other -> return (Left e)
171 -- | tryUser is like try, but catches only UserErrors.
172 -- These are the ones that are thrown by the TcRn monad
173 -- to signal an error in the program being compiled
174 tryUser :: IO a -> IO (Either Exception.Exception a)
175 tryUser action = tryJust tc_errors action
177 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
178 tc_errors _other = Nothing
181 Standard signal handlers for catching ^C, which just throw an
182 exception in the target thread. The current target thread is
183 the thread at the head of the list in the MVar passed to
184 installSignalHandlers.
187 installSignalHandlers :: IO ()
188 installSignalHandlers = do
190 interrupt_exn = Exception.DynException (toDyn Interrupted)
193 withMVar interruptTargetThread $ \targets ->
196 (thread:_) -> throwTo thread interrupt_exn
198 #if !defined(mingw32_HOST_OS)
199 installHandler sigQUIT (Catch interrupt) Nothing
200 installHandler sigINT (Catch interrupt) Nothing
202 #elif __GLASGOW_HASKELL__ >= 603
203 -- GHC 6.3+ has support for console events on Windows
204 -- NOTE: running GHCi under a bash shell for some reason requires
205 -- you to press Ctrl-Break rather than Ctrl-C to provoke
206 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
207 -- why --SDM 17/12/2004
208 let sig_handler ControlC = interrupt
209 sig_handler Break = interrupt
210 sig_handler _ = return ()
212 installHandler (Catch sig_handler)
218 {-# NOINLINE interruptTargetThread #-}
219 interruptTargetThread :: MVar [ThreadId]
220 interruptTargetThread = unsafePerformIO (newMVar [])