[project @ 2005-07-25 11:11:36 by simonpj]

[ghc-hetmet.git] / ghc / compiler / main / ErrUtils.lhs

diff --git a/ghc/compiler/main/ErrUtils.lhs b/ghc/compiler/main/ErrUtils.lhs
index 9e43b3f..50db73c 100644 (file)
--- a/ghc/compiler/main/ErrUtils.lhs
+++ b/ghc/compiler/main/ErrUtils.lhs
@@ -39,6 +39,7 @@ import StaticFlags    ( opt_ErrorSpans )
 import System          ( ExitCode(..), exitWith )
 import DATA_IOREF
 import IO              ( hPutStrLn, stderr )
+import DYNAMIC
 
 
 -- -----------------------------------------------------------------------------
@@ -71,6 +72,17 @@ data ErrMsg = ErrMsg {
        -- NB  Pretty.Doc not SDoc: we deal with the printing style (in ptic 
        -- whether to qualify an External Name) at the error occurrence
 
+-- So we can throw these things as exceptions
+errMsgTc :: TyCon
+errMsgTc = mkTyCon "ErrMsg"
+{-# NOINLINE errMsgTc #-}
+instance Typeable ErrMsg where
+#if __GLASGOW_HASKELL__ < 603
+  typeOf _ = mkAppTy errMsgTc []
+#else
+  typeOf _ = mkTyConApp errMsgTc []
+#endif
+
 type WarnMsg = ErrMsg
 
 -- A short (one-line) error message, with context to tell us whether
@@ -219,9 +231,9 @@ compilationPassMsg :: DynFlags -> String -> IO ()
 compilationPassMsg dflags msg
   = ifVerbose dflags 2 (putMsg msg)
 
-debugTraceMsg :: DynFlags -> String -> IO ()
-debugTraceMsg dflags msg
-  = ifVerbose dflags 2 (putMsg msg)
+debugTraceMsg :: DynFlags -> Int -> String -> IO ()
+debugTraceMsg dflags val msg
+  = ifVerbose dflags val (putMsg msg)
 
 GLOBAL_VAR(msgHandler, hPutStrLn stderr, (String -> IO ()))