diff options
Diffstat (limited to 'compiler/rename/RnUtils.hs')
| -rw-r--r-- | compiler/rename/RnUtils.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/compiler/rename/RnUtils.hs b/compiler/rename/RnUtils.hs index 3a743b56fb..9de4aacaba 100644 --- a/compiler/rename/RnUtils.hs +++ b/compiler/rename/RnUtils.hs @@ -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) |