[commit: ghc] master: Fix a trailing case in making FamInstTyCon, where the invariant didn't hold, leading to subsequent chaos. Happily an ASSERT caught it. (d0ecba6)

[Simon Peyton Jones]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : master

https://github.com/ghc/ghc/commit/d0ecba6d98c5fae1df8b63632557a44a09c559f8

>---------------------------------------------------------------

commit d0ecba6d98c5fae1df8b63632557a44a09c559f8
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu May 30 22:03:24 2013 +0100

    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 89d9807..4c7435a 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,