X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Ftypecheck%2FTcRnMonad.lhs;h=550cf6013737e28a073ea066dede07f51ab2f571;hb=a06f5e7b2158b57e40ebf255eb9d0b74e9625762;hp=07dbe1200e6f8e73a5405307527c833712ec6200;hpb=5c614bc5f79ac6134e081e71c5db97495e52e1e2;p=ghc-hetmet.git

diff --git a/ghc/compiler/typecheck/TcRnMonad.lhs b/ghc/compiler/typecheck/TcRnMonad.lhs
index 07dbe12..550cf60 100644
--- a/ghc/compiler/typecheck/TcRnMonad.lhs
+++ b/ghc/compiler/typecheck/TcRnMonad.lhs
@@ -14,7 +14,7 @@ import HscTypes		( HscEnv(..), PersistentCompilerState(..),
 			  GlobalRdrEnv, LocalRdrEnv, NameCache, FixityEnv,
 			  GhciMode, lookupType, unQualInScope )
 import TcRnTypes
-import Module		( Module, moduleName, foldModuleEnv )
+import Module		( Module, moduleName, unitModuleEnv, foldModuleEnv )
 import Name		( Name, isInternalName )
 import Type		( Type )
 import NameEnv		( extendNameEnvList )
@@ -169,21 +169,20 @@ initTc  (HscEnv { hsc_mode   = ghci_mode,
 	eps' <- readIORef eps_var ;
 	nc'  <- readIORef nc_var ;
 	let { pcs' = PCS { pcs_EPS = eps', pcs_nc = nc' } ;
-	      final_res | errorsFound msgs = Nothing
-			| otherwise	   = maybe_res } ;
+	      final_res | errorsFound dflags msgs = Nothing
+			| otherwise	   	  = maybe_res } ;
 
 	return (pcs', final_res)
     }
   where
     eps = pcs_EPS pcs
 
-    init_imports = mkImportAvails (moduleName mod) True []
+    init_imports = emptyImportAvails { imp_qual = unitModuleEnv mod emptyAvailEnv }
 	-- 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 
 	-- "unknown module M".
 
-
 defaultDefaultTys :: [Type]
 defaultDefaultTys = [integerTy, doubleTy]
 
@@ -283,6 +282,9 @@ getModule = do { env <- getGblEnv; return (tcg_mod env) }
 getGlobalRdrEnv :: TcRn m GlobalRdrEnv
 getGlobalRdrEnv = do { env <- getGblEnv; return (tcg_rdr_env env) }
 
+getImports :: TcRn m ImportAvails
+getImports = do { env <- getGblEnv; return (tcg_imports env) }
+
 getFixityEnv :: TcRn m FixityEnv
 getFixityEnv = do { env <- getGblEnv; return (tcg_fix_env env) }
 
@@ -296,13 +298,13 @@ getDefaultTys = do { env <- getGblEnv; return (tcg_default env) }
 \end{code}
 
 \begin{code}
-getUsageVar :: TcRn m (TcRef Usages)
+getUsageVar :: TcRn m (TcRef EntityUsage)
 getUsageVar = do { env <- getGblEnv; return (tcg_usages env) }
 
-getUsages :: TcRn m Usages
+getUsages :: TcRn m EntityUsage
 getUsages = do { usg_var <- getUsageVar; readMutVar usg_var }
 
-updUsages :: (Usages -> Usages) -> TcRn m () 
+updUsages :: (EntityUsage -> EntityUsage) -> TcRn m () 
 updUsages upd = do { usg_var <- getUsageVar ;
 		     usg <- readMutVar usg_var ;
 		     writeMutVar usg_var (upd usg) }
@@ -398,11 +400,13 @@ tryTc m
 
 	new_errs <- readMutVar errs_var ;
 
+	dflags <- getDOpts ;
+
 	return (new_errs, 
 		case mb_r of
-		  Left exn  			 -> Nothing
-		  Right r | errorsFound new_errs -> Nothing
-			  | otherwise		 -> Just r) 
+		  Left exn  			 	-> Nothing
+		  Right r | errorsFound dflags new_errs -> Nothing
+			  | otherwise		        -> Just r) 
    }
 
 tryTcLIE :: TcM a -> TcM (Messages, Maybe a)
@@ -446,7 +450,8 @@ ifErrsM :: TcRn m r -> TcRn m r -> TcRn m r
 ifErrsM bale_out normal
  = do { errs_var <- getErrsVar ;
 	msgs <- readMutVar errs_var ;
-	if errorsFound msgs then
+	dflags <- getDOpts ;
+	if errorsFound dflags msgs then
 	   bale_out
 	else	
 	   normal }