Introduce tcTypeKind, and use it
[ghc.git] / compiler / typecheck / TcTypeable.hs
index 90a4a83..1fe2c68 100644 (file)
@@ -28,7 +28,6 @@ import TysWiredIn ( tupleTyCon, sumTyCon, runtimeRepTyCon
 import Name
 import Id
 import Type
-import Kind ( isTYPEApp )
 import TyCon
 import DataCon
 import Module
@@ -430,7 +429,7 @@ typeIsTypeable :: Type -> Bool
 typeIsTypeable ty
   | Just ty' <- coreView ty         = typeIsTypeable ty'
 typeIsTypeable ty
-  | Just _ <- isTYPEApp ty          = True
+  | isJust (kindRep_maybe ty)       = True
 typeIsTypeable (TyVarTy _)          = True
 typeIsTypeable (AppTy a b)          = typeIsTypeable a && typeIsTypeable b
 typeIsTypeable (FunTy a b)          = typeIsTypeable a && typeIsTypeable b
@@ -549,11 +548,15 @@ mkKindRepRhs :: TypeableStuff
 mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep
   where
     new_kind_rep k
-        -- We handle TYPE separately to make it clear to consumers
-        -- (e.g. serializers) that there is a loop here (as
-        -- TYPE :: RuntimeRep -> TYPE 'LiftedRep)
-      | Just rr <- isTYPEApp k
-      = return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon rr
+        -- We handle (TYPE LiftedRep) etc separately to make it
+        -- clear to consumers (e.g. serializers) that there is
+        -- a loop here (as TYPE :: RuntimeRep -> TYPE 'LiftedRep)
+      | not (tcIsConstraintKind k)    -- Typeable respects the Constraint/* distinction
+                                      -- so do not follow the special case here
+      , Just arg <- kindRep_maybe k
+      , Just (tc, []) <- splitTyConApp_maybe arg
+      , Just dc <- isPromotedDataCon_maybe tc
+      = return $ nlHsDataCon kindRepTYPEDataCon `nlHsApp` nlHsDataCon dc
 
     new_kind_rep (TyVarTy v)
       | Just idx <- lookupCME in_scope v