X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnMonad.lhs;h=f515334830c14985ea90c328563d64bc82c4d01f;hp=ee3c6c6bf017b431f5f0bde7cb9f592848751e49;hb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;hpb=b93eb0c23bed01905e86c0a8c485edb388626761

diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index ee3c6c6..f515334 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -11,7 +11,7 @@ import TcRnTypes	-- Re-export all
 import IOEnv		-- Re-export all
 
 #if defined(GHCI) && defined(BREAKPOINT)
-import TypeRep          ( Type(..), liftedTypeKind, TyThing(..) )
+import TypeRep          ( Type(..), liftedTypeKind )
 import Var              ( mkTyVar, mkGlobalId )
 import IdInfo           ( GlobalIdDetails(..), vanillaIdInfo )
 import OccName          ( mkOccName, tvName )
@@ -23,14 +23,13 @@ import NameEnv          ( mkNameEnv )
 
 import HsSyn		( emptyLHsBinds )
 import HscTypes		( HscEnv(..), ModGuts(..), ModIface(..),
-			  TyThing, TypeEnv, emptyTypeEnv, HscSource(..),
-			  isHsBoot, ModSummary(..),
+			  TypeEnv, emptyTypeEnv, HscSource(..), isHsBoot,
 			  ExternalPackageState(..), HomePackageTable,
 			  Deprecs(..), FixityEnv, FixItem, 
-			  lookupType, unQualInScope )
-import Module		( Module, unitModuleEnv )
+			  mkPrintUnqualified )
+import Module		( Module, moduleName )
 import RdrName		( GlobalRdrEnv, LocalRdrEnv, emptyLocalRdrEnv )
-import Name		( Name, isInternalName, mkInternalName, tidyNameOcc, nameOccName, getSrcLoc )
+import Name		( Name, mkInternalName, tidyNameOcc, nameOccName, getSrcLoc )
 import Type		( Type )
 import TcType		( tcIsTyVarTy, tcGetTyVar )
 import NameEnv		( extendNameEnvList, nameEnvElts )
@@ -42,7 +41,6 @@ import VarEnv		( TidyEnv, emptyTidyEnv, extendVarEnv )
 import ErrUtils		( Message, Messages, emptyMessages, errorsFound, 
 			  mkWarnMsg, printErrorsAndWarnings,
 			  mkLocMessage, mkLongErrMsg )
-import Packages		( mkHomeModules )
 import SrcLoc		( mkGeneralSrcSpan, isGoodSrcSpan, SrcSpan, Located(..) )
 import NameEnv		( emptyNameEnv )
 import NameSet		( NameSet, emptyDUs, emptyNameSet, unionNameSets, addOneToNameSet )
@@ -50,6 +48,7 @@ import OccName		( emptyOccEnv, tidyOccName )
 import Bag		( emptyBag )
 import Outputable
 import UniqSupply	( UniqSupply, mkSplitUniqSupply, uniqFromSupply, splitUniqSupply )
+import UniqFM		( unitUFM )
 import Unique		( Unique )
 import DynFlags		( DynFlags(..), DynFlag(..), dopt, dopt_set, GhcMode )
 import StaticFlags	( opt_PprStyle_Debug )
@@ -105,7 +104,6 @@ initTc hsc_env hsc_src mod do_this
 		tcg_th_used   = th_var,
 		tcg_exports  = emptyNameSet,
 		tcg_imports  = init_imports,
-		tcg_home_mods = home_mods,
 		tcg_dus      = emptyDUs,
                 tcg_rn_imports = Nothing,
                 tcg_rn_exports = Nothing,
@@ -174,17 +172,8 @@ initTc hsc_env hsc_src mod do_this
 	return (msgs, final_res)
     }
   where
-    home_mods = mkHomeModules (map ms_mod (hsc_mod_graph hsc_env))
-	-- A guess at the home modules.  This will be correct in
-	-- --make and GHCi modes, but in one-shot mode we need to 
-	-- fix it up after we know the real dependencies of the current
-	-- module (see tcRnModule).
-	-- Setting it here is necessary for the typechecker entry points
-	-- other than tcRnModule: tcRnGetInfo, for example.  These are
-	-- all called via the GHC module, so hsc_mod_graph will contain
-	-- something sensible.
-
-    init_imports = emptyImportAvails {imp_env = unitModuleEnv mod emptyNameSet}
+    init_imports = emptyImportAvails {imp_env = 
+					unitUFM (moduleName mod) emptyNameSet}
 	-- Initialise tcg_imports with an empty set of bindings for
 	-- this module, so that if we see 'module M' in the export
 	-- list, and there are no bindings in M, we don't bleat 
@@ -199,15 +188,6 @@ initTcPrintErrors env mod todo = do
   (msgs, res) <- initTc env HsSrcFile mod todo
   printErrorsAndWarnings (hsc_dflags env) msgs
   return res
-
--- mkImpTypeEnv makes the imported symbol table
-mkImpTypeEnv :: ExternalPackageState -> HomePackageTable
- 	     -> Name -> Maybe TyThing
-mkImpTypeEnv pcs hpt = lookup 
-  where
-    pte = eps_PTE pcs
-    lookup name | isInternalName name = Nothing
-	        | otherwise	      = lookupType hpt pte name
 \end{code}
 
 
@@ -395,7 +375,7 @@ traceOptTcRn flag doc = ifOptM flag $ do
 
 dumpTcRn :: SDoc -> TcRn ()
 dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv ;
-		    ioToTcRn (printForUser stderr (unQualInScope rdr_env) doc) }
+		    ioToTcRn (printForUser stderr (mkPrintUnqualified rdr_env) doc) }
 
 dumpOptTcRn :: DynFlag -> SDoc -> TcRn ()
 dumpOptTcRn flag doc = ifOptM flag (dumpTcRn doc)
@@ -493,7 +473,7 @@ addLongErrAt loc msg extra
   = 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 } ;
+	 let { err = mkLongErrMsg loc (mkPrintUnqualified rdr_env) msg extra } ;
 	 (warns, errs) <- readMutVar errs_var ;
   	 writeMutVar errs_var (warns, errs `snocBag` err) }
 
@@ -509,7 +489,7 @@ addReportAt :: SrcSpan -> Message -> TcRn ()
 addReportAt loc msg
   = do { errs_var <- getErrsVar ;
 	 rdr_env <- getGlobalRdrEnv ;
-	 let { warn = mkWarnMsg loc (unQualInScope rdr_env) msg } ;
+	 let { warn = mkWarnMsg loc (mkPrintUnqualified rdr_env) msg } ;
 	 (warns, errs) <- readMutVar errs_var ;
   	 writeMutVar errs_var (warns `snocBag` warn, errs) }