driver: split -fwarn-unused-binds into 3 flags (fixes #17)

Summary: New flags:

 -fwarn-unused-top-binds
 -fwarn-unused-local-binds
 -fwarn-unused-pattern-binds

Test Plan: `tests/rename/should_compile/T17` tests

Correct other tests

Reviewers: austin, rwbarton

Reviewed By: austin, rwbarton

Subscribers: rwbarton, carter, thomie

Differential Revision: https://phabricator.haskell.org/D591

GHC Trac Issues: #17

4 files changed, 29 insertions, 8 deletions

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index de768c0315..6d6670cb32 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -488,7 +488,9 @@ data WarningFlag =
    | Opt_WarnOverlappingPatterns
    | Opt_WarnTypeDefaults
    | Opt_WarnMonomorphism
-   | Opt_WarnUnusedBinds
+   | Opt_WarnUnusedTopBinds
+   | Opt_WarnUnusedLocalBinds
+   | Opt_WarnUnusedPatternBinds
    | Opt_WarnUnusedImports
    | Opt_WarnUnusedMatches
    | Opt_WarnContextQuantification
@@ -2676,6 +2678,8 @@ dynamic_flags = [
   , defFlag "fno-glasgow-exts"
       (NoArg (do disableGlasgowExts
                  deprecate "Use individual extensions instead"))
+  , defFlag "fwarn-unused-binds" (NoArg enableUnusedBinds)
+  , defFlag "fno-warn-unused-binds" (NoArg disableUnusedBinds)
 
         ------ Safe Haskell flags -------------------------------------------
   , defFlag "fpackage-trust"   (NoArg setPackageTrust)
@@ -2883,10 +2887,12 @@ fWarningFlags = [
   flagSpec "warn-unsupported-llvm-version"    Opt_WarnUnsupportedLlvmVersion,
   flagSpec "warn-unticked-promoted-constructors"
                                          Opt_WarnUntickedPromotedConstructors,
-  flagSpec "warn-unused-binds"                Opt_WarnUnusedBinds,
   flagSpec "warn-unused-do-bind"              Opt_WarnUnusedDoBind,
   flagSpec "warn-unused-imports"              Opt_WarnUnusedImports,
+  flagSpec "warn-unused-local-binds"          Opt_WarnUnusedLocalBinds,
   flagSpec "warn-unused-matches"              Opt_WarnUnusedMatches,
+  flagSpec "warn-unused-pattern-binds"        Opt_WarnUnusedPatternBinds,
+  flagSpec "warn-unused-top-binds"            Opt_WarnUnusedTopBinds,
   flagSpec "warn-warnings-deprecations"       Opt_WarnWarningsDeprecations,
   flagSpec "warn-wrong-do-bind"               Opt_WarnWrongDoBind]
 
@@ -3359,7 +3365,9 @@ minusWOpts :: [WarningFlag]
 -- Things you get with -W
 minusWOpts
     = standardWarnings ++
-      [ Opt_WarnUnusedBinds,
+      [ Opt_WarnUnusedTopBinds,
+        Opt_WarnUnusedLocalBinds,
+        Opt_WarnUnusedPatternBinds,
         Opt_WarnUnusedMatches,
         Opt_WarnUnusedImports,
         Opt_WarnIncompletePatterns,
@@ -3381,6 +3389,19 @@ minusWallOpts
         Opt_WarnUntickedPromotedConstructors
       ]
 
+enableUnusedBinds :: DynP ()
+enableUnusedBinds = mapM_ setWarningFlag unusedBindsFlags
+
+disableUnusedBinds :: DynP ()
+disableUnusedBinds = mapM_ unSetWarningFlag unusedBindsFlags
+
+-- Things you get with -fwarn-unused-binds
+unusedBindsFlags :: [WarningFlag]
+unusedBindsFlags = [ Opt_WarnUnusedTopBinds
+                   , Opt_WarnUnusedLocalBinds
+                   , Opt_WarnUnusedPatternBinds
+                   ]
+
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setGeneralFlag Opt_PrintExplicitForalls
                        mapM_ setExtensionFlag glasgowExtsFlags
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 70c61f2215..ff588e1276 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -168,10 +168,10 @@ runStmtWithLocation source linenumber expr step =
     breakMVar  <- liftIO $ newEmptyMVar  -- wait on this when we hit a breakpoint
     statusMVar <- liftIO $ newEmptyMVar  -- wait on this when a computation is running
 
-    -- Turn off -fwarn-unused-bindings when running a statement, to hide
+    -- Turn off -fwarn-unused-local-binds when running a statement, to hide
     -- warnings about the implicit bindings we introduce.
     let ic       = hsc_IC hsc_env -- use the interactive dflags
-        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedBinds
+        idflags' = ic_dflags ic `wopt_unset` Opt_WarnUnusedLocalBinds
         hsc_env' = hsc_env{ hsc_IC = ic{ ic_dflags = idflags' } }
 
     -- compile to value (IO [HValue]), don't run
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index 89f8a14e6e..beda054423 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -497,7 +497,7 @@ rnBind _ bind@(PatBind { pat_lhs = pat
         -- which (a) is not that different from  _v = rhs
         --       (b) is sometimes used to give a type sig for,
         --           or an occurrence of, a variable on the RHS
-        ; whenWOptM Opt_WarnUnusedBinds $
+        ; whenWOptM Opt_WarnUnusedPatternBinds $
           when (null bndrs && not is_wild_pat) $
           addWarn $ unusedPatBindWarn bind'
 
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 580f0b9d3d..d9d471ace3 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -1734,7 +1734,7 @@ mapFvRnCPS f (x:xs) cont = f x             $ \ x' ->
 
 warnUnusedTopBinds :: [GlobalRdrElt] -> RnM ()
 warnUnusedTopBinds gres
-    = whenWOptM Opt_WarnUnusedBinds
+    = whenWOptM Opt_WarnUnusedTopBinds
     $ do env <- getGblEnv
          let isBoot = tcg_src env == HsBootFile
          let noParent gre = case gre_par gre of
@@ -1751,7 +1751,7 @@ warnUnusedTopBinds gres
          warnUnusedGREs gres'
 
 warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> FreeVars -> RnM ()
-warnUnusedLocalBinds = check_unused Opt_WarnUnusedBinds
+warnUnusedLocalBinds = check_unused Opt_WarnUnusedLocalBinds
 warnUnusedMatches    = check_unused Opt_WarnUnusedMatches
 
 check_unused :: WarningFlag -> [Name] -> FreeVars -> RnM ()