diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2ec7132bc5ff145fb87fae999ae69bc9c56457d1..06a9fa77375ae743b5b8802ba05366e1307c1d2c 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -402,6 +402,7 @@ data ExtensionFlag
    | Opt_RebindableSyntax
    | Opt_ConstraintKinds
    | Opt_PolyKinds                -- Kind polymorphism
+   | Opt_DataKinds                -- Datatype promotion
 
    | Opt_StandaloneDeriving
    | Opt_DeriveDataTypeable
@@ -1945,6 +1946,7 @@ xFlags = [
   ( "RebindableSyntax",                 Opt_RebindableSyntax, nop ),
   ( "ConstraintKinds",                  Opt_ConstraintKinds, nop ),
   ( "PolyKinds",                        Opt_PolyKinds, nop ),
+  ( "DataKinds",                        Opt_DataKinds, nop ),
   ( "MonoPatBinds",                     Opt_MonoPatBinds,
     \ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
   ( "ExplicitForAll",                   Opt_ExplicitForAll, nop ),
@@ -2031,8 +2033,6 @@ impliedFlags
     , (Opt_TypeFamilies,     turnOn, Opt_KindSignatures)  -- Type families use kind signatures
                                                           -- all over the place
 
-    , (Opt_PolyKinds,        turnOn, Opt_KindSignatures)
-
     , (Opt_ImpredicativeTypes,  turnOn, Opt_RankNTypes)
 
         -- Record wild-cards implies field disambiguation
diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs
index 4f36d03254994dbdb17b2c3a5100398484e2da84..229167a6afbff28e4131ff37303e9de1d8a3b679 100644
--- a/compiler/rename/RnEnv.lhs
+++ b/compiler/rename/RnEnv.lhs
@@ -39,7 +39,7 @@ module RnEnv (
 	addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
 	warnUnusedMatches,
 	warnUnusedTopBinds, warnUnusedLocalBinds,
-	dataTcOccs, unknownNameErr, kindSigErr, polyKindsErr, perhapsForallMsg,
+	dataTcOccs, unknownNameErr, kindSigErr, dataKindsErr, perhapsForallMsg,
 
         HsDocContext(..), docOfHsDocContext
     ) where
@@ -469,13 +469,13 @@ lookupPromotedOccRn rdr_name = do {
       Nothing -> err
       -- 2.b let's try every thing again -> 3
       Just demoted_rdr_name -> do {
-  ; poly_kinds <- xoptM Opt_PolyKinds
+  ; data_kinds <- xoptM Opt_DataKinds
     -- 3. lookup again
   ; opt_demoted_name <- lookupOccRn_maybe demoted_rdr_name ;
   ; case opt_demoted_name of
       -- 3.a. it was implicitly promoted, but confirm that we can promote
-      -- JPM: We could try to suggest turning on PolyKinds here
-      Just demoted_name -> if poly_kinds then return demoted_name else err
+      -- JPM: We could try to suggest turning on DataKinds here
+      Just demoted_name -> if data_kinds then return demoted_name else err
       -- 3.b. use rdr_name to have a correct error message
       Nothing -> err } } }
   where err = unboundName WL_Any rdr_name
@@ -1418,10 +1418,10 @@ kindSigErr thing
   = hang (ptext (sLit "Illegal kind signature for") <+> quotes (ppr thing))
        2 (ptext (sLit "Perhaps you intended to use -XKindSignatures"))
 
-polyKindsErr :: Outputable a => a -> SDoc
-polyKindsErr thing
+dataKindsErr :: Outputable a => a -> SDoc
+dataKindsErr thing
   = hang (ptext (sLit "Illegal kind:") <+> quotes (ppr thing))
-       2 (ptext (sLit "Perhaps you intended to use -XPolyKinds"))
+       2 (ptext (sLit "Perhaps you intended to use -XDataKinds"))
 
 
 badQualBndrErr :: RdrName -> SDoc
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index df6008b5746e76ddd6dca9236b376442afb0e398..3b86d0b38c40471d6deed7a93f99b0bfcf5159bd 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -196,8 +196,8 @@ rnHsTyKi isType doc (HsFunTy ty1 ty2) = do
       else return (HsFunTy ty1' ty2')
 
 rnHsTyKi isType doc listTy@(HsListTy ty) = do
-    poly_kinds <- xoptM Opt_PolyKinds
-    unless (poly_kinds || isType) (addErr (polyKindsErr listTy))
+    data_kinds <- xoptM Opt_DataKinds
+    unless (data_kinds || isType) (addErr (dataKindsErr listTy))
     ty' <- rnLHsTyKi isType doc ty
     return (HsListTy ty')
 
@@ -216,8 +216,8 @@ rnHsTyKi isType doc (HsPArrTy ty) = ASSERT ( isType ) do
 -- Unboxed tuples are allowed to have poly-typed arguments.  These
 -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
 rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys) = do
-    poly_kinds <- xoptM Opt_PolyKinds
-    unless (poly_kinds || isType) (addErr (polyKindsErr tupleTy))
+    data_kinds <- xoptM Opt_DataKinds
+    unless (data_kinds || isType) (addErr (dataKindsErr tupleTy))
     tys' <- mapM (rnLHsTyKi isType doc) tys
     return (HsTupleTy tup_con tys')
 
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 33ba9cf1163b4b092f46a2c5644399262bafd2e9..b103076517523e8a705adbb1f1aff895646cb9a5 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -68,7 +68,7 @@ import NameSet
 import TysWiredIn
 import BasicTypes
 import SrcLoc
-import DynFlags ( ExtensionFlag( Opt_PolyKinds ) )
+import DynFlags ( ExtensionFlag( Opt_DataKinds ) )
 import Util
 import UniqSupply
 import Outputable
@@ -969,7 +969,7 @@ kindGeneralizeKinds kinds
          -- Zonk the kinds again, to pick up either the kind 
          -- variables we quantify over, or *, depending on whether
          -- zonkQuantifiedTyVars decided to generalise (which in
-         -- turn depends on PolyKinds)
+         -- turn depends on DataKinds)
        ; final_kinds <- mapM zonkTcKind zonked_kinds
 
        ; traceTc "generalizeKind" (    ppr kinds <+> ppr kvs_to_quantify
@@ -1348,8 +1348,8 @@ sc_ds_var_app name arg_kis = do
   case mb_thing of
     Just (AGlobal (ATyCon tc))
       | isAlgTyCon tc || isTupleTyCon tc -> do
-      poly_kinds <- xoptM Opt_PolyKinds
-      unless poly_kinds $ addErr (polyKindsErr name)
+      data_kinds <- xoptM Opt_DataKinds
+      unless data_kinds $ addErr (dataKindsErr name)
       let tc_kind = tyConKind tc
       case isPromotableKind tc_kind of
         Just n | n == length arg_kis ->