[commit: ghc] master: Reify data family instances correctly. (e319d6d)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e319d6d2704edc2696f47409f85f4d4ce58a6cc4/ghc

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

commit e319d6d2704edc2696f47409f85f4d4ce58a6cc4
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Oct 20 15:36:57 2014 -0400

    Reify data family instances correctly.
    
    Summary:
    Fix #9692.
    
    The reifier didn't account for the possibility that data/newtype
    instances are sometimes eta-reduced. It now eta-expands as necessary.
    
    Test Plan: th/T9692
    
    Reviewers: simonpj, austin
    
    Subscribers: thomie, carter, ezyang, simonmar
    
    Differential Revision: https://phabricator.haskell.org/D355


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

e319d6d2704edc2696f47409f85f4d4ce58a6cc4
 compiler/typecheck/TcSplice.lhs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index bb6af8c..e952a27 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -1338,8 +1338,16 @@ reifyFamilyInstance (FamInst { fi_flavor = flavor
       DataFamilyInst rep_tc ->
         do { let tvs = tyConTyVars rep_tc
                  fam' = reifyName fam
+
+                   -- eta-expand lhs types, because sometimes data/newtype
+                   -- instances are eta-reduced; See Trac #9692
+                   -- See Note [Eta reduction for data family axioms]
+                   -- in TcInstDcls
+                 (_rep_tc, rep_tc_args) = splitTyConApp rhs
+                 etad_tyvars            = dropList rep_tc_args tvs
+                 eta_expanded_lhs = lhs `chkAppend` mkTyVarTys etad_tyvars
            ; cons <- mapM (reifyDataCon (mkTyVarTys tvs)) (tyConDataCons rep_tc)
-           ; th_tys <- reifyTypes lhs
+           ; th_tys <- reifyTypes (filter (not . isKind) eta_expanded_lhs)
            ; return (if isNewTyCon rep_tc
                      then TH.NewtypeInstD [] fam' th_tys (head cons) []
                      else TH.DataInstD    [] fam' th_tys cons        []) }