[commit: ghc] master: Look through type synonyms in GADT kind signatures (efaa51d)

[git at git.haskell.org]

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

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

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

commit efaa51de15017b92618634898fc2c2aee2c5fd5b
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date:   Wed Dec 16 12:57:45 2015 +0100

    Look through type synonyms in GADT kind signatures
    
    Summary: Fixes #11237
    
    Test Plan: ./validate
    
    Reviewers: goldfire, austin, bgamari
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D1636
    
    GHC Trac Issues: #11237


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

efaa51de15017b92618634898fc2c2aee2c5fd5b
 compiler/types/TyCoRep.hs                          |  6 +++---
 compiler/types/Type.hs-boot                        |  2 ++
 testsuite/tests/typecheck/should_compile/T11237.hs | 13 +++++++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 4 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/compiler/types/TyCoRep.hs b/compiler/types/TyCoRep.hs
index c25bd11..d409c7d 100644
--- a/compiler/types/TyCoRep.hs
+++ b/compiler/types/TyCoRep.hs
@@ -114,7 +114,7 @@ module TyCoRep (
 import {-# SOURCE #-} DataCon( dataConTyCon, dataConFullSig
                               , DataCon, eqSpecTyVar )
 import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy
-                          , partitionInvisibles )
+                          , partitionInvisibles, coreView )
    -- Transitively pulls in a LOT of stuff, better to break the loop
 
 import {-# SOURCE #-} Coercion
@@ -412,13 +412,13 @@ Some basic functions, put here to break loops eg with the pretty printer
 -}
 
 isLiftedTypeKind :: Kind -> Bool
-isLiftedTypeKind (TyConApp tc []) = isLiftedTypeKindTyConName (tyConName tc)
+isLiftedTypeKind ki | Just ki' <- coreView ki = isLiftedTypeKind ki'
 isLiftedTypeKind (TyConApp tc [TyConApp lev []])
   = tc `hasKey` tYPETyConKey && lev `hasKey` liftedDataConKey
 isLiftedTypeKind _                = False
 
 isUnliftedTypeKind :: Kind -> Bool
-isUnliftedTypeKind (TyConApp tc []) = tc `hasKey` unliftedTypeKindTyConKey
+isUnliftedTypeKind ki | Just ki' <- coreView ki = isUnliftedTypeKind ki'
 isUnliftedTypeKind (TyConApp tc [TyConApp lev []])
   = tc `hasKey` tYPETyConKey && lev `hasKey` unliftedDataConKey
 isUnliftedTypeKind _ = False
diff --git a/compiler/types/Type.hs-boot b/compiler/types/Type.hs-boot
index aa12398..abddc24 100644
--- a/compiler/types/Type.hs-boot
+++ b/compiler/types/Type.hs-boot
@@ -14,3 +14,5 @@ eqType :: Type -> Type -> Bool
 coreViewOneStarKind :: Type -> Maybe Type
 
 partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a])
+
+coreView :: Type -> Maybe Type
diff --git a/testsuite/tests/typecheck/should_compile/T11237.hs b/testsuite/tests/typecheck/should_compile/T11237.hs
new file mode 100644
index 0000000..422aefd
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T11237.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE GADTs #-}
+module TypeInTypeBug where
+
+import qualified Data.Kind
+
+data Works :: Data.Kind.Type where
+  WorksConstr :: Works
+
+type Set = Data.Kind.Type
+
+data ShouldWork :: Set where
+  ShouldWorkConstr :: ShouldWork
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index 8acb9a3..6bd0b03 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -479,3 +479,4 @@ test('T10770a', expect_broken(10770), compile, [''])
 test('T10770b', expect_broken(10770), compile, [''])
 test('T10935', normal, compile, [''])
 test('T10971a', normal, compile, [''])
+test('T11237', normal, compile, [''])