X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=eabd3bc7ee48b276be379c3e19d5163fe6378c69;hp=a93133dad24e1c0418b5ba9d5ac1f91999d65931;hb=7aa3f5247ae454b10b61e2f28a9431f0889a8cff;hpb=2c92736ea5a4aedf263a77d58c6e9b032a05b7ef

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index a93133d..eabd3bc 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -70,6 +70,7 @@ import TyCon
 import SrcLoc
 import HscTypes
 import Outputable
+import Breakpoints
 
 #ifdef GHCI
 import Linker
@@ -301,6 +302,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 				mg_types     = final_type_env,
 				mg_insts     = tcg_insts tcg_env,
 				mg_fam_insts = tcg_fam_insts tcg_env,
+				mg_fam_inst_env = tcg_fam_inst_env tcg_env,
 				mg_rules     = [],
 				mg_binds     = core_binds,
 
@@ -309,7 +311,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 				mg_fix_env   = emptyFixityEnv,
 				mg_deprecs   = NoDeprecs,
 				mg_foreign   = NoStubs,
-				mg_hpc_info  = noHpcInfo
+				mg_hpc_info  = noHpcInfo,
+                                mg_dbg_sites = noDbgSites
 		    } } ;
 
    tcCoreDump mod_guts ;
@@ -394,15 +397,16 @@ tc_rn_src_decls boot_details ds
 
 	-- Deal with decls up to, but not including, the first splice
 	(tcg_env, rn_decls) <- checkNoErrs $ rnTopSrcDecls first_group ;
-		-- checkNoErrs: don't typecheck if renaming failed
-	tc_envs <- setGblEnv tcg_env $ 
-		   tcTopSrcDecls boot_details rn_decls ;
+		-- checkNoErrs: stop if renaming fails
+
+	(tcg_env, tcl_env) <- setGblEnv tcg_env $ 
+			      tcTopSrcDecls boot_details rn_decls ;
 
 	-- If there is no splice, we're nearly done
-	setEnvs tc_envs $ 
+	setEnvs (tcg_env, tcl_env) $ 
 	case group_tail of {
 	   Nothing -> do { tcg_env <- checkMain ;	-- Check for `main'
-			   return (tcg_env, snd tc_envs) 
+			   return (tcg_env, tcl_env) 
 		      } ;
 
 	-- If there's a splice, we must carry on
@@ -1090,19 +1094,32 @@ tcRnType hsc_env ictxt rdr_type
 -- could not be found.
 getModuleExports :: HscEnv -> Module -> IO (Messages, Maybe [AvailInfo])
 getModuleExports hsc_env mod
-  = initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod)
-
-tcGetModuleExports :: Module -> TcM [AvailInfo]
-tcGetModuleExports mod = do
-  let doc = ptext SLIT("context for compiling statements")
-  iface <- initIfaceTcRn $ loadSysInterface doc mod
-  loadOrphanModules (dep_orphs (mi_deps iface)) False 
-  		-- Load any orphan-module interfaces,
-  		-- so their instances are visible
-  loadOrphanModules (dep_finsts (mi_deps iface)) True
-  		-- Load any family instance-module interfaces,
-  		-- so all family instances are visible
-  ifaceExportNames (mi_exports iface)
+  = let
+      ic        = hsc_IC hsc_env
+      checkMods = ic_toplev_scope ic ++ ic_exports ic
+    in
+    initTc hsc_env HsSrcFile iNTERACTIVE (tcGetModuleExports mod checkMods)
+
+-- Get the export avail info and also load all orphan and family-instance
+-- modules.  Finally, check that the family instances of all modules in the
+-- interactive context are consistent (these modules are in the second
+-- argument).
+tcGetModuleExports :: Module -> [Module] -> TcM [AvailInfo]
+tcGetModuleExports mod directlyImpMods
+  = do { let doc = ptext SLIT("context for compiling statements")
+       ; iface <- initIfaceTcRn $ loadSysInterface doc mod
+
+  		-- Load any orphan-module and family instance-module
+  		-- interfaces, so their instances are visible.
+       ; loadOrphanModules (dep_orphs (mi_deps iface)) False 
+       ; loadOrphanModules (dep_finsts (mi_deps iface)) True
+
+                -- Check that the family instances of all directly loaded
+                -- modules are consistent.
+       ; checkFamInstConsistency (dep_finsts (mi_deps iface)) directlyImpMods
+
+       ; ifaceExportNames (mi_exports iface)
+       }
 
 tcRnLookupRdrName :: HscEnv -> RdrName -> IO (Maybe [Name])
 tcRnLookupRdrName hsc_env rdr_name