Panic.lhs 6.03 KB
Newer Older
1
%
2
% (c) The GRASP Project, Glasgow University, 1992-2000
3
4
5
6
7
8
9
10
11
%
\section{Panic error messages}

Defines basic funtions for printing error messages.

It's hard to put these functions anywhere else without causing
some unnecessary loops in the module dependency graph.

\begin{code}
12
13
14
module Panic  
   ( 
     GhcException(..), ghcError, progName, 
15
     pgmError,
sof's avatar
sof committed
16
     panic, panic#, assertPanic, trace,
17
     showException, showGhcException, tryMost,
18
     installSignalHandlers, 
19

20
     catchJust, tryJust, ioErrors, throwTo,
21
   ) where
22

23
#include "HsVersions.h"
24
#include "../includes/ghcconfig.h"
25

26
import Config
27
import FastTypes
28

29
#ifndef mingw32_HOST_OS
sof's avatar
sof committed
30
# if __GLASGOW_HASKELL__ > 504
31
import System.Posix.Signals
sof's avatar
sof committed
32
# else
33
import Posix		( Handler(Catch), installHandler, sigINT, sigQUIT )
34
# endif /* GHC > 504 */
35
#endif /* mingw32_HOST_OS */
36

37
38
39
40
#if defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 603
import GHC.ConsoleHandler
#endif

41
42
43
44
# if __GLASGOW_HASKELL__ < 500
import EXCEPTION        ( raiseInThread )
# else
import EXCEPTION	( throwTo )
45
# endif /* GHC < 500 */
46

47
48
49
50
#if __GLASGOW_HASKELL__ > 408
import EXCEPTION	( catchJust, tryJust, ioErrors )
#endif

51
import CONCURRENT	( myThreadId )
52
import DYNAMIC
53
import qualified EXCEPTION as Exception
54
55
import TRACE		( trace )
import UNSAFE_IO	( unsafePerformIO )
56
57

import System
58
59
\end{code}

60
61
62
63
GHC's own exception type.

\begin{code}
ghcError :: GhcException -> a
64
ghcError e = Exception.throwDyn e
65

66
67
68
69
70
71
72
73
74
-- error messages all take the form
--
--	<location>: <error>
--
-- If the location is on the command line, or in GHC itself, then 
-- <location>="ghc".  All of the error types below correspond to 
-- a <location> of "ghc", except for ProgramError (where the string is
-- assumed to contain a location already, so we don't print one).

75
data GhcException
sof's avatar
sof committed
76
77
  = PhaseFailed String		-- name of phase 
  		ExitCode	-- an external phase (eg. cpp) failed
78
  | Interrupted			-- someone pressed ^C
79
  | UsageError String		-- prints the short usage msg after the error
80
  | CmdLineError String		-- cmdline prob, but doesn't print usage
81
  | Panic String		-- the `impossible' happened
82
83
  | InstallationError String	-- an installation problem
  | ProgramError String		-- error in the user's code, probably
84
85
86
87
88
89
90
  deriving Eq

progName = unsafePerformIO (getProgName)
{-# NOINLINE progName #-}

short_usage = "Usage: For basic information, try the `--help' option."
   
91
showException :: Exception.Exception -> String
92
-- Show expected dynamic exceptions specially
93
94
95
showException (Exception.DynException d) | Just e <- fromDynamic d 
					 = show (e::GhcException)
showException other_exn	       	 	 = show other_exn
96

97
instance Show GhcException where
98
99
  showsPrec _ e@(ProgramError _) = showGhcException e
  showsPrec _ e = showString progName . showString ": " . showGhcException e
100

101
showGhcException (UsageError str)
102
   = showString str . showChar '\n' . showString short_usage
103
showGhcException (PhaseFailed phase code)
sof's avatar
sof committed
104
105
106
107
108
109
110
111
   = showString "phase `" . showString phase . 
     showString "' failed (exitcode = " . shows int_code . 
     showString ")"
  where
    int_code = 
      case code of
        ExitSuccess   -> (0::Int)
	ExitFailure x -> x
112
113
114
115
116
117
118
showGhcException (CmdLineError str)
   = showString str
showGhcException (ProgramError str)
   = showString str
showGhcException (InstallationError str)
   = showString str
showGhcException (Interrupted)
119
   = showString "interrupted"
120
showGhcException (Panic s)
121
122
   = showString ("panic! (the `impossible' happened, GHC version "
		 ++ cProjectVersion ++ "):\n\t"
123
124
	         ++ s ++ "\n\n"
	         ++ "Please report it as a compiler bug "
125
126
	         ++ "to glasgow-haskell-bugs@haskell.org,\n"
		 ++ "or http://sourceforge.net/projects/ghc/.\n\n")
127

ralf's avatar
ralf committed
128
#if __GLASGOW_HASKELL__ < 603
ralf's avatar
ralf committed
129
130
131
132
133
myMkTyConApp = mkAppTy
#else 
myMkTyConApp = mkTyConApp
#endif

134
135
136
ghcExceptionTc = mkTyCon "GhcException"
{-# NOINLINE ghcExceptionTc #-}
instance Typeable GhcException where
ralf's avatar
ralf committed
137
  typeOf _ = myMkTyConApp ghcExceptionTc []
138
139
140
141
\end{code}

Panics and asserts.

142
\begin{code}
143
144
145
panic, pgmError :: String -> a
panic    x = Exception.throwDyn (Panic x)
pgmError x = Exception.throwDyn (ProgramError x)
146
147
148
149
150

-- #-versions because panic can't return an unboxed int, and that's
-- what TAG_ is with GHC at the moment.  Ugh. (Simon)
-- No, man -- Too Beautiful! (Will)

151
152
panic# :: String -> FastInt
panic# s = case (panic s) of () -> _ILIT 0
153
154

assertPanic :: String -> Int -> a
155
assertPanic file line = 
156
  Exception.throw (Exception.AssertionFailed 
157
           ("ASSERT failed! file " ++ file ++ ", line " ++ show line))
158
\end{code}
159
160
161
162
163
164

\begin{code}
-- | tryMost is like try, but passes through Interrupted and Panic
-- exceptions.  Used when we want soft failures when reading interface
-- files, for example.

165
tryMost :: IO a -> IO (Either Exception.Exception a)
166
tryMost action = do r <- myTry action; filter r
167
  where
168
   filter (Left e@(Exception.DynException d))
169
170
	    | Just ghc_ex <- fromDynamic d
		= case ghc_ex of
171
172
		    Interrupted -> Exception.throw e
		    Panic _     -> Exception.throw e
173
174
175
176
177
		    _other      -> return (Left e)
   filter other 
     = return other

#if __GLASGOW_HASKELL__ <= 408
178
myTry = Exception.tryAllIO
179
#else
180
myTry = Exception.try
181
182
183
184
185
186
187
#endif
\end{code}	

Compatibility stuff:

\begin{code}
#if __GLASGOW_HASKELL__ <= 408
sof's avatar
sof committed
188
catchJust = Exception.catchIO
189
tryJust   = Exception.tryIO
sof's avatar
sof committed
190
191
ioErrors  = Exception.justIoErrors
throwTo   = Exception.raiseInThread
192
193
#endif
\end{code}
194
195
196
197
198
199
200
201
202

Standard signal handlers for catching ^C, which just throw an
exception in the main thread.  NOTE: must be called from the main
thread.

\begin{code}
installSignalHandlers :: IO ()
installSignalHandlers = do
  main_thread <- myThreadId
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
  let
      interrupt_exn = Exception.DynException (toDyn Interrupted)
      interrupt = throwTo main_thread interrupt_exn
  --
#if !defined(mingw32_HOST_OS)
  installHandler sigQUIT interrupt Nothing 
  installHandler sigINT  interrupt Nothing
  return ()
#elif __GLASGOW_HASKELL__ >= 603
  -- GHC 6.3+ has support for console events on Windows
  let sig_handler ControlC = interrupt
      sig_handler Break    = interrupt
      sig_handler _        = return ()

  installHandler (Catch sig_handler)
218
  return ()
219
220
221
#else
  -- nothing
#endif
222
\end{code}