X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcRnDriver.lhs;h=6c55a6232fde3e1be64185eed529201fd938c742;hb=c7addbef67840954ad788434c28b0a3476ee0ad7;hp=05777df471c803f65bcb8f33511edd9e1ec01eb8;hpb=c94fac1c94f35f344edd6818db13a3fc021674b5;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 05777df..6c55a62 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -62,7 +62,6 @@ import CoreSyn
 import ErrUtils
 import Id
 import Var
-import VarSet
 import Module
 import UniqFM
 import Name
@@ -211,7 +210,8 @@ tcRnImports hsc_env this_mod import_decls
 	      ; want_instances :: ModuleName -> Bool
 	      ; want_instances mod = mod `elemUFM` dep_mods
 				   && mod /= moduleName this_mod
-	      ; home_insts = hptInstances hsc_env want_instances
+	      ; (home_insts, home_fam_insts) = hptInstances hsc_env 
+                                                            want_instances
 	      } ;
 
 		-- Record boot-file info in the EPS, so that it's 
@@ -221,11 +221,14 @@ tcRnImports hsc_env this_mod import_decls
 
 		-- Update the gbl env
 	; updGblEnv ( \ gbl -> 
-		gbl { tcg_rdr_env    = plusOccEnv (tcg_rdr_env gbl) rdr_env,
-		      tcg_imports    = tcg_imports gbl `plusImportAvails` imports,
-                      tcg_rn_imports = fmap (const rn_imports) (tcg_rn_imports gbl),
-		      tcg_inst_env   = extendInstEnvList (tcg_inst_env gbl) home_insts
-		}) $ do {
+	    gbl { 
+              tcg_rdr_env      = plusOccEnv (tcg_rdr_env gbl) rdr_env,
+	      tcg_imports      = tcg_imports gbl `plusImportAvails` imports,
+              tcg_rn_imports   = fmap (const rn_imports) (tcg_rn_imports gbl),
+	      tcg_inst_env     = extendInstEnvList (tcg_inst_env gbl) home_insts,
+	      tcg_fam_inst_env = extendFamInstEnvList (tcg_fam_inst_env gbl) 
+                                                      home_fam_insts
+	    }) $ do {
 
 	; traceRn (text "rn1" <+> ppr (imp_dep_mods imports))
 		-- Fail if there are any errors so far
@@ -321,7 +324,8 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds)
 				mg_deprecs   = NoDeprecs,
 				mg_foreign   = NoStubs,
 				mg_hpc_info  = noHpcInfo,
-                                mg_modBreaks = emptyModBreaks  
+                                mg_modBreaks = emptyModBreaks,
+                                mg_vect_info = noVectInfo
 		    } } ;
 
    tcCoreDump mod_guts ;
@@ -826,14 +830,14 @@ setInteractiveContext hsc_env icxt thing_inside
 	-- Initialise the tcg_inst_env with instances 
 	-- from all home modules.  This mimics the more selective
 	-- call to hptInstances in tcRnModule
-	dfuns = hptInstances hsc_env (\mod -> True)
+	dfuns = fst (hptInstances hsc_env (\mod -> True))
     in
     updGblEnv (\env -> env { 
 	tcg_rdr_env  = ic_rn_gbl_env icxt,
 	tcg_inst_env = extendInstEnvList (tcg_inst_env env) dfuns }) $
 
 
-    tcExtendIdEnv (typeEnvIds (ic_type_env icxt)) $
+    tcExtendIdEnv (ic_tmp_ids icxt) $
         -- tcExtendIdEnv does lots: 
         --   - it extends the local type env (tcl_env) with the given Ids,
         --   - it extends the local rdr env (tcl_rdr) with the Names from 
@@ -841,11 +845,10 @@ setInteractiveContext hsc_env icxt thing_inside
         --   - it adds the free tyvars of the Ids to the tcl_tyvars
         --     set.
         --
-        -- We should have no Ids with the same name in the
-        -- ic_type_env, otherwise we'll end up with shadowing in the
-        -- tcl_rdr, and it's random which one will be in scope.
+        -- later ids in ic_tmp_ids must shadow earlier ones with the same
+        -- OccName, and tcExtendIdEnv implements this behaviour.
 
-    do	{ traceTc (text "setIC" <+> ppr (ic_type_env icxt))
+    do	{ traceTc (text "setIC" <+> ppr (ic_tmp_ids icxt))
  	; thing_inside }
 \end{code}
 
@@ -854,9 +857,10 @@ setInteractiveContext hsc_env icxt thing_inside
 tcRnStmt :: HscEnv
 	 -> InteractiveContext
 	 -> LStmt RdrName
-	 -> IO (Maybe (InteractiveContext, [Name], LHsExpr Id))
-		-- The returned [Name] is the same as the input except for
-		-- ExprStmt, in which case the returned [Name] is [itName]
+	 -> IO (Maybe ([Id], LHsExpr Id))
+		-- The returned [Id] is the list of new Ids bound by
+                -- this statement.  It can be used to extend the
+                -- InteractiveContext via extendInteractiveContext.
 		--
 		-- The returned TypecheckedHsExpr is of type IO [ () ],
 		-- a list of the bound values, coerced to ().
@@ -891,8 +895,6 @@ tcRnStmt hsc_env ictxt rdr_stmt
 		--     up to have tidy types
 	global_ids = map globaliseAndTidy zonked_ids ;
     
-	bound_names = map idName global_ids ;
-
 {- ---------------------------------------------
    At one stage I removed any shadowed bindings from the type_env;
    they are inaccessible but might, I suppose, cause a space leak if we leave them there.
@@ -911,15 +913,13 @@ tcRnStmt hsc_env ictxt rdr_stmt
    Hence this code is commented out
 
 -------------------------------------------------- -}
-
-	new_ic = extendInteractiveContext ictxt global_ids emptyVarSet ;
     } ;
 
     dumpOptTcRn Opt_D_dump_tc 
     	(vcat [text "Bound Ids" <+> pprWithCommas ppr global_ids,
     	       text "Typechecked expr" <+> ppr zonked_expr]) ;
 
-    returnM (new_ic, bound_names, zonked_expr)
+    returnM (global_ids, zonked_expr)
     }
   where
     bad_unboxed id = addErr (sep [ptext SLIT("GHCi can't bind a variable of unlifted type:"),