[Git][ghc/ghc][wip/sand-witch/modern-STV-add-warning] Adding -Wpattern-signature-binds (#23291)
Andrei Borzenkov (@sand-witch)
gitlab at gitlab.haskell.org
Thu Jun 8 06:50:37 UTC 2023
Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC
Commits:
57538c95 by Andrei Borzenkov at 2023-06-08T10:50:22+04:00
Adding -Wpattern-signature-binds (#23291)
Was introduced one new warning option: -Wpattern-signature-binds
It warns when pattern signature binds into scope new type variable. For
example:
f (a :: t) = ...
- - - - -
12 changed files:
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error/Codes.hs
- docs/users_guide/9.8.1-notes.rst
- docs/users_guide/using-warnings.rst
- + testsuite/tests/rename/should_fail/WPatternSigBinds.hs
- + testsuite/tests/rename/should_fail/WPatternSigBinds.stderr
- testsuite/tests/rename/should_fail/all.T
Changes:
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -640,6 +640,7 @@ data WarningFlag =
| Opt_WarnLoopySuperclassSolve -- Since 9.6
| Opt_WarnTermVariableCapture -- Since 9.8
| Opt_WarnMissingRoleAnnotations -- Since 9.8
+ | Opt_WarnPatternSignatureBinds -- Since 9.8
deriving (Eq, Ord, Show, Enum)
-- | Return the names of a WarningFlag
@@ -747,6 +748,7 @@ warnFlagNames wflag = case wflag of
Opt_WarnLoopySuperclassSolve -> "loopy-superclass-solve" :| []
Opt_WarnTypeEqualityRequiresOperators -> "type-equality-requires-operators" :| []
Opt_WarnMissingRoleAnnotations -> "missing-role-annotations" :| []
+ Opt_WarnPatternSignatureBinds -> "pattern-signature-binds" :| []
-- -----------------------------------------------------------------------------
-- Standard sets of warning options
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -2257,7 +2257,8 @@ wWarningFlagsDeps = mconcat [
warnSpec Opt_WarnTypeEqualityOutOfScope,
warnSpec Opt_WarnTypeEqualityRequiresOperators,
warnSpec Opt_WarnTermVariableCapture,
- warnSpec Opt_WarnMissingRoleAnnotations
+ warnSpec Opt_WarnMissingRoleAnnotations,
+ warnSpec Opt_WarnPatternSignatureBinds
]
warningGroupsDeps :: [(Deprecation, FlagSpec WarningGroup)]
=====================================
compiler/GHC/Rename/Bind.hs
=====================================
@@ -519,7 +519,7 @@ rnBind sig_fn bind@(FunBind { fun_id = name
-- invariant: no free vars here when it's a FunBind
= do { let plain_name = unLoc name
- ; (matches', rhs_fvs) <- bindSigTyVarsFVExtended (sig_fn plain_name) $
+ ; (matches', rhs_fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
-- bindSigTyVars tests for LangExt.ScopedTyVars
rnMatchGroup (mkPrefixFunRhs name)
rnLExpr matches
@@ -726,7 +726,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
; unless pattern_synonym_ok (addErr TcRnIllegalPatternSynonymDecl)
; let scoped_tvs = sig_fn name
- ; ((pat', details'), fvs1) <- bindSigTyVarsFVExtended scoped_tvs $
+ ; ((pat', details'), fvs1) <- bindSigTyVarsFV scoped_tvs $
rnPat PatSyn pat $ \pat' ->
-- We check the 'RdrName's instead of the 'Name's
-- so that the binding locations are reported
@@ -763,7 +763,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
Unidirectional -> return (Unidirectional, emptyFVs)
ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
ExplicitBidirectional mg ->
- do { (mg', fvs) <- bindSigTyVarsFVExtended scoped_tvs $
+ do { (mg', fvs) <- bindSigTyVarsFV scoped_tvs $
rnMatchGroup (mkPrefixFunRhs (L l name))
rnLExpr mg
; return (ExplicitBidirectional mg', fvs) }
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -173,6 +173,10 @@ rnHsPatSigType scoping ctx sig_ty thing_inside
then tv_rdrs
else []
NeverBind -> []
+ ; let i_bndrs = nubN implicit_bndrs in
+ unless (null i_bndrs) $
+ forM_ i_bndrs $ \i_bndr ->
+ addDiagnosticAt (locA $ getLoc i_bndr) (TcRnPatternSignatureBinds i_bndr)
; rnImplicitTvOccs Nothing implicit_bndrs $ \ imp_tvs ->
do { (nwcs, pat_sig_ty', fvs1) <- rnWcBody ctx nwc_rdrs pat_sig_ty
; let sig_names = HsPSRn { hsps_nwcs = nwcs, hsps_imp_tvs = imp_tvs }
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1848,6 +1848,11 @@ instance Diagnostic TcRnMessage where
, text "Either a standalone kind signature (SAKS)"
, text "or a complete user-supplied kind (CUSK, legacy feature)"
, text "is required to use invisible binders." ]
+
+ TcRnPatternSignatureBinds fvar -> mkSimpleDecorated $
+ sep [text "Type variable binding"
+ , text "in pattern signature:" <+> quotes (ppr fvar)
+ ]
diagnosticReason = \case
TcRnUnknownMessage m
@@ -2465,6 +2470,8 @@ instance Diagnostic TcRnMessage where
-> ErrorWithoutFlag
TcRnInvisBndrWithoutSig{}
-> ErrorWithoutFlag
+ TcRnPatternSignatureBinds{}
+ -> WarningWithFlag Opt_WarnPatternSignatureBinds
diagnosticHints = \case
TcRnUnknownMessage m
@@ -3128,6 +3135,8 @@ instance Diagnostic TcRnMessage where
-> noHints
TcRnInvisBndrWithoutSig name _
-> [SuggestAddStandaloneKindSignature name]
+ TcRnPatternSignatureBinds{}
+ -> noHints
diagnosticCode :: TcRnMessage -> Maybe DiagnosticCode
diagnosticCode = constructorCode
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -4094,6 +4094,18 @@ data TcRnMessage where
-}
TcRnMissingRoleAnnotation :: Name -> [Role] -> TcRnMessage
+ {-| TcRnPatternSignatureBinds is a warning thrown when a user binds
+ type variables in a pattern signature. This is only performed with
+ -Wpattern-signature-binds
+
+ Example(s):
+
+ id (x :: b) = x
+
+ Test case: rename/should_fail/WPatternSigBinds
+ -}
+ TcRnPatternSignatureBinds :: LocatedN RdrName -> TcRnMessage
+
deriving Generic
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -591,6 +591,7 @@ type family GhcDiagnosticCode c = n | n -> c where
GhcDiagnosticCode "TcRnArityMismatch" = 27346
GhcDiagnosticCode "TcRnSimplifiableConstraint" = 62412
GhcDiagnosticCode "TcRnIllegalQuasiQuotes" = 77343
+ GhcDiagnosticCode "TcRnPatternSignatureBinds" = 65467
-- TcRnTypeApplicationsDisabled
GhcDiagnosticCode "TypeApplication" = 23482
=====================================
docs/users_guide/9.8.1-notes.rst
=====================================
@@ -30,6 +30,9 @@ Compiler
- Added a new warning :ghc-flag:`-Wterm-variable-capture` that helps to make code compatible with
the future extension ``RequiredTypeArguments``.
+- Added a new warning :ghc-flag:`-Wpattern-signature-binds` which alerts the user when they bind
+ a new type variable in a pattern signature.
+
- Rewrite rules now support a limited form of higher order matching when a
pattern variable is applied to distinct locally bound variables. For example: ::
=====================================
docs/users_guide/using-warnings.rst
=====================================
@@ -2415,6 +2415,28 @@ of ``-W(no-)*``.
In other words the type-class role cannot be accidentally left
representational or phantom, which could affected the code correctness.
+.. ghc-flag:: -Wpattern-signature-binds
+ :shortdesc: warn when a pattern signature binds new type variables
+ :type: dynamic
+
+ :since: 9.8.1
+
+ Added in accordance with `GHC Proposal #448
+ <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0448-type-variable-scoping.rst>`__.
+
+ Type variable bindings in pattern signatures violate the Lexical Scoping Principle: depending
+ on the context, type variables in pattern signatures can be either occurrences or bindings.
+
+ For example: ::
+
+ f (x :: a) = ... -- binding of ‘a’
+
+ g :: forall a . ...
+ g (x :: a) = ... -- occurrence of ‘a’
+
+ When :ghc-flag:`-Wpattern-signature-binds` is enabled, GHC warns about type variable bindings
+ in pattern signatures.
+
If you're feeling really paranoid, the :ghc-flag:`-dcore-lint` option is a good choice.
It turns on heavyweight intra-pass sanity-checking within GHC. (It checks GHC's
=====================================
testsuite/tests/rename/should_fail/WPatternSigBinds.hs
=====================================
@@ -0,0 +1,11 @@
+{-# OPTIONS_GHC -Wpattern-signature-binds -Werror #-}
+module WPatternSigBinds where
+
+f (x :: a) = x
+
+g (x :: a) (y :: b) = x
+
+h (x :: a) (y :: b c d) = x
+
+i :: forall f a . f a -> f a
+i (x :: b c) = x
=====================================
testsuite/tests/rename/should_fail/WPatternSigBinds.stderr
=====================================
@@ -0,0 +1,27 @@
+
+WPatternSigBinds.hs:4:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘a’
+
+WPatternSigBinds.hs:6:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘a’
+
+WPatternSigBinds.hs:6:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘b’
+
+WPatternSigBinds.hs:8:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘a’
+
+WPatternSigBinds.hs:8:18: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘b’
+
+WPatternSigBinds.hs:8:20: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘c’
+
+WPatternSigBinds.hs:8:22: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘d’
+
+WPatternSigBinds.hs:11:9: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘b’
+
+WPatternSigBinds.hs:11:11: error: [GHC-65467] [-Wpattern-signature-binds, Werror=pattern-signature-binds]
+ Type variable binding in pattern signature: ‘c’
=====================================
testsuite/tests/rename/should_fail/all.T
=====================================
@@ -198,3 +198,4 @@ test('RnUnexpectedStandaloneDeriving', normal, compile_fail, [''])
test('RnStupidThetaInGadt', normal, compile_fail, [''])
test('PackageImportsDisabled', normal, compile_fail, [''])
test('ImportLookupIllegal', normal, compile_fail, [''])
+test('WPatternSigBinds', normal, compile_fail, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57538c9569954da222aa6b01b453a252a8667b34
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/57538c9569954da222aa6b01b453a252a8667b34
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/20230608/ccb42091/attachment-0001.html>
More information about the ghc-commits
mailing list