Fix a trailing case in making FamInstTyCon,
authorSimon Peyton Jones <simonpj@microsoft.com>
Thu, 30 May 2013 21:03:24 +0000 (22:03 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Thu, 30 May 2013 21:03:48 +0000 (22:03 +0100)
where the invariant didn't hold, leading to
subsequent chaos. Happily an ASSERT caught it.

compiler/iface/TcIface.lhs

index 89d9807..4c7435a 100644 (file)
@@ -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,