Commit 71e037d1 authored by Simon Marlow's avatar Simon Marlow

Tidy types of free vars at a breakpoint

Also share the code that extends the InteractiveContext between
tcRnStmt and GHC.extendEnvironment.
parent ea033094
......@@ -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
......
......@@ -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}
%************************************************************************
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment