summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2019-03-07 17:19:45 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2019-03-11 18:18:06 -0400
commit60b03adea8cc55ff65fbf6458487c3baf12bb0a1 (patch)
treeec2167a91851cf81b3e65f1fe72fd19df139dd0a
parentbcb6769c83744c211d3ddddbc7fd9dec88452c88 (diff)
downloadhaskell-60b03adea8cc55ff65fbf6458487c3baf12bb0a1.tar.gz
Change the warning in substTy back to an assertion
We'd like to enforce the substitution invariant (Trac #11371). In a492af06d326453 the assertion was downgraded to a warning; I'm restoring the assertion and making the calls that don't maintain the invariant as unchecked.
-rw-r--r--compiler/coreSyn/CoreArity.hs2
-rw-r--r--compiler/typecheck/TcGenGenerics.hs2
-rw-r--r--compiler/typecheck/TcSigs.hs2
-rw-r--r--compiler/types/TyCoRep.hs5
4 files changed, 5 insertions, 6 deletions
diff --git a/compiler/coreSyn/CoreArity.hs b/compiler/coreSyn/CoreArity.hs
index 37454ebee0..afd6759571 100644
--- a/compiler/coreSyn/CoreArity.hs
+++ b/compiler/coreSyn/CoreArity.hs
@@ -1153,7 +1153,7 @@ freshEtaId :: Int -> TCvSubst -> Type -> (TCvSubst, Id)
freshEtaId n subst ty
= (subst', eta_id')
where
- ty' = Type.substTy subst ty
+ ty' = Type.substTyUnchecked subst ty
eta_id' = uniqAway (getTCvInScope subst) $
mkSysLocalOrCoVar (fsLit "eta") (mkBuiltinUnique n) ty'
subst' = extendTCvInScope subst eta_id'
diff --git a/compiler/typecheck/TcGenGenerics.hs b/compiler/typecheck/TcGenGenerics.hs
index abc7d59a55..123cfd3535 100644
--- a/compiler/typecheck/TcGenGenerics.hs
+++ b/compiler/typecheck/TcGenGenerics.hs
@@ -431,7 +431,7 @@ tc_mkRepFamInsts gk tycon inst_tys =
env = zipTyEnv env_tyvars env_inst_args
in_scope = mkInScopeSet (tyCoVarsOfTypes inst_tys)
subst = mkTvSubst in_scope env
- repTy' = substTy subst repTy
+ repTy' = substTyUnchecked subst repTy
tcv' = tyCoVarsOfTypeList inst_ty
(tv', cv') = partition isTyVar tcv'
tvs' = scopedSort tv'
diff --git a/compiler/typecheck/TcSigs.hs b/compiler/typecheck/TcSigs.hs
index 9146b10fe2..7b00165c52 100644
--- a/compiler/typecheck/TcSigs.hs
+++ b/compiler/typecheck/TcSigs.hs
@@ -505,7 +505,7 @@ tcInstSig hs_sig@(PartialSig { psig_hs_ty = hs_ty
, sig_inst_wcs = wcs
, sig_inst_wcx = wcx
, sig_inst_theta = substTys subst theta
- , sig_inst_tau = substTy subst tau }
+ , sig_inst_tau = substTyUnchecked subst tau }
; traceTc "End partial sig }" (ppr inst_sig)
; return inst_sig }
diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index 9ccfaae31d..27fde88613 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -3196,8 +3196,7 @@ isValidTCvSubst (TCvSubst in_scope tenv cenv) =
-- Note [The substitution invariant].
checkValidSubst :: HasCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a
checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a
--- TODO (RAE): Change back to ASSERT
- = WARN( not (isValidTCvSubst subst),
+ = ASSERT2( isValidTCvSubst subst,
text "in_scope" <+> ppr in_scope $$
text "tenv" <+> ppr tenv $$
text "tenvFVs" <+> ppr (tyCoVarsOfTypesSet tenv) $$
@@ -3205,7 +3204,7 @@ checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a
text "cenvFVs" <+> ppr (tyCoVarsOfCosSet cenv) $$
text "tys" <+> ppr tys $$
text "cos" <+> ppr cos )
- WARN( not tysCosFVsInScope,
+ ASSERT2( tysCosFVsInScope,
text "in_scope" <+> ppr in_scope $$
text "tenv" <+> ppr tenv $$
text "cenv" <+> ppr cenv $$