[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 08:20:57 UTC 2023



Andrei Borzenkov pushed to branch wip/sand-witch/modern-STV-add-warning at Glasgow Haskell Compiler / GHC


Commits:
ef6806b5 by Andrei Borzenkov at 2023-06-08T12:20:41+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) = ...

- - - - -


13 changed files:

- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Rename/Bind.hs
- compiler/GHC/Rename/Expr.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/Expr.hs
=====================================
@@ -523,7 +523,7 @@ rnExpr (HsRecSel x _) = dataConCantHappen x
 
 rnExpr (ExprWithTySig _ expr pty)
   = do  { (pty', fvTy)    <- rnHsSigWcType ExprWithTySigCtx pty
-        ; (expr', fvExpr) <- bindSigTyVarsFVExtended (hsWcScopedTvs pty') $
+        ; (expr', fvExpr) <- bindSigTyVarsFV (hsWcScopedTvs pty') $
                              rnLExpr expr
         ; return (ExprWithTySig noExtField expr' pty', fvExpr `plusFV` fvTy) }
 


=====================================
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/ef6806b5dd867c40bffd0631dca5da178f14f1f4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef6806b5dd867c40bffd0631dca5da178f14f1f4
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/27870c3d/attachment-0001.html>


More information about the ghc-commits mailing list