Commit 19626218 authored by Matthew Pickering's avatar Matthew Pickering Committed by Marge Bot

Implement -Wredundant-record-wildcards and -Wunused-record-wildcards

-Wredundant-record-wildcards warns when a .. pattern binds no variables.

-Wunused-record-wildcards warns when none of the variables bound by a ..
pattern are used.

These flags are enabled by `-Wall`.
parent 1d9a1d9f
Pipeline #2204 passed with stages
in 222 minutes and 32 seconds
......@@ -374,7 +374,7 @@ data HsRecFields p arg -- A bunch of record fields
-- { x = 3, y = True }
-- Used for both expressions and patterns
= HsRecFields { rec_flds :: [LHsRecField p arg],
rec_dotdot :: Maybe Int } -- Note [DotDot fields]
rec_dotdot :: Maybe (Located Int) } -- Note [DotDot fields]
deriving (Functor, Foldable, Traversable)
......@@ -593,7 +593,7 @@ instance (Outputable arg)
=> Outputable (HsRecFields p arg) where
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Nothing })
= braces (fsep (punctuate comma (map ppr flds)))
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just n })
ppr (HsRecFields { rec_flds = flds, rec_dotdot = Just (unLoc -> n) })
= braces (fsep (punctuate comma (map ppr (take n flds) ++ [dotdot])))
where
dotdot = text ".." <+> whenPprDebug (ppr (drop n flds))
......
......@@ -1316,26 +1316,35 @@ that were defined "implicitly", without being explicitly written by the user.
The main purpose is to find names introduced by record wildcards so that we can avoid
warning the user when they don't use those names (#4404)
Since the addition of -Wunused-record-wildcards, this function returns a pair
of [(SrcSpan, [Name])]. Each element of the list is one set of implicit
binders, the first component of the tuple is the document describes the possible
fix to the problem (by removing the ..).
This means there is some unfortunate coupling between this function and where it
is used but it's only used for one specific purpose in one place so it seemed
easier.
-}
lStmtsImplicits :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
-> [(SrcSpan, [Name])]
lStmtsImplicits = hs_lstmts
where
hs_lstmts :: [LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> NameSet
hs_lstmts = foldr (\stmt rest -> unionNameSet (hs_stmt (unLoc stmt)) rest) emptyNameSet
-> [(SrcSpan, [Name])]
hs_lstmts = concatMap (hs_stmt . unLoc)
hs_stmt :: StmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))
-> NameSet
-> [(SrcSpan, [Name])]
hs_stmt (BindStmt _ pat _ _ _) = lPatImplicits pat
hs_stmt (ApplicativeStmt _ args _) = unionNameSets (map do_arg args)
hs_stmt (ApplicativeStmt _ args _) = concatMap do_arg args
where do_arg (_, ApplicativeArgOne _ pat _ _) = lPatImplicits pat
do_arg (_, ApplicativeArgMany _ stmts _ _) = hs_lstmts stmts
do_arg (_, XApplicativeArg _) = panic "lStmtsImplicits"
hs_stmt (LetStmt _ binds) = hs_local_binds (unLoc binds)
hs_stmt (BodyStmt {}) = emptyNameSet
hs_stmt (LastStmt {}) = emptyNameSet
hs_stmt (BodyStmt {}) = []
hs_stmt (LastStmt {}) = []
hs_stmt (ParStmt _ xs _ _) = hs_lstmts [s | ParStmtBlock _ ss _ _ <- xs
, s <- ss]
hs_stmt (TransStmt { trS_stmts = stmts }) = hs_lstmts stmts
......@@ -1343,28 +1352,28 @@ lStmtsImplicits = hs_lstmts
hs_stmt (XStmtLR {}) = panic "lStmtsImplicits"
hs_local_binds (HsValBinds _ val_binds) = hsValBindsImplicits val_binds
hs_local_binds (HsIPBinds {}) = emptyNameSet
hs_local_binds (EmptyLocalBinds _) = emptyNameSet
hs_local_binds (XHsLocalBindsLR _) = emptyNameSet
hs_local_binds (HsIPBinds {}) = []
hs_local_binds (EmptyLocalBinds _) = []
hs_local_binds (XHsLocalBindsLR _) = []
hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> NameSet
hsValBindsImplicits :: HsValBindsLR GhcRn (GhcPass idR) -> [(SrcSpan, [Name])]
hsValBindsImplicits (XValBindsLR (NValBinds binds _))
= foldr (unionNameSet . lhsBindsImplicits . snd) emptyNameSet binds
= concatMap (lhsBindsImplicits . snd) binds
hsValBindsImplicits (ValBinds _ binds _)
= lhsBindsImplicits binds
lhsBindsImplicits :: LHsBindsLR GhcRn idR -> NameSet
lhsBindsImplicits = foldBag unionNameSet (lhs_bind . unLoc) emptyNameSet
lhsBindsImplicits :: LHsBindsLR GhcRn idR -> [(SrcSpan, [Name])]
lhsBindsImplicits = foldBag (++) (lhs_bind . unLoc) []
where
lhs_bind (PatBind { pat_lhs = lpat }) = lPatImplicits lpat
lhs_bind _ = emptyNameSet
lhs_bind _ = []
lPatImplicits :: LPat GhcRn -> NameSet
lPatImplicits :: LPat GhcRn -> [(SrcSpan, [Name])]
lPatImplicits = hs_lpat
where
hs_lpat lpat = hs_pat (unLoc lpat)
hs_lpats = foldr (\pat rest -> hs_lpat pat `unionNameSet` rest) emptyNameSet
hs_lpats = foldr (\pat rest -> hs_lpat pat ++ rest) []
hs_pat (LazyPat _ pat) = hs_lpat pat
hs_pat (BangPat _ pat) = hs_lpat pat
......@@ -1377,16 +1386,26 @@ lPatImplicits = hs_lpat
hs_pat (SigPat _ pat _) = hs_lpat pat
hs_pat (CoPat _ _ pat _) = hs_pat pat
hs_pat (ConPatIn _ ps) = details ps
hs_pat (ConPatOut {pat_args=ps}) = details ps
hs_pat (ConPatIn n ps) = details n ps
hs_pat (ConPatOut {pat_con=con, pat_args=ps}) = details (fmap conLikeName con) ps
hs_pat _ = []
hs_pat _ = emptyNameSet
details :: Located Name -> HsConPatDetails GhcRn -> [(SrcSpan, [Name])]
details _ (PrefixCon ps) = hs_lpats ps
details n (RecCon fs) =
[(err_loc, collectPatsBinders implicit_pats) | Just{} <- [rec_dotdot fs] ]
++ hs_lpats explicit_pats
details (PrefixCon ps) = hs_lpats ps
details (RecCon fs) = hs_lpats explicit `unionNameSet` mkNameSet (collectPatsBinders implicit)
where (explicit, implicit) = partitionEithers [if pat_explicit then Left pat else Right pat
where implicit_pats = map (hsRecFieldArg . unLoc) implicit
explicit_pats = map (hsRecFieldArg . unLoc) explicit
(explicit, implicit) = partitionEithers [if pat_explicit then Left fld else Right fld
| (i, fld) <- [0..] `zip` rec_flds fs
, let pat = hsRecFieldArg
(unLoc fld)
pat_explicit = maybe True (i<) (rec_dotdot fs)]
details (InfixCon p1 p2) = hs_lpat p1 `unionNameSet` hs_lpat p2
, let pat_explicit =
maybe True ((i<) . unLoc)
(rec_dotdot fs)]
err_loc = maybe (getLoc n) getLoc (rec_dotdot fs)
details _ (InfixCon p1 p2) = hs_lpat p1 ++ hs_lpat p2
......@@ -790,6 +790,8 @@ data WarningFlag =
| Opt_WarnUnusedMatches
| Opt_WarnUnusedTypePatterns
| Opt_WarnUnusedForalls
| Opt_WarnUnusedRecordWildcards
| Opt_WarnRedundantRecordWildcards
| Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
| Opt_WarnMissingMonadFailInstances -- since 8.0
......@@ -4046,6 +4048,8 @@ wWarningFlagsDeps = [
flagSpec "unused-pattern-binds" Opt_WarnUnusedPatternBinds,
flagSpec "unused-top-binds" Opt_WarnUnusedTopBinds,
flagSpec "unused-type-patterns" Opt_WarnUnusedTypePatterns,
flagSpec "unused-record-wildcards" Opt_WarnUnusedRecordWildcards,
flagSpec "redundant-record-wildcards" Opt_WarnRedundantRecordWildcards,
flagSpec "warnings-deprecations" Opt_WarnWarningsDeprecations,
flagSpec "wrong-do-bind" Opt_WarnWrongDoBind,
flagSpec "missing-pattern-synonym-signatures"
......@@ -4799,7 +4803,9 @@ minusWallOpts
Opt_WarnUnusedDoBind,
Opt_WarnTrustworthySafe,
Opt_WarnUntickedPromotedConstructors,
Opt_WarnMissingPatternSynonymSignatures
Opt_WarnMissingPatternSynonymSignatures,
Opt_WarnUnusedRecordWildcards,
Opt_WarnRedundantRecordWildcards
]
-- | Things you get with -Weverything, i.e. *all* known warnings flags
......
......@@ -3084,16 +3084,16 @@ qual :: { LStmt GhcPs (LHsExpr GhcPs) }
-----------------------------------------------------------------------------
-- Record Field Update/Construction
fbinds :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)) }
fbinds :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)) }
: fbinds1 { $1 }
| {- empty -} { ([],([], False)) }
| {- empty -} { ([],([], Nothing)) }
fbinds1 :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)) }
fbinds1 :: { ([AddAnn],([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)) }
: fbind ',' fbinds1
{% addAnnotation (gl $1) AnnComma (gl $2) >>
return (case $3 of (ma,(flds, dd)) -> (ma,($1 : flds, dd))) }
| fbind { ([],([$1], False)) }
| '..' { ([mj AnnDotdot $1],([], True)) }
| fbind { ([],([$1], Nothing)) }
| '..' { ([mj AnnDotdot $1],([], Just (getLoc $1))) }
fbind :: { LHsRecField GhcPs (LHsExpr GhcPs) }
: qvar '=' texp {% ams (sLL $1 $> $ HsRecField (sL1 $1 $ mkFieldOcc $1) $3 False)
......
......@@ -1976,14 +1976,14 @@ checkPrecP (dL->L l (_,i)) (dL->L _ ol)
mkRecConstrOrUpdate
:: LHsExpr GhcPs
-> SrcSpan
-> ([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)
-> ([LHsRecField GhcPs (LHsExpr GhcPs)], Maybe SrcSpan)
-> P (HsExpr GhcPs)
mkRecConstrOrUpdate (dL->L l (HsVar _ (dL->L _ c))) _ (fs,dd)
| isRdrDataCon c
= return (mkRdrRecordCon (cL l c) (mk_rec_fields fs dd))
mkRecConstrOrUpdate exp@(dL->L l _) _ (fs,dd)
| dd = parseErrorSDoc l (text "You cannot use `..' in a record update")
mkRecConstrOrUpdate exp _ (fs,dd)
| Just dd_loc <- dd = parseErrorSDoc dd_loc (text "You cannot use `..' in a record update")
| otherwise = return (mkRdrRecordUpd exp (map (fmap mk_rec_upd_field) fs))
mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
......@@ -1996,10 +1996,10 @@ mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
mkRdrRecordCon con flds
= RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }
mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg
mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
mk_rec_fields fs True = HsRecFields { rec_flds = fs
, rec_dotdot = Just (length fs) }
mk_rec_fields :: [LHsRecField id arg] -> Maybe SrcSpan -> HsRecFields id arg
mk_rec_fields fs Nothing = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
mk_rec_fields fs (Just s) = HsRecFields { rec_flds = fs
, rec_dotdot = Just (cL s (length fs)) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
mk_rec_upd_field (HsRecField (dL->L loc (FieldOcc _ rdr)) arg pun)
......
......@@ -38,7 +38,8 @@ import RnNames
import RnEnv
import RnFixity
import RnUtils ( HsDocContext(..), mapFvRn, extendTyVarEnvFVRn
, checkDupRdrNames, warnUnusedLocalBinds
, checkDupRdrNames, warnUnusedLocalBinds,
checkUnusedRecordWildcard
, checkDupAndShadowedNames, bindLocalNamesFV )
import DynFlags
import Module
......@@ -362,7 +363,12 @@ rnLocalValBindsAndThen binds@(ValBinds _ _ sigs) thing_inside
; let real_uses = findUses dus result_fvs
-- Insert fake uses for variables introduced implicitly by
-- wildcards (#4404)
implicit_uses = hsValBindsImplicits binds'
rec_uses = hsValBindsImplicits binds'
implicit_uses = mkNameSet $ concatMap snd
$ rec_uses
; mapM_ (\(loc, ns) ->
checkUnusedRecordWildcard loc real_uses (Just ns))
rec_uses
; warnUnusedLocalBinds bound_names
(real_uses `unionNameSet` implicit_uses)
......
......@@ -35,7 +35,8 @@ import RnFixity
import RnUtils ( HsDocContext(..), bindLocalNamesFV, checkDupNames
, bindLocalNames
, mapMaybeFvRn, mapFvRn
, warnUnusedLocalBinds, typeAppErr )
, warnUnusedLocalBinds, typeAppErr
, checkUnusedRecordWildcard )
import RnUnbound ( reportUnboundName )
import RnSplice ( rnBracket, rnSpliceExpr, checkThLocalName )
import RnTypes
......@@ -1089,13 +1090,16 @@ rnRecStmtsAndThen rnBody s cont
-- ...bring them and their fixities into scope
; let bound_names = collectLStmtsBinders (map fst new_lhs_and_fv)
-- Fake uses of variables introduced implicitly (warning suppression, see #4404)
implicit_uses = lStmtsImplicits (map fst new_lhs_and_fv)
rec_uses = lStmtsImplicits (map fst new_lhs_and_fv)
implicit_uses = mkNameSet $ concatMap snd $ rec_uses
; bindLocalNamesFV bound_names $
addLocalFixities fix_env bound_names $ do
-- (C) do the right-hand-sides and thing-inside
{ segs <- rn_rec_stmts rnBody bound_names new_lhs_and_fv
; (res, fvs) <- cont segs
; mapM_ (\(loc, ns) -> checkUnusedRecordWildcard loc fvs (Just ns))
rec_uses
; warnUnusedLocalBinds bound_names (fvs `unionNameSet` implicit_uses)
; return (res, fvs) }}
......
......@@ -54,6 +54,7 @@ import RnEnv
import RnFixity
import RnUtils ( HsDocContext(..), newLocalBndrRn, bindLocalNames
, warnUnusedMatches, newLocalBndrRn
, checkUnusedRecordWildcard
, checkDupNames, checkDupAndShadowedNames
, checkTupSize , unknownSubordinateErr )
import RnTypes
......@@ -529,6 +530,12 @@ rnConPatAndThen mk con (RecCon rpats)
; rpats' <- rnHsRecPatsAndThen mk con' rpats
; return (ConPatIn con' (RecCon rpats')) }
checkUnusedRecordWildcardCps :: SrcSpan -> Maybe [Name] -> CpsRn ()
checkUnusedRecordWildcardCps loc dotdot_names =
CpsRn (\thing -> do
(r, fvs) <- thing ()
checkUnusedRecordWildcard loc fvs dotdot_names
return (r, fvs) )
--------------------
rnHsRecPatsAndThen :: NameMaker
-> Located Name -- Constructor
......@@ -539,6 +546,7 @@ rnHsRecPatsAndThen mk (dL->L _ con)
= do { flds <- liftCpsFV $ rnHsRecFields (HsRecFieldPat con) mkVarPat
hs_rec_fields
; flds' <- mapM rn_field (flds `zip` [1..])
; check_unused_wildcard (implicit_binders flds' <$> dd)
; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }) }
where
mkVarPat l n = VarPat noExt (cL l n)
......@@ -546,10 +554,23 @@ rnHsRecPatsAndThen mk (dL->L _ con)
do { arg' <- rnLPatAndThen (nested_mk dd mk n') (hsRecFieldArg fld)
; return (cL l (fld { hsRecFieldArg = arg' })) }
loc = maybe noSrcSpan getLoc dd
-- Get the arguments of the implicit binders
implicit_binders fs (unLoc -> n) = collectPatsBinders implicit_pats
where
implicit_pats = map (hsRecFieldArg . unLoc) (drop n fs)
-- Don't warn for let P{..} = ... in ...
check_unused_wildcard = case mk of
LetMk{} -> const (return ())
LamMk{} -> checkUnusedRecordWildcardCps loc
-- Suppress unused-match reporting for fields introduced by ".."
nested_mk Nothing mk _ = mk
nested_mk (Just _) mk@(LetMk {}) _ = mk
nested_mk (Just n) (LamMk report_unused) n' = LamMk (report_unused && (n' <= n))
nested_mk (Just (unLoc -> n)) (LamMk report_unused) n'
= LamMk (report_unused && (n' <= n))
{-
************************************************************************
......@@ -622,19 +643,18 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
-- due to #15884
rn_dotdot :: Maybe Int -- See Note [DotDot fields] in HsPat
rn_dotdot :: Maybe (Located Int) -- See Note [DotDot fields] in HsPat
-> Maybe Name -- The constructor (Nothing for an
-- out of scope constructor)
-> [LHsRecField GhcRn arg] -- Explicit fields
-> RnM [LHsRecField GhcRn arg] -- Filled in .. fields
rn_dotdot (Just n) (Just con) flds -- ".." on record construction / pat match
-> RnM ([LHsRecField GhcRn arg]) -- Field Labels we need to fill in
rn_dotdot (Just (dL -> L loc n)) (Just con) flds -- ".." on record construction / pat match
| not (isUnboundName con) -- This test is because if the constructor
-- isn't in scope the constructor lookup will add
-- an error but still return an unbound name. We
-- don't want that to screw up the dot-dot fill-in stuff.
= ASSERT( flds `lengthIs` n )
do { loc <- getSrcSpanM -- Rather approximate
; dd_flag <- xoptM LangExt.RecordWildCards
do { dd_flag <- xoptM LangExt.RecordWildCards
; checkErr dd_flag (needFlagDotDot ctxt)
; (rdr_env, lcl_env) <- getRdrEnvs
; con_fields <- lookupConstructorFields con
......
......@@ -14,6 +14,7 @@ module RnUtils (
addFvRn, mapFvRn, mapMaybeFvRn,
warnUnusedMatches, warnUnusedTypePatterns,
warnUnusedTopBinds, warnUnusedLocalBinds,
checkUnusedRecordWildcard,
mkFieldEnv,
unknownSubordinateErr, badQualBndrErr, typeAppErr,
HsDocContext(..), pprHsDocContext,
......@@ -222,6 +223,57 @@ warnUnusedTopBinds gres
else gres
warnUnusedGREs gres'
-- | Checks to see if we need to warn for -Wunused-record-wildcards or
-- -Wredundant-record-wildcards
checkUnusedRecordWildcard :: SrcSpan
-> FreeVars
-> Maybe [Name]
-> RnM ()
checkUnusedRecordWildcard _ _ Nothing = return ()
checkUnusedRecordWildcard loc _ (Just []) = do
-- Add a new warning if the .. pattern binds no variables
setSrcSpan loc $ warnRedundantRecordWildcard
checkUnusedRecordWildcard loc fvs (Just dotdot_names) =
setSrcSpan loc $ warnUnusedRecordWildcard dotdot_names fvs
-- | Produce a warning when the `..` pattern binds no new
-- variables.
--
-- @
-- data P = P { x :: Int }
--
-- foo (P{x, ..}) = x
-- @
--
-- The `..` here doesn't bind any variables as `x` is already bound.
warnRedundantRecordWildcard :: RnM ()
warnRedundantRecordWildcard =
whenWOptM Opt_WarnRedundantRecordWildcards
(addWarn (Reason Opt_WarnRedundantRecordWildcards)
redundantWildcardWarning)
-- | Produce a warning when no variables bound by a `..` pattern are used.
--
-- @
-- data P = P { x :: Int }
--
-- foo (P{..}) = ()
-- @
--
-- The `..` pattern binds `x` but it is not used in the RHS so we issue
-- a warning.
warnUnusedRecordWildcard :: [Name] -> FreeVars -> RnM ()
warnUnusedRecordWildcard ns used_names = do
let used = filter (`elemNameSet` used_names) ns
traceRn "warnUnused" (ppr ns $$ ppr used_names $$ ppr used)
warnIfFlag Opt_WarnUnusedRecordWildcards (null used)
unusedRecordWildcardWarning
warnUnusedLocalBinds, warnUnusedMatches, warnUnusedTypePatterns
:: [Name] -> FreeVars -> RnM ()
warnUnusedLocalBinds = check_unused Opt_WarnUnusedLocalBinds
......@@ -296,6 +348,20 @@ addUnusedWarning flag occ span msg
nest 2 $ pprNonVarNameSpace (occNameSpace occ)
<+> quotes (ppr occ)]
unusedRecordWildcardWarning :: SDoc
unusedRecordWildcardWarning =
wildcardDoc $ text "No variables bound in the record wildcard match are used"
redundantWildcardWarning :: SDoc
redundantWildcardWarning =
wildcardDoc $ text "Record wildcard does not bind any new variables"
wildcardDoc :: SDoc -> SDoc
wildcardDoc herald =
herald
$$ nest 2 (text "Possible fix" <> colon <+> text "omit the"
<+> quotes (text ".."))
addNameClashErrRn :: RdrName -> [GlobalRdrElt] -> RnM ()
addNameClashErrRn rdr_name gres
| all isLocalGRE gres && not (all isRecFldGRE gres)
......
......@@ -397,7 +397,7 @@ mkTrNameLit = do
-- | Make Typeable bindings for the given 'TyCon'.
mkTyConRepBinds :: TypeableStuff -> TypeRepTodo
-> TypeableTyCon -> KindRepM (LHsBinds GhcTc)
mkTyConRepBinds stuff@(Stuff {..}) todo (TypeableTyCon {..})
mkTyConRepBinds stuff todo (TypeableTyCon {..})
= do -- Make a KindRep
let (bndrs, kind) = splitForAllVarBndrs (tyConKind tycon)
liftTc $ traceTc "mkTyConKindRepBinds"
......@@ -477,7 +477,7 @@ initialKindRepEnv = foldlM add_kind_rep emptyTypeMap builtInKindReps
mkExportedKindReps :: TypeableStuff
-> [(Kind, Id)] -- ^ the kinds to generate bindings for
-> KindRepM ()
mkExportedKindReps stuff@(Stuff {..}) = mapM_ kindrep_binding
mkExportedKindReps stuff = mapM_ kindrep_binding
where
empty_scope = mkDeBruijnContext []
......
.. _release-8-10-1:
Release notes for version 8.10.1
===============================
The significant changes to the various parts of the compiler are listed in the
following sections.
Highlights
----------
Full details
------------
Language
~~~~~~~~
Compiler
~~~~~~~~
- Add new flags :ghc-flag:`-Wunused-record-wildcards` and
:ghc-flag:`-Wredundant-record-wildcards` which warn users when they have
redundant or unused uses of a record wildcard match.
Runtime system
~~~~~~~~~~~~~~
Template Haskell
~~~~~~~~~~~~~~~~
``ghc-prim`` library
~~~~~~~~~~~~~~~~~~~~
``ghc`` library
~~~~~~~~~~~~~~~
``base`` library
~~~~~~~~~~~~~~~~
Build system
~~~~~~~~~~~~
Included libraries
------------------
......@@ -1565,9 +1565,9 @@ of ``-W(no-)*``.
When :extension:`ExplicitForAll` is enabled, explicitly quantified type
variables may also be identified as unused. For instance: ::
type instance forall x y. F x y = []
would still report ``x`` and ``y`` as unused on the right hand side
Unlike :ghc-flag:`-Wunused-matches`, :ghc-flag:`-Wunused-type-patterns` is
......@@ -1575,7 +1575,7 @@ of ``-W(no-)*``.
unlike term-level pattern names, type names are often chosen expressly for
documentation purposes, so using underscores in type names can make the
documentation harder to read.
.. ghc-flag:: -Wunused-foralls
:shortdesc: warn about type variables in user-written
``forall``\\s that are unused
......@@ -1594,6 +1594,50 @@ of ``-W(no-)*``.
would report ``a`` and ``c`` as unused.
.. ghc-flag:: -Wunused-record-wildcards
:shortdesc: Warn about record wildcard matches when none of the bound variables
are used.
:type: dynamic
:since: 8.10.1
:reverse: -Wno-unused-record-wildcards
:category:
.. index::
single: unused, warning, record wildcards
Report all record wildcards where none of the variables bound implicitly
are used. For instance: ::
data P = P { x :: Int, y :: Int }
f1 :: P -> Int
f1 P{..} = 1 + 3
would report that the ``P{..}`` match is unused.
.. ghc-flag:: -Wredundant-record-wildcards
:shortdesc: Warn about record wildcard matches when the wildcard binds no patterns.
:type: dynamic
:since: 8.10.1
:reverse: -Wno-redundant-record-wildcards
:category:
.. index::
single: unused, warning, record wildcards
Report all record wildcards where the wild card match binds no patterns.
For instance: ::
data P = P { x :: Int, y :: Int }
f1 :: P -> Int
f1 P{x,y,..} = x + y
would report that the ``P{x, y, ..}`` match has a redundant use of ``..``.
.. ghc-flag:: -Wwrong-do-bind
:shortdesc: warn about do bindings that appear to throw away monadic values
that you should have bound instead
......
......@@ -604,7 +604,7 @@ hSetBinaryMode handle bin =
-- data is flushed first.
hSetNewlineMode :: Handle -> NewlineMode -> IO ()
hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} ->
withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{} ->
do
flushBuffer h_
return h_{ haInputNL=i, haOutputNL=o }
......@@ -705,7 +705,7 @@ dupHandleTo :: FilePath
-> Maybe HandleFinalizer
-> IO Handle__
dupHandleTo filepath h other_side
hto_@Handle__{haDevice=devTo,..}
hto_@Handle__{haDevice=devTo}
h_@Handle__{haDevice=dev} mb_finalizer = do
flushBuffer h_
case cast devTo of
......
......@@ -313,7 +313,7 @@ allClosures (APClosure {..}) = fun:payload
allClosures (PAPClosure {..}) = fun:payload
allClosures (APStackClosure {..}) = fun:payload
allClosures (BCOClosure {..}) = [instrs,literals,bcoptrs]
allClosures (ArrWordsClosure {..}) = []
allClosures (ArrWordsClosure {}) = []
allClosures (MutArrClosure {..}) = mccPayload
allClosures (MutVarClosure {..}) = [var]
allClosures (MVarClosure {..}) = [queueHead,queueTail,value]
......
......@@ -265,7 +265,7 @@ runTH pipe rstate rhv ty mb_loc = do
runTHQ
:: Binary a => Pipe -> RemoteRef (IORef QState) -> Maybe TH.Loc -> TH.Q a
-> IO ByteString
runTHQ pipe@Pipe{..} rstate mb_loc ghciq = do
runTHQ pipe rstate mb_loc ghciq = do
qstateref <- localRef rstate
qstate <- readIORef qstateref
let st = qstate { qsLocation = mb_loc, qsPipe = pipe }
......
......@@ -13,7 +13,7 @@ import Data.Binary
type MessageHook = Msg -> IO Msg
serv :: Bool -> MessageHook -> Pipe -> (forall a .IO a -> IO a) -> IO ()
serv verbose hook pipe@Pipe{..} restore = loop
serv verbose hook pipe restore = loop
where
loop = do
Msg msg <- readPipe pipe getMessage >>= hook
......
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module T15957 where
data P = P { x :: Int, y :: Int }
g1 P{..} = x + 3 -- x from .. is used
g2 P{x, ..} = x + y -- y from .. is used, even if it's in a weird style
old P{..} | x < 5 = 10
-- Record wildcards in lets have different scoping rules.. they bring
-- all the identifiers into scope
do_example :: IO Int
do_example = do
let P{..} = P 1 2
return $ x + y
let_in_example =
let P{..} = P 1 2
in x + 4
......@@ -166,3 +166,4 @@ test('T15798a', normal, compile, [''])
test('T15798b', normal, compile, [''])
test('T15798c', normal, compile, [''])
test('T16116a', normal, compile, [''])
test('T15957', normal, compile, ['-Werror -Wredundant-record-wildcards -Wunused-record-wildcards'])
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}
module T15957_Fail where
data P = P { x :: Int, y :: Int }
f1 P{..} = 1 + 3 -- nothing bound is used
f2 P{x, ..} = x + 3 -- y bound but not used
f3 P{x, y, ..} = x + y -- no bindings left, i.e. no new useful bindings introduced
g2 P{x=a, ..} = a + 3
g3 P{x=a, y=b, ..} = a + b
g4 P{x=0, y=0,..} = 0
g4 _ = 0
-- Record wildcards in lets have different scoping rules.. they bring
-- all the identifiers into scope
do_example :: IO Int
do_example = do
let P{..} = P 1 2
return $ 0
let_in_example :: Int
let_in_example =
let P{..} = P 1 2
in 0
data Q = Q { a, b :: P }
nested :: Q -> Int
nested Q { a = P{..}, .. } = (case b of (P x1 _) -> x1)
T15957_Fail.hs:7:6: error: [-Wunused-record-wildcards (in -Wall), -Werror=unused-record-wildcards]
No variables bound in the record wildcard match are used
Possible fix: omit the ‘..’