summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Flags.hs1
-rw-r--r--compiler/GHC/Driver/Session.hs1
-rw-r--r--compiler/GHC/Rename/Names.hs28
-rw-r--r--compiler/GHC/Tc/TyCl.hs25
-rw-r--r--compiler/GHC/Tc/Types.hs1
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs1
-rw-r--r--docs/users_guide/using-warnings.rst27
-rw-r--r--testsuite/tests/warnings/should_compile/T19564a.hs32
-rw-r--r--testsuite/tests/warnings/should_compile/T19564a.stderr36
-rw-r--r--testsuite/tests/warnings/should_compile/T19564b.hs46
-rw-r--r--testsuite/tests/warnings/should_compile/T19564c.hs34
-rw-r--r--testsuite/tests/warnings/should_compile/T19564c.stderr36
-rw-r--r--testsuite/tests/warnings/should_compile/T19564d.hs34
-rw-r--r--testsuite/tests/warnings/should_compile/all.T5
14 files changed, 297 insertions, 10 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index 2b86c0f266..b6d20ada3a 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -511,6 +511,7 @@ data WarningFlag =
| Opt_WarnOperatorWhitespace -- Since 9.2
| Opt_WarnAmbiguousFields -- Since 9.2
| Opt_WarnImplicitLift -- Since 9.2
+ | Opt_WarnMissingKindSignatures -- Since 9.2
deriving (Eq, Show, Enum)
-- | Used when outputting warnings: if a reason is given, it is
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index eb14bbc91f..aea644aac8 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3124,6 +3124,7 @@ wWarningFlagsDeps = [
flagSpec "missing-monadfail-instances" Opt_WarnMissingMonadFailInstances,
flagSpec "semigroup" Opt_WarnSemigroup,
flagSpec "missing-signatures" Opt_WarnMissingSignatures,
+ flagSpec "missing-kind-signatures" Opt_WarnMissingKindSignatures,
depFlagSpec "missing-exported-sigs" Opt_WarnMissingExportedSignatures
"it is replaced by -Wmissing-exported-signatures",
flagSpec "missing-exported-signatures" Opt_WarnMissingExportedSignatures,
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index 6c99bf7b5b..835e39a246 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -52,6 +52,7 @@ import GHC.Parser.PostProcess ( setRdrNameSpace )
import GHC.Core.Type
import GHC.Core.PatSyn
import GHC.Core.TyCo.Ppr
+import GHC.Core.TyCon ( TyCon, tyConName, tyConKind )
import qualified GHC.LanguageExtensions as LangExt
import GHC.Utils.Outputable as Outputable
@@ -1417,7 +1418,8 @@ reportUnusedNames gbl_env hsc_src
; traceRn "RUN" (ppr (tcg_dus gbl_env))
; warnUnusedImportDecls gbl_env hsc_src
; warnUnusedTopBinds $ unused_locals keep
- ; warnMissingSignatures gbl_env }
+ ; warnMissingSignatures gbl_env
+ ; warnMissingKindSignatures gbl_env }
where
used_names :: NameSet -> NameSet
used_names keep = findUses (tcg_dus gbl_env) emptyNameSet `unionNameSet` keep
@@ -1519,6 +1521,30 @@ warnMissingSignatures gbl_env
; add_sig_warns }
+-- | Warn the user about tycons that lack kind signatures.
+-- Called /after/ type (and kind) inference, so that we can report the
+-- inferred kinds.
+warnMissingKindSignatures :: TcGblEnv -> RnM ()
+warnMissingKindSignatures gbl_env
+ = do { warn_missing_kind_sigs <- woptM Opt_WarnMissingKindSignatures
+ ; cusks_enabled <- xoptM LangExt.CUSKs
+ ; when (warn_missing_kind_sigs) (mapM_ (add_ty_warn cusks_enabled) tcs)
+ }
+ where
+ tcs = tcg_tcs gbl_env
+ ksig_ns = tcg_ksigs gbl_env
+
+ add_ty_warn :: Bool -> TyCon -> IOEnv (Env TcGblEnv TcLclEnv) ()
+ add_ty_warn cusks_enabled tyCon = when (name `elemNameSet` ksig_ns) $
+ addWarnAt (Reason Opt_WarnMissingKindSignatures) (getSrcSpan name) $
+ hang msg 2 (text "type" <+> pprPrefixName name <+> dcolon <+> ki_msg)
+ where
+ msg | cusks_enabled = text "Top-level type constructor with no standalone kind signature or CUSK:"
+ | otherwise = text "Top-level type constructor with no standalone kind signature:"
+ name = tyConName tyCon
+ ki = tyConKind tyCon
+ ki_msg :: SDoc
+ ki_msg = pprKind ki
{-
*********************************************************
diff --git a/compiler/GHC/Tc/TyCl.hs b/compiler/GHC/Tc/TyCl.hs
index bcb9fa084d..d4b25806bf 100644
--- a/compiler/GHC/Tc/TyCl.hs
+++ b/compiler/GHC/Tc/TyCl.hs
@@ -180,7 +180,7 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
-- Step 1: Typecheck the standalone kind signatures and type/class declarations
; traceTc "---- tcTyClGroup ---- {" empty
; traceTc "Decls for" (ppr (map (tcdName . unLoc) tyclds))
- ; (tyclss, data_deriv_info) <-
+ ; (tyclss, data_deriv_info, kindless) <-
tcExtendKindEnv (mkPromotionErrorEnv tyclds) $ -- See Note [Type environment evolution]
do { kisig_env <- mkNameEnv <$> traverse tcStandaloneKindSig kisigs
; tcTyClDecls tyclds kisig_env role_annots }
@@ -214,7 +214,9 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
tcInstDecls1 instds
; let deriv_info = datafam_deriv_info ++ data_deriv_info
- ; return (gbl_env', inst_info, deriv_info) }
+ ; let gbl_env'' = gbl_env'
+ { tcg_ksigs = tcg_ksigs gbl_env' `unionNameSet` kindless }
+ ; return (gbl_env'', inst_info, deriv_info) }
-- Gives the kind for every TyCon that has a standalone kind signature
type KindSigEnv = NameEnv Kind
@@ -223,12 +225,12 @@ tcTyClDecls
:: [LTyClDecl GhcRn]
-> KindSigEnv
-> RoleAnnotEnv
- -> TcM ([TyCon], [DerivInfo])
+ -> TcM ([TyCon], [DerivInfo], NameSet)
tcTyClDecls tyclds kisig_env role_annots
= do { -- Step 1: kind-check this group and returns the final
-- (possibly-polymorphic) kind of each TyCon and Class
-- See Note [Kind checking for type and class decls]
- tc_tycons <- kcTyClGroup kisig_env tyclds
+ (tc_tycons, kindless) <- kcTyClGroup kisig_env tyclds
; traceTc "tcTyAndCl generalized kinds" (vcat (map ppr_tc_tycon tc_tycons))
-- Step 2: type-check all groups together, returning
@@ -237,7 +239,7 @@ tcTyClDecls tyclds kisig_env role_annots
-- NB: We have to be careful here to NOT eagerly unfold
-- type synonyms, as we have not tested for type synonym
-- loops yet and could fall into a black hole.
- ; fixM $ \ ~(rec_tyclss, _) -> do
+ ; fixM $ \ ~(rec_tyclss, _, _) -> do
{ tcg_env <- getGblEnv
-- Forced so we don't retain a reference to the TcGblEnv
; let !src = tcg_src tcg_env
@@ -258,7 +260,7 @@ tcTyClDecls tyclds kisig_env role_annots
-- Kind and type check declarations for this group
mapAndUnzipM (tcTyClDecl roles) tyclds
- ; return (tycons, concat data_deriv_infos)
+ ; return (tycons, concat data_deriv_infos, kindless)
} }
where
ppr_tc_tycon tc = parens (sep [ ppr (tyConName tc) <> comma
@@ -631,12 +633,14 @@ been generalized.
-}
-kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM [TcTyCon]
+kcTyClGroup :: KindSigEnv -> [LTyClDecl GhcRn] -> TcM ([TcTyCon], NameSet)
-- Kind check this group, kind generalize, and return the resulting local env
-- This binds the TyCons and Classes of the group, but not the DataCons
-- See Note [Kind checking for type and class decls]
-- and Note [Inferring kinds for type declarations]
+--
+-- The NameSet returned contains kindless tycon names, without CUSK or SAKS.
kcTyClGroup kisig_env decls
= do { mod <- getModule
; traceTc "---- kcTyClGroup ---- {"
@@ -651,9 +655,12 @@ kcTyClGroup kisig_env decls
; cusks_enabled <- xoptM LangExt.CUSKs <&&> xoptM LangExt.PolyKinds
-- See Note [CUSKs and PolyKinds]
; let (kindless_decls, kinded_decls) = partitionWith get_kind decls
+ kindless_names = mkNameSet $ map get_name kindless_decls
+
+ get_name d = tcdName (unLoc d)
get_kind d
- | Just ki <- lookupNameEnv kisig_env (tcdName (unLoc d))
+ | Just ki <- lookupNameEnv kisig_env (get_name d)
= Right (d, SAKS ki)
| cusks_enabled && hsDeclHasCusk (unLoc d)
@@ -700,7 +707,7 @@ kcTyClGroup kisig_env decls
; let poly_tcs = checked_tcs ++ generalized_tcs
; traceTc "---- kcTyClGroup end ---- }" (ppr_tc_kinds poly_tcs)
- ; return poly_tcs }
+ ; return (poly_tcs, kindless_names) }
where
ppr_tc_kinds tcs = vcat (map pp_tc tcs)
pp_tc tc = ppr (tyConName tc) <+> dcolon <+> ppr (tyConKind tc)
diff --git a/compiler/GHC/Tc/Types.hs b/compiler/GHC/Tc/Types.hs
index 5da6364444..dbed564efc 100644
--- a/compiler/GHC/Tc/Types.hs
+++ b/compiler/GHC/Tc/Types.hs
@@ -540,6 +540,7 @@ data TcGblEnv
tcg_warns :: Warnings, -- ...Warnings and deprecations
tcg_anns :: [Annotation], -- ...Annotations
tcg_tcs :: [TyCon], -- ...TyCons and Classes
+ tcg_ksigs :: NameSet, -- ...Top-level TyCon names that *lack* a signature
tcg_insts :: [ClsInst], -- ...Instances
tcg_fam_insts :: [FamInst], -- ...Family instances
tcg_rules :: [LRuleDecl GhcTc], -- ...Rules
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 1a70f0ecbd..b79200c288 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -322,6 +322,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_binds = emptyLHsBinds,
tcg_imp_specs = [],
tcg_sigs = emptyNameSet,
+ tcg_ksigs = emptyNameSet,
tcg_ev_binds = emptyBag,
tcg_warns = NoWarnings,
tcg_anns = [],
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 9771837b93..4c1a01f6db 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -114,6 +114,7 @@ The following flags are simple ways to select standard "packages" of warnings:
* :ghc-flag:`-Wunused-type-patterns`
* :ghc-flag:`-Wsafe`
* :ghc-flag:`-Wimplicit-lift`
+ * :ghc-flag:`-Wmissing-kind-signatures`
.. ghc-flag:: -Weverything
:shortdesc: enable all warnings supported by GHC
@@ -1182,6 +1183,32 @@ of ``-W(no-)*``.
synonyms must have a type signature. GHC also reports the inferred
type. This option is off by default.
+.. ghc-flag:: -Wmissing-kind-signatures
+ :shortdesc: warn when type declarations don't have kind signatures nor CUSKs
+ :type: dynamic
+ :reverse: -Wno-missing-kind-signatures
+ :category:
+
+ :since: 9.2
+
+ .. index::
+ single: kind signatures, missing
+
+ If you would like GHC to check that every data, type family,
+ type-class definition has a :ref:`standalone kind signature <standalone-kind-signatures>` or a :ref:`CUSK <complete-kind-signatures>`, use the
+ :ghc-flag:`-Wmissing-kind-signatures` option.
+ You can specify the kind via :extension:`StandaloneKindSignatures`
+ or :extension:`CUSKs`.
+
+ Note that :ghc-flag:`-Wmissing-kind-signatures` does not warn about
+ associated type families, as GHC considers an associated type family
+ declaration to have a CUSK if its enclosing class has a CUSK. (See
+ :ref:`complete-kind-signatures` for more on this point.) Therefore, giving
+ the parent class a standalone kind signature or CUSK is sufficient to fix
+ the warning for the class's associated type families as well.
+
+ This option is off by default.
+
.. ghc-flag:: -Wname-shadowing
:shortdesc: warn when names are shadowed
:type: dynamic
diff --git a/testsuite/tests/warnings/should_compile/T19564a.hs b/testsuite/tests/warnings/should_compile/T19564a.hs
new file mode 100644
index 0000000000..462d82cc42
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T19564a.hs
@@ -0,0 +1,32 @@
+{-# OPTIONS_GHC -Wmissing-kind-signatures #-}
+{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-}
+-- without standalone kind signatures or cusks: warnings
+module T19564a where
+
+-- type family
+type family Id x where
+ Id Int = Int
+
+-- class definition
+class Functor f => Alt f where
+ (<!>) :: f a -> f a -> f a
+
+-- type alias
+type Arr a b = a -> b
+type B = Bool
+
+-- Haskell98 data
+data YesNo = Yes | No
+data V2 a = V2 a a
+
+-- GADT
+data Free f a where
+ Pure :: a -> Free f a
+ Ap :: f b -> Free f (b -> a) -> Free f a
+
+-- data family
+data family D1 a
+
+-- associated type family
+class C a where
+ type AT a b
diff --git a/testsuite/tests/warnings/should_compile/T19564a.stderr b/testsuite/tests/warnings/should_compile/T19564a.stderr
new file mode 100644
index 0000000000..f64805fa31
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T19564a.stderr
@@ -0,0 +1,36 @@
+
+T19564a.hs:7:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Id :: * -> *
+
+T19564a.hs:11:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Alt :: (* -> *) -> Constraint
+
+T19564a.hs:15:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Arr :: * -> * -> *
+
+T19564a.hs:16:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type B :: *
+
+T19564a.hs:19:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type YesNo :: *
+
+T19564a.hs:20:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type V2 :: * -> *
+
+T19564a.hs:23:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Free :: (* -> *) -> * -> *
+
+T19564a.hs:28:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type D1 :: * -> *
+
+T19564a.hs:31:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type C :: forall {k}. k -> Constraint
diff --git a/testsuite/tests/warnings/should_compile/T19564b.hs b/testsuite/tests/warnings/should_compile/T19564b.hs
new file mode 100644
index 0000000000..a981e9f61c
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T19564b.hs
@@ -0,0 +1,46 @@
+{-# OPTIONS_GHC -Wmissing-kind-signatures #-}
+{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-}
+-- with kind signatures: no warnings
+module T19564b where
+
+import Data.Kind (Type, Constraint)
+
+-- type family
+type Id :: Type -> Type
+type family Id x where
+ Id Int = Int
+
+-- class definition
+type Alt :: (Type -> Type) -> Constraint
+class Functor f => Alt f where
+ (<!>) :: f a -> f a -> f a
+
+-- type alias
+type Arr :: Type -> Type -> Type
+type Arr a b = a -> b
+
+type B :: Type
+type B = Bool
+
+-- Haskell98 data
+type YesNo :: Type
+data YesNo = Yes | No
+
+type V2 :: Type -> Type
+data V2 a = V2 a a
+
+-- GADT
+type Free :: (Type -> Type) -> (Type -> Type)
+data Free f a where
+ Pure :: a -> Free f a
+ Ap :: f b -> Free f (b -> a) -> Free f a
+
+-- data family
+type D1 :: Type -> Type
+data family D1 a
+
+-- associated type family
+type C :: Type -> Constraint
+class C a where
+ -- is defaulted, doesn't need annotation
+ type AT a b
diff --git a/testsuite/tests/warnings/should_compile/T19564c.hs b/testsuite/tests/warnings/should_compile/T19564c.hs
new file mode 100644
index 0000000000..6f950b7307
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T19564c.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -Wmissing-kind-signatures #-}
+{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-}
+-- with cusks but without -XCUSK, warnings
+module T19564c where
+
+import Data.Kind (Type, Constraint)
+
+-- type family
+type family Id (x :: Type) :: Type where
+ Id Int = Int
+
+-- class definition
+class Functor f => Alt (f :: Type -> Type) where
+ (<!>) :: f a -> f a -> f a
+
+-- type alias
+type Arr (a :: Type) (b :: Type) = a -> b :: Type
+type B = Bool :: Type
+
+-- Haskell98 data
+data YesNo = Yes | No
+data V2 (a :: Type) = V2 a a
+
+-- GADT
+data Free (f :: Type -> Type) (a :: Type) where
+ Pure :: a -> Free f a
+ Ap :: f b -> Free f (b -> a) -> Free f a
+
+-- data family
+data family D1 (a :: Type)
+
+-- associated type family
+class C (a :: Type) where
+ type AT a b
diff --git a/testsuite/tests/warnings/should_compile/T19564c.stderr b/testsuite/tests/warnings/should_compile/T19564c.stderr
new file mode 100644
index 0000000000..587ea089fc
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T19564c.stderr
@@ -0,0 +1,36 @@
+
+T19564c.hs:9:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Id :: * -> *
+
+T19564c.hs:13:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Alt :: (* -> *) -> Constraint
+
+T19564c.hs:17:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Arr :: * -> * -> *
+
+T19564c.hs:18:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type B :: *
+
+T19564c.hs:21:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type YesNo :: *
+
+T19564c.hs:22:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type V2 :: * -> *
+
+T19564c.hs:25:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Free :: (* -> *) -> * -> *
+
+T19564c.hs:30:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type D1 :: * -> *
+
+T19564c.hs:33:1: warning: [-Wmissing-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type C :: * -> Constraint
diff --git a/testsuite/tests/warnings/should_compile/T19564d.hs b/testsuite/tests/warnings/should_compile/T19564d.hs
new file mode 100644
index 0000000000..599f5bbc6a
--- /dev/null
+++ b/testsuite/tests/warnings/should_compile/T19564d.hs
@@ -0,0 +1,34 @@
+{-# OPTIONS_GHC -Wmissing-kind-signatures #-}
+{-# LANGUAGE GADTs, PolyKinds, TypeFamilies, CUSKs #-}
+-- with -XCUSKs, no warnings
+module T19564c where
+
+import Data.Kind (Type, Constraint)
+
+-- type family
+type family Id (x :: Type) :: Type where
+ Id Int = Int
+
+-- class definition
+class Functor f => Alt (f :: Type -> Type) where
+ (<!>) :: f a -> f a -> f a
+
+-- type alias
+type Arr (a :: Type) (b :: Type) = a -> b :: Type
+type B = Bool :: Type
+
+-- Haskell98 data
+data YesNo = Yes | No
+data V2 (a :: Type) = V2 a a
+
+-- GADT
+data Free (f :: Type -> Type) (a :: Type) where
+ Pure :: a -> Free f a
+ Ap :: f b -> Free f (b -> a) -> Free f a
+
+-- data family
+data family D1 (a :: Type)
+
+-- associated type family
+class C (a :: Type) where
+ type AT a b
diff --git a/testsuite/tests/warnings/should_compile/all.T b/testsuite/tests/warnings/should_compile/all.T
index 7e8668c8d8..f1739aebc3 100644
--- a/testsuite/tests/warnings/should_compile/all.T
+++ b/testsuite/tests/warnings/should_compile/all.T
@@ -38,3 +38,8 @@ test('UnusedPackages', normal, multimod_compile,
['UnusedPackages.hs', '-package=bytestring -package=base -package=process -package=ghc -Wunused-packages'])
test('T18402', normal, compile, [''])
+
+test('T19564a', normal, compile, [''])
+test('T19564b', normal, compile, [''])
+test('T19564c', normal, compile, [''])
+test('T19564d', normal, compile, [''])
View Lorry Controller Status