diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2019-06-05 08:23:03 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-06-19 22:15:39 -0400 |
| commit | 3c9b57b07fa1d4a5fa69fb77ee8e49f7a0b6ada9 (patch) | |
| tree | 3adb66ec896f60813a6788a9b72373f01fbeb250 | |
| parent | 39c758e1426c9e5b00de2207ad53bb4377c1e6a6 (diff) | |
| download | haskell-3c9b57b07fa1d4a5fa69fb77ee8e49f7a0b6ada9.tar.gz | |
Fix two places that failed the substitution invariant
The substition invariant relies on keeping the in-scope
set in sync, and we weren't always doing so, which means that
a DEBUG compiler crashes sometimes with an assertion failure
This patch fixes a couple more cases. Still not validate
clean (with -DEEBUG) but closer!
| -rw-r--r-- | compiler/typecheck/Inst.hs | 9 | ||||
| -rw-r--r-- | compiler/typecheck/TcCanonical.hs | 2 |
2 files changed, 5 insertions, 6 deletions
diff --git a/compiler/typecheck/Inst.hs b/compiler/typecheck/Inst.hs index daadf57313..28794aaafa 100644 --- a/compiler/typecheck/Inst.hs +++ b/compiler/typecheck/Inst.hs @@ -297,24 +297,23 @@ instTyVarsWith :: CtOrigin -> [TyVar] -> [TcType] -> TcM TCvSubst -- If they don't match, emit a kind-equality to promise that they will -- eventually do so, and thus make a kind-homongeneous substitution. instTyVarsWith orig tvs tys - = go empty_subst tvs tys + = go emptyTCvSubst tvs tys where - empty_subst = mkEmptyTCvSubst (mkInScopeSet (tyCoVarsOfTypes tys)) - go subst [] [] = return subst go subst (tv:tvs) (ty:tys) | tv_kind `tcEqType` ty_kind - = go (extendTCvSubst subst tv ty) tvs tys + = go (extendTvSubstAndInScope subst tv ty) tvs tys | otherwise = do { co <- emitWantedEq orig KindLevel Nominal ty_kind tv_kind - ; go (extendTCvSubst subst tv (ty `mkCastTy` co)) tvs tys } + ; go (extendTvSubstAndInScope subst tv (ty `mkCastTy` co)) tvs tys } where tv_kind = substTy subst (tyVarKind tv) ty_kind = tcTypeKind ty go _ _ _ = pprPanic "instTysWith" (ppr tvs $$ ppr tys) + {- ************************************************************************ * * diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index e0c87e0f70..c296a9eee3 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -1007,7 +1007,7 @@ can_eq_nc_forall ev eq_rel s1 s2 = do { let tv2 = binderVar bndr2 ; (kind_co, wanteds1) <- unify loc Nominal (tyVarKind skol_tv) (substTy subst (tyVarKind tv2)) - ; let subst' = extendTvSubst subst tv2 + ; let subst' = extendTvSubstAndInScope subst tv2 (mkCastTy (mkTyVarTy skol_tv) kind_co) ; (co, wanteds2) <- go skol_tvs subst' bndrs2 ; return ( mkTcForAllCo skol_tv kind_co co |