Support for -fwarn-unused-do-bind and -fwarn-wrong-do-bind, as per #3263

7 files changed, 20 insertions, 14 deletions

diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs
index 400f8bdf0b..2aa1aa2ea9 100644
--- a/compiler/main/DriverMkDepend.hs
+++ b/compiler/main/DriverMkDepend.hs
@@ -73,7 +73,7 @@ doMkDependHS srcs = do
     -- and complaining about cycles
     hsc_env <- getSession
     root <- liftIO getCurrentDirectory
-    mapM (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
+    mapM_ (liftIO . processDeps dflags hsc_env excl_mods root (mkd_tmp_hdl files)) sorted
 
     -- If -ddump-mod-cycles, show cycles in the module graph
     liftIO $ dumpModCycles dflags mod_summaries
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 5a7e78d860..d120f18d53 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -187,7 +187,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler)
                             -> return ([], ms_hs_date summary)
                           -- We're in --make mode: finish the compilation pipeline.
                           _other
-                            -> do runPipeline StopLn hsc_env' (output_fn,Nothing)
+                            -> do _ <- runPipeline StopLn hsc_env' (output_fn,Nothing)
                                               (Just basename)
                                               Persistent
                                               (Just location)
@@ -264,7 +264,7 @@ compileStub hsc_env mod location = do
 	let (stub_c,_,stub_o) = mkStubPaths (hsc_dflags hsc_env) 
                                    (moduleName mod) location
 
-	runPipeline StopLn hsc_env (stub_c,Nothing)  Nothing
+	_ <- runPipeline StopLn hsc_env (stub_c,Nothing)  Nothing
 		(SpecificFile stub_o) Nothing{-no ModLocation-}
 
 	return stub_o
@@ -1234,7 +1234,7 @@ runPhase_MoveBinary dflags input_fn dep_packages
            pvm_executable_base = "=" ++ input_fn
            pvm_executable = pvm_root ++ "/bin/" ++ pvm_arch ++ "/" ++ pvm_executable_base
         -- nuke old binary; maybe use configur'ed names for cp and rm?
-        tryIO (removeFile pvm_executable)
+        _ <- tryIO (removeFile pvm_executable)
         -- move the newly created binary into PVM land
         copy dflags "copying PVM executable" input_fn pvm_executable
         -- generate a wrapper script for running a parallel prg under PVM
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index f4971cd7cd..394965a850 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -1,4 +1,3 @@
-
 -- |
 -- Dynamic flags
 --
@@ -192,6 +191,9 @@ data DynFlag
    | Opt_WarnUnrecognisedPragmas
    | Opt_WarnDodgyForeignImports
    | Opt_WarnLazyUnliftedBindings
+   | Opt_WarnUnusedDoBind
+   | Opt_WarnWrongDoBind
+
 
    -- language opts
    | Opt_OverlappingInstances
@@ -909,7 +911,8 @@ standardWarnings
         Opt_WarnMissingMethods,
         Opt_WarnDuplicateExports,
         Opt_WarnLazyUnliftedBindings,
-        Opt_WarnDodgyForeignImports
+        Opt_WarnDodgyForeignImports,
+        Opt_WarnWrongDoBind
       ]
 
 minusWOpts :: [DynFlag]
@@ -929,7 +932,8 @@ minusWallOpts
         Opt_WarnNameShadowing,
         Opt_WarnMissingSigs,
         Opt_WarnHiShadows,
-        Opt_WarnOrphans
+        Opt_WarnOrphans,
+        Opt_WarnUnusedDoBind
       ]
 
 -- minuswRemovesOpts should be every warning option
@@ -1664,6 +1668,8 @@ fFlags = [
   ( "warn-unrecognised-pragmas",        Opt_WarnUnrecognisedPragmas, const Supported ),
   ( "warn-lazy-unlifted-bindings",      Opt_WarnLazyUnliftedBindings,
     const $ Deprecated "lazy unlifted bindings will be an error in GHC 6.14, and this flag will no longer exist"),
+  ( "warn-unused-do-bind",              Opt_WarnUnusedDoBind, const Supported ),
+  ( "warn-wrong-do-bind",               Opt_WarnWrongDoBind, const Supported ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls, const Supported ),
   ( "strictness",                       Opt_Strictness, const Supported ),
   ( "static-argument-transformation",   Opt_StaticArgumentTransformation, const Supported ),
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 52ff90692c..76bbeb2760 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -784,7 +784,7 @@ load2 how_much mod_graph = do
 				(flattenSCCs mg2_with_srcimps)
 				stable_mods
 
-	liftIO $ evaluate pruned_hpt
+	_ <- liftIO $ evaluate pruned_hpt
 
         -- before we unload anything, make sure we don't leave an old
         -- interactive context around pointing to dead bindings.  Also,
@@ -1208,7 +1208,7 @@ compileCoreToObj simplify cm@(CoreModule{ cm_module = mName }) = do
   (iface, changed, _details, cgguts)
       <- hscNormalIface guts Nothing
   hscWriteIface iface changed modSummary
-  hscGenHardCode cgguts modSummary
+  _ <- hscGenHardCode cgguts modSummary
   return ()
 
 -- Makes a "vanilla" ModGuts.
@@ -1242,7 +1242,7 @@ compileCore simplify fn = do
    -- First, set the target to the desired filename
    target <- guessTarget fn Nothing
    addTarget target
-   load LoadAllTargets
+   _ <- load LoadAllTargets
    -- Then find dependencies
    modGraph <- depanal [] True
    case find ((== fn) . msHsFilePath) modGraph of
diff --git a/compiler/main/HscMain.lhs b/compiler/main/HscMain.lhs
index 12b12e350c..34e459386d 100644
--- a/compiler/main/HscMain.lhs
+++ b/compiler/main/HscMain.lhs
@@ -773,7 +773,7 @@ hscCmmFile hsc_env filename = do
              parseCmmFile dflags filename
     cmms <- liftIO $ optionallyConvertAndOrCPS hsc_env [cmm]
     rawCmms <- liftIO $ cmmToRawCmm cmms
-    liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
+    _ <- liftIO $ codeOutput dflags no_mod no_loc NoStubs [] rawCmms
     return ()
   where
 	no_mod = panic "hscCmmFile: no_mod"
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 794459c458..44972d5d36 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -308,7 +308,7 @@ traceRunStatus expr bindings final_ids
              let history' = mkHistory hsc_env apStack info `consBL` history
                 -- probably better make history strict here, otherwise
                 -- our BoundedList will be pointless.
-             liftIO $ evaluate history'
+             _ <- liftIO $ evaluate history'
              status <-
                  withBreakAction True (hsc_dflags hsc_env)
                                       breakMVar statusMVar $ do
diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs
index 357616bfb9..26c85bdc2c 100644
--- a/compiler/main/SysTools.lhs
+++ b/compiler/main/SysTools.lhs
@@ -608,8 +608,8 @@ builderMainLoop dflags filter_fn pgm real_args mb_env = do
   -- and run a loop piping the output from the compiler to the log_action in DynFlags
   hSetBuffering hStdOut LineBuffering
   hSetBuffering hStdErr LineBuffering
-  forkIO (readerProc chan hStdOut filter_fn)
-  forkIO (readerProc chan hStdErr filter_fn)
+  _ <- forkIO (readerProc chan hStdOut filter_fn)
+  _ <- forkIO (readerProc chan hStdErr filter_fn)
   -- we don't want to finish until 2 streams have been completed
   -- (stdout and stderr)
   -- nor until 1 exit code has been retrieved.