diff options
| author | Matthew Pickering <matthewtpickering@gmail.com> | 2019-02-11 09:24:04 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-02-14 02:36:02 -0500 |
| commit | 19626218566ea709b5f6f287d3c296b0c4021de2 (patch) | |
| tree | d22f486e543a19670be2ae88e8e358f99e1e54fd /compiler/parser | |
| parent | 1d9a1d9fb8fe0a1fea2c44c4246f102ff3e1f3a3 (diff) | |
| download | haskell-19626218566ea709b5f6f287d3c296b0c4021de2.tar.gz | |
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`.
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 10 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 14 |
2 files changed, 12 insertions, 12 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 820144d930..da9febdcd8 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -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) diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 88217c27a2..91a27e93e6 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -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) |