summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorVladislav Zavialov <vlad.z.4096@gmail.com>2021-11-05 00:47:32 +0300
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-11-12 21:22:03 -0500
commitdfc4093ccb7c4b7402830ab7c715b55d90980af1 (patch)
tree7cd92eafd556c01b35d4298597f364dfbabbe25b
parentca90ffa321a31842a32be1b5b6e26743cd677ec5 (diff)
downloadhaskell-dfc4093ccb7c4b7402830ab7c715b55d90980af1.tar.gz
Implement -Wforall-identifier (#20609)
In accordance with GHC Proposal #281 "Visible forall in types of terms": For three releases before this change takes place, include a new warning -Wforall-identifier in -Wdefault. This warning will be triggered at definition sites (but not use sites) of forall as an identifier. Updates the haddock submodule.
-rw-r--r--compiler/GHC/Driver/Flags.hs3
-rw-r--r--compiler/GHC/Driver/Session.hs1
-rw-r--r--compiler/GHC/Rename/Bind.hs5
-rw-r--r--compiler/GHC/Rename/HsType.hs6
-rw-r--r--compiler/GHC/Rename/Module.hs7
-rw-r--r--compiler/GHC/Rename/Pat.hs8
-rw-r--r--compiler/GHC/Rename/Utils.hs8
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs9
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs11
-rw-r--r--compiler/GHC/Types/Hint.hs5
-rw-r--r--compiler/GHC/Types/Hint/Ppr.hs5
-rw-r--r--docs/users_guide/using-warnings.rst28
-rw-r--r--libraries/template-haskell/Language/Haskell/TH/Ppr.hs6
-rw-r--r--testsuite/tests/ghci/prog017/TopLevel.hs4
-rw-r--r--testsuite/tests/ghci/prog017/prog017.script2
-rw-r--r--testsuite/tests/ghci/prog017/prog017.stdout4
-rw-r--r--testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr7
-rw-r--r--testsuite/tests/rename/should_compile/T20609.hs23
-rw-r--r--testsuite/tests/rename/should_compile/T20609.stderr49
-rw-r--r--testsuite/tests/rename/should_compile/T20609a.hs12
-rw-r--r--testsuite/tests/rename/should_compile/T20609a.stderr7
-rw-r--r--testsuite/tests/rename/should_compile/T20609b.hs13
-rw-r--r--testsuite/tests/rename/should_compile/T20609b.stderr7
-rw-r--r--testsuite/tests/rename/should_compile/T20609c.hs8
-rw-r--r--testsuite/tests/rename/should_compile/T20609c.stderr14
-rw-r--r--testsuite/tests/rename/should_compile/T20609d.hs6
-rw-r--r--testsuite/tests/rename/should_compile/T20609d.stderr7
-rw-r--r--testsuite/tests/rename/should_compile/all.T5
m---------utils/haddock0
29 files changed, 254 insertions, 16 deletions
diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs
index d7f72fcf2e..192b983887 100644
--- a/compiler/GHC/Driver/Flags.hs
+++ b/compiler/GHC/Driver/Flags.hs
@@ -536,6 +536,7 @@ data WarningFlag =
| Opt_WarnMissingKindSignatures -- Since 9.2
| Opt_WarnMissingExportedPatternSynonymSignatures -- since 9.2
| Opt_WarnRedundantStrictnessFlags -- Since 9.4
+ | Opt_WarnForallIdentifier -- Since 9.4
| Opt_WarnUnicodeBidirectionalFormatCharacters -- Since 9.0.2
deriving (Eq, Ord, Show, Enum)
@@ -636,6 +637,7 @@ warnFlagNames wflag = case wflag of
Opt_WarnOperatorWhitespace -> "operator-whitespace" :| []
Opt_WarnImplicitLift -> "implicit-lift" :| []
Opt_WarnMissingExportedPatternSynonymSignatures -> "missing-exported-pattern-synonym-signatures" :| []
+ Opt_WarnForallIdentifier -> "forall-identifier" :| []
Opt_WarnUnicodeBidirectionalFormatCharacters -> "unicode-bidirectional-format-characters" :| []
-- -----------------------------------------------------------------------------
@@ -728,6 +730,7 @@ standardWarnings -- see Note [Documenting warning flags]
Opt_WarnNonCanonicalMonadInstances,
Opt_WarnNonCanonicalMonoidInstances,
Opt_WarnOperatorWhitespaceExtConflict,
+ Opt_WarnForallIdentifier,
Opt_WarnUnicodeBidirectionalFormatCharacters
]
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index b4983d9218..5f4479939a 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -3218,6 +3218,7 @@ wWarningFlagsDeps = mconcat [
warnSpec Opt_WarnOperatorWhitespace,
warnSpec Opt_WarnImplicitLift,
warnSpec Opt_WarnMissingExportedPatternSynonymSignatures,
+ warnSpec Opt_WarnForallIdentifier,
warnSpec Opt_WarnUnicodeBidirectionalFormatCharacters
]
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index b85cee2a51..08e8672d00 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -43,7 +43,9 @@ import GHC.Rename.Names
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( HsDocContext(..), mapFvRn
- , checkDupRdrNames, checkDupRdrNamesN, warnUnusedLocalBinds
+ , checkDupRdrNames, checkDupRdrNamesN
+ , warnUnusedLocalBinds
+ , warnForallIdentifier
, checkUnusedRecordWildcard
, checkDupAndShadowedNames, bindLocalNamesFV
, addNoNestedForallsContextsErr, checkInferredVars )
@@ -981,6 +983,7 @@ renameSig ctxt sig@(ClassOpSig _ is_deflt vs ty)
= do { defaultSigs_on <- xoptM LangExt.DefaultSignatures
; when (is_deflt && not defaultSigs_on) $
addErr (defaultSigErr sig)
+ ; mapM_ warnForallIdentifier vs
; new_v <- mapM (lookupSigOccRnN ctxt sig) vs
; (new_ty, fvs) <- rnHsSigType ty_ctxt TypeLevel ty
; return (ClassOpSig noAnn is_deflt new_v new_ty, fvs) }
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs
index 1340993084..6740e02430 100644
--- a/compiler/GHC/Rename/HsType.hs
+++ b/compiler/GHC/Rename/HsType.hs
@@ -51,7 +51,8 @@ import GHC.Rename.Env
import GHC.Rename.Utils ( HsDocContext(..), inHsDocContext, withHsDocContext
, mapFvRn, pprHsDocContext, bindLocalNamesFV
, typeAppErr, newLocalBndrRn, checkDupRdrNamesN
- , checkShadowedRdrNames )
+ , checkShadowedRdrNames
+ , warnForallIdentifier )
import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
, lookupTyFixityRn )
import GHC.Rename.Unbound ( notInScopeErr, WhereLooking(WL_LocalOnly) )
@@ -1281,7 +1282,8 @@ rnConDeclFields ctxt fls fields
rnField :: FastStringEnv FieldLabel -> RnTyKiEnv -> LConDeclField GhcPs
-> RnM (LConDeclField GhcRn, FreeVars)
rnField fl_env env (L l (ConDeclField _ names ty haddock_doc))
- = do { let new_names = map (fmap (lookupField fl_env)) names
+ = do { mapM_ (\(L _ (FieldOcc _ rdr_name)) -> warnForallIdentifier rdr_name) names
+ ; let new_names = map (fmap (lookupField fl_env)) names
; (new_ty, fvs) <- rnLHsTyKi env ty
; return (L l (ConDeclField noAnn new_names new_ty haddock_doc)
, fvs) }
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index 2febede5c5..d2f5463d58 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -31,6 +31,7 @@ import GHC.Rename.Env
import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, bindLocalNames
, checkDupRdrNamesN, bindLocalNamesFV
, checkShadowedRdrNames, warnUnusedTypePatterns
+ , warnForallIdentifier
, newLocalBndrsRn
, withHsDocContext, noNestedForallsContextsErr
, addNoNestedForallsContextsErr, checkInferredVars )
@@ -351,6 +352,7 @@ rnDefaultDecl (DefaultDecl _ tys)
rnHsForeignDecl :: ForeignDecl GhcPs -> RnM (ForeignDecl GhcRn, FreeVars)
rnHsForeignDecl (ForeignImport { fd_name = name, fd_sig_ty = ty, fd_fi = spec })
= do { topEnv :: HscEnv <- getTopEnv
+ ; warnForallIdentifier name
; name' <- lookupLocatedTopBndrRnN name
; (ty', fvs) <- rnHsSigType (ForeignDeclCtx name) TypeLevel ty
@@ -1220,6 +1222,7 @@ rnHsRuleDecl (HsRule { rd_name = rule_name
, rd_lhs = lhs
, rd_rhs = rhs })
= do { let rdr_names_w_loc = map (get_var . unLoc) tmvs
+ ; mapM_ warnForallIdentifier rdr_names_w_loc
; checkDupRdrNamesN rdr_names_w_loc
; checkShadowedRdrNames rdr_names_w_loc
; names <- newLocalBndrsRn rdr_names_w_loc
@@ -2299,7 +2302,7 @@ rnConDecls = mapFvRn (wrapLocFstMA rnConDecl)
rnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars)
rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
, con_mb_cxt = mcxt, con_args = args
- , con_doc = mb_doc, con_forall = forall })
+ , con_doc = mb_doc, con_forall = forall_ })
= do { _ <- addLocMA checkConName name
; new_name <- lookupLocatedTopConstructorRnN name
@@ -2326,7 +2329,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
, con_name = new_name, con_ex_tvs = new_ex_tvs
, con_mb_cxt = new_context, con_args = new_args
, con_doc = mb_doc
- , con_forall = forall }, -- Remove when #18311 is fixed
+ , con_forall = forall_ }, -- Remove when #18311 is fixed
all_fvs) }}
rnConDecl (ConDeclGADT { con_names = names
diff --git a/compiler/GHC/Rename/Pat.hs b/compiler/GHC/Rename/Pat.hs
index a011b709cf..79eeaa3477 100644
--- a/compiler/GHC/Rename/Pat.hs
+++ b/compiler/GHC/Rename/Pat.hs
@@ -53,7 +53,7 @@ import GHC.Tc.Utils.Zonk ( hsOverLitName )
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( HsDocContext(..), newLocalBndrRn, bindLocalNames
- , warnUnusedMatches, newLocalBndrRn
+ , warnUnusedMatches, warnForallIdentifier
, checkUnusedRecordWildcard
, checkDupNames, checkDupAndShadowedNames
, wrapGenSpan, genHsApps, genLHsVar, genHsIntegralLit )
@@ -232,14 +232,16 @@ newPatLName name_maker rdr_name@(L loc _)
newPatName :: NameMaker -> LocatedN RdrName -> CpsRn Name
newPatName (LamMk report_unused) rdr_name
= CpsRn (\ thing_inside ->
- do { name <- newLocalBndrRn rdr_name
+ do { warnForallIdentifier rdr_name
+ ; name <- newLocalBndrRn rdr_name
; (res, fvs) <- bindLocalNames [name] (thing_inside name)
; when report_unused $ warnUnusedMatches [name] fvs
; return (res, name `delFV` fvs) })
newPatName (LetMk is_top fix_env) rdr_name
= CpsRn (\ thing_inside ->
- do { name <- case is_top of
+ do { warnForallIdentifier rdr_name
+ ; name <- case is_top of
NotTopLevel -> newLocalBndrRn rdr_name
TopLevel -> newTopSrcBinder rdr_name
; bindLocalNames [name] $
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index fc27dac004..4041b0b6c8 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -15,6 +15,7 @@ module GHC.Rename.Utils (
addFvRn, mapFvRn, mapMaybeFvRn,
warnUnusedMatches, warnUnusedTypePatterns,
warnUnusedTopBinds, warnUnusedLocalBinds,
+ warnForallIdentifier,
checkUnusedRecordWildcard,
mkFieldEnv,
unknownSubordinateErr, badQualBndrErr, typeAppErr,
@@ -426,6 +427,13 @@ check_unused flag bound_names used_names
= whenWOptM flag (warnUnused flag (filterOut (`elemNameSet` used_names)
bound_names))
+warnForallIdentifier :: LocatedN RdrName -> RnM ()
+warnForallIdentifier (L l rdr_name@(Unqual occ))
+ | isKw (fsLit "forall") || isKw (fsLit "∀")
+ = addDiagnosticAt (locA l) (TcRnForallIdentifier rdr_name)
+ where isKw = (occNameFS occ ==)
+warnForallIdentifier _ = return ()
+
-------------------------
-- Helpers
warnUnusedGREs :: [GlobalRdrElt] -> RnM ()
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index e282d8fe8d..b5a0dbb284 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -517,6 +517,11 @@ instance Diagnostic TcRnMessage where
= text " when Safe Haskell is enabled."
| otherwise
= dot
+ TcRnForallIdentifier rdr_name
+ -> mkSimpleDecorated $
+ fsep [ text "The use of" <+> quotes (ppr rdr_name)
+ <+> text "as an identifier",
+ text "will become an error in a future GHC release." ]
diagnosticReason = \case
TcRnUnknownMessage m
@@ -733,6 +738,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnSpecialClassInst {}
-> ErrorWithoutFlag
+ TcRnForallIdentifier {}
+ -> WarningWithFlag Opt_WarnForallIdentifier
diagnosticHints = \case
TcRnUnknownMessage m
@@ -943,6 +950,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnSpecialClassInst {}
-> noHints
+ TcRnForallIdentifier {}
+ -> [SuggestRenameForall]
deriveInstanceErrReasonHints :: Class
-> UsingGeneralizedNewtypeDeriving
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index 10cc3524df..98e2479e52 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -1412,6 +1412,17 @@ data TcRnMessage where
-}
TcRnArrowProcGADTPattern :: TcRnMessage
+ {- TcRnForallIdentifier is a warning (controlled with -Wforall-identifier) that occurs
+ when a definition uses 'forall' as an identifier.
+
+ Example:
+ forall x = ()
+ g forall = ()
+
+ Test cases: T20609 T20609a T20609b T20609c T20609d
+ -}
+ TcRnForallIdentifier :: RdrName -> TcRnMessage
+
-- | Which parts of a record field are affected by a particular error or warning.
data RecordFieldPart
= RecordFieldConstructor !Name
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index d0980bce95..1f76f028d7 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -309,6 +309,11 @@ data GhcHint
-}
| SuggestFillInWildcardConstraint
+ {-| Suggests to use an identifier other than 'forall'
+ Triggered by: 'GHC.Tc.Errors.Types.TcRnForallIdentifier'
+ -}
+ | SuggestRenameForall
+
-- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
-- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
-- to instantiate a particular signature, where the first argument is
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index 00ffb9173a..1419078df6 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -126,6 +126,11 @@ instance Outputable GhcHint where
-> text "Use a standalone deriving declaration instead"
SuggestFillInWildcardConstraint
-> text "Fill in the wildcard constraint yourself"
+ SuggestRenameForall
+ -> vcat [ text "Consider using another name, such as"
+ , quotes (text "forAll") <> comma <+>
+ quotes (text "for_all") <> comma <+> text "or" <+>
+ quotes (text "forall_") <> dot ]
perhapsAsPat :: SDoc
perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
diff --git a/docs/users_guide/using-warnings.rst b/docs/users_guide/using-warnings.rst
index 8cdd5677fe..baabbbdc37 100644
--- a/docs/users_guide/using-warnings.rst
+++ b/docs/users_guide/using-warnings.rst
@@ -56,6 +56,7 @@ To reverse ``-Werror``, which makes all warnings into errors, use ``-Wwarn``.
* :ghc-flag:`-Woperator-whitespace-ext-conflict`
* :ghc-flag:`-Wambiguous-fields`
* :ghc-flag:`-Wunicode-bidirectional-format-characters`
+ * :ghc-flag:`-Wforall-identifier`
The following flags are simple ways to select standard "packages" of warnings:
@@ -2170,6 +2171,33 @@ of ``-W(no-)*``.
This warning has no effect when :extension:`DuplicateRecordFields` is
disabled.
+.. ghc-flag:: -Wforall-identifier
+ :shortdesc: warn when ``forall`` is used as an identifier (at definition sites)
+ :type: dynamic
+ :reverse: -Wno-forall-identifier
+
+ :since: 9.4
+
+ In a future GHC release, ``forall`` will become a keyword regardless of
+ enabled extensions. This will make definitions such as the following
+ illegal::
+
+ -- from constraints-0.13
+ forall :: forall p. (forall a. Dict (p a)) -> Dict (Forall p)
+ forall d = ...
+
+ Library authors are advised to use a different identifier, such as
+ ``forAll``, ``forall_``, or ``for_all``::
+
+ forall_ :: forall p. (forall a. Dict (p a)) -> Dict (Forall p)
+ forall_ d = ...
+
+ The warning is only triggered at definition sites where it can be
+ addressed by using a different name.
+
+ Users of a library that exports ``forall`` as an identifier cannot address
+ the issue themselves, so the warning is not reported at use sites.
+
.. ghc-flag:: -Wunicode-bidirectional-format-characters
:shortdesc: warn about the usage of unicode bidirectional layout override characters
:type: dynamic
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
index 7ed842ca94..9f19d75dcd 100644
--- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
+++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs
@@ -93,10 +93,10 @@ pprPatSynType :: PatSynType -> Doc
pprPatSynType ty@(ForallT uniTys reqs ty'@(ForallT exTys provs ty''))
| null exTys, null provs = ppr (ForallT uniTys reqs ty'')
| null uniTys, null reqs = noreqs <+> ppr ty'
- | null reqs = forall uniTys <+> noreqs <+> ppr ty'
+ | null reqs = pprForallBndrs uniTys <+> noreqs <+> ppr ty'
| otherwise = ppr ty
- where noreqs = text "() =>"
- forall tvs = text "forall" <+> (hsep (map ppr tvs)) <+> text "."
+ where noreqs = text "() =>"
+ pprForallBndrs tvs = text "forall" <+> hsep (map ppr tvs) <+> text "."
pprPatSynType ty = ppr ty
------------------------------
diff --git a/testsuite/tests/ghci/prog017/TopLevel.hs b/testsuite/tests/ghci/prog017/TopLevel.hs
index c2e562b1f9..6e9d38812a 100644
--- a/testsuite/tests/ghci/prog017/TopLevel.hs
+++ b/testsuite/tests/ghci/prog017/TopLevel.hs
@@ -72,8 +72,8 @@ import Level2.Level2
(➾➔) = undefined :: () -- ... U+2794
-- mathematicalOperators
-(∀) = undefined :: () -- U+2200
-(∀⋙) = undefined :: () -- ... U+22D9
+(∁) = undefined :: () -- U+2201 (skip U+2200 because it's the keyword ∀)
+(∁⋙) = undefined :: () -- ... U+22D9
-- miscellaneousMathematicalSymbolsAR
(⟑) = undefined :: () -- U+27D1
diff --git a/testsuite/tests/ghci/prog017/prog017.script b/testsuite/tests/ghci/prog017/prog017.script
index 302233869b..7144d087fd 100644
--- a/testsuite/tests/ghci/prog017/prog017.script
+++ b/testsuite/tests/ghci/prog017/prog017.script
@@ -61,7 +61,7 @@
:complete repl "➾"
-- mathematicalOperators
-:complete repl "∀"
+:complete repl "∁"
-- miscellaneousMathematicalSymbolsAR
:complete repl "⟑"
diff --git a/testsuite/tests/ghci/prog017/prog017.stdout b/testsuite/tests/ghci/prog017/prog017.stdout
index 903660d369..57b1ba0d6c 100644
--- a/testsuite/tests/ghci/prog017/prog017.stdout
+++ b/testsuite/tests/ghci/prog017/prog017.stdout
@@ -68,8 +68,8 @@
"\10174"
"\10174\10132"
2 2 ""
-"\8704"
-"\8704\8921"
+"\8705"
+"\8705\8921"
2 2 ""
"\10193"
"\10193\10193"
diff --git a/testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr b/testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr
index 5852074450..88c7e7c771 100644
--- a/testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr
+++ b/testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr
@@ -1,4 +1,11 @@
+ExplicitForAllRules1.hs:46:31: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
ExplicitForAllRules1.hs:49:31: warning: [-Wunused-foralls (in -Wextra)]
Unused quantified type variable ‘b’
In the rewrite rule "example7"
diff --git a/testsuite/tests/rename/should_compile/T20609.hs b/testsuite/tests/rename/should_compile/T20609.hs
new file mode 100644
index 0000000000..7e8955f29f
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609.hs
@@ -0,0 +1,23 @@
+module T20609 where
+
+-- Triggers the warning (definition/binding sites):
+-- ------------------------------------------------
+
+forall x = ()
+
+(∀) x = ()
+
+fparam forall = ()
+
+asPattern forall@Nothing = ()
+
+localLet = let forall = () in forall
+
+{-# RULES "rule" forall forall. id forall = forall #-}
+
+{-# RULES "rule_sig" forall a. forall (forall :: a). id forall = forall #-}
+
+-- Does not trigger the warning (use sites):
+-- -----------------------------------------
+
+other = forall
diff --git a/testsuite/tests/rename/should_compile/T20609.stderr b/testsuite/tests/rename/should_compile/T20609.stderr
new file mode 100644
index 0000000000..a9958e2b85
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609.stderr
@@ -0,0 +1,49 @@
+
+T20609.hs:6:1: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609.hs:8:1: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘∀’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609.hs:10:8: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609.hs:12:11: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609.hs:14:16: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609.hs:16:25: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609.hs:18:40: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
diff --git a/testsuite/tests/rename/should_compile/T20609a.hs b/testsuite/tests/rename/should_compile/T20609a.hs
new file mode 100644
index 0000000000..0cf753760f
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609a.hs
@@ -0,0 +1,12 @@
+module T20609a where
+
+-- Triggers the warning (definition/binding sites):
+-- ------------------------------------------------
+
+data MyRecord a = R { forall :: a }
+
+-- Does not trigger the warning (use sites):
+-- -----------------------------------------
+
+x = forall (R { forall = () })
+f (R { forall = r }) = r
diff --git a/testsuite/tests/rename/should_compile/T20609a.stderr b/testsuite/tests/rename/should_compile/T20609a.stderr
new file mode 100644
index 0000000000..d828a1b269
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609a.stderr
@@ -0,0 +1,7 @@
+
+T20609a.hs:6:23: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
diff --git a/testsuite/tests/rename/should_compile/T20609b.hs b/testsuite/tests/rename/should_compile/T20609b.hs
new file mode 100644
index 0000000000..2e08bdcee2
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609b.hs
@@ -0,0 +1,13 @@
+module T20609b where
+
+-- Triggers the warning (definition/binding sites):
+-- ------------------------------------------------
+
+class MyClass c where
+ forall :: c -> ()
+
+-- Does not trigger the warning (use sites):
+-- -----------------------------------------
+
+instance MyClass () where
+ forall = id
diff --git a/testsuite/tests/rename/should_compile/T20609b.stderr b/testsuite/tests/rename/should_compile/T20609b.stderr
new file mode 100644
index 0000000000..c356dde8b0
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609b.stderr
@@ -0,0 +1,7 @@
+
+T20609b.hs:7:3: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
diff --git a/testsuite/tests/rename/should_compile/T20609c.hs b/testsuite/tests/rename/should_compile/T20609c.hs
new file mode 100644
index 0000000000..2e36f8c7e1
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609c.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE PatternSynonyms #-}
+
+module T20609c where
+
+pattern Pat forall = forall
+
+pattern RPat { forall } = forall
+
diff --git a/testsuite/tests/rename/should_compile/T20609c.stderr b/testsuite/tests/rename/should_compile/T20609c.stderr
new file mode 100644
index 0000000000..c22ead3d0b
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609c.stderr
@@ -0,0 +1,14 @@
+
+T20609c.hs:5:22: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
+
+T20609c.hs:7:27: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
diff --git a/testsuite/tests/rename/should_compile/T20609d.hs b/testsuite/tests/rename/should_compile/T20609d.hs
new file mode 100644
index 0000000000..bed945bcfa
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609d.hs
@@ -0,0 +1,6 @@
+module T20609d where
+
+import Data.Word (Word8)
+
+foreign import ccall unsafe "forall"
+ forall :: IO Word8
diff --git a/testsuite/tests/rename/should_compile/T20609d.stderr b/testsuite/tests/rename/should_compile/T20609d.stderr
new file mode 100644
index 0000000000..8060b3298f
--- /dev/null
+++ b/testsuite/tests/rename/should_compile/T20609d.stderr
@@ -0,0 +1,7 @@
+
+T20609d.hs:6:3: warning: [-Wforall-identifier (in -Wdefault)]
+ The use of ‘forall’ as an identifier
+ will become an error in a future GHC release.
+ Suggested fix:
+ Consider using another name, such as
+ ‘forAll’, ‘for_all’, or ‘forall_’.
diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T
index 2148470c66..8e55b3705a 100644
--- a/testsuite/tests/rename/should_compile/all.T
+++ b/testsuite/tests/rename/should_compile/all.T
@@ -177,3 +177,8 @@ test('T18302', expect_broken(18302), compile, [''])
test('T17853', [], multimod_compile, ['T17853', '-v0'])
test('T19966', expect_broken(19966), compile, ['-fdefer-out-of-scope-variables'])
test('T20472', normal, compile, [''])
+test('T20609', normal, compile, [''])
+test('T20609a', normal, compile, [''])
+test('T20609b', normal, compile, [''])
+test('T20609c', normal, compile, [''])
+test('T20609d', normal, compile, [''])
diff --git a/utils/haddock b/utils/haddock
-Subproject 1ef24e617651955f07c4fb6f2d488806cc6785e
+Subproject f7bfa0013f2bc3934a63ea7af21fe41a4e91058