Commit a62c4375 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Add some ASSERTs to calls of zipTopTvSubst

parent aad93f5c
......@@ -911,7 +911,7 @@ classDataCon clas = case tyConDataCons (classTyCon clas) of
dataConCannotMatch :: [Type] -> DataCon -> Bool
-- Returns True iff the data con *definitely cannot* match a
-- scrutinee of type (T tys)
-- where T is the type constructor for the data con
-- where T is the dcRepTyCon for the data con
-- NB: look at *all* equality constraints, not only those
-- in dataConEqSpec; see Trac #5168
dataConCannotMatch tys con
......@@ -923,7 +923,8 @@ dataConCannotMatch tys con
where
dc_tvs = dataConUnivTyVars con
theta = dataConTheta con
subst = zipTopTvSubst dc_tvs tys
subst = ASSERT2( length dc_tvs == length tys, ppr con $$ ppr dc_tvs $$ ppr tys )
zipTopTvSubst dc_tvs tys
-- TODO: could gather equalities from superclasses too
predEqs pred = case classifyPredType pred of
......
......@@ -398,7 +398,9 @@ lookupFamInstEnvConflicts envs fam_inst skol_tvs
inst_axiom = famInstAxiom fam_inst
(fam, tys) = famInstLHS fam_inst
skol_tys = mkTyVarTys skol_tvs
tys1 = substTys (zipTopTvSubst (coAxiomTyVars inst_axiom) skol_tys) tys
ax_tvs = coAxiomTyVars inst_axiom
tys1 = ASSERT2( length ax_tvs == length skol_tys, ppr inst_axiom $$ ppr skol_tys )
substTys (zipTopTvSubst ax_tvs skol_tys) tys
-- In example above, fam tys' = F [b]
my_unify old_fam_inst tpl_tvs tpl_tys match_tys
......
......@@ -1034,7 +1034,9 @@ mkFamilyTyConApp :: TyCon -> [Type] -> Type
-- > mkFamilyTyConApp :RTL Int = T (Maybe Int)
mkFamilyTyConApp tc tys
| Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc
, let fam_subst = zipTopTvSubst (tyConTyVars tc) tys
, let tvs = tyConTyVars tc
fam_subst = ASSERT2( length tvs == length tys, ppr tc <+> ppr tys )
zipTopTvSubst tvs tys
= mkTyConApp fam_tc (substTys fam_subst fam_tys)
| otherwise
= mkTyConApp tc tys
......@@ -1615,13 +1617,11 @@ typeKind _ty@(FunTy _arg res)
where
k = typeKind res
typeLiteralKind :: TyLit -> Kind
typeLiteralKind l =
case l of
NumTyLit _ -> typeNatKind
StrTyLit _ -> typeStringKind
\end{code}
Kind inference
......
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