diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 6b01da47223a6a74fda3d95e04fe73dca337baf2..61b56359fc91932c418d43af380ee1b397df0e8f 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -41,7 +41,7 @@ module RnEnv ( addFvRn, mapFvRn, mapMaybeFvRn, mapFvRnCPS, warnUnusedMatches, warnUnusedTopBinds, warnUnusedLocalBinds, - dataTcOccs, unknownNameErr, kindSigErr, dataKindsErr, perhapsForallMsg, + dataTcOccs, unknownNameErr, kindSigErr, perhapsForallMsg, HsDocContext(..), docOfHsDocContext ) where @@ -1649,12 +1649,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 diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index ed2144084ab58d1f7dd4ec4d9662214ea6d3602e..d9809239e2e33546089cba2018ffdd4d22f18652 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -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] diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 8b4004490b79cedd8b756d465b940708f20afcea..77c4a8bbdd93ea245195b46ab309756e5f0992d4 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -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 @@ -1437,6 +1436,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"))