Commit 18b782e3 authored by niteria's avatar niteria

Kill varEnvElts in zonkEnvIds

This localizes the nondeterminism that varEnvElts could
have introduced, so that it's obvious that it's benign.

Test Plan: ./validate

Reviewers: simonpj, austin, bgamari

Subscribers: thomie, simonmar

Differential Revision: https://phabricator.haskell.org/D2390

GHC Trac Issues: #4012
parent 27fc75b2
......@@ -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
......
......@@ -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],
......
......@@ -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',
......
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