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, panicFastInt, 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 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 )
43 import System.IO.Error ( isUserError )
45 import System.Environment
48 GHC's own exception type.
51 ghcError :: GhcException -> a
52 ghcError e = Exception.throwDyn 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 | Interrupted -- someone pressed ^C
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 | InstallationError String -- an installation problem
71 | ProgramError String -- error in the user's code, probably
75 progName = unsafePerformIO (getProgName)
76 {-# NOINLINE progName #-}
79 short_usage = "Usage: For basic information, try the `--help' option."
81 showException :: Exception.Exception -> String
82 -- Show expected dynamic exceptions specially
83 showException (Exception.DynException d) | Just e <- fromDynamic d
84 = show (e::GhcException)
85 showException other_exn = show other_exn
87 instance Show GhcException where
88 showsPrec _ e@(ProgramError _) = showGhcException e
89 showsPrec _ e@(CmdLineError _) = showString "<command line>: " . showGhcException e
90 showsPrec _ e = showString progName . showString ": " . showGhcException e
92 showGhcException :: GhcException -> String -> String
93 showGhcException (UsageError str)
94 = showString str . showChar '\n' . showString short_usage
95 showGhcException (PhaseFailed phase code)
96 = showString "phase `" . showString phase .
97 showString "' failed (exitcode = " . shows int_code .
102 ExitSuccess -> (0::Int)
104 showGhcException (CmdLineError str)
106 showGhcException (ProgramError str)
108 showGhcException (InstallationError str)
110 showGhcException (Interrupted)
111 = showString "interrupted"
112 showGhcException (Panic s)
113 = showString ("panic! (the 'impossible' happened)\n"
114 ++ " (GHC version " ++ cProjectVersion ++ " for " ++ TargetPlatform_NAME ++ "):\n\t"
116 ++ "Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n")
118 ghcExceptionTc :: TyCon
119 ghcExceptionTc = mkTyCon "GhcException"
120 {-# NOINLINE ghcExceptionTc #-}
121 instance Typeable GhcException where
122 typeOf _ = mkTyConApp ghcExceptionTc []
128 panic, pgmError :: String -> a
129 panic x = Exception.throwDyn (Panic x)
130 pgmError x = Exception.throwDyn (ProgramError x)
132 -- #-versions because panic can't return an unboxed int, and that's
133 -- what TAG_ is with GHC at the moment. Ugh. (Simon)
134 -- No, man -- Too Beautiful! (Will)
136 panicFastInt :: String -> FastInt
137 panicFastInt s = case (panic s) of () -> _ILIT(0)
139 assertPanic :: String -> Int -> a
140 assertPanic file line =
141 Exception.throw (Exception.AssertionFailed
142 ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
146 -- | tryMost is like try, but passes through Interrupted and Panic
147 -- exceptions. Used when we want soft failures when reading interface
148 -- files, for example.
150 tryMost :: IO a -> IO (Either Exception.Exception a)
151 tryMost action = do r <- try action; filter r
153 filter (Left e@(Exception.DynException d))
154 | Just ghc_ex <- fromDynamic d
156 Interrupted -> Exception.throw e
157 Panic _ -> Exception.throw e
158 _other -> return (Left e)
162 -- | tryUser is like try, but catches only UserErrors.
163 -- These are the ones that are thrown by the TcRn monad
164 -- to signal an error in the program being compiled
165 tryUser :: IO a -> IO (Either Exception.Exception a)
166 tryUser action = tryJust tc_errors action
168 tc_errors e@(Exception.IOException ioe) | isUserError ioe = Just e
169 tc_errors _other = Nothing
172 Standard signal handlers for catching ^C, which just throw an
173 exception in the target thread. The current target thread is
174 the thread at the head of the list in the MVar passed to
175 installSignalHandlers.
178 installSignalHandlers :: IO ()
179 installSignalHandlers = do
181 interrupt_exn = Exception.DynException (toDyn Interrupted)
184 withMVar interruptTargetThread $ \targets ->
187 (thread:_) -> throwTo thread interrupt_exn
189 #if !defined(mingw32_HOST_OS)
190 installHandler sigQUIT (Catch interrupt) Nothing
191 installHandler sigINT (Catch interrupt) Nothing
194 -- GHC 6.3+ has support for console events on Windows
195 -- NOTE: running GHCi under a bash shell for some reason requires
196 -- you to press Ctrl-Break rather than Ctrl-C to provoke
197 -- an interrupt. Ctrl-C is getting blocked somewhere, I don't know
198 -- why --SDM 17/12/2004
199 let sig_handler ControlC = interrupt
200 sig_handler Break = interrupt
201 sig_handler _ = return ()
203 installHandler (Catch sig_handler)
207 {-# NOINLINE interruptTargetThread #-}
208 interruptTargetThread :: MVar [ThreadId]
209 interruptTargetThread = unsafePerformIO (newMVar [])