X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FHscTypes.lhs;h=78dd841b1232c63cc29ee4068290e127ff50e899;hb=71e037d119b8e7d05884cc149ac851243ee62bd4;hp=99495fe4d6d75e3a61b39f3b84ec23b77a0bda57;hpb=367b0590cc0d8ba3d1561c85b366a183b8a71d24;p=ghc-hetmet.git

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 99495fe..78dd841 100644
--- a/compiler/main/HscTypes.lhs
+++ b/compiler/main/HscTypes.lhs
@@ -27,7 +27,7 @@ module HscTypes (
 	lookupIfaceByModule, emptyModIface,
 
 	InteractiveContext(..), emptyInteractiveContext, 
-	icPrintUnqual, mkPrintUnqualified,
+	icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
 
 	ModIface(..), mkIfaceDepCache, mkIfaceVerCache, mkIfaceFixCache,
 	emptyIfaceDepCache,
@@ -85,7 +85,8 @@ import InstEnv		( InstEnv, Instance )
 import FamInstEnv	( FamInstEnv, FamInst )
 import Rules		( RuleBase )
 import CoreSyn		( CoreBind )
-import Id		( Id, isImplicitId )
+import VarSet
+import Id
 import Type		( TyThing(..) )
 
 import Class		( Class, classSelIds, classATs, classTyCon )
@@ -614,21 +615,51 @@ data InteractiveContext
 	ic_rn_gbl_env :: GlobalRdrEnv,	-- The cached GlobalRdrEnv, built from
 					-- ic_toplev_scope and ic_exports
 
-	ic_rn_local_env :: LocalRdrEnv,	-- Lexical context for variables bound
-					-- during interaction
-
-	ic_type_env :: TypeEnv		-- Ditto for types
+	ic_type_env :: TypeEnv,         -- Type env for names bound during
+                                        -- interaction.  NB. the names from
+                                        -- these Ids are used to populate
+                                        -- the LocalRdrEnv used during
+                                        -- typechecking of a statement, so
+                                        -- there should be no duplicate
+                                        -- names in here.
+
+        ic_tyvars :: TyVarSet           -- skolem type variables free in
+                                        -- ic_type_env.  These arise at
+                                        -- breakpoints in a polymorphic 
+                                        -- context, where we have only partial
+                                        -- type information.
     }
 
 emptyInteractiveContext
   = InteractiveContext { ic_toplev_scope = [],
 			 ic_exports = [],
 			 ic_rn_gbl_env = emptyGlobalRdrEnv,
-			 ic_rn_local_env = emptyLocalRdrEnv,
-			 ic_type_env = emptyTypeEnv }
+			 ic_type_env = emptyTypeEnv,
+                         ic_tyvars = emptyVarSet }
 
 icPrintUnqual :: InteractiveContext -> PrintUnqualified
 icPrintUnqual ictxt = mkPrintUnqualified (ic_rn_gbl_env ictxt)
+
+
+extendInteractiveContext
+        :: InteractiveContext
+        -> [Id]
+        -> TyVarSet
+        -> InteractiveContext
+extendInteractiveContext ictxt ids tyvars
+  = ictxt { ic_type_env = extendTypeEnvWithIds filtered_type_env ids,
+            ic_tyvars   = ic_tyvars ictxt `unionVarSet` tyvars }
+  where
+       type_env    = ic_type_env ictxt
+       bound_names = map idName ids
+       -- Remove any shadowed bindings from the type_env;
+       -- we aren't allowed any duplicates because the LocalRdrEnv is
+       -- build directly from the Ids in the type env in here.
+       old_bound_names = map idName (typeEnvIds type_env)
+       shadowed = [ n | name <- bound_names,
+                         n <- old_bound_names,
+                         nameOccName name == nameOccName n ]
+       filtered_type_env = delListFromNameEnv type_env shadowed
 \end{code}
 
 %************************************************************************