Commit 72e7f57c authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Require DataKinds for promoted list/tuple syntax in types

Fixes Trac #7151
parent bdce8f0a
......@@ -34,7 +34,7 @@ module RnEnv (
addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS,
warnUnusedMatches,
warnUnusedTopBinds, warnUnusedLocalBinds,
dataTcOccs, unknownNameErr, kindSigErr, dataKindsErr, perhapsForallMsg,
dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg,
HsDocContext(..), docOfHsDocContext
) where
......@@ -1642,12 +1642,6 @@ kindSigErr thing
= hang (ptext (sLit "Illegal kind signature for") <+> quotes (ppr thing))
2 (ptext (sLit "Perhaps you intended to use -XKindSignatures"))
dataKindsErr :: Outputable a => a -> SDoc
dataKindsErr thing
= hang (ptext (sLit "Illegal kind:") <+> quotes (ppr thing))
2 (ptext (sLit "Perhaps you intended to use -XDataKinds"))
badQualBndrErr :: RdrName -> SDoc
badQualBndrErr rdr_name
= ptext (sLit "Qualified name in binding position:") <+> ppr rdr_name
......
......@@ -207,7 +207,7 @@ rnHsTyKi isType doc (HsFunTy ty1 ty2)
rnHsTyKi isType doc listTy@(HsListTy ty)
= do { data_kinds <- xoptM Opt_DataKinds
; unless (data_kinds || isType) (addErr (dataKindsErr listTy))
; unless (data_kinds || isType) (addErr (dataKindsErr isType listTy))
; (ty', fvs) <- rnLHsTyKi isType doc ty
; return (HsListTy ty', fvs) }
......@@ -228,7 +228,7 @@ rnHsTyKi isType doc (HsPArrTy ty)
-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys)
= do { data_kinds <- xoptM Opt_DataKinds
; unless (data_kinds || isType) (addErr (dataKindsErr tupleTy))
; unless (data_kinds || isType) (addErr (dataKindsErr isType tupleTy))
; (tys', fvs) <- mapFvRn (rnLHsTyKi isType doc) tys
; return (HsTupleTy tup_con tys', fvs) }
......@@ -236,7 +236,7 @@ rnHsTyKi isType doc tupleTy@(HsTupleTy tup_con tys)
-- 2. Check that the integer is positive?
rnHsTyKi isType _ tyLit@(HsTyLit t)
= do { data_kinds <- xoptM Opt_DataKinds
; unless (data_kinds || isType) (addErr (dataKindsErr tyLit))
; unless (data_kinds || isType) (addErr (dataKindsErr isType tyLit))
; return (HsTyLit t, emptyFVs) }
rnHsTyKi isType doc (HsAppTy ty1 ty2)
......@@ -284,14 +284,18 @@ rnHsTyKi isType _ (HsCoreTy ty)
rnHsTyKi _ _ (HsWrapTy {})
= panic "rnHsTyKi"
rnHsTyKi isType doc (HsExplicitListTy k tys)
rnHsTyKi isType doc ty@(HsExplicitListTy k tys)
= ASSERT( isType )
do { (tys', fvs) <- rnLHsTypes doc tys
do { data_kinds <- xoptM Opt_DataKinds
; unless data_kinds (addErr (dataKindsErr isType ty))
; (tys', fvs) <- rnLHsTypes doc tys
; return (HsExplicitListTy k tys', fvs) }
rnHsTyKi isType doc (HsExplicitTupleTy kis tys)
rnHsTyKi isType doc ty@(HsExplicitTupleTy kis tys)
= ASSERT( isType )
do { (tys', fvs) <- rnLHsTypes doc tys
do { data_kinds <- xoptM Opt_DataKinds
; unless data_kinds (addErr (dataKindsErr isType ty))
; (tys', fvs) <- rnLHsTypes doc tys
; return (HsExplicitTupleTy kis tys', fvs) }
--------------
......@@ -443,6 +447,14 @@ badSigErr is_type doc (L loc ty)
| otherwise = ptext (sLit "kind")
flag | is_type = ptext (sLit "-XScopedTypeVariables")
| otherwise = ptext (sLit "-XKindSignatures")
dataKindsErr :: Bool -> HsType RdrName -> SDoc
dataKindsErr is_type thing
= hang (ptext (sLit "Illegal") <+> what <> colon <+> quotes (ppr thing))
2 (ptext (sLit "Perhaps you intended to use -XDataKinds"))
where
what | is_type = ptext (sLit "type")
| otherwise = ptext (sLit "kind")
\end{code}
Note [Renaming associated types]
......
......@@ -48,7 +48,6 @@ import {-# SOURCE #-} TcSplice( tcSpliceType )
import HsSyn
import TcHsSyn ( zonkTcTypeToType, emptyZonkEnv )
import TcRnMonad
import RnEnv ( dataKindsErr )
import TcEvidence( HsWrapper )
import TcEnv
import TcMType
......@@ -1439,6 +1438,11 @@ tc_kind_var_app name arg_kis
tycon_err tc msg = failWithTc (quotes (ppr tc) <+> ptext (sLit "of kind")
<+> quotes (ppr (tyConKind tc)) <+> ptext (sLit msg))
dataKindsErr :: Name -> SDoc
dataKindsErr name
= hang (ptext (sLit "Illegal kind:") <+> quotes (ppr name))
2 (ptext (sLit "Perhaps you intended to use -XDataKinds"))
promotionErr :: Name -> PromotionErr -> TcM a
promotionErr name err
= failWithTc (hang (pprPECategory err <+> quotes (ppr name) <+> ptext (sLit "cannot be used here"))
......
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