Look through type synonyms in GADT kind signatures
authorJan Stolarek <jan.stolarek@p.lodz.pl>
Wed, 16 Dec 2015 11:57:45 +0000 (12:57 +0100)
committerJan Stolarek <jan.stolarek@p.lodz.pl>
Wed, 16 Dec 2015 17:14:32 +0000 (18:14 +0100)
Summary: Fixes #11237

Test Plan: ./validate

Reviewers: goldfire, austin, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1636

GHC Trac Issues: #11237

compiler/types/TyCoRep.hs
compiler/types/Type.hs-boot
testsuite/tests/typecheck/should_compile/T11237.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index c25bd11..d409c7d 100644 (file)
@@ -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
index aa12398..abddc24 100644 (file)
@@ -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 (file)
index 0000000..422aefd
--- /dev/null
@@ -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
index 8acb9a3..6bd0b03 100644 (file)
@@ -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, [''])