From d0ecba6d98c5fae1df8b63632557a44a09c559f8 Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Thu, 30 May 2013 22:03:24 +0100 Subject: [PATCH] Fix a trailing case in making FamInstTyCon, where the invariant didn't hold, leading to subsequent chaos. Happily an ASSERT caught it. --- compiler/iface/TcIface.lhs | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 89d9807a3759..4c7435a554e9 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -461,15 +461,22 @@ tc_iface_decl parent _ (IfaceData {ifName = occ_name, ; let fam_tc = coAxiomTyCon ax ax_unbr = toUnbranchedAxiom ax -- data families don't have branches: - branch = coAxiomSingleBranch ax_unbr - ax_tvs = coAxBranchTyVars branch - ax_lhs = coAxBranchLHS branch - subst = zipTopTvSubst ax_tvs (mkTyVarTys tyvars) + branch = coAxiomSingleBranch ax_unbr + ax_tvs = coAxBranchTyVars branch + ax_lhs = coAxBranchLHS branch + tycon_tys = mkTyVarTys tyvars + subst = mkTopTvSubst (ax_tvs `zip` tycon_tys) -- The subst matches the tyvar of the TyCon -- with those from the CoAxiom. They aren't -- necessarily the same, since the two may be -- gotten from separate interface-file declarations - ; return (FamInstTyCon ax_unbr fam_tc (substTys subst ax_lhs)) } + -- NB: ax_tvs may be shorter because of eta-reduction + -- See Note [Eta reduction for data family axioms] in TcInstDcls + lhs_tys = substTys subst ax_lhs `chkAppend` + dropList ax_tvs tycon_tys + -- The 'lhs_tys' should be 1-1 with the 'tyvars' + -- but ax_tvs maybe shorter because of eta-reduction + ; return (FamInstTyCon ax_unbr fam_tc lhs_tys) } tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs, ifSynRhs = mb_rhs_ty,