[commit: ghc] master: Fix #10713. (f063bd5)

[git at git.haskell.org]

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

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

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

commit f063bd5413edf40f1b48e0f958410dcb6bf20b68
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!)


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

f063bd5413edf40f1b48e0f958410dcb6bf20b68
 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 bea00fc..11e93df 100644
--- a/compiler/types/FamInstEnv.hs
+++ b/compiler/types/FamInstEnv.hs
@@ -1045,7 +1045,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 773ad30..ff5070b 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -260,3 +260,4 @@ test('T10340', normal, compile, [''])
 test('T10226', normal, compile, [''])
 test('T10507', normal, compile, [''])
 test('T10634', normal, compile, [''])
+test('T10713', normal, compile, [''])