Tidy types of free vars at a breakpoint

Also share the code that extends the InteractiveContext between
tcRnStmt and GHC.extendEnvironment.

diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index c5e6fa0..a8c435a 100644 (file)
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -2337,29 +2337,26 @@ extendEnvironment hsc_env apStack span idsOffsets result_ty occs = do
                           (mkVarOccFS result_fs) (srcSpanStart span)
        result_id   = Id.mkLocalId result_name result_ty
 
+   -- for each Id we're about to bind in the local envt:
+   --    - skolemise the type variables in its type, so they can't
+   --      be randomly unified with other types.  These type variables
+   --      can only be resolved by type reconstruction in RtClosureInspect
+   --    - tidy the type variables
+   --    - globalise the Id (Ids are supposed to be Global, apparently).
+   --
    let all_ids = result_id : ids
        (id_tys, tyvarss) = mapAndUnzip (skolemiseTy.idType) all_ids
+       (_,tidy_tys) = tidyOpenTypes emptyTidyEnv id_tys
        new_tyvars = unionVarSets tyvarss             
-       new_ids = zipWith setIdType all_ids id_tys
-
-   let ictxt = hsc_IC hsc_env
-       type_env = ic_type_env ictxt
-       bound_names = map idName new_ids
-       -- Remove any shadowed bindings from the type_env;
-       -- they are inaccessible but might, I suppose, cause 
-       -- a space leak if we leave them there
-       old_bound_names = map idName (typeEnvIds (ic_type_env ictxt)) ;
-       shadowed = [ n | name <- bound_names,
-                         n <- old_bound_names,
-                         nameOccName name == nameOccName n ] ;
-       filtered_type_env = delListFromNameEnv type_env shadowed
-       new_type_env = extendTypeEnvWithIds filtered_type_env new_ids
-       old_tyvars = ic_tyvars ictxt
-       new_ic = ictxt { ic_type_env = new_type_env,
-                        ic_tyvars = old_tyvars `unionVarSet` new_tyvars }
+       new_ids = zipWith setIdType all_ids tidy_tys
+       global_ids = map (globaliseId VanillaGlobal) new_ids
+
+   let ictxt = extendInteractiveContext (hsc_IC hsc_env) 
+                                        global_ids new_tyvars
+
    Linker.extendLinkEnv (zip names hValues)
    Linker.extendLinkEnv [(result_name, unsafeCoerce# apStack)]
-   return (hsc_env{hsc_IC = new_ic}, result_name:names)
+   return (hsc_env{hsc_IC = ictxt}, result_name:names)
   where
    mkNewId :: OccName -> Id -> IO Id
    mkNewId occ id = do

diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs
index 04f2b7c..78dd841 100644 (file)
--- 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,
@@ -86,7 +86,7 @@ import FamInstEnv     ( FamInstEnv, FamInst )
 import Rules           ( RuleBase )
 import CoreSyn         ( CoreBind )
 import VarSet
-import Id              ( Id, isImplicitId )
+import Id
 import Type            ( TyThing(..) )
 
 import Class           ( Class, classSelIds, classATs, classTyCon )
@@ -639,6 +639,27 @@ emptyInteractiveContext
 
 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}
 
 %************************************************************************

diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index 08ea437..07a48ae 100644 (file)
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -62,6 +62,7 @@ import CoreSyn
 import ErrUtils
 import Id
 import Var
+import VarSet
 import Module
 import UniqFM
 import Name
@@ -884,9 +885,6 @@ tcRnStmt hsc_env ictxt rdr_stmt
                --     up to have tidy types
        global_ids = map globaliseAndTidy zonked_ids ;
     
-               -- Update the interactive context
-       type_env = ic_type_env ictxt ;
-
        bound_names = map idName global_ids ;
 
 {- ---------------------------------------------
@@ -908,15 +906,7 @@ tcRnStmt hsc_env ictxt rdr_stmt
 
 -------------------------------------------------- -}
 
-        old_bound_names = map idName (typeEnvIds (ic_type_env ictxt)) ;
-       shadowed = [ n | name <- bound_names,
-                         n <- old_bound_names,
-                         nameOccName name == nameOccName n ] ;
-
-       filtered_type_env = delListFromNameEnv type_env shadowed ;
-
-       new_type_env = extendTypeEnvWithIds filtered_type_env global_ids ;
-       new_ic = ictxt { ic_type_env = new_type_env }
+       new_ic = extendInteractiveContext ictxt global_ids emptyVarSet ;
     } ;
 
     dumpOptTcRn Opt_D_dump_tc