[commit: ghc] ghc-7.10: Fix #10713. (976fa5e)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/976fa5ee0fc8ff7c5c0634f42d8ebf654bd14b78/ghc

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

commit 976fa5ee0fc8ff7c5c0634f42d8ebf654bd14b78
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Mon Aug 3 08:53:03 2015 -0400

    Fix #10713.
    
    When doing the apartness/flattening thing, we really only need to
    eliminate non-generative tycons, not *all* families. (Data families
    are indeed generative!)


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

976fa5ee0fc8ff7c5c0634f42d8ebf654bd14b78
 compiler/types/FamInstEnv.hs                           |  4 +++-
 testsuite/tests/indexed-types/should_compile/T10713.hs | 13 +++++++++++++
 testsuite/tests/indexed-types/should_compile/all.T     |  1 +
 3 files changed, 17 insertions(+), 1 deletion(-)

diff --git a/compiler/types/FamInstEnv.hs b/compiler/types/FamInstEnv.hs
index 808dece..373dd5c 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -1020,7 +1020,9 @@ coreFlattenTy in_scope = go
                                (m2, ty2') = go m1 ty2 in
                            (m2, AppTy ty1' ty2')
     go m (TyConApp tc tys)
-      | isFamilyTyCon tc
+         -- NB: Don't just check if isFamilyTyCon: this catches *data* families,
+         -- which are generative and thus can be preserved during flattening
+      | not (isGenerativeTyCon tc Nominal)
       = let (m', tv) = coreFlattenTyFamApp in_scope m tc tys in
         (m', mkTyVarTy tv)
 
diff --git a/testsuite/tests/indexed-types/should_compile/T10713.hs b/testsuite/tests/indexed-types/should_compile/T10713.hs
new file mode 100644
index 0000000..cf4af28
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T10713.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds #-}
+
+module T10713 where
+
+import Data.Proxy
+
+type family TEq t s where
+  TEq t t = 'True
+  TEq t s = 'False
+data family T a
+
+foo :: Proxy (TEq (T Int) (T Bool)) -> Proxy 'False
+foo = id
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index f4df933..181d3d0 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -252,3 +252,4 @@ test('T9582', normal, compile, [''])
 test('T9090', normal, compile, [''])
 test('T10020', normal, compile, [''])
 test('T10079', normal, compile, [''])
+test('T10713', normal, compile, [''])