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, ghcError, progName,
17 panic, panic#, assertPanic, trace,
19 Exception.Exception(..), showException, try, tryJust, tryMost, tryUser,
20 catchJust, ioErrors, throwTo,
22 installSignalHandlers, interruptTargetThread
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 import Control.Exception hiding (try)
43 import Control.Concurrent ( myThreadId, MVar, ThreadId, withMVar, newMVar )
45 import qualified Control.Exception as Exception
46 import Debug.Trace ( trace )
47 import System.IO.Unsafe ( unsafePerformIO )
48 import System.IO.Error ( isUserError )
50 import System.Environment
53 GHC's own exception type.
56 ghcError :: GhcException -> a
57 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 progName = unsafePerformIO (getProgName)
80 {-# NOINLINE progName #-}
82 short_usage = "Usage: For basic information, try the `--help' option."
84 showException :: Exception.Exception -> String
85 -- Show expected dynamic exceptions specially
86 showException (Exception.DynException d) | Just e <- fromDynamic d
87 = show (e::GhcException)
88 showException other_exn = show other_exn
90 instance Show GhcException where
91 showsPrec _ e@(ProgramError _) = showGhcException e
92 showsPrec _ e = showString progName . showString ": " . showGhcException e
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 (Interrupted)
112 = showString "interrupted"
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")
119 #if __GLASGOW_HASKELL__ < 603
120 myMkTyConApp = mkAppTy
122 myMkTyConApp = mkTyConApp
125 ghcExceptionTc = mkTyCon "GhcException"
126 {-# NOINLINE ghcExceptionTc #-}
127 instance Typeable GhcException where
128 typeOf _ = myMkTyConApp ghcExceptionTc []
134 panic, pgmError :: String -> a
135 panic x = Exception.throwDyn (Panic x)
136 pgmError x = Exception.throwDyn (ProgramError x)
138 -- #-versions because panic can't return an unboxed int, and that's
139 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
140 -- No, man -- Too Beautiful! (Will)
142 panic# :: String -> FastInt
143 panic# s = case (panic s) of () -> _ILIT 0
145 assertPanic :: String -> Int -> a
146 assertPanic file line =
147 Exception.throw (Exception.AssertionFailed
148 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
152 -- | tryMost is like try, but passes through Interrupted and Panic
153 -- exceptions. Used when we want soft failures when reading interface
154 -- files, for example.
156 tryMost :: IO a -> IO (Either Exception.Exception a)
157 tryMost action = do r <- try action; filter r
159 filter (Left e@(Exception.DynException d))
160 | Just ghc_ex <- fromDynamic d
162 Interrupted -> Exception.throw e
163 Panic _ -> Exception.throw e
164 _other -> return (Left e)
168 -- | tryUser is like try, but catches only UserErrors.
169 -- These are the ones that are thrown by the TcRn monad
170 -- to signal an error in the program being compiled
171 tryUser :: IO a -> IO (Either Exception.Exception a)
172 tryUser action = tryJust tc_errors action
174 #if __GLASGOW_HASKELL__ > 504 || __GLASGOW_HASKELL__ < 500
175 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
176 #elif __GLASGOW_HASKELL__ == 502
177 tc_errors e@(UserError _) = Just e
179 tc_errors e@(Exception.IOException ioe) | isUserError e = Just e
181 tc_errors _other = Nothing
187 #if __GLASGOW_HASKELL__ <= 408
188 try = Exception.tryAllIO
193 #if __GLASGOW_HASKELL__ <= 408
194 catchJust = Exception.catchIO
195 tryJust = Exception.tryIO
196 ioErrors = Exception.justIoErrors
197 throwTo = Exception.raiseInThread
201 Standard signal handlers for catching ^C, which just throw an
202 exception in the target thread. The current target thread is
203 the thread at the head of the list in the MVar passed to
204 installSignalHandlers.
207 installSignalHandlers :: IO ()
208 installSignalHandlers = do
210 interrupt_exn = Exception.DynException (toDyn Interrupted)
213 withMVar interruptTargetThread $ \targets ->
216 (thread:_) -> throwTo thread interrupt_exn
218 #if !defined(mingw32_HOST_OS)
219 installHandler sigQUIT (Catch interrupt) Nothing
220 installHandler sigINT (Catch interrupt) Nothing
222 #elif __GLASGOW_HASKELL__ >= 603
223 -- GHC 6.3+ has support for console events on Windows
224 -- NOTE: running GHCi under a bash shell for some reason requires
225 -- you to press Ctrl-Break rather than Ctrl-C to provoke
226 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
227 -- why --SDM 17/12/2004
228 let sig_handler ControlC = interrupt
229 sig_handler Break = interrupt
230 sig_handler _ = return ()
232 installHandler (Catch sig_handler)
238 {-# NOINLINE interruptTargetThread #-}
239 interruptTargetThread :: MVar [ThreadId]
240 interruptTargetThread = unsafePerformIO (newMVar [])