[project @ 2005-10-27 14:35:20 by simonpj]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcRnMonad.lhs

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index d8032b2..a4032cd 100644 (file)
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -28,7 +28,7 @@ import InstEnv                ( emptyInstEnv )
 import VarSet          ( emptyVarSet )
 import VarEnv          ( TidyEnv, emptyTidyEnv, emptyVarEnv )
 import ErrUtils                ( Message, Messages, emptyMessages, errorsFound, 
-                         mkWarnMsg, printErrorsAndWarnings, pprBagOfErrors,
+                         mkWarnMsg, printErrorsAndWarnings,
                          mkLocMessage, mkLongErrMsg )
 import Packages                ( mkHomeModules )
 import SrcLoc          ( mkGeneralSrcSpan, isGoodSrcSpan, SrcSpan, Located(..) )
@@ -41,7 +41,7 @@ import UniqSupply     ( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupp
 import Unique          ( Unique )
 import DynFlags                ( DynFlags(..), DynFlag(..), dopt, dopt_set, GhcMode )
 import StaticFlags     ( opt_PprStyle_Debug )
-import Bag             ( snocBag, unionBags, unitBag )
+import Bag             ( snocBag, unionBags )
 import Panic           ( showException )
  
 import IO              ( stderr )
@@ -159,7 +159,7 @@ initTcPrintErrors   -- Used from the interactive loop only
        -> IO (Maybe r)
 initTcPrintErrors env mod todo = do
   (msgs, res) <- initTc env HsSrcFile mod todo
-  printErrorsAndWarnings msgs
+  printErrorsAndWarnings (hsc_dflags env) msgs
   return res
 
 -- mkImpTypeEnv makes the imported symbol table
@@ -448,12 +448,12 @@ addErrAt loc msg = addLongErrAt loc msg empty
 
 addLongErrAt :: SrcSpan -> Message -> Message -> TcRn ()
 addLongErrAt loc msg extra
- = do {  errs_var <- getErrsVar ;
+  = do { traceTc (ptext SLIT("Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ; 
+
+        errs_var <- getErrsVar ;
         rdr_env <- getGlobalRdrEnv ;
         let { err = mkLongErrMsg loc (unQualInScope rdr_env) msg extra } ;
         (warns, errs) <- readMutVar errs_var ;
-        traceTc (ptext SLIT("Adding error:") <+> \ _ -> pprBagOfErrors (unitBag err)) ;        
-               -- Ugh!  traceTc is too specific; unitBag is horrible
         writeMutVar errs_var (warns, errs `snocBag` err) }
 
 addErrs :: [(SrcSpan,Message)] -> TcRn ()