Commit 15fc5281 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix the in-scope set for extendTvSubstWithClone

We'd forgotten the variables free in the kind.

Ditto extendCvSubstWithClone
parent 1f661281
......@@ -1190,6 +1190,9 @@ mkNakedCastTy :: Type -> Coercion -> Type
-- for which it's plain stupid to create a cast
-- This simple function killed off a huge number of Refl casts
-- in types, at birth.
-- Note that it's fine to do this even for a "mkNaked" function,
-- because we don't look at TyCons. isReflCo checks if the coercion
-- is structurally Refl; it does not check for shape k ~ k.
mkNakedCastTy ty co | isReflCo co = ty
mkNakedCastTy (CastTy ty co1) co2 = CastTy ty (co1 `mkTransCo` co2)
mkNakedCastTy ty co = CastTy ty co
......
......@@ -1829,9 +1829,11 @@ extendTvSubst (TCvSubst in_scope tenv cenv) tv ty
extendTvSubstWithClone :: TCvSubst -> TyVar -> TyVar -> TCvSubst
-- Adds a new tv -> tv mapping, /and/ extends the in-scope set
extendTvSubstWithClone (TCvSubst in_scope tenv cenv) tv tv'
= TCvSubst (extendInScopeSet in_scope tv')
= TCvSubst (extendInScopeSetSet in_scope new_in_scope)
(extendVarEnv tenv tv (mkTyVarTy tv'))
cenv
where
new_in_scope = tyCoVarsOfType (tyVarKind tv') `extendVarSet` tv'
extendCvSubst :: TCvSubst -> CoVar -> Coercion -> TCvSubst
extendCvSubst (TCvSubst in_scope tenv cenv) v co
......@@ -1839,9 +1841,11 @@ extendCvSubst (TCvSubst in_scope tenv cenv) v co
extendCvSubstWithClone :: TCvSubst -> CoVar -> CoVar -> TCvSubst
extendCvSubstWithClone (TCvSubst in_scope tenv cenv) cv cv'
= TCvSubst (extendInScopeSet in_scope cv')
= TCvSubst (extendInScopeSetSet in_scope new_in_scope)
tenv
(extendVarEnv cenv cv (mkCoVarCo cv'))
where
new_in_scope = tyCoVarsOfType (varType cv') `extendVarSet` cv'
extendTvSubstAndInScope :: TCvSubst -> TyVar -> Type -> TCvSubst
-- Also extends the in-scope set
......
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