[Git][ghc/ghc][master] Add -Wmissing-poly-kind-signatures
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jun 14 11:01:43 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
e4b33a1d by Oleg Grenrus at 2023-06-14T07:01:21-04:00
Add -Wmissing-poly-kind-signatures
Implements #22826
This is a restricted version of -Wmissing-kind-signatures shown only for polykinded types.
- - - - -
11 changed files:
- compiler/GHC/Core/Type.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Utils/Monad.hs
- docs/users_guide/using-warnings.rst
- + testsuite/tests/warnings/should_compile/T22826.hs
- + testsuite/tests/warnings/should_compile/T22826.stderr
- testsuite/tests/warnings/should_compile/all.T
Changes:
=====================================
compiler/GHC/Core/Type.hs
=====================================
@@ -111,6 +111,7 @@ module GHC.Core.Type (
isTyVarTy, isFunTy, isCoercionTy,
isCoercionTy_maybe, isForAllTy,
isForAllTy_ty, isForAllTy_co,
+ isForAllTy_invis_ty,
isPiTy, isTauTy, isFamFreeTy,
isCoVarType, isAtomicTy,
@@ -1891,6 +1892,15 @@ isForAllTy_ty ty
| otherwise = False
+-- | Like `isForAllTy`, but returns True only if it is an inferred tyvar binder
+isForAllTy_invis_ty :: Type -> Bool
+isForAllTy_invis_ty ty
+ | ForAllTy (Bndr tv (Invisible InferredSpec)) _ <- coreFullView ty
+ , isTyVar tv
+ = True
+
+ | otherwise = False
+
-- | Like `isForAllTy`, but returns True only if it is a covar binder
isForAllTy_co :: Type -> Bool
isForAllTy_co ty
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -631,6 +631,7 @@ data WarningFlag =
| Opt_WarnAmbiguousFields -- Since 9.2
| Opt_WarnImplicitLift -- Since 9.2
| Opt_WarnMissingKindSignatures -- Since 9.2
+ | Opt_WarnMissingPolyKindSignatures -- Since 9.8
| Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2
| Opt_WarnRedundantStrictnessFlags -- Since 9.4
| Opt_WarnForallIdentifier -- Since 9.4
@@ -685,6 +686,7 @@ warnFlagNames wflag = case wflag of
Opt_WarnSemigroup -> "semigroup" :| []
Opt_WarnMissingSignatures -> "missing-signatures" :| []
Opt_WarnMissingKindSignatures -> "missing-kind-signatures" :| []
+ Opt_WarnMissingPolyKindSignatures -> "missing-poly-kind-signatures" :| []
Opt_WarnMissingExportedSignatures -> "missing-exported-signatures" :| []
Opt_WarnMonomorphism -> "monomorphism-restriction" :| []
Opt_WarnNameShadowing -> "name-shadowing" :| []
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2192,6 +2192,7 @@ wWarningFlagsDeps = mconcat [
warnSpec Opt_WarnSemigroup,
warnSpec Opt_WarnMissingSignatures,
warnSpec Opt_WarnMissingKindSignatures,
+ warnSpec Opt_WarnMissingPolyKindSignatures,
subWarnSpec "missing-exported-sigs"
Opt_WarnMissingExportedSignatures
"it is replaced by -Wmissing-exported-signatures",
=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -1689,12 +1689,13 @@ warnMissingKindSignatures gbl_env
tcs = tcg_tcs gbl_env
ksig_ns = tcg_ksigs gbl_env
exports = availsToNameSet (tcg_exports gbl_env)
- not_ghc_generated :: Name -> Bool
- not_ghc_generated name = name `elemNameSet` ksig_ns
+
+ has_kind_signature :: Name -> Bool
+ has_kind_signature name = name `elemNameSet` ksig_ns
add_ty_warn :: Bool -> TyCon -> RnM ()
add_ty_warn cusks_enabled tyCon =
- when (not_ghc_generated name) $
+ when (has_kind_signature name) $
addDiagnosticAt (getSrcSpan name) diag
where
name = tyConName tyCon
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -3321,8 +3321,8 @@ missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported
missingSignatureWarningFlags (MissingPatSynSig {}) exported
= Opt_WarnMissingPatternSynonymSignatures :|
[ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported == exported ]
-missingSignatureWarningFlags (MissingTyConKindSig {}) _
- = Opt_WarnMissingKindSignatures :| []
+missingSignatureWarningFlags (MissingTyConKindSig ty_con _) _
+ = Opt_WarnMissingKindSignatures :| [Opt_WarnMissingPolyKindSignatures | isForAllTy_invis_ty (tyConKind ty_con) ]
useDerivingStrategies :: GhcHint
useDerivingStrategies =
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -936,6 +936,7 @@ data TcRnMessage where
-Wmissing-pattern-synonym-signatures
-Wmissing-exported-pattern-synonym-signatures
-Wmissing-kind-signatures
+ -Wmissing-poly-kind-signatures
Test cases:
T11077 (top-level bindings)
=====================================
compiler/GHC/Tc/Utils/Monad.hs
=====================================
@@ -1543,6 +1543,17 @@ tryTcDiscardingErrs recover thing_inside
tidy up the message; we then use it to tidy the context messages
-}
+{-
+
+Note [Reporting warning diagnostics]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use functions below to report warnings. For the most part,
+we do /not/ need to check any warning flags before doing so.
+See https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values
+for the design.
+
+-}
+
addErrTc :: TcRnMessage -> TcM ()
addErrTc err_msg = do { env0 <- liftZonkM tcInitTidyEnv
; addErrTcM (env0, err_msg) }
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -1324,6 +1324,31 @@ of ``-W(no-)*``.
the parent class a standalone kind signature or CUSK is sufficient to fix
the warning for the class's associated type families as well.
+.. ghc-flag:: -Wmissing-poly-kind-signatures
+ :shortdesc: warn when inferred polykinded type or class declaration don't have kind signatures nor CUSKs
+ :type: dynamic
+ :reverse: -Wno-missing-poly-kind-signatures
+ :category:
+
+ :since: 9.8
+ :default: off
+
+ .. index::
+ single: kind signatures, missing
+
+ This is a restricted version of :ghc-flag:`-Wmissing-kind-signatures`.
+
+ It warns when a declaration defines a type constructor that lacks a :ref:`standalone kind signature <standalone-kind-signatures>`
+ and whose inferred kind is polymorphic (which happens with `-PolyKinds`. For example ::
+
+ data T a = MkT (a -> Int) -- T :: Type -> Type
+ -- Not polymorphic, hence no warning
+ data W f a = MkW (f a) -- W :: forall k. (k->Type) -> k -> Type
+ -- Polymorphic, hence warning!
+
+ It is useful to catch accidentally polykinded types, or to make that polymorphism explicit,
+ without requiring a kind signature for every type.
+
.. ghc-flag:: -Wmissing-exported-pattern-synonym-signatures
:shortdesc: warn about pattern synonyms without signatures, only if they
are exported
=====================================
testsuite/tests/warnings/should_compile/T22826.hs
=====================================
@@ -0,0 +1,53 @@
+{-# OPTIONS_GHC -Wmissing-poly-kind-signatures #-}
+{-# LANGUAGE GADTs, PolyKinds, TypeFamilies #-}
+-- without standalone kind signatures or cusks: warnings
+module T22826 where
+
+import Data.Kind (Type)
+
+-- type family
+type family Id x where
+ Id Int = Int
+
+-- class definition
+class Functor f => Alt f where
+ (<!>) :: f a -> f a -> f a
+
+-- polykinded class
+class EqP f where
+ eqp :: f a -> f b -> Bool
+
+-- 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
+
+-- polykinded data
+data Proxy a = Proxy
+
+-- associated type family
+class C a where
+ type AT a b
+
+-- polykinded type with partial kind spec
+-- not warned: PolyKinds don't add variables here
+data D (k :: Type) a (b :: k) where
+ D :: [a] -> D k a b
+
+-- polykinded type without kind signature, which is polymorphic,
+-- but PolyKinds won't change it.
+data E a k b = MkE a (VProxy k b)
+
+type VProxy :: forall k -> k -> Type
+data VProxy k a = MkVP
=====================================
testsuite/tests/warnings/should_compile/T22826.stderr
=====================================
@@ -0,0 +1,12 @@
+
+T22826.hs:17:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type EqP :: forall {k}. (k -> *) -> Constraint
+
+T22826.hs:37:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type Proxy :: forall {k}. k -> *
+
+T22826.hs:40:1: warning: [GHC-38417] [-Wmissing-poly-kind-signatures]
+ Top-level type constructor with no standalone kind signature:
+ type C :: forall {k}. k -> Constraint
=====================================
testsuite/tests/warnings/should_compile/all.T
=====================================
@@ -64,3 +64,4 @@ test('DodgyImports', normal, compile, ['-Wdodgy-imports'])
test('DodgyImports_hiding', normal, compile, ['-Wdodgy-imports'])
test('T22702a', normal, compile, [''])
test('T22702b', normal, compile, [''])
+test('T22826', normal, compile, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4b33a1ded2a3934f4b1bf61c348f06241eb49c5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/e4b33a1ded2a3934f4b1bf61c348f06241eb49c5
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230614/79217781/attachment-0001.html>
More information about the ghc-commits
mailing list