diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-12 00:04:30 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2016-06-13 10:57:22 +0100 |
| commit | 15fc52819c440f9e9b91ce92fcfda3c264cbe1c1 (patch) | |
| tree | 55257a89174913b80ea963d7faa89ab9a08b470d | |
| parent | 1f661281a23b6eab83a1144c43e464c0e2d2195a (diff) | |
| download | haskell-15fc52819c440f9e9b91ce92fcfda3c264cbe1c1.tar.gz | |
Fix the in-scope set for extendTvSubstWithClone
We'd forgotten the variables free in the kind.
Ditto extendCvSubstWithClone
| -rw-r--r-- | compiler/typecheck/TcType.hs | 3 | ||||
| -rw-r--r-- | compiler/types/TyCoRep.hs | 8 |
2 files changed, 9 insertions, 2 deletions
diff --git a/compiler/typecheck/TcType.hs b/compiler/typecheck/TcType.hs index 5a453dd9c5..d6cd5b21ad 100644 --- a/compiler/typecheck/TcType.hs +++ b/compiler/typecheck/TcType.hs @@ -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 diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs index 70d8bba9ee..7df02b63df 100644 --- a/compiler/types/TyCoRep.hs +++ b/compiler/types/TyCoRep.hs @@ -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 |