[project @ 2005-11-02 09:57:45 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 d1d8528..845bdd4 100644 (file)
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -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 )
@@ -373,6 +373,9 @@ dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
 getModule :: TcRn Module
 getModule = do { env <- getGblEnv; return (tcg_mod env) }
 
+setModule :: Module -> TcRn a -> TcRn a
+setModule mod thing_inside = updGblEnv (\env -> env { tcg_mod = mod }) thing_inside
+
 tcIsHsBoot :: TcRn Bool
 tcIsHsBoot = do { env <- getGblEnv; return (isHsBoot (tcg_src env)) }
 
@@ -448,14 +451,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 ;
-        
-        let style = mkErrStyle (unQualInScope rdr_env)
-            doc   = mkLocMessage loc (msg $$ extra)
-        in traceTc (ptext SLIT("Adding error:") <+> doc) ;     
         writeMutVar errs_var (warns, errs `snocBag` err) }
 
 addErrs :: [(SrcSpan,Message)] -> TcRn ()