Commit 384f6099 authored by dreixel's avatar dreixel
Browse files

Split -XDataKinds from -XPolyKinds

parent 3c67c9af
...@@ -406,6 +406,7 @@ data ExtensionFlag ...@@ -406,6 +406,7 @@ data ExtensionFlag
| Opt_RebindableSyntax | Opt_RebindableSyntax
| Opt_ConstraintKinds | Opt_ConstraintKinds
| Opt_PolyKinds -- Kind polymorphism | Opt_PolyKinds -- Kind polymorphism
| Opt_DataKinds -- Datatype promotion
| Opt_InstanceSigs | Opt_InstanceSigs
| Opt_StandaloneDeriving | Opt_StandaloneDeriving
...@@ -1956,6 +1957,7 @@ xFlags = [ ...@@ -1956,6 +1957,7 @@ xFlags = [
( "RebindableSyntax", Opt_RebindableSyntax, nop ), ( "RebindableSyntax", Opt_RebindableSyntax, nop ),
( "ConstraintKinds", Opt_ConstraintKinds, nop ), ( "ConstraintKinds", Opt_ConstraintKinds, nop ),
( "PolyKinds", Opt_PolyKinds, nop ), ( "PolyKinds", Opt_PolyKinds, nop ),
( "DataKinds", Opt_DataKinds, nop ),
( "InstanceSigs", Opt_InstanceSigs, nop ), ( "InstanceSigs", Opt_InstanceSigs, nop ),
( "MonoPatBinds", Opt_MonoPatBinds, ( "MonoPatBinds", Opt_MonoPatBinds,
\ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ), \ turn_on -> when turn_on $ deprecate "Experimental feature now removed; has no effect" ),
...@@ -2043,8 +2045,6 @@ impliedFlags ...@@ -2043,8 +2045,6 @@ impliedFlags
, (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures , (Opt_TypeFamilies, turnOn, Opt_KindSignatures) -- Type families use kind signatures
-- all over the place -- all over the place
, (Opt_PolyKinds, turnOn, Opt_KindSignatures)
, (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes) , (Opt_ImpredicativeTypes, turnOn, Opt_RankNTypes)
-- Record wild-cards implies field disambiguation -- Record wild-cards implies field disambiguation
......
...@@ -462,17 +462,17 @@ lookupPromotedOccRn rdr_name ...@@ -462,17 +462,17 @@ lookupPromotedOccRn rdr_name
Nothing -> Nothing ->
do { -- Maybe it's the name of a *data* constructor do { -- Maybe it's the name of a *data* constructor
poly_kinds <- xoptM Opt_PolyKinds data_kinds <- xoptM Opt_DataKinds
; mb_demoted_name <- case demoteRdrName rdr_name of ; mb_demoted_name <- case demoteRdrName rdr_name of
Just demoted_rdr -> lookupOccRn_maybe demoted_rdr Just demoted_rdr -> lookupOccRn_maybe demoted_rdr
Nothing -> return Nothing Nothing -> return Nothing
; case mb_demoted_name of ; case mb_demoted_name of
Nothing -> unboundName WL_Any rdr_name Nothing -> unboundName WL_Any rdr_name
Just demoted_name Just demoted_name
| poly_kinds -> return demoted_name | data_kinds -> return demoted_name
| otherwise -> unboundNameX WL_Any rdr_name suggest_pk }}} | otherwise -> unboundNameX WL_Any rdr_name suggest_pk }}}
where where
suggest_pk = ptext (sLit "A data constructor of that name is in scope; did you mean -XPolyKinds?") suggest_pk = ptext (sLit "A data constructor of that name is in scope; did you mean -XDataKinds?")
\end{code} \end{code}
Note [Demotion] Note [Demotion]
...@@ -1437,7 +1437,7 @@ kindSigErr thing ...@@ -1437,7 +1437,7 @@ kindSigErr thing
polyKindsErr :: Outputable a => a -> SDoc polyKindsErr :: Outputable a => a -> SDoc
polyKindsErr thing polyKindsErr thing
= hang (ptext (sLit "Illegal kind:") <+> quotes (ppr 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 badQualBndrErr :: RdrName -> SDoc
......
...@@ -196,8 +196,8 @@ rnHsTyKi isType doc (HsFunTy ty1 ty2) = do ...@@ -196,8 +196,8 @@ rnHsTyKi isType doc (HsFunTy ty1 ty2) = do
else return (HsFunTy ty1' ty2') else return (HsFunTy ty1' ty2')
rnHsTyKi isType doc listTy@(HsListTy ty) = do rnHsTyKi isType doc listTy@(HsListTy ty) = do
poly_kinds <- xoptM Opt_PolyKinds data_kinds <- xoptM Opt_DataKinds
unless (poly_kinds || isType) (addErr (polyKindsErr listTy)) unless (data_kinds || isType) (addErr (polyKindsErr listTy))
ty' <- rnLHsTyKi isType doc ty ty' <- rnLHsTyKi isType doc ty
return (HsListTy ty') return (HsListTy ty')
...@@ -216,8 +216,8 @@ rnHsTyKi isType doc (HsPArrTy ty) = ASSERT ( isType ) do ...@@ -216,8 +216,8 @@ rnHsTyKi isType doc (HsPArrTy ty) = ASSERT ( isType ) do
-- Unboxed tuples are allowed to have poly-typed arguments. These -- Unboxed tuples are allowed to have poly-typed arguments. These
-- sometimes crop up as a result of CPR worker-wrappering dictionaries. -- sometimes crop up as a result of CPR worker-wrappering dictionaries.
rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys) = do rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys) = do
poly_kinds <- xoptM Opt_PolyKinds data_kinds <- xoptM Opt_DataKinds
unless (poly_kinds || isType) (addErr (polyKindsErr tupleTy)) unless (data_kinds || isType) (addErr (polyKindsErr tupleTy))
tys' <- mapM (rnLHsTyKi isType doc) tys tys' <- mapM (rnLHsTyKi isType doc) tys
return (HsTupleTy tup_con tys') return (HsTupleTy tup_con tys')
......
...@@ -68,7 +68,7 @@ import NameSet ...@@ -68,7 +68,7 @@ import NameSet
import TysWiredIn import TysWiredIn
import BasicTypes import BasicTypes
import SrcLoc import SrcLoc
import DynFlags ( ExtensionFlag( Opt_PolyKinds ) ) import DynFlags ( ExtensionFlag( Opt_DataKinds ) )
import Util import Util
import UniqSupply import UniqSupply
import Outputable import Outputable
...@@ -1343,8 +1343,8 @@ sc_ds_var_app name arg_kis = do ...@@ -1343,8 +1343,8 @@ sc_ds_var_app name arg_kis = do
case mb_thing of case mb_thing of
Just (AGlobal (ATyCon tc)) Just (AGlobal (ATyCon tc))
| isAlgTyCon tc || isTupleTyCon tc -> do | isAlgTyCon tc || isTupleTyCon tc -> do
poly_kinds <- xoptM Opt_PolyKinds data_kinds <- xoptM Opt_DataKinds
unless poly_kinds $ addErr (polyKindsErr name) unless data_kinds $ addErr (polyKindsErr name)
let tc_kind = tyConKind tc let tc_kind = tyConKind tc
case isPromotableKind tc_kind of case isPromotableKind tc_kind of
Just n | n == length arg_kis -> Just n | n == length arg_kis ->
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment