[commit: ghc] master: Reject promoted constructors when -XDataKinds is not enabled (FIX #7433) (6486213)

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6486213bc4ad307273956bc6164eeeb3f6f31d1c

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

commit 6486213bc4ad307273956bc6164eeeb3f6f31d1c
Author: Jose Pedro Magalhaes <[email protected]>
Date:   Wed Nov 21 13:13:44 2012 +0000

    Reject promoted constructors when -XDataKinds is not enabled (FIX #7433)

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

 compiler/typecheck/TcHsType.lhs  |    5 ++++-
 compiler/typecheck/TcRnTypes.lhs |    3 +++
 2 files changed, 7 insertions(+), 1 deletions(-)

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 36762b9..e9f68c1 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -607,7 +607,9 @@ tcTyVar name         -- Could be a tyvar, a tycon, or a datacon
 
            AGlobal (ADataCon dc)
              | Just tc <- promoteDataCon_maybe dc
-             -> inst_tycon (mkTyConApp tc) (tyConKind tc)
+             -> do { data_kinds <- xoptM Opt_DataKinds
+                   ; unless data_kinds $ promotionErr name NoDataKinds
+                   ; inst_tycon (mkTyConApp tc) (tyConKind tc) }
              | otherwise -> failWithTc (quotes (ppr dc) <+> ptext (sLit "of type")
                             <+> quotes (ppr (dataConUserType dc)) <+> ptext (sLit "is not promotable"))
 
@@ -1516,6 +1518,7 @@ promotionErr name err
   where
     reason = case err of
                FamDataConPE -> ptext (sLit "it comes from a data family instance")
+               NoDataKinds  -> ptext (sLit "Perhaps you intended to use -XDataKinds")
                _ -> ptext (sLit "it is defined and used in the same recursive group")
 \end{code}
 
diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs
index 4b2ea8f..99b9a07 100644
--- a/compiler/typecheck/TcRnTypes.lhs
+++ b/compiler/typecheck/TcRnTypes.lhs
@@ -591,6 +591,7 @@ data PromotionErr
 
   | RecDataConPE     -- Data constructor in a reuursive loop
                      -- See Note [ARecDataCon: recusion and promoting data constructors] in TcTyClsDecls
+  | NoDataKinds      -- -XDataKinds not enabled
 
 instance Outputable TcTyThing where     -- Debugging only
    ppr (AGlobal g)      = pprTyThing g
@@ -608,6 +609,7 @@ instance Outputable PromotionErr where
   ppr TyConPE      = text "TyConPE"
   ppr FamDataConPE = text "FamDataConPE"
   ppr RecDataConPE = text "RecDataConPE"
+  ppr NoDataKinds  = text "NoDataKinds"
 
 pprTcTyThingCategory :: TcTyThing -> SDoc
 pprTcTyThingCategory (AGlobal thing)    = pprTyThingCategory thing
@@ -621,6 +623,7 @@ pprPECategory ClassPE      = ptext (sLit "Class")
 pprPECategory TyConPE      = ptext (sLit "Type constructor")
 pprPECategory FamDataConPE = ptext (sLit "Data constructor")
 pprPECategory RecDataConPE = ptext (sLit "Data constructor")
+pprPECategory NoDataKinds  = ptext (sLit "Data constructor")
 \end{code}