diff options
| -rw-r--r-- | compiler/main/HscTypes.hs | 5 | ||||
| -rw-r--r-- | compiler/typecheck/TcHsSyn.hs | 11 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 4 |
3 files changed, 14 insertions, 6 deletions
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index 99c51cd328..d297a83898 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -87,7 +87,7 @@ module HscTypes ( TypeEnv, lookupType, lookupTypeHscEnv, mkTypeEnv, emptyTypeEnv, typeEnvFromEntities, mkTypeEnvWithImplicits, extendTypeEnv, extendTypeEnvList, - extendTypeEnvWithIds, + extendTypeEnvWithIds, plusTypeEnv, lookupTypeEnv, typeEnvElts, typeEnvTyCons, typeEnvIds, typeEnvPatSyns, typeEnvDataCons, typeEnvCoAxioms, typeEnvClasses, @@ -1941,6 +1941,9 @@ extendTypeEnvWithIds :: TypeEnv -> [Id] -> TypeEnv extendTypeEnvWithIds env ids = extendNameEnvList env [(getName id, AnId id) | id <- ids] +plusTypeEnv :: TypeEnv -> TypeEnv -> TypeEnv +plusTypeEnv env1 env2 = plusNameEnv env1 env2 + -- | Find the 'TyThing' for the given 'Name' by using all the resources -- at our disposal: the compiled modules in the 'HomePackageTable' and the -- compiled modules in other packages that live in 'PackageTypeEnv'. Note diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index a50cb4d306..ad75033932 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -53,7 +53,9 @@ import TyCon import Coercion import ConLike import DataCon +import HscTypes import Name +import NameEnv import Var import VarSet import VarEnv @@ -256,8 +258,11 @@ setZonkType :: ZonkEnv -> UnboundTyVarZonker -> ZonkEnv setZonkType (ZonkEnv _ ty_env id_env) zonk_ty = ZonkEnv zonk_ty ty_env id_env -zonkEnvIds :: ZonkEnv -> [Id] -zonkEnvIds (ZonkEnv _ _ id_env) = varEnvElts id_env +zonkEnvIds :: ZonkEnv -> TypeEnv +zonkEnvIds (ZonkEnv _ _ id_env) = + mkNameEnv [(getName id, AnId id) | id <- nonDetEltsUFM id_env] + -- It's OK to use nonDetEltsUFM here because we forget the ordering + -- immediately by creating a TypeEnv zonkIdOcc :: ZonkEnv -> TcId -> Id -- Ids defined in this module should be in the envt; @@ -357,7 +362,7 @@ zonkTopLExpr e = zonkLExpr emptyZonkEnv e zonkTopDecls :: Bag EvBind -> LHsBinds TcId -> [LRuleDecl TcId] -> [LVectDecl TcId] -> [LTcSpecPrag] -> [LForeignDecl TcId] - -> TcM ([Id], + -> TcM (TypeEnv, Bag EvBind, LHsBinds Id, [LForeignDecl Id], diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 48b055b85a..c551356ad3 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -521,13 +521,13 @@ tcRnSrcDecls explicit_mod_hdr decls tcg_fords = fords } = tcg_env ; all_ev_binds = cur_ev_binds `unionBags` new_ev_binds } ; - ; (bind_ids, ev_binds', binds', fords', imp_specs', rules', vects') + ; (bind_env, ev_binds', binds', fords', imp_specs', rules', vects') <- {-# SCC "zonkTopDecls" #-} zonkTopDecls all_ev_binds binds rules vects imp_specs fords ; ; traceTc "Tc11" empty - ; let { final_type_env = extendTypeEnvWithIds type_env bind_ids + ; let { final_type_env = plusTypeEnv type_env bind_env ; tcg_env' = tcg_env { tcg_binds = binds', tcg_ev_binds = ev_binds', tcg_imp_specs = imp_specs', |