X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=f118f47ab523785dca713f1e3f78457a5da264e9;hp=dd8949894e857e5f821fbf23b2f1ac11408f1a4e;hb=3f1b316d7035c55cd712cd39a9981339bcef2e8c;hpb=ad94d40948668032189ad22a0ad741ac1f645f50

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index dd89498..f118f47 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -7,7 +7,7 @@
 -- The above warning supression flag is a temporary kludge.
 -- While working on this module you are encouraged to remove it and fix
 -- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
 -- for details
 
 module TcRnMonad(
@@ -44,6 +44,7 @@ import Bag
 import Outputable
 import UniqSupply
 import Unique
+import UniqFM
 import DynFlags
 import StaticFlags
 import FastString
@@ -369,7 +370,8 @@ traceOptTcRn flag doc = ifOptM flag $ do
 
 dumpTcRn :: SDoc -> TcRn ()
 dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
-		    ioToTcRn (printForUser stderr (mkPrintUnqualified rdr_env) doc) }
+                    dflags <- getDOpts ;
+		    ioToTcRn (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
 
 dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
 dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
@@ -475,7 +477,8 @@ addLongErrAt loc msg extra
   = do { traceTc (ptext SLIT("Adding error:") <+> (mkLocMessage loc (msg $$ extra))) ;	
 	 errs_var <- getErrsVar ;
 	 rdr_env <- getGlobalRdrEnv ;
-	 let { err = mkLongErrMsg loc (mkPrintUnqualified rdr_env) msg extra } ;
+         dflags <- getDOpts ;
+	 let { err = mkLongErrMsg loc (mkPrintUnqualified dflags rdr_env) msg extra } ;
 	 (warns, errs) <- readMutVar errs_var ;
   	 writeMutVar errs_var (warns, errs `snocBag` err) }
 
@@ -491,7 +494,8 @@ addReportAt :: SrcSpan -> Message -> TcRn ()
 addReportAt loc msg
   = do { errs_var <- getErrsVar ;
 	 rdr_env <- getGlobalRdrEnv ;
-	 let { warn = mkWarnMsg loc (mkPrintUnqualified rdr_env) msg } ;
+         dflags <- getDOpts ;
+	 let { warn = mkWarnMsg loc (mkPrintUnqualified dflags rdr_env) msg } ;
 	 (warns, errs) <- readMutVar errs_var ;
   	 writeMutVar errs_var (warns `snocBag` warn, errs) }
 
@@ -871,9 +875,11 @@ setLclTypeEnv lcl_env thing_inside
 recordThUse :: TcM ()
 recordThUse = do { env <- getGblEnv; writeMutVar (tcg_th_used env) True }
 
-keepAliveTc :: Name -> TcM ()  	-- Record the name in the keep-alive set
-keepAliveTc n = do { env <- getGblEnv; 
-		   ; updMutVar (tcg_keep env) (`addOneToNameSet` n) }
+keepAliveTc :: Id -> TcM ()  	-- Record the name in the keep-alive set
+keepAliveTc id 
+  | isLocalId id = do { env <- getGblEnv; 
+		      ; updMutVar (tcg_keep env) (`addOneToNameSet` idName id) }
+  | otherwise = return ()
 
 keepAliveSetTc :: NameSet -> TcM ()  	-- Record the name in the keep-alive set
 keepAliveSetTc ns = do { env <- getGblEnv; 
@@ -913,8 +919,8 @@ setLocalRdrEnv rdr_env thing_inside
 mkIfLclEnv :: Module -> SDoc -> IfLclEnv
 mkIfLclEnv mod loc = IfLclEnv { if_mod     = mod,
 			        if_loc     = loc,
-			        if_tv_env  = emptyOccEnv,
-			        if_id_env  = emptyOccEnv }
+			        if_tv_env  = emptyUFM,
+			        if_id_env  = emptyUFM }
 
 initIfaceTcRn :: IfG a -> TcRn a
 initIfaceTcRn thing_inside