Add the proper HLint rules and remove redundant keywords from compiler

113 files changed, 1232 insertions, 1314 deletions

diff --git a/compiler/.hlint.yaml b/compiler/.hlint.yaml
index 6ebe02e94c..16e593d87c 100644
--- a/compiler/.hlint.yaml
+++ b/compiler/.hlint.yaml
@@ -5,3 +5,20 @@
 - ignore: {}
 - warn: {name: Unused LANGUAGE pragma}
 - warn: {name: Use fewer LANGUAGE pragmas}
+- warn: {name: Redundant return}
+- warn: {name: Redundant True guards}
+- warn: {name: Redundant do}
+- warn: {name: Redundant variable capture}
+- warn: {name: Redundant void}
+- warn: {name: Redundant as}
+- warn: {name: Use fewer imports}
+- warn: {name: Redundant as-pattern}
+- warn: {name: Redundant where}
+
+## Exceptions
+# Sometimes, the hlint parser flags some functions and modules as incorrectly
+# using a language extension. Some other times, we need to make exceptions to
+# lints that we otherwise want applied elsewhere. Such exceptions are listed
+# below.
+
+- ignore: {name: Redundant do, within: [GHC.SysTools.Terminal, GHC.Utils.Binary]}
diff --git a/compiler/GHC/Cmm/Graph.hs b/compiler/GHC/Cmm/Graph.hs
index be7eafb162..edff1d8f11 100644
--- a/compiler/GHC/Cmm/Graph.hs
+++ b/compiler/GHC/Cmm/Graph.hs
@@ -250,10 +250,10 @@ mkCallReturnsTo :: Profile -> CmmExpr -> Convention -> [CmmExpr]
                 -> UpdFrameOffset
                 -> [CmmExpr]
                 -> CmmAGraph
-mkCallReturnsTo profile f callConv actuals ret_lbl ret_off updfr_off extra_stack = do
+mkCallReturnsTo profile f callConv actuals ret_lbl ret_off updfr_off extra_stack =
   lastWithArgsAndExtraStack profile Call (Young ret_lbl) callConv actuals
-     updfr_off extra_stack $
-       toCall f (Just ret_lbl) updfr_off ret_off
+    updfr_off extra_stack $
+      toCall f (Just ret_lbl) updfr_off ret_off
 
 -- Like mkCallReturnsTo, but does not push the return address (it is assumed to be
 -- already on the stack).
@@ -262,9 +262,9 @@ mkJumpReturnsTo :: Profile -> CmmExpr -> Convention -> [CmmExpr]
                 -> ByteOff
                 -> UpdFrameOffset
                 -> CmmAGraph
-mkJumpReturnsTo profile f callConv actuals ret_lbl ret_off updfr_off  = do
+mkJumpReturnsTo profile f callConv actuals ret_lbl ret_off updfr_off =
   lastWithArgs profile JumpRet (Young ret_lbl) callConv actuals updfr_off $
-       toCall f (Just ret_lbl) updfr_off ret_off
+    toCall f (Just ret_lbl) updfr_off ret_off
 
 mkUnsafeCall  :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> CmmAGraph
 mkUnsafeCall t fs as = mkMiddle $ CmmUnsafeForeignCall t fs as
diff --git a/compiler/GHC/Cmm/LayoutStack.hs b/compiler/GHC/Cmm/LayoutStack.hs
index 5b393de902..9e86ab58c5 100644
--- a/compiler/GHC/Cmm/LayoutStack.hs
+++ b/compiler/GHC/Cmm/LayoutStack.hs
@@ -451,26 +451,25 @@ handleLastNode
 
 handleLastNode dflags procpoints liveness cont_info stackmaps
                stack0@StackMap { sm_sp = sp0 } tscp middle last
- = case last of
-    --  At each return / tail call,
-    --  adjust Sp to point to the last argument pushed, which
-    --  is cml_args, after popping any other junk from the stack.
-    CmmCall{ cml_cont = Nothing, .. } -> do
-      let sp_off = sp0 - cml_args
-      return ([], sp_off, last, [], mapEmpty)
-
-    --  At each CmmCall with a continuation:
-    CmmCall{ cml_cont = Just cont_lbl, .. } ->
-       return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off
-
-    CmmForeignCall{ succ = cont_lbl, .. } -> do
-       return $ lastCall cont_lbl (platformWordSizeInBytes platform) ret_args ret_off
-            -- one word of args: the return address
-
-    CmmBranch {}     ->  handleBranches
-    CmmCondBranch {} ->  handleBranches
-    CmmSwitch {}     ->  handleBranches
-
+  = case last of
+      --  At each return / tail call,
+      --  adjust Sp to point to the last argument pushed, which
+      --  is cml_args, after popping any other junk from the stack.
+      CmmCall{ cml_cont = Nothing, .. } -> do
+        let sp_off = sp0 - cml_args
+        return ([], sp_off, last, [], mapEmpty)
+
+      --  At each CmmCall with a continuation:
+      CmmCall{ cml_cont = Just cont_lbl, .. } ->
+        return $ lastCall cont_lbl cml_args cml_ret_args cml_ret_off
+
+      CmmForeignCall{ succ = cont_lbl, .. } ->
+        return $ lastCall cont_lbl (platformWordSizeInBytes platform) ret_args ret_off
+              -- one word of args: the return address
+
+      CmmBranch {}     ->  handleBranches
+      CmmCondBranch {} ->  handleBranches
+      CmmSwitch {}     ->  handleBranches
   where
      platform = targetPlatform dflags
      -- Calls and ForeignCalls are handled the same way:
@@ -1051,7 +1050,7 @@ insertReloadsAsNeeded
     -> BlockId
     -> [CmmBlock]
     -> UniqSM [CmmBlock]
-insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks = do
+insertReloadsAsNeeded platform procpoints final_stackmaps entry blocks =
     toBlockList . fst <$>
         rewriteCmmBwd liveLattice rewriteCC (ofBlockList entry blocks) mapEmpty
   where
diff --git a/compiler/GHC/Cmm/Pipeline.hs b/compiler/GHC/Cmm/Pipeline.hs
index d408402e27..59dc19ba80 100644
--- a/compiler/GHC/Cmm/Pipeline.hs
+++ b/compiler/GHC/Cmm/Pipeline.hs
@@ -62,95 +62,95 @@ cpsTop :: DynFlags -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDecl
 cpsTop dflags p@(CmmData _ statics) = return (Right (cafAnalData (targetPlatform dflags) statics, p))
 cpsTop dflags proc =
     do
-       ----------- Control-flow optimisations ----------------------------------
-
-       -- The first round of control-flow optimisation speeds up the
-       -- later passes by removing lots of empty blocks, so we do it
-       -- even when optimisation isn't turned on.
-       --
-       CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
-            return $ cmmCfgOptsProc splitting_proc_points proc
-       dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
-
-       let !TopInfo {stack_info=StackInfo { arg_space = entry_off
-                                          , do_layout = do_layout }} = h
-
-       ----------- Eliminate common blocks -------------------------------------
-       g <- {-# SCC "elimCommonBlocks" #-}
-            condPass Opt_CmmElimCommonBlocks elimCommonBlocks g
-                          Opt_D_dump_cmm_cbe "Post common block elimination"
-
-       -- Any work storing block Labels must be performed _after_
-       -- elimCommonBlocks
-
-       ----------- Implement switches ------------------------------------------
-       g <- {-# SCC "createSwitchPlans" #-}
-            runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g
-       dump Opt_D_dump_cmm_switch "Post switch plan" g
-
-       ----------- Proc points -------------------------------------------------
-       let
-         call_pps :: ProcPointSet -- LabelMap
-         call_pps = {-# SCC "callProcPoints" #-} callProcPoints g
-       proc_points <-
-          if splitting_proc_points
-             then do
-               pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $
-                  minimalProcPointSet platform call_pps g
-               dumpWith dflags Opt_D_dump_cmm_proc "Proc points"
-                     FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g)
-               return pp
-             else
-               return call_pps
-
-       ----------- Layout the stack and manifest Sp ----------------------------
-       (g, stackmaps) <-
-            {-# SCC "layoutStack" #-}
-            if do_layout
-               then runUniqSM $ cmmLayoutStack dflags proc_points entry_off g
-               else return (g, mapEmpty)
-       dump Opt_D_dump_cmm_sp "Layout Stack" g
-
-       ----------- Sink and inline assignments  --------------------------------
-       g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout]
-            condPass Opt_CmmSink (cmmSink platform) g
-                     Opt_D_dump_cmm_sink "Sink assignments"
-
-       ------------- CAF analysis ----------------------------------------------
-       let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g
-       dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (pdoc platform cafEnv)
-
-       g <- if splitting_proc_points
+      ----------- Control-flow optimisations ----------------------------------
+
+      -- The first round of control-flow optimisation speeds up the
+      -- later passes by removing lots of empty blocks, so we do it
+      -- even when optimisation isn't turned on.
+      --
+      CmmProc h l v g <- {-# SCC "cmmCfgOpts(1)" #-}
+           return $ cmmCfgOptsProc splitting_proc_points proc
+      dump Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+
+      let !TopInfo {stack_info=StackInfo { arg_space = entry_off
+                                         , do_layout = do_layout }} = h
+
+      ----------- Eliminate common blocks -------------------------------------
+      g <- {-# SCC "elimCommonBlocks" #-}
+           condPass Opt_CmmElimCommonBlocks elimCommonBlocks g
+                         Opt_D_dump_cmm_cbe "Post common block elimination"
+
+      -- Any work storing block Labels must be performed _after_
+      -- elimCommonBlocks
+
+      ----------- Implement switches ------------------------------------------
+      g <- {-# SCC "createSwitchPlans" #-}
+           runUniqSM $ cmmImplementSwitchPlans (backend dflags) platform g
+      dump Opt_D_dump_cmm_switch "Post switch plan" g
+
+      ----------- Proc points -------------------------------------------------
+      let
+        call_pps :: ProcPointSet -- LabelMap
+        call_pps = {-# SCC "callProcPoints" #-} callProcPoints g
+      proc_points <-
+         if splitting_proc_points
             then do
-               ------------- Split into separate procedures -----------------------
-               let pp_map = {-# SCC "procPointAnalysis" #-}
-                            procPointAnalysis proc_points g
-               dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map"
-                  FormatCMM (ppr pp_map)
-               g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
-                    splitAtProcPoints platform l call_pps proc_points pp_map
-                                      (CmmProc h l v g)
-               dumps Opt_D_dump_cmm_split "Post splitting" g
-               return g
-             else do
-               -- attach info tables to return points
-               return $ [attachContInfoTables call_pps (CmmProc h l v g)]
-
-       ------------- Populate info tables with stack info -----------------
-       g <- {-# SCC "setInfoTableStackMap" #-}
-            return $ map (setInfoTableStackMap platform stackmaps) g
-       dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g
-
-       ----------- Control-flow optimisations -----------------------------
-       g <- {-# SCC "cmmCfgOpts(2)" #-}
-            return $ if optLevel dflags >= 1
-                     then map (cmmCfgOptsProc splitting_proc_points) g
-                     else g
-       g <- return (map removeUnreachableBlocksProc g)
-            -- See Note [unreachable blocks]
-       dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
-
-       return (Left (cafEnv, g))
+              pp <- {-# SCC "minimalProcPointSet" #-} runUniqSM $
+                 minimalProcPointSet platform call_pps g
+              dumpWith dflags Opt_D_dump_cmm_proc "Proc points"
+                    FormatCMM (pdoc platform l $$ ppr pp $$ pdoc platform g)
+              return pp
+            else
+              return call_pps
+
+      ----------- Layout the stack and manifest Sp ----------------------------
+      (g, stackmaps) <-
+           {-# SCC "layoutStack" #-}
+           if do_layout
+              then runUniqSM $ cmmLayoutStack dflags proc_points entry_off g
+              else return (g, mapEmpty)
+      dump Opt_D_dump_cmm_sp "Layout Stack" g
+
+      ----------- Sink and inline assignments  --------------------------------
+      g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout]
+           condPass Opt_CmmSink (cmmSink platform) g
+                    Opt_D_dump_cmm_sink "Sink assignments"
+
+      ------------- CAF analysis ----------------------------------------------
+      let cafEnv = {-# SCC "cafAnal" #-} cafAnal platform call_pps l g
+      dumpWith dflags Opt_D_dump_cmm_caf "CAFEnv" FormatText (pdoc platform cafEnv)
+
+      g <- if splitting_proc_points
+           then do
+             ------------- Split into separate procedures -----------------------
+             let pp_map = {-# SCC "procPointAnalysis" #-}
+                          procPointAnalysis proc_points g
+             dumpWith dflags Opt_D_dump_cmm_procmap "procpoint map"
+                FormatCMM (ppr pp_map)
+             g <- {-# SCC "splitAtProcPoints" #-} runUniqSM $
+                  splitAtProcPoints platform l call_pps proc_points pp_map
+                                    (CmmProc h l v g)
+             dumps Opt_D_dump_cmm_split "Post splitting" g
+             return g
+           else
+             -- attach info tables to return points
+             return $ [attachContInfoTables call_pps (CmmProc h l v g)]
+
+      ------------- Populate info tables with stack info -----------------
+      g <- {-# SCC "setInfoTableStackMap" #-}
+           return $ map (setInfoTableStackMap platform stackmaps) g
+      dumps Opt_D_dump_cmm_info "after setInfoTableStackMap" g
+
+      ----------- Control-flow optimisations -----------------------------
+      g <- {-# SCC "cmmCfgOpts(2)" #-}
+           return $ if optLevel dflags >= 1
+                    then map (cmmCfgOptsProc splitting_proc_points) g
+                    else g
+      g <- return (map removeUnreachableBlocksProc g)
+           -- See Note [unreachable blocks]
+      dumps Opt_D_dump_cmm_cfg "Post control-flow optimisations" g
+
+      return (Left (cafEnv, g))
 
   where platform = targetPlatform dflags
         dump = dumpGraph dflags
diff --git a/compiler/GHC/Cmm/ProcPoint.hs b/compiler/GHC/Cmm/ProcPoint.hs
index 23dbc282d9..0cabea1536 100644
--- a/compiler/GHC/Cmm/ProcPoint.hs
+++ b/compiler/GHC/Cmm/ProcPoint.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE GADTs, DisambiguateRecordFields, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DisambiguateRecordFields #-}
+{-# LANGUAGE GADTs #-}
+
 {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
 
 module GHC.Cmm.ProcPoint
@@ -237,155 +240,152 @@ extendPPSet platform g blocks procPoints =
 -- Input invariant: A block should only be reachable from a single ProcPoint.
 -- ToDo: use the _ret naming convention that the old code generator
 -- used. -- EZY
-splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status ->
-                     CmmDecl -> UniqSM [CmmDecl]
-splitAtProcPoints platform entry_label callPPs procPoints procMap
-                  (CmmProc (TopInfo {info_tbls = info_tbls})
-                           top_l _ g@(CmmGraph {g_entry=entry})) =
-  do -- Build a map from procpoints to the blocks they reach
-     let add_block
-             :: LabelMap (LabelMap CmmBlock)
-             -> CmmBlock
-             -> LabelMap (LabelMap CmmBlock)
-         add_block graphEnv b =
-           case mapLookup bid procMap of
-             Just ProcPoint -> add graphEnv bid bid b
-             Just (ReachedBy set) ->
-               case setElems set of
-                 []   -> graphEnv
-                 [id] -> add graphEnv id bid b
-                 _    -> panic "Each block should be reachable from only one ProcPoint"
-             Nothing -> graphEnv
-           where bid = entryLabel b
-         add graphEnv procId bid b = mapInsert procId graph' graphEnv
-               where graph  = mapLookup procId graphEnv `orElse` mapEmpty
-                     graph' = mapInsert bid b graph
-
-     let liveness = cmmGlobalLiveness platform g
-     let ppLiveness pp = filter isArgReg $
-                         regSetToList $
-                         expectJust "ppLiveness" $ mapLookup pp liveness
-
-     graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g
-
-     -- Build a map from proc point BlockId to pairs of:
-     --  * Labels for their new procedures
-     --  * Labels for the info tables of their new procedures (only if
-     --    the proc point is a callPP)
-     -- Due to common blockification, we may overestimate the set of procpoints.
-     let add_label map pp = mapInsert pp lbls map
-           where lbls | pp == entry = (entry_label, fmap cit_lbl (mapLookup entry info_tbls))
-                      | otherwise   = (block_lbl, guard (setMember pp callPPs) >>
-                                                    Just info_table_lbl)
-                      where block_lbl      = blockLbl pp
-                            info_table_lbl = infoTblLbl pp
-
-         procLabels :: LabelMap (CLabel, Maybe CLabel)
-         procLabels = foldl' add_label mapEmpty
-                             (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
-
-     -- In each new graph, add blocks jumping off to the new procedures,
-     -- and replace branches to procpoints with branches to the jump-off blocks
-     let add_jump_block
-             :: (LabelMap Label, [CmmBlock])
-             -> (Label, CLabel)
-             -> UniqSM (LabelMap Label, [CmmBlock])
-         add_jump_block (env, bs) (pp, l) =
-           do bid <- liftM mkBlockId getUniqueM
-              let b = blockJoin (CmmEntry bid GlobalScope) emptyBlock jump
-                  live = ppLiveness pp
-                  jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
-              return (mapInsert pp bid env, b : bs)
-
-         add_jumps
-             :: LabelMap CmmGraph
-             -> (Label, LabelMap CmmBlock)
-             -> UniqSM (LabelMap CmmGraph)
-         add_jumps newGraphEnv (ppId, blockEnv) =
-           do let needed_jumps = -- find which procpoints we currently branch to
-                    mapFoldr add_if_branch_to_pp [] blockEnv
-                  add_if_branch_to_pp :: CmmBlock -> [(BlockId, CLabel)] -> [(BlockId, CLabel)]
-                  add_if_branch_to_pp block rst =
-                    case lastNode block of
-                      CmmBranch id          -> add_if_pp id rst
-                      CmmCondBranch _ ti fi _ -> add_if_pp ti (add_if_pp fi rst)
-                      CmmSwitch _ ids       -> foldr add_if_pp rst $ switchTargetsToList ids
-                      _                     -> rst
-
-                  -- when jumping to a PP that has an info table, if
-                  -- tablesNextToCode is off we must jump to the entry
-                  -- label instead.
-                  tablesNextToCode = platformTablesNextToCode platform
-                  jump_label (Just info_lbl) _
-                             | tablesNextToCode = info_lbl
-                             | otherwise        = toEntryLbl platform info_lbl
-                  jump_label Nothing  block_lbl = block_lbl
-
-                  add_if_pp id rst = case mapLookup id procLabels of
-                                       Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst
-                                       Nothing                 -> rst
-              (jumpEnv, jumpBlocks) <-
-                 foldM add_jump_block (mapEmpty, []) needed_jumps
-                  -- update the entry block
-              let b = expectJust "block in env" $ mapLookup ppId blockEnv
-                  blockEnv' = mapInsert ppId b blockEnv
-                  -- replace branches to procpoints with branches to jumps
-                  blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv'
-                  -- add the jump blocks to the graph
-                  blockEnv''' = foldl' (flip addBlock) blockEnv'' jumpBlocks
-              let g' = ofBlockMap ppId blockEnv'''
-              -- pprTrace "g' pre jumps" (ppr g') $ do
-              return (mapInsert ppId g' newGraphEnv)
-
-     graphEnv <- foldM add_jumps mapEmpty $ mapToList graphEnv
-
-     let to_proc (bid, g)
-             | bid == entry
-             =  CmmProc (TopInfo {info_tbls  = info_tbls,
-                                  stack_info = stack_info})
-                        top_l live g'
-             | otherwise
-             = case expectJust "pp label" $ mapLookup bid procLabels of
-                 (lbl, Just info_lbl)
-                    -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
-                                        , stack_info=stack_info})
-                               lbl live g'
-                 (lbl, Nothing)
-                    -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
-                               lbl live g'
-                where
-                 g' = replacePPIds g
-                 live = ppLiveness (g_entry g')
-                 stack_info = StackInfo { arg_space = 0
-                                        , do_layout = True }
-                               -- cannot use panic, this is printed by -ddump-cmm
-
-         -- References to procpoint IDs can now be replaced with the
-         -- infotable's label
-         replacePPIds g = {-# SCC "replacePPIds" #-}
-                          mapGraphNodes (id, mapExp repl, mapExp repl) g
-           where repl e@(CmmLit (CmmBlock bid)) =
-                   case mapLookup bid procLabels of
-                     Just (_, Just info_lbl)  -> CmmLit (CmmLabel info_lbl)
-                     _ -> e
-                 repl e = e
-
-     -- The C back end expects to see return continuations before the
-     -- call sites.  Here, we sort them in reverse order -- it gets
-     -- reversed later.
-     let (_, block_order) =
-             foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int)
-                   (revPostorder g)
-         add_block_num (i, map) block =
-           (i + 1, mapInsert (entryLabel block) i map)
-         sort_fn (bid, _) (bid', _) =
-           compare (expectJust "block_order" $ mapLookup bid  block_order)
-                   (expectJust "block_order" $ mapLookup bid' block_order)
-     procs <- return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv
-     return -- pprTrace "procLabels" (ppr procLabels)
-            -- pprTrace "splitting graphs" (ppr procs)
-            procs
+splitAtProcPoints :: Platform -> CLabel -> ProcPointSet-> ProcPointSet -> LabelMap Status -> CmmDecl
+                  -> UniqSM [CmmDecl]
 splitAtProcPoints _ _ _ _ _ t@(CmmData _ _) = return [t]
+splitAtProcPoints platform entry_label callPPs procPoints procMap cmmProc = do
+  -- Build a map from procpoints to the blocks they reach
+  let (CmmProc (TopInfo {info_tbls = info_tbls}) top_l _ g@(CmmGraph {g_entry=entry})) = cmmProc
+
+  let add graphEnv procId bid b = mapInsert procId graph' graphEnv
+        where
+          graph' = mapInsert bid b graph
+          graph  = mapLookup procId graphEnv `orElse` mapEmpty
+
+  let add_block :: LabelMap (LabelMap CmmBlock) -> CmmBlock -> LabelMap (LabelMap CmmBlock)
+      add_block graphEnv b =
+        case mapLookup bid procMap of
+          Just ProcPoint -> add graphEnv bid bid b
+          Just (ReachedBy set) ->
+            case setElems set of
+              []   -> graphEnv
+              [id] -> add graphEnv id bid b
+              _    -> panic "Each block should be reachable from only one ProcPoint"
+          Nothing -> graphEnv
+        where
+          bid = entryLabel b
+
+
+  let liveness = cmmGlobalLiveness platform g
+  let ppLiveness pp = filter isArgReg $ regSetToList $
+                        expectJust "ppLiveness" $ mapLookup pp liveness
+  graphEnv <- return $ foldlGraphBlocks add_block mapEmpty g
+
+  -- Build a map from proc point BlockId to pairs of:
+  --  * Labels for their new procedures
+  --  * Labels for the info tables of their new procedures (only if
+  --    the proc point is a callPP)
+  -- Due to common blockification, we may overestimate the set of procpoints.
+  let add_label map pp = mapInsert pp lbls map
+        where lbls | pp == entry = (entry_label, fmap cit_lbl (mapLookup entry info_tbls))
+                   | otherwise   = (block_lbl, guard (setMember pp callPPs) >>
+                                                 Just info_table_lbl)
+                   where block_lbl      = blockLbl pp
+                         info_table_lbl = infoTblLbl pp
+
+      procLabels :: LabelMap (CLabel, Maybe CLabel)
+      procLabels = foldl' add_label mapEmpty
+                          (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
+
+  -- In each new graph, add blocks jumping off to the new procedures,
+  -- and replace branches to procpoints with branches to the jump-off blocks
+  let add_jump_block :: (LabelMap Label, [CmmBlock])
+                     -> (Label, CLabel)
+                     -> UniqSM (LabelMap Label, [CmmBlock])
+      add_jump_block (env, bs) (pp, l) = do
+        bid <- liftM mkBlockId getUniqueM
+        let b    = blockJoin (CmmEntry bid GlobalScope) emptyBlock jump
+            live = ppLiveness pp
+            jump = CmmCall (CmmLit (CmmLabel l)) Nothing live 0 0 0
+        return (mapInsert pp bid env, b : bs)
+
+  -- when jumping to a PP that has an info table, if
+  -- tablesNextToCode is off we must jump to the entry
+  -- label instead.
+  let tablesNextToCode = platformTablesNextToCode platform
+
+  let jump_label (Just info_lbl) _
+                 | tablesNextToCode = info_lbl
+                 | otherwise        = toEntryLbl platform info_lbl
+      jump_label Nothing  block_lbl = block_lbl
+
+  let add_if_pp id rst =
+        case mapLookup id procLabels of
+          Just (lbl, mb_info_lbl) -> (id, jump_label mb_info_lbl lbl) : rst
+          Nothing                 -> rst
+
+  let add_if_branch_to_pp :: CmmBlock -> [(BlockId, CLabel)] -> [(BlockId, CLabel)]
+      add_if_branch_to_pp block rst =
+        case lastNode block of
+          CmmBranch id            -> add_if_pp id rst
+          CmmCondBranch _ ti fi _ -> add_if_pp ti (add_if_pp fi rst)
+          CmmSwitch _ ids         -> foldr add_if_pp rst $ switchTargetsToList ids
+          _                       -> rst
+
+  let add_jumps :: LabelMap CmmGraph -> (Label, LabelMap CmmBlock) -> UniqSM (LabelMap CmmGraph)
+      add_jumps newGraphEnv (ppId, blockEnv) = do
+        -- find which procpoints we currently branch to
+        let needed_jumps = mapFoldr add_if_branch_to_pp [] blockEnv
+
+        (jumpEnv, jumpBlocks) <-
+           foldM add_jump_block (mapEmpty, []) needed_jumps
+            -- update the entry block
+        let b = expectJust "block in env" $ mapLookup ppId blockEnv
+            blockEnv' = mapInsert ppId b blockEnv
+            -- replace branches to procpoints with branches to jumps
+            blockEnv'' = toBlockMap $ replaceBranches jumpEnv $ ofBlockMap ppId blockEnv'
+            -- add the jump blocks to the graph
+            blockEnv''' = foldl' (flip addBlock) blockEnv'' jumpBlocks
+        let g' = ofBlockMap ppId blockEnv'''
+        -- pprTrace "g' pre jumps" (ppr g') $ do
+        return (mapInsert ppId g' newGraphEnv)
+
+  graphEnv <- foldM add_jumps mapEmpty $ mapToList graphEnv
+
+  let to_proc (bid, g)
+          | bid == entry
+          =  CmmProc (TopInfo {info_tbls  = info_tbls,
+                               stack_info = stack_info})
+                     top_l live g'
+          | otherwise
+          = case expectJust "pp label" $ mapLookup bid procLabels of
+              (lbl, Just info_lbl)
+                 -> CmmProc (TopInfo { info_tbls = mapSingleton (g_entry g) (mkEmptyContInfoTable info_lbl)
+                                     , stack_info=stack_info})
+                            lbl live g'
+              (lbl, Nothing)
+                 -> CmmProc (TopInfo {info_tbls = mapEmpty, stack_info=stack_info})
+                            lbl live g'
+             where
+              g' = replacePPIds g
+              live = ppLiveness (g_entry g')
+              stack_info = StackInfo { arg_space = 0
+                                     , do_layout = True }
+                            -- cannot use panic, this is printed by -ddump-cmm
+
+      -- References to procpoint IDs can now be replaced with the
+      -- infotable's label
+      replacePPIds g = {-# SCC "replacePPIds" #-}
+                       mapGraphNodes (id, mapExp repl, mapExp repl) g
+        where repl e@(CmmLit (CmmBlock bid)) =
+                case mapLookup bid procLabels of
+                  Just (_, Just info_lbl)  -> CmmLit (CmmLabel info_lbl)
+                  _ -> e
+              repl e = e
+
+  -- The C back end expects to see return continuations before the
+  -- call sites.  Here, we sort them in reverse order -- it gets
+  -- reversed later.
+  let add_block_num (i, map) block =
+        (i + 1, mapInsert (entryLabel block) i map)
+  let (_, block_order) =
+          foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int)
+                (revPostorder g)
+  let sort_fn (bid, _) (bid', _) =
+        compare (expectJust "block_order" $ mapLookup bid  block_order)
+                (expectJust "block_order" $ mapLookup bid' block_order)
+
+  return $ map to_proc $ sortBy sort_fn $ mapToList graphEnv
 
 -- Only called from GHC.Cmm.ProcPoint.splitAtProcPoints. NB. does a
 -- recursive lookup, see comment below.
diff --git a/compiler/GHC/CmmToAsm.hs b/compiler/GHC/CmmToAsm.hs
index 7112d603b6..09ff24e96f 100644
--- a/compiler/GHC/CmmToAsm.hs
+++ b/compiler/GHC/CmmToAsm.hs
@@ -1101,30 +1101,28 @@ cmmExprNative referenceKind expr = do
          arch = platformArch platform
      case expr of
         CmmLoad addr rep
-           -> do addr' <- cmmExprNative DataReference addr
-                 return $ CmmLoad addr' rep
+          -> do addr' <- cmmExprNative DataReference addr
+                return $ CmmLoad addr' rep
 
         CmmMachOp mop args
-           -> do args' <- mapM (cmmExprNative DataReference) args
-                 return $ CmmMachOp mop args'
+          -> do args' <- mapM (cmmExprNative DataReference) args
+                return $ CmmMachOp mop args'
 
         CmmLit (CmmBlock id)
-           -> cmmExprNative referenceKind (CmmLit (CmmLabel (infoTblLbl id)))
-           -- we must convert block Ids to CLabels here, because we
-           -- might have to do the PIC transformation.  Hence we must
-           -- not modify BlockIds beyond this point.
+          -> cmmExprNative referenceKind (CmmLit (CmmLabel (infoTblLbl id)))
+          -- we must convert block Ids to CLabels here, because we
+          -- might have to do the PIC transformation.  Hence we must
+          -- not modify BlockIds beyond this point.
 
         CmmLit (CmmLabel lbl)
-           -> do
-                cmmMakeDynamicReference config referenceKind lbl
+          -> cmmMakeDynamicReference config referenceKind lbl
         CmmLit (CmmLabelOff lbl off)
-           -> do
-                 dynRef <- cmmMakeDynamicReference config referenceKind lbl
-                 -- need to optimize here, since it's late
-                 return $ cmmMachOpFold platform (MO_Add (wordWidth platform)) [
-                     dynRef,
-                     (CmmLit $ CmmInt (fromIntegral off) (wordWidth platform))
-                   ]
+          -> do dynRef <- cmmMakeDynamicReference config referenceKind lbl
+                -- need to optimize here, since it's late
+                return $ cmmMachOpFold platform (MO_Add (wordWidth platform)) [
+                    dynRef,
+                    (CmmLit $ CmmInt (fromIntegral off) (wordWidth platform))
+                  ]
 
         -- On powerpc (non-PIC), it's easier to jump directly to a label than
         -- to use the register table, so we replace these registers
diff --git a/compiler/GHC/CmmToAsm/BlockLayout.hs b/compiler/GHC/CmmToAsm/BlockLayout.hs
index 0a71d00449..d32357b5cc 100644
--- a/compiler/GHC/CmmToAsm/BlockLayout.hs
+++ b/compiler/GHC/CmmToAsm/BlockLayout.hs
@@ -475,7 +475,6 @@ combineNeighbourhood edges chains
                  applyEdges edges newEnds newFronts (Set.insert (from,to) combined)
             | otherwise
             = applyEdges edges chainEnds chainFronts combined
-         where
 
         getFronts chain = takeL neighbourOverlapp chain
         getEnds chain = takeR neighbourOverlapp chain
@@ -588,19 +587,14 @@ buildChains edges blocks
         , Just predChain <- mapLookup from chainEnds
         , Just succChain <- mapLookup to chainStarts
         , predChain /= succChain -- Otherwise we try to create a cycle.
-        = do
-            -- pprTraceM "Fusing edge" (ppr edge)
-            fuseChain predChain succChain
+          = fuseChain predChain succChain
 
         | (alreadyPlaced from) &&
           (alreadyPlaced to)
-        =   --pprTraceM "Skipping:" (ppr edge) >>
-            buildNext placed chainStarts chainEnds todo linked
+          = buildNext placed chainStarts chainEnds todo linked
 
         | otherwise
-        = do -- pprTraceM "Finding chain for:" (ppr edge $$
-             --         text "placed" <+> ppr placed)
-             findChain
+          = findChain
       where
         from = edgeFrom edge
         to   = edgeTo   edge
diff --git a/compiler/GHC/CmmToAsm/CFG/Dominators.hs b/compiler/GHC/CmmToAsm/CFG/Dominators.hs
index d9edc86cee..92ef5d95ec 100644
--- a/compiler/GHC/CmmToAsm/CFG/Dominators.hs
+++ b/compiler/GHC/CmmToAsm/CFG/Dominators.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE RankNTypes, BangPatterns, FlexibleContexts, Strict #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Strict #-}
 
 {- |
   Module      :  GHC.CmmToAsm.CFG.Dominators
@@ -250,7 +253,7 @@ link v w = do
   zw  <- sizeM w
   store labelE s lw
   store sizeE v . (+zw) =<< sizeM v
-  let follow s = do
+  let follow s =
         when (s /= n0) (do
           store ancestorE s v
           follow =<< childM s)
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index b25e6187b9..01a3a67333 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE CPP, GADTs #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
 
 -----------------------------------------------------------------------------
 --
@@ -117,7 +118,7 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
         return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
       fixup_entry _ = panic "cmmTopCodegen: Broken CmmProc"
 
-cmmTopCodeGen (CmmData sec dat) = do
+cmmTopCodeGen (CmmData sec dat) =
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
 
 basicBlockCodeGen
@@ -787,7 +788,7 @@ getAmode DS (CmmMachOp (MO_Sub W64) [x, CmmLit (CmmInt i _)])
         (reg, code) <- getSomeReg x
         (reg', off', code')  <-
                      if i `mod` 4 == 0
-                      then do return (reg, off, code)
+                      then return (reg, off, code)
                       else do
                            tmp <- getNewRegNat II64
                            return (tmp, ImmInt 0,
@@ -800,7 +801,7 @@ getAmode DS (CmmMachOp (MO_Add W64) [x, CmmLit (CmmInt i _)])
         (reg, code) <- getSomeReg x
         (reg', off', code')  <-
                      if i `mod` 4 == 0
-                      then do return (reg, off, code)
+                      then return (reg, off, code)
                       else do
                            tmp <- getNewRegNat II64
                            return (tmp, ImmInt 0,
@@ -882,8 +883,7 @@ getCondCode :: CmmExpr -> NatM CondCode
 -- extend small integers to 32 bit or 64 bit first
 
 getCondCode (CmmMachOp mop [x, y])
-  = do
-    case mop of
+  = case mop of
       MO_F_Eq W32 -> condFltCode EQQ x y
       MO_F_Ne W32 -> condFltCode NE  x y
       MO_F_Gt W32 -> condFltCode GTT x y
@@ -1670,7 +1670,7 @@ genCCall' config gcp target dest_regs args
             codeAfter = move_sp_up finalStack `appOL` moveResult reduceToFF32
 
         case labelOrExpr of
-            Left lbl -> do -- the linker does all the work for us
+            Left lbl -> -- the linker does all the work for us
                 return (         codeBefore
                         `snocOL` BL lbl usedRegs
                         `appOL`  maybeNOP -- some ABI require a NOP after BL
@@ -1716,7 +1716,7 @@ genCCall' config gcp target dest_regs args
     where
         platform = ncgPlatform config
 
-        uses_pic_base_implicitly = do
+        uses_pic_base_implicitly =
             -- See Note [implicit register in PPC PIC code]
             -- on why we claim to use PIC register here
             when (ncgPIC config && target32Bit platform) $ do
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
index b3c06cefcc..e290be505e 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Spill.hs
@@ -1,4 +1,3 @@
-
 -- | When there aren't enough registers to hold all the vregs we have to spill
 --   some of those vregs to slots on the stack. This module is used modify the
 --   code to use those slots.
@@ -7,6 +6,7 @@ module GHC.CmmToAsm.Reg.Graph.Spill (
         SpillStats(..),
         accSpillSL
 ) where
+
 import GHC.Prelude
 
 import GHC.CmmToAsm.Reg.Liveness
@@ -182,46 +182,41 @@ regSpill_instr
         -> UniqFM Reg Int -- ^ map of vregs to slots they're being spilled to.
         -> LiveInstr instr
         -> SpillM [LiveInstr instr]
-
-regSpill_instr _ _ li@(LiveInstr _ Nothing)
- = do   return [li]
-
-regSpill_instr platform regSlotMap
-        (LiveInstr instr (Just _))
- = do
-        -- work out which regs are read and written in this instr
-        let RU rlRead rlWritten = regUsageOfInstr platform instr
-
-        -- sometimes a register is listed as being read more than once,
-        --      nub this so we don't end up inserting two lots of spill code.
-        let rsRead_             = nub rlRead
-        let rsWritten_          = nub rlWritten
-
-        -- if a reg is modified, it appears in both lists, want to undo this..
-        let rsRead              = rsRead_    \\ rsWritten_
-        let rsWritten           = rsWritten_ \\ rsRead_
-        let rsModify            = intersect rsRead_ rsWritten_
-
-        -- work out if any of the regs being used are currently being spilled.
-        let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
-        let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
-        let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
-
-        -- rewrite the instr and work out spill code.
-        (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
-        (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
-        (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
-
-        let (mPrefixes, mPostfixes)     = unzip (prepost1 ++ prepost2 ++ prepost3)
-        let prefixes                    = concat mPrefixes
-        let postfixes                   = concat mPostfixes
-
-        -- final code
-        let instrs'     =  prefixes
-                        ++ [LiveInstr instr3 Nothing]
-                        ++ postfixes
-
-        return $ instrs'
+regSpill_instr _ _ li@(LiveInstr _ Nothing) = return [li]
+regSpill_instr platform regSlotMap (LiveInstr instr (Just _)) = do
+  -- work out which regs are read and written in this instr
+  let RU rlRead rlWritten = regUsageOfInstr platform instr
+
+  -- sometimes a register is listed as being read more than once,
+  --      nub this so we don't end up inserting two lots of spill code.
+  let rsRead_             = nub rlRead
+  let rsWritten_          = nub rlWritten
+
+  -- if a reg is modified, it appears in both lists, want to undo this..
+  let rsRead              = rsRead_    \\ rsWritten_
+  let rsWritten           = rsWritten_ \\ rsRead_
+  let rsModify            = intersect rsRead_ rsWritten_
+
+  -- work out if any of the regs being used are currently being spilled.
+  let rsSpillRead         = filter (\r -> elemUFM r regSlotMap) rsRead
+  let rsSpillWritten      = filter (\r -> elemUFM r regSlotMap) rsWritten
+  let rsSpillModify       = filter (\r -> elemUFM r regSlotMap) rsModify
+
+  -- rewrite the instr and work out spill code.
+  (instr1, prepost1)      <- mapAccumLM (spillRead   regSlotMap) instr  rsSpillRead
+  (instr2, prepost2)      <- mapAccumLM (spillWrite  regSlotMap) instr1 rsSpillWritten
+  (instr3, prepost3)      <- mapAccumLM (spillModify regSlotMap) instr2 rsSpillModify
+
+  let (mPrefixes, mPostfixes) = unzip (prepost1 ++ prepost2 ++ prepost3)
+  let prefixes                = concat mPrefixes
+  let postfixes               = concat mPostfixes
+
+  -- final code
+  let instrs' =  prefixes
+              ++ [LiveInstr instr3 Nothing]
+              ++ postfixes
+
+  return instrs'
 
 
 -- | Add a RELOAD met a instruction to load a value for an instruction that
diff --git a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
index 13a9ef4f9e..c06d4178ad 100644
--- a/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/SPARC/CodeGen.hs
@@ -73,7 +73,7 @@ cmmTopCodeGen (CmmProc info lab live graph)
 
       return tops
 
-cmmTopCodeGen (CmmData sec dat) = do
+cmmTopCodeGen (CmmData sec dat) =
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
 
 
@@ -430,8 +430,8 @@ genCCall target dest_regs args
 
                 PrimTarget mop
                  -> do  res     <- outOfLineMachOp mop
-                        lblOrMopExpr <- case res of
-                                Left lbl -> do
+                        case res of
+                                Left lbl ->
                                         return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
 
                                 Right mopExpr -> do
@@ -441,8 +441,6 @@ genCCall target dest_regs args
                                                       _ -> panic "SPARC.CodeGen.genCCall: arg_to_int"
                                         return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 
-                        return lblOrMopExpr
-
         let argcode = concatOL argcodes
 
         let (move_sp_down, move_sp_up)
diff --git a/compiler/GHC/CmmToAsm/X86/CodeGen.hs b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
index aa4769f376..e59ddb01cc 100644
--- a/compiler/GHC/CmmToAsm/X86/CodeGen.hs
+++ b/compiler/GHC/CmmToAsm/X86/CodeGen.hs
@@ -1,6 +1,8 @@
-{-# LANGUAGE CPP, GADTs, NondecreasingIndentation #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NondecreasingIndentation #-}
+{-# LANGUAGE TupleSections #-}
 
 #if __GLASGOW_HASKELL__ <= 808
 -- GHC 8.10 deprecates this flag, but GHC 8.8 needs it
@@ -131,7 +133,7 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
       Just picBase -> initializePicBase_x86 ArchX86 os picBase tops
       Nothing -> return tops
 
-cmmTopCodeGen (CmmData sec dat) = do
+cmmTopCodeGen (CmmData sec dat) =
   return [CmmData sec (mkAlignment 1, dat)]  -- no translation, we just use CmmStatic
 
 {- Note [Verifying basic blocks]
@@ -750,11 +752,11 @@ getRegister' _ is32Bit (CmmMachOp (MO_SS_Conv W32 W64) [CmmLoad addr _])
 
 getRegister' _ is32Bit (CmmMachOp (MO_Add W64) [CmmReg (CmmGlobal PicBaseReg),
                                      CmmLit displacement])
- | not is32Bit = do
+ | not is32Bit =
       return $ Any II64 (\dst -> unitOL $
         LEA II64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst))
 
-getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
+getRegister' platform is32Bit (CmmMachOp mop [x]) = -- unary MachOps
     case mop of
       MO_F_Neg w  -> sse2NegCode w x
 
@@ -886,7 +888,7 @@ getRegister' platform is32Bit (CmmMachOp mop [x]) = do -- unary MachOps
                  return (swizzleRegisterRep e_code new_format)
 
 
-getRegister' _ is32Bit (CmmMachOp mop [x, y]) = do -- dyadic MachOps
+getRegister' _ is32Bit (CmmMachOp mop [x, y]) = -- dyadic MachOps
   case mop of
       MO_F_Eq _ -> condFltReg is32Bit EQQ x y
       MO_F_Ne _ -> condFltReg is32Bit NE  x y
@@ -1371,17 +1373,16 @@ x86_complex_amode base index shift offset
 -- (see trivialCode where this function is used for an example).
 
 getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
-getNonClobberedOperand (CmmLit lit) = do
+getNonClobberedOperand (CmmLit lit) =
   if isSuitableFloatingPointLit lit
-    then do
-      let CmmFloat _ w = lit
-      Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
-      return (OpAddr addr, code)
-     else do
-
-  is32Bit <- is32BitPlatform
-  platform <- getPlatform
-  if is32BitLit is32Bit lit && not (isFloatType (cmmLitType platform lit))
+  then do
+    let CmmFloat _ w = lit
+    Amode addr code <- memConstant (mkAlignment $ widthInBytes w) lit
+    return (OpAddr addr, code)
+  else do
+    is32Bit <- is32BitPlatform
+    platform <- getPlatform
+    if is32BitLit is32Bit lit && not (isFloatType (cmmLitType platform lit))
     then return (OpImm (litToImm lit), nilOL)
     else getNonClobberedOperand_generic (CmmLit lit)
 
@@ -1407,7 +1408,7 @@ getNonClobberedOperand (CmmLoad mem pk) = do
                 else
                    return (src, nilOL)
       return (OpAddr src', mem_code `appOL` save_code)
-    else do
+    else
       -- if its a word or gcptr on 32bit?
       getNonClobberedOperand_generic (CmmLoad mem pk)
 
@@ -1415,8 +1416,8 @@ getNonClobberedOperand e = getNonClobberedOperand_generic e
 
 getNonClobberedOperand_generic :: CmmExpr -> NatM (Operand, InstrBlock)
 getNonClobberedOperand_generic e = do
-    (reg, code) <- getNonClobberedReg e
-    return (OpReg reg, code)
+  (reg, code) <- getNonClobberedReg e
+  return (OpReg reg, code)
 
 amodeCouldBeClobbered :: Platform -> AddrMode -> Bool
 amodeCouldBeClobbered platform amode = any (regClobbered platform) (addrModeRegs amode)
@@ -1795,7 +1796,7 @@ genJump (CmmLoad mem _) regs = do
   Amode target code <- getAmode mem
   return (code `snocOL` JMP (OpAddr target) regs)
 
-genJump (CmmLit lit) regs = do
+genJump (CmmLit lit) regs =
   return (unitOL (JMP (OpImm (litToImm lit)) regs))
 
 genJump expr regs = do
diff --git a/compiler/GHC/CmmToLlvm/CodeGen.hs b/compiler/GHC/CmmToLlvm/CodeGen.hs
index 78f22e5710..5c0f08f641 100644
--- a/compiler/GHC/CmmToLlvm/CodeGen.hs
+++ b/compiler/GHC/CmmToLlvm/CodeGen.hs
@@ -188,18 +188,18 @@ barrierUnless exs = do
         else barrier
 
 -- | Foreign Calls
-genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual]
-              -> LlvmM StmtData
+genCall :: ForeignTarget -> [CmmFormal] -> [CmmActual] -> LlvmM StmtData
 
 -- Barriers need to be handled specially as they are implemented as LLVM
 -- intrinsic functions.
 genCall (PrimTarget MO_ReadBarrier) _ _ =
     barrierUnless [ArchX86, ArchX86_64, ArchSPARC]
-genCall (PrimTarget MO_WriteBarrier) _ _ = do
+
+genCall (PrimTarget MO_WriteBarrier) _ _ =
     barrierUnless [ArchX86, ArchX86_64, ArchSPARC]
 
-genCall (PrimTarget MO_Touch) _ _
- = return (nilOL, [])
+genCall (PrimTarget MO_Touch) _ _ =
+    return (nilOL, [])
 
 genCall (PrimTarget (MO_UF_Conv w)) [dst] [e] = runStmtsDecls $ do
     dstV <- getCmmRegW (CmmLocal dst)
@@ -514,9 +514,8 @@ genCall target res args = do
 
     -- make the actual call
     case retTy of
-        LMVoid -> do
+        LMVoid ->
             statement $ Expr $ Call ccTy fptr argVars fnAttrs
-
         _ -> do
             v1 <- doExprW retTy $ Call ccTy fptr argVars fnAttrs
             -- get the return register
@@ -1559,9 +1558,8 @@ genMachOp_slow opt op [x, y] = case op of
             vx <- exprToVarW x
             vy <- exprToVarW y
             if getVarType vx == getVarType vy
-                then do
+                then
                     doExprW (ty vx) $ binOp vx vy
-
                 else do
                     -- Error. Continue anyway so we can debug the generated ll file.
                     dflags <- getDynFlags
@@ -1717,19 +1715,19 @@ genLoad_slow atomic e ty meta = do
   runExprData $ do
     iptr <- exprToVarW e
     case getVarType iptr of
-         LMPointer _ -> do
+        LMPointer _ ->
                     doExprW (cmmToLlvmType ty) (MExpr meta $ loadInstr iptr)
 
-         i@(LMInt _) | i == llvmWord platform -> do
+        i@(LMInt _) | i == llvmWord platform -> do
                     let pty = LMPointer $ cmmToLlvmType ty
                     ptr <- doExprW pty $ Cast LM_Inttoptr iptr pty
                     doExprW (cmmToLlvmType ty) (MExpr meta $ loadInstr ptr)
 
-         other -> do pprPanic "exprToVar: CmmLoad expression is not right type!"
-                        (PprCmm.pprExpr platform e <+> text (
-                            "Size of Ptr: " ++ show (llvmPtrBits platform) ++
-                            ", Size of var: " ++ show (llvmWidthInBits platform other) ++
-                            ", Var: " ++ showSDoc dflags (ppVar opts iptr)))
+        other -> pprPanic "exprToVar: CmmLoad expression is not right type!"
+                     (PprCmm.pprExpr platform e <+> text (
+                         "Size of Ptr: " ++ show (llvmPtrBits platform) ++
+                         ", Size of var: " ++ show (llvmWidthInBits platform other) ++
+                         ", Var: " ++ showSDoc dflags (ppVar opts iptr)))
   where
     loadInstr ptr | atomic    = ALoad SyncSeqCst False ptr
                   | otherwise = Load ptr
diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs
index 6fdcb02c8c..5104b00c61 100644
--- a/compiler/GHC/Core/Lint.hs
+++ b/compiler/GHC/Core/Lint.hs
@@ -51,7 +51,6 @@ import GHC.Types.Name.Env
 import GHC.Types.Id
 import GHC.Types.Id.Info
 import GHC.Core.Ppr
-import GHC.Utils.Error
 import GHC.Core.Coercion
 import GHC.Types.SrcLoc
 import GHC.Core.Type as Type
@@ -402,7 +401,6 @@ displayLintResults dflags pass warns errs binds
         (lint_banner "warnings" (ppr pass) $$ Err.pprMessageBag (mapBag ($$ blankLine) warns))
 
   | otherwise = return ()
-  where
 
 lint_banner :: String -> SDoc -> SDoc
 lint_banner string pass = text "*** Core Lint"      <+> text string
@@ -925,7 +923,7 @@ lintCoreExpr e@(App _ _)
        ; (fun_ty2, ue2) <- lintCoreArg fun_pair1      arg_ty2
          -- See Note [Linting of runRW#]
        ; let lintRunRWCont :: CoreArg -> LintM (LintedType, UsageEnv)
-             lintRunRWCont expr@(Lam _ _) = do
+             lintRunRWCont expr@(Lam _ _) =
                 lintJoinLams 1 (Just fun) expr
              lintRunRWCont other = markAllJoinsBad $ lintCoreExpr other
              -- TODO: Look through ticks?
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs
index cb3b0a2a05..73b266de11 100644
--- a/compiler/GHC/Core/Opt/ConstantFold.hs
+++ b/compiler/GHC/Core/Opt/ConstantFold.hs
@@ -43,7 +43,7 @@ import GHC.Core
 import GHC.Core.Make
 import GHC.Types.Id
 import GHC.Types.Literal
-import GHC.Core.SimpleOpt ( exprIsLiteral_maybe )
+import GHC.Core.SimpleOpt (  exprIsConApp_maybe, exprIsLiteral_maybe )
 import GHC.Builtin.PrimOps ( PrimOp(..), tagToEnumKey )
 import GHC.Builtin.Types
 import GHC.Builtin.Types.Prim
@@ -54,7 +54,6 @@ import GHC.Core.TyCon
 import GHC.Core.DataCon ( dataConTagZ, dataConTyCon, dataConWrapId, dataConWorkId )
 import GHC.Core.Utils  ( eqExpr, cheapEqExpr, exprIsHNF, exprType
                        , stripTicksTop, stripTicksTopT, mkTicks )
-import GHC.Core.SimpleOpt ( exprIsConApp_maybe )
 import GHC.Core.Multiplicity
 import GHC.Core.FVs
 import GHC.Core.Type
@@ -447,7 +446,7 @@ intOp2' _ _ _ _ = Nothing
 intOpC2 :: (Integral a, Integral b)
         => (a -> b -> Integer)
         -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr
-intOpC2 op env (LitNumber LitNumInt i1) (LitNumber LitNumInt i2) = do
+intOpC2 op env (LitNumber LitNumInt i1) (LitNumber LitNumInt i2) =
   intCResult (roPlatform env) (fromInteger i1 `op` fromInteger i2)
 intOpC2 _ _ _ _ = Nothing
 
diff --git a/compiler/GHC/Core/Opt/Exitify.hs b/compiler/GHC/Core/Opt/Exitify.hs
index 60b1e7a61c..d806e9c607 100644
--- a/compiler/GHC/Core/Opt/Exitify.hs
+++ b/compiler/GHC/Core/Opt/Exitify.hs
@@ -116,7 +116,7 @@ exitifyRec in_scope pairs
     -- Which are the recursive calls?
     recursive_calls = mkVarSet $ map fst pairs
 
-    (pairs',exits) = (`runState` []) $ do
+    (pairs',exits) = (`runState` []) $
         forM ann_pairs $ \(x,rhs) -> do
             -- go past the lambdas of the join point
             let (args, body) = collectNAnnBndrs (idJoinArity x) rhs
diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs
index c535c24638..bdacfba90b 100644
--- a/compiler/GHC/Core/Opt/Monad.hs
+++ b/compiler/GHC/Core/Opt/Monad.hs
@@ -65,9 +65,8 @@ import GHC.Types.Name.Env
 import GHC.Types.SrcLoc
 
 import GHC.Utils.Outputable as Outputable
-import GHC.Utils.Error( Severity(..), DumpFormat (..), dumpOptionsFromFlag )
+import GHC.Utils.Error ( Severity(..), DumpFormat (..), dumpAction, dumpOptionsFromFlag )
 import GHC.Utils.Monad
-import GHC.Utils.Error (dumpAction)
 
 import GHC.Data.FastString
 import GHC.Data.IOEnv hiding     ( liftIO, failM, failWithM )
diff --git a/compiler/GHC/Core/Opt/Pipeline.hs b/compiler/GHC/Core/Opt/Pipeline.hs
index c8e10865cb..f393255b54 100644
--- a/compiler/GHC/Core/Opt/Pipeline.hs
+++ b/compiler/GHC/Core/Opt/Pipeline.hs
@@ -461,7 +461,7 @@ runCorePasses passes guts
   where
     do_pass guts CoreDoNothing = return guts
     do_pass guts (CoreDoPasses ps) = runCorePasses ps guts
-    do_pass guts pass = do
+    do_pass guts pass =
        withTimingD (ppr pass <+> brackets (ppr mod))
                    (const ()) $ do
             { guts' <- lintAnnots (ppr pass) (doCorePass pass) guts
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 42cc081498..15bf703639 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -17,13 +17,11 @@ import GHC.Platform
 import GHC.Driver.Session
 import GHC.Driver.Ppr
 import GHC.Driver.Config
-import GHC.Core.SimpleOpt   ( exprIsConApp_maybe )
 import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst )
 import GHC.Core.Opt.Simplify.Env
 import GHC.Core.Opt.Simplify.Utils
 import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
-import GHC.Core.FamInstEnv ( FamInstEnv )
 import GHC.Types.Literal   ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326
 import GHC.Types.SourceText
 import GHC.Types.Id
@@ -34,7 +32,7 @@ import GHC.Types.Id.Info
 import GHC.Types.Name           ( mkSystemVarName, isExternalName, getOccFS )
 import GHC.Core.Coercion hiding ( substCo, substCoVar )
 import GHC.Core.Coercion.Opt    ( optCoercion )
-import GHC.Core.FamInstEnv      ( topNormaliseType_maybe )
+import GHC.Core.FamInstEnv      ( FamInstEnv, topNormaliseType_maybe )
 import GHC.Core.DataCon
    ( DataCon, dataConWorkId, dataConRepStrictness
    , dataConRepArgTys, isUnboxedTupleDataCon
@@ -54,7 +52,7 @@ import GHC.Core.Utils
 import GHC.Core.Opt.Arity ( ArityType(..), arityTypeArity, isBotArityType
                           , pushCoTyArg, pushCoValArg
                           , idArityType, etaExpandAT )
-import GHC.Core.SimpleOpt ( joinPointBinding_maybe, joinPointBindings_maybe )
+import GHC.Core.SimpleOpt ( exprIsConApp_maybe, joinPointBinding_maybe, joinPointBindings_maybe )
 import GHC.Core.FVs     ( mkRuleInfo )
 import GHC.Core.Rules   ( lookupRule, getRules, initRuleOpts )
 import GHC.Types.Basic
@@ -2197,21 +2195,21 @@ tryRules env rules fn args call_cont
 
     nodump
       | dopt Opt_D_dump_rule_rewrites dflags
-      = liftIO $ do
-         touchDumpFile dflags (dumpOptionsFromFlag Opt_D_dump_rule_rewrites)
+      = liftIO $
+          touchDumpFile dflags (dumpOptionsFromFlag Opt_D_dump_rule_rewrites)
 
       | dopt Opt_D_dump_rule_firings dflags
-      = liftIO $ do
-         touchDumpFile dflags (dumpOptionsFromFlag Opt_D_dump_rule_firings)
+      = liftIO $
+          touchDumpFile dflags (dumpOptionsFromFlag Opt_D_dump_rule_firings)
 
       | otherwise
       = return ()
 
     log_rule dflags flag hdr details
       = liftIO $ do
-         let sty = mkDumpStyle alwaysQualify
-         dumpAction dflags sty (dumpOptionsFromFlag flag) "" FormatText $
-           sep [text hdr, nest 4 details]
+          let sty = mkDumpStyle alwaysQualify
+          dumpAction dflags sty (dumpOptionsFromFlag flag) "" FormatText $
+              sep [text hdr, nest 4 details]
 
 trySeqRules :: SimplEnv
             -> OutExpr -> InExpr   -- Scrutinee and RHS
diff --git a/compiler/GHC/Core/Opt/SpecConstr.hs b/compiler/GHC/Core/Opt/SpecConstr.hs
index 2ca8e1a080..c613ac2ebd 100644
--- a/compiler/GHC/Core/Opt/SpecConstr.hs
+++ b/compiler/GHC/Core/Opt/SpecConstr.hs
@@ -1066,14 +1066,6 @@ nullUsage = SCU { scu_calls = emptyVarEnv, scu_occs = emptyVarEnv }
 
 combineCalls :: CallEnv -> CallEnv -> CallEnv
 combineCalls = plusVarEnv_C (++)
-  where
---    plus cs ds | length res > 1
---               = pprTrace "combineCalls" (vcat [ text "cs:" <+> ppr cs
---                                               , text "ds:" <+> ppr ds])
---                 res
---               | otherwise = res
---       where
---          res = cs ++ ds
 
 combineUsage :: ScUsage -> ScUsage -> ScUsage
 combineUsage u1 u2 = SCU { scu_calls = combineCalls (scu_calls u1) (scu_calls u2),
diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs
index 2fa9e9b18c..4cca5199c7 100644
--- a/compiler/GHC/Core/Opt/Specialise.hs
+++ b/compiler/GHC/Core/Opt/Specialise.hs
@@ -724,8 +724,7 @@ spec_import top_env callers rb dict_binds cis@(CIS fn _)
                         -- call to the original function
 
   | null good_calls
-  = do { -- debugTraceMsg (text "specImport:no valid calls")
-       ; return ([], []) }
+  = return ([], [])
 
   | Just rhs <- canSpecImport dflags fn
   = do {     -- Get rules from the external package state
@@ -738,9 +737,8 @@ spec_import top_env callers rb dict_binds cis@(CIS fn _)
              rules_for_fn = getRules (RuleEnv full_rb vis_orphs) fn
 
        ; (rules1, spec_pairs, MkUD { ud_binds = dict_binds1, ud_calls = new_calls })
-             <- do { -- debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls, ppr rhs])
-                   ; runSpecM $
-                     specCalls True top_env rules_for_fn good_calls fn rhs }
+            <- -- debugTraceMsg (text "specImport1" <+> vcat [ppr fn, ppr good_calls, ppr rhs]) >>
+                (runSpecM $ specCalls True top_env rules_for_fn good_calls fn rhs)
        ; let spec_binds1 = [NonRec b r | (b,r) <- spec_pairs]
              -- After the rules kick in we may get recursion, but
              -- we rely on a global GlomBinds to sort that out later
diff --git a/compiler/GHC/Core/Opt/StaticArgs.hs b/compiler/GHC/Core/Opt/StaticArgs.hs
index 04b21b588e..180d555c2f 100644
--- a/compiler/GHC/Core/Opt/StaticArgs.hs
+++ b/compiler/GHC/Core/Opt/StaticArgs.hs
@@ -189,7 +189,7 @@ satExpr var@(Var v) interesting_ids = do
                    else Nothing
     return (var, emptyIdSATInfo, app_info)
 
-satExpr lit@(Lit _) _ = do
+satExpr lit@(Lit _) _ =
     return (lit, emptyIdSATInfo, Nothing)
 
 satExpr (Lam binders body) interesting_ids = do
@@ -238,10 +238,10 @@ satExpr (Tick tickish expr) interesting_ids = do
     (expr', sat_info_expr, expr_app) <- satExpr expr interesting_ids
     return (Tick tickish expr', sat_info_expr, expr_app)
 
-satExpr ty@(Type _) _ = do
+satExpr ty@(Type _) _ =
     return (ty, emptyIdSATInfo, Nothing)
 
-satExpr co@(Coercion _) _ = do
+satExpr co@(Coercion _) _ =
     return (co, emptyIdSATInfo, Nothing)
 
 satExpr (Cast expr coercion) interesting_ids = do
diff --git a/compiler/GHC/Core/TyCon/Env.hs b/compiler/GHC/Core/TyCon/Env.hs
index f2ec25ba0d..76edb829fd 100644
--- a/compiler/GHC/Core/TyCon/Env.hs
+++ b/compiler/GHC/Core/TyCon/Env.hs
@@ -5,9 +5,7 @@
 \section[TyConEnv]{@TyConEnv@: tyCon environments}
 -}
 
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
-
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 
diff --git a/compiler/GHC/Core/TyCon/RecWalk.hs b/compiler/GHC/Core/TyCon/RecWalk.hs
index 09ba6402ac..7ddb2eb4d2 100644
--- a/compiler/GHC/Core/TyCon/RecWalk.hs
+++ b/compiler/GHC/Core/TyCon/RecWalk.hs
@@ -6,7 +6,7 @@ Check for recursive type constructors.
 
 -}
 
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
 
 module GHC.Core.TyCon.RecWalk (
 
diff --git a/compiler/GHC/Core/TyCon/Set.hs b/compiler/GHC/Core/TyCon/Set.hs
index 40beac6c58..d2615dfd73 100644
--- a/compiler/GHC/Core/TyCon/Set.hs
+++ b/compiler/GHC/Core/TyCon/Set.hs
@@ -4,7 +4,7 @@
 
 -}
 
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE CPP #-}
 
 module GHC.Core.TyCon.Set (
         -- * TyCons set type
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index e980c560e0..2e40ddc659 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -74,7 +74,7 @@ import GHC.Platform
 import GHC.Driver.Ppr
 
 import GHC.Core
-import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofName )
+import GHC.Builtin.Names (absentErrorIdKey, makeStaticName, unsafeEqualityProofName)
 import GHC.Core.Ppr
 import GHC.Core.FVs( exprFreeVars )
 import GHC.Types.Var
@@ -87,7 +87,6 @@ import GHC.Core.DataCon
 import GHC.Builtin.PrimOps
 import GHC.Types.Id
 import GHC.Types.Id.Info
-import GHC.Builtin.Names( absentErrorIdKey )
 import GHC.Core.Type as Type
 import GHC.Core.Predicate
 import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder )
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 2361a041d3..e0c7ef2521 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -51,9 +51,10 @@ import GHC.Builtin.PrimOps ( PrimCall(..) )
 import GHC.Types.SrcLoc    ( mkGeneralSrcSpan )
 import GHC.Builtin.Names   ( unsafeEqualityProofName )
 
-import Data.List.NonEmpty (nonEmpty, toList)
-import Data.Maybe    (fromMaybe)
 import Control.Monad (ap)
+import Data.List.NonEmpty (nonEmpty, toList)
+import Data.Maybe (fromMaybe)
+import Data.Tuple (swap)
 import qualified Data.Set as Set
 
 -- Note [Live vs free]
@@ -309,14 +310,10 @@ coreTopBindToStg dflags this_mod env ccs (Rec pairs)
 
         -- generate StgTopBindings and CAF cost centres created for CAFs
         (ccs', stg_rhss)
-          = initCts dflags env' $ do
-               mapAccumLM (\ccs rhs -> do
-                            (rhs', ccs') <-
-                              coreToTopStgRhs dflags ccs this_mod rhs
-                            return (ccs', rhs'))
-                          ccs
-                          pairs
-
+          = initCts dflags env' $
+              mapAccumLM (\ccs rhs -> swap <$> coreToTopStgRhs dflags ccs this_mod rhs)
+                         ccs
+                         pairs
         bind = StgTopLifted $ StgRec (zip binders stg_rhss)
     in
     (env', ccs', bind)
@@ -467,10 +464,8 @@ coreToStgExpr e0@(Case scrut bndr _ alts) = do
         rhs2 <- coreToStgExpr rhs
         return (con, binders', rhs2)
 
-coreToStgExpr (Let bind body) = do
-    coreToStgLet bind body
-
-coreToStgExpr e = pprPanic "coreToStgExpr" (ppr e)
+coreToStgExpr (Let bind body) = coreToStgLet bind body
+coreToStgExpr e               = pprPanic "coreToStgExpr" (ppr e)
 
 mkStgAltType :: Id -> [CoreAlt] -> AltType
 mkStgAltType bndr alts
diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs
index 771ce24146..0f6a26f75e 100644
--- a/compiler/GHC/Data/FastString.hs
+++ b/compiler/GHC/Data/FastString.hs
@@ -1,8 +1,12 @@
 -- (c) The University of Glasgow, 1997-2006
 
-{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples,
-    GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
 {-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -501,7 +505,7 @@ mkFastStringBytes !ptr !len =
         mkFastStringWith (mkNewFastStringShortByteString sbs) sbs
 
 newSBSFromPtr :: Ptr a -> Int -> IO ShortByteString
-newSBSFromPtr (Ptr src#) (I# len#) = do
+newSBSFromPtr (Ptr src#) (I# len#) =
   IO $ \s ->
     case newByteArray# len# s of { (# s, dst# #) ->
     case copyAddrToByteArray# src# dst# 0# len# s of { s ->
diff --git a/compiler/GHC/Data/StringBuffer.hs b/compiler/GHC/Data/StringBuffer.hs
index 11ddfe47bc..42ab89f8cc 100644
--- a/compiler/GHC/Data/StringBuffer.hs
+++ b/compiler/GHC/Data/StringBuffer.hs
@@ -6,7 +6,11 @@
 Buffers for scanning string input stored in external arrays.
 -}
 
-{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
 {-# OPTIONS_GHC -O2 #-}
 -- We always optimise this, otherwise performance of a non-optimised
 -- compiler is severely affected
@@ -124,8 +128,8 @@ hGetStringBufferBlock handle wanted
 
 hPutStringBuffer :: Handle -> StringBuffer -> IO ()
 hPutStringBuffer hdl (StringBuffer buf len cur)
-    = do withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
-             hPutBuf hdl ptr len
+    = withForeignPtr (plusForeignPtr buf cur) $ \ptr ->
+          hPutBuf hdl ptr len
 
 -- | Skip the byte-order mark if there is one (see #1744 and #6016),
 -- and return the new position of the handle in bytes.
@@ -198,8 +202,8 @@ stringToStringBuffer str =
 nextChar :: StringBuffer -> (Char,StringBuffer)
 nextChar (StringBuffer buf len (I# cur#)) =
   -- Getting our fingers dirty a little here, but this is performance-critical
-  inlinePerformIO $ do
-    withForeignPtr buf $ \(Ptr a#) -> do
+  inlinePerformIO $
+    withForeignPtr buf $ \(Ptr a#) ->
         case utf8DecodeCharAddr# (a# `plusAddr#` cur#) 0# of
           (# c#, nBytes# #) ->
              let cur' = I# (cur# +# nBytes#) in
@@ -215,7 +219,7 @@ currentChar = fst . nextChar
 prevChar :: StringBuffer -> Char -> Char
 prevChar (StringBuffer _   _   0)   deflt = deflt
 prevChar (StringBuffer buf _   cur) _     =
-  inlinePerformIO $ do
+  inlinePerformIO $
     withForeignPtr buf $ \p -> do
       p' <- utf8PrevChar (p `plusPtr` cur)
       return (fst (utf8DecodeChar p'))
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs
index 54961066d8..332023dd74 100644
--- a/compiler/GHC/Driver/Backpack.hs
+++ b/compiler/GHC/Driver/Backpack.hs
@@ -224,7 +224,7 @@ withBkpSession cid insts deps session_type do_this = do
         do_this
 
 withBkpExeSession :: [(Unit, ModRenaming)] -> BkpM a -> BkpM a
-withBkpExeSession deps do_this = do
+withBkpExeSession deps do_this =
     withBkpSession (Indefinite (UnitId (fsLit "main"))) [] deps ExeSession do_this
 
 getSource :: IndefUnitId -> BkpM (LHsUnit HsComponentId)
@@ -472,7 +472,7 @@ overHscDynFlags f hsc_env = hsc_env { hsc_dflags = f (hsc_dflags hsc_env) }
 
 -- | Run a 'BkpM' computation, with the nesting level bumped one.
 innerBkpM :: BkpM a -> BkpM a
-innerBkpM do_this = do
+innerBkpM do_this =
     -- NB: withTempSession mutates, so we don't have to worry
     -- about bkp_session being stale.
     updEnv (\env -> env { bkp_level = bkp_level env + 1 }) do_this
@@ -491,14 +491,14 @@ getEpsGhc = do
 
 -- | Run 'BkpM' in 'Ghc'.
 initBkpM :: FilePath -> [LHsUnit HsComponentId] -> BkpM a -> Ghc a
-initBkpM file bkp m = do
-    reifyGhc $ \session -> do
+initBkpM file bkp m =
+  reifyGhc $ \session -> do
     let env = BkpEnv {
-                    bkp_session = session,
-                    bkp_table = Map.fromList [(hsComponentId (unLoc (hsunitName (unLoc u))), u) | u <- bkp],
-                    bkp_filename = file,
-                    bkp_level = 0
-                }
+        bkp_session = session,
+        bkp_table = Map.fromList [(hsComponentId (unLoc (hsunitName (unLoc u))), u) | u <- bkp],
+        bkp_filename = file,
+        bkp_level = 0
+      }
     runIOEnv env m
 
 -- ----------------------------------------------------------------------------
@@ -666,7 +666,7 @@ hsunitModuleGraph unit = do
 
     --  1. Create a HsSrcFile/HsigFile summary for every
     --  explicitly mentioned module/signature.
-    let get_decl (L _ (DeclD hsc_src lmodname mb_hsmod)) = do
+    let get_decl (L _ (DeclD hsc_src lmodname mb_hsmod)) =
           Just `fmap` summariseDecl pn hsc_src lmodname mb_hsmod
         get_decl _ = return Nothing
     nodes <- catMaybes `fmap` mapM get_decl decls
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index f9912ee303..4886d5a2ee 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -131,17 +131,15 @@ outputC :: DynFlags
         -> Stream IO RawCmmGroup a
         -> [UnitId]
         -> IO a
-
-outputC dflags filenm cmm_stream packages
-  = do
-       withTiming dflags (text "C codegen") (\a -> seq a () {- FIXME -}) $ do
-         let pkg_names = map unitIdString packages
-         doOutput filenm $ \ h -> do
-            hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
-            hPutStr h "#include \"Stg.h\"\n"
-            let platform = targetPlatform dflags
-                writeC = printForC dflags h . cmmToC platform
-            Stream.consume cmm_stream writeC
+outputC dflags filenm cmm_stream packages =
+  withTiming dflags (text "C codegen") (\a -> seq a () {- FIXME -}) $ do
+    let pkg_names = map unitIdString packages
+    doOutput filenm $ \ h -> do
+      hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
+      hPutStr h "#include \"Stg.h\"\n"
+      let platform = targetPlatform dflags
+          writeC = printForC dflags h . cmmToC platform
+      Stream.consume cmm_stream writeC
 
 {-
 ************************************************************************
@@ -151,17 +149,18 @@ outputC dflags filenm cmm_stream packages
 ************************************************************************
 -}
 
-outputAsm :: DynFlags -> Module -> ModLocation -> FilePath
+outputAsm :: DynFlags
+          -> Module
+          -> ModLocation
+          -> FilePath
           -> Stream IO RawCmmGroup a
           -> IO a
-outputAsm dflags this_mod location filenm cmm_stream
-  = do ncg_uniqs <- mkSplitUniqSupply 'n'
-
-       debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)
-
-       {-# SCC "OutputAsm" #-} doOutput filenm $
-           \h -> {-# SCC "NativeCodeGen" #-}
-                 nativeCodeGen dflags this_mod location h ncg_uniqs cmm_stream
+outputAsm dflags this_mod location filenm cmm_stream = do
+  ncg_uniqs <- mkSplitUniqSupply 'n'
+  debugTraceMsg dflags 4 (text "Outputing asm to" <+> text filenm)
+  {-# SCC "OutputAsm" #-} doOutput filenm $
+    \h -> {-# SCC "NativeCodeGen" #-}
+      nativeCodeGen dflags this_mod location h ncg_uniqs cmm_stream
 
 {-
 ************************************************************************
@@ -172,10 +171,10 @@ outputAsm dflags this_mod location filenm cmm_stream
 -}
 
 outputLlvm :: DynFlags -> FilePath -> Stream IO RawCmmGroup a -> IO a
-outputLlvm dflags filenm cmm_stream
-  = do {-# SCC "llvm_output" #-} doOutput filenm $
-           \f -> {-# SCC "llvm_CodeGen" #-}
-                 llvmCodeGen dflags f cmm_stream
+outputLlvm dflags filenm cmm_stream =
+  {-# SCC "llvm_output" #-} doOutput filenm $
+    \f -> {-# SCC "llvm_CodeGen" #-}
+      llvmCodeGen dflags f cmm_stream
 
 {-
 ************************************************************************
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 143b1f5ccd..d12099f21b 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -575,7 +575,7 @@ tcRnModule' sum save_rn_syntax mod = do
       else do
           tcg_res' <- hscCheckSafeImports tcg_res
           safe <- liftIO $ fst <$> readIORef (tcg_safeInfer tcg_res')
-          when safe $ do
+          when safe $
             case wopt Opt_WarnSafe dflags of
               True
                 | safeHaskell dflags == Sf_Safe -> return ()
@@ -801,8 +801,7 @@ hscIncrementalCompile always_do_basic_recompilation_check m_tc_result
                 -- in one-shot mode, since we're not going to do
                 -- any further typechecking.  It's much more useful
                 -- in make mode, since this HMI will go into the HPT.
-                details <- genModDetails hsc_env' iface
-                return details
+                genModDetails hsc_env' iface
             return (HscUpToDate iface details, dflags)
         -- We finished type checking.  (mb_old_hash is the hash of
         -- the interface that existed on disk; it's possible we had
@@ -1012,7 +1011,7 @@ hscCheckSafeImports tcg_env = do
     checkRULES dflags tcg_env'
 
   where
-    checkRULES dflags tcg_env' = do
+    checkRULES dflags tcg_env' =
       case safeLanguageOn dflags of
           True -> do
               -- XSafe: we nuke user written RULES
@@ -1254,10 +1253,9 @@ hscCheckSafe' m l = do
         -- the 'lookupIfaceByModule' method will always fail when calling from GHCi
         -- as the compiler hasn't filled in the various module tables
         -- so we need to call 'getModuleInterface' to load from disk
-        iface' <- case iface of
+        case iface of
             Just _  -> return iface
             Nothing -> snd `fmap` (liftIO $ getModuleInterface hsc_env m)
-        return iface'
 
 
 -- | Check the list of packages are trusted.
@@ -1924,9 +1922,8 @@ hscParseThingWithLocation source linenumber parser str
         loc = mkRealSrcLoc (fsLit source) linenumber 1
 
     case unP parser (initParserState (initParserOpts dflags) buf loc) of
-        PFailed pst -> do
+        PFailed pst ->
             handleWarningsThrowErrors (getMessages pst)
-
         POk pst thing -> do
             logWarningsReportErrors (getMessages pst)
             liftIO $ dumpIfSet_dyn dflags Opt_D_dump_parsed "Parser"
@@ -1965,9 +1962,7 @@ hscCompileCoreExpr' hsc_env srcspan ds_expr
                      (icInteractiveModule (hsc_IC hsc_env)) prepd_expr
 
            {- link it -}
-         ; hval <- linkExpr hsc_env srcspan bcos
-
-         ; return hval }
+         ; linkExpr hsc_env srcspan bcos }
 
 
 {- **********************************************************************
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 5023eacdc7..19bef47e42 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -1168,7 +1168,7 @@ parUpsweep n_jobs mHscMessage old_hpt stable_mods cleanup sccs = do
     -- The log_action callback that is used to synchronize messages from a
     -- worker thread.
     parLogAction :: LogQueue -> LogAction
-    parLogAction log_queue _dflags !reason !severity !srcSpan !msg = do
+    parLogAction log_queue _dflags !reason !severity !srcSpan !msg =
         writeLogQueue log_queue (Just (reason,severity,srcSpan,msg))
 
     -- Print each message from the log_queue using the log_action from the
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 5428c83b99..2a2d9e294c 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -1,4 +1,8 @@
-{-# LANGUAGE CPP, NamedFieldPuns, NondecreasingIndentation, BangPatterns, MultiWayIf #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
@@ -222,7 +226,7 @@ compileOne' m_tc_result mHscMessage
             in return $! HomeModInfo iface hmi_details mb_linkable
         (HscNotGeneratingCode _ _, _) -> panic "compileOne HscNotGeneratingCode"
         (_, NoBackend) -> panic "compileOne NoBackend"
-        (HscUpdateBoot iface hmi_details, Interpreter) -> do
+        (HscUpdateBoot iface hmi_details, Interpreter) ->
             return $! HomeModInfo iface hmi_details Nothing
         (HscUpdateBoot iface hmi_details, _) -> do
             touchObjectFile dflags object_filename
@@ -773,7 +777,7 @@ runPipeline stop_phase hsc_env0 (input_fn, mb_input_buf, mb_phase)
          -- path, then rerun the pipeline for the dyn way
          let dflags = hsc_dflags hsc_env
          -- NB: Currently disabled on Windows (ref #7134, #8228, and #5987)
-         when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $ do
+         when (not $ platformOS (targetPlatform dflags) == OSMinGW32) $
            when isHaskellishFile $ whenCannotGenerateDynamicToo dflags $ do
                debugTraceMsg dflags 4
                    (text "Running the pipeline again for -dynamic-too")
@@ -1094,31 +1098,30 @@ runPhase (RealPhase (Cpp sf)) input_fn dflags0
 -- HsPp phase
 
 runPhase (RealPhase (HsPp sf)) input_fn dflags
-  = do
-       if not (gopt Opt_Pp dflags) then
-           -- no need to preprocess, just pass input file along
-           -- to the next phase of the pipeline.
-          return (RealPhase (Hsc sf), input_fn)
-        else do
-            PipeEnv{src_basename, src_suffix} <- getPipeEnv
-            let orig_fn = src_basename <.> src_suffix
-            output_fn <- phaseOutputFilename (Hsc sf)
-            liftIO $ GHC.SysTools.runPp dflags
-                           ( [ GHC.SysTools.Option     orig_fn
-                             , GHC.SysTools.Option     input_fn
-                             , GHC.SysTools.FileOption "" output_fn
-                             ]
-                           )
-
-            -- re-read pragmas now that we've parsed the file (see #3674)
-            src_opts <- liftIO $ getOptionsFromFile dflags output_fn
-            (dflags1, unhandled_flags, warns)
-                <- liftIO $ parseDynamicFilePragma dflags src_opts
-            setDynFlags dflags1
-            liftIO $ checkProcessArgsResult dflags1 unhandled_flags
-            liftIO $ handleFlagWarnings dflags1 warns
-
-            return (RealPhase (Hsc sf), output_fn)
+  = if not (gopt Opt_Pp dflags) then
+      -- no need to preprocess, just pass input file along
+      -- to the next phase of the pipeline.
+       return (RealPhase (Hsc sf), input_fn)
+    else do
+        PipeEnv{src_basename, src_suffix} <- getPipeEnv
+        let orig_fn = src_basename <.> src_suffix
+        output_fn <- phaseOutputFilename (Hsc sf)
+        liftIO $ GHC.SysTools.runPp dflags
+                       ( [ GHC.SysTools.Option     orig_fn
+                         , GHC.SysTools.Option     input_fn
+                         , GHC.SysTools.FileOption "" output_fn
+                         ]
+                       )
+
+        -- re-read pragmas now that we've parsed the file (see #3674)
+        src_opts <- liftIO $ getOptionsFromFile dflags output_fn
+        (dflags1, unhandled_flags, warns)
+            <- liftIO $ parseDynamicFilePragma dflags src_opts
+        setDynFlags dflags1
+        liftIO $ checkProcessArgsResult dflags1 unhandled_flags
+        liftIO $ handleFlagWarnings dflags1 warns
+
+        return (RealPhase (Hsc sf), output_fn)
 
 -----------------------------------------------------------------------------
 -- Hsc phase
@@ -1144,7 +1147,6 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
 
   -- gather the imports and module name
         (hspp_buf,mod_name,imps,src_imps) <- liftIO $ do
-          do
             buf <- hGetStringBuffer input_fn
             let imp_prelude = xopt LangExt.ImplicitPrelude dflags
                 popts = initParserOpts dflags
@@ -1478,8 +1480,8 @@ runPhase (RealPhase (As with_cpp)) input_fn dflags
         let local_includes = [ GHC.SysTools.Option ("-iquote" ++ p)
                              | p <- includePathsQuote cmdline_include_paths ]
         let runAssembler inputFilename outputFilename
-              = liftIO $ do
-                  withAtomicRename outputFilename $ \temp_outputFilename -> do
+              = liftIO $
+                  withAtomicRename outputFilename $ \temp_outputFilename ->
                     as_prog
                        dflags
                        (local_includes ++ global_includes
@@ -2028,15 +2030,13 @@ maybeCreateManifest dflags exe_filename
 
 
 linkDynLibCheck :: DynFlags -> [String] -> [UnitId] -> IO ()
-linkDynLibCheck dflags o_files dep_units
- = do
-    when (haveRtsOptsFlags dflags) $ do
-      putLogMsg dflags NoReason SevInfo noSrcSpan
-          $ withPprStyle defaultUserStyle
-          (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
-           text "    Call hs_init_ghc() from your main() function to set these options.")
-
-    linkDynLib dflags o_files dep_units
+linkDynLibCheck dflags o_files dep_units = do
+  when (haveRtsOptsFlags dflags) $
+    putLogMsg dflags NoReason SevInfo noSrcSpan
+      $ withPprStyle defaultUserStyle
+      (text "Warning: -rtsopts and -with-rtsopts have no effect with -shared." $$
+      text "    Call hs_init_ghc() from your main() function to set these options.")
+  linkDynLib dflags o_files dep_units
 
 -- | Linking a static lib will not really link anything. It will merely produce
 -- a static archive of all dependent static libraries. The resulting library
@@ -2313,7 +2313,7 @@ joinObjectFiles dflags o_files output_fn = do
           writeFile filelist $ unlines o_files
           ld_r [GHC.SysTools.Option "-filelist",
                 GHC.SysTools.FileOption "" filelist]
-     else do
+     else
           ld_r (map (GHC.SysTools.FileOption "") o_files)
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 20fd137ea7..2000b9760b 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1351,7 +1351,7 @@ defaultFatalMessager = hPutStrLn stderr
 --
 jsonLogAction :: LogAction
 jsonLogAction dflags reason severity srcSpan msg
-  = do
+  =
     defaultLogActionHPutStrDoc dflags stdout
       (withPprStyle (PprCode CStyle) (doc $$ text ""))
     where
@@ -3030,7 +3030,7 @@ package_flags_deps = [
       (HasArg $ addPkgDbRef . PkgDbPath) "Use -package-db instead"
   , make_dep_flag defFlag "no-user-package-conf"
       (NoArg removeUserPkgDb)              "Use -no-user-package-db instead"
-  , make_ord_flag defGhcFlag "package-name"       (HasArg $ \name -> do
+  , make_ord_flag defGhcFlag "package-name"       (HasArg $ \name ->
                                       upd (setUnitId name))
   , make_ord_flag defGhcFlag "this-unit-id"       (hasArg setUnitId)
   , make_ord_flag defFlag "package"               (HasArg exposePackage)
diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs
index db6508d581..1845f060ed 100644
--- a/compiler/GHC/Hs/Type.hs
+++ b/compiler/GHC/Hs/Type.hs
@@ -1595,8 +1595,8 @@ getLHsInstDeclClass_maybe :: LHsSigType (GhcPass p)
 -- Works on (LHsSigType GhcPs)
 getLHsInstDeclClass_maybe inst_ty
   = do { let head_ty = getLHsInstDeclHead inst_ty
-       ; cls <- hsTyGetAppHead_maybe head_ty
-       ; return cls }
+       ; hsTyGetAppHead_maybe head_ty
+       }
 
 {-
 Note [No nested foralls or contexts in instance types]
diff --git a/compiler/GHC/HsToCore.hs b/compiler/GHC/HsToCore.hs
index 9954c204dc..14de36906d 100644
--- a/compiler/GHC/HsToCore.hs
+++ b/compiler/GHC/HsToCore.hs
@@ -767,5 +767,3 @@ mkUnsafeCoercePrimPair _old_id old_expr
 
              id   = mkExportedVanillaId unsafeCoercePrimName ty `setIdInfo` info
        ; return (id, old_expr) }
-
-  where
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 9b3bbdf0b0..cdc68599ba 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -163,7 +163,7 @@ mkModBreaks hsc_env mod count entries
 mkCCSArray
   :: HscEnv -> Module -> Int -> [MixEntry_]
   -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre))
-mkCCSArray hsc_env modul count entries = do
+mkCCSArray hsc_env modul count entries =
   case hsc_interp hsc_env of
     Just interp | GHCi.interpreterProfiled interp -> do
       let module_str = moduleNameString (moduleName modul)
@@ -198,7 +198,7 @@ writeMixEntries dflags mod count entries filename
         modTime <- getModificationUTCTime filename
         let entries' = [ (hpcPos, box)
                        | (span,_,_,box) <- entries, hpcPos <- [mkHpcPos span] ]
-        when (entries' `lengthIsNot` count) $ do
+        when (entries' `lengthIsNot` count) $
           panic "the number of .mix entries are inconsistent"
         let hashNo = mixHash filename modTime tabStop entries'
         mixCreate hpc_mod_dir mod_name
@@ -268,12 +268,12 @@ addTickLHsBinds = mapBagM addTickLHsBind
 
 addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
 addTickLHsBind (L pos bind@(AbsBinds { abs_binds   = binds,
-                                       abs_exports = abs_exports })) = do
-  withEnv add_exports $ do
-  withEnv add_inlines $ do
-  binds' <- addTickLHsBinds binds
-  return $ L pos $ bind { abs_binds = binds' }
- where
+                                       abs_exports = abs_exports })) =
+  withEnv add_exports $
+    withEnv add_inlines $ do
+      binds' <- addTickLHsBinds binds
+      return $ L pos $ bind { abs_binds = binds' }
+  where
    -- in AbsBinds, the Id on each binding is not the actual top-level
    -- Id that we are defining, they are related by the abs_exports
    -- field of AbsBinds.  So if we're doing TickExportedFunctions we need
@@ -668,7 +668,7 @@ addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats
 
 addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
              -> TM (GRHSs GhcTc (LHsExpr GhcTc))
-addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (L l local_binds)) = do
+addTickGRHSs isOneOfMany isLambda (GRHSs x guarded (L l local_binds)) =
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded
@@ -711,12 +711,12 @@ addTickLStmts' isGuard lstmts res
 
 addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt GhcTc (LHsExpr GhcTc)
             -> TM (Stmt GhcTc (LHsExpr GhcTc))
-addTickStmt _isGuard (LastStmt x e noret ret) = do
+addTickStmt _isGuard (LastStmt x e noret ret) =
         liftM3 (LastStmt x)
                 (addTickLHsExpr e)
                 (pure noret)
                 (addTickSyntaxExpr hpcSrcSpan ret)
-addTickStmt _isGuard (BindStmt xbs pat e) = do
+addTickStmt _isGuard (BindStmt xbs pat e) =
         liftM4 (\b f -> BindStmt $ XBindStmtTc
                     { xbstc_bindOp = b
                     , xbstc_boundResultType = xbstc_boundResultType xbs
@@ -727,15 +727,15 @@ addTickStmt _isGuard (BindStmt xbs pat e) = do
                 (mapM (addTickSyntaxExpr hpcSrcSpan) (xbstc_failOp xbs))
                 (addTickLPat pat)
                 (addTickLHsExprRHS e)
-addTickStmt isGuard (BodyStmt x e bind' guard') = do
+addTickStmt isGuard (BodyStmt x e bind' guard') =
         liftM3 (BodyStmt x)
                 (addTick isGuard e)
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
-addTickStmt _isGuard (LetStmt x (L l binds)) = do
+addTickStmt _isGuard (LetStmt x (L l binds)) =
         liftM (LetStmt x . L l)
                 (addTickHsLocalBinds binds)
-addTickStmt isGuard (ParStmt x pairs mzipExpr bindExpr) = do
+addTickStmt isGuard (ParStmt x pairs mzipExpr bindExpr) =
     liftM3 (ParStmt x)
         (mapM (addTickStmtAndBinders isGuard) pairs)
         (unLoc <$> addTickLHsExpr (L hpcSrcSpan mzipExpr))
@@ -920,7 +920,7 @@ addTickCmdMatch match@(Match { m_pats = pats, m_grhss = gRHSs }) =
     return $ match { m_grhss = gRHSs' }
 
 addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
-addTickCmdGRHSs (GRHSs x guarded (L l local_binds)) = do
+addTickCmdGRHSs (GRHSs x guarded (L l local_binds)) =
   bindLocals binders $ do
     local_binds' <- addTickHsLocalBinds local_binds
     guarded' <- mapM (liftL addTickCmdGRHS) guarded
@@ -953,21 +953,21 @@ addTickLCmdStmts' lstmts res
         binders = collectLStmtsBinders lstmts
 
 addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
-addTickCmdStmt (BindStmt x pat c) = do
+addTickCmdStmt (BindStmt x pat c) =
         liftM2 (BindStmt x)
                 (addTickLPat pat)
                 (addTickLHsCmd c)
-addTickCmdStmt (LastStmt x c noret ret) = do
+addTickCmdStmt (LastStmt x c noret ret) =
         liftM3 (LastStmt x)
                 (addTickLHsCmd c)
                 (pure noret)
                 (addTickSyntaxExpr hpcSrcSpan ret)
-addTickCmdStmt (BodyStmt x c bind' guard') = do
+addTickCmdStmt (BodyStmt x c bind' guard') =
         liftM3 (BodyStmt x)
                 (addTickLHsCmd c)
                 (addTickSyntaxExpr hpcSrcSpan bind')
                 (addTickSyntaxExpr hpcSrcSpan guard')
-addTickCmdStmt (LetStmt x (L l binds)) = do
+addTickCmdStmt (LetStmt x (L l binds)) =
         liftM (LetStmt x . L l)
                 (addTickHsLocalBinds binds)
 addTickCmdStmt stmt@(RecStmt {})
diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs
index 1fa2c5f98b..c1479d7c9a 100644
--- a/compiler/GHC/HsToCore/Expr.hs
+++ b/compiler/GHC/HsToCore/Expr.hs
@@ -239,16 +239,18 @@ dsUnliftedBind bind body = pprPanic "dsLet: unlifted" (ppr bind $$ ppr body)
 ************************************************************************
 -}
 
-dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
 
-dsLExpr (L loc e)
-  = putSrcSpanDs loc $
-    do { core_expr <- dsExpr e
-   -- uncomment this check to test the hsExprType function in GHC.Tc.Utils.Zonk
-   --    ; MASSERT2( exprType core_expr `eqType` hsExprType e
-   --              , ppr e <+> dcolon <+> ppr (hsExprType e) $$
-   --                ppr core_expr <+> dcolon <+> ppr (exprType core_expr) )
-       ; return core_expr }
+-- | Replace the body of the fucntion with this block to test the hsExprType
+-- function in GHC.Tc.Utils.Zonk:
+-- putSrcSpanDs loc $ do
+--   { core_expr <- dsExpr e
+--   ; MASSERT2( exprType core_expr `eqType` hsExprType e
+--             , ppr e <+> dcolon <+> ppr (hsExprType e) $$
+--                 ppr core_expr <+> dcolon <+> ppr (exprType core_expr) )
+--   ; return core_expr }
+dsLExpr :: LHsExpr GhcTc -> DsM CoreExpr
+dsLExpr (L loc e) =
+  putSrcSpanDs loc $ dsExpr e
 
 -- | Variant of 'dsLExpr' that ensures that the result is not levity
 -- polymorphic. This should be used when the resulting expression will
@@ -416,7 +418,7 @@ dsExpr e@(SectionL _ expr op) = do
     x_core <- dsLExpr expr
     case splitFunTys (exprType core_op) of
       -- Binary operator section
-      (x_ty:y_ty:_, _) -> do
+      (x_ty:y_ty:_, _) ->
         dsWhenNoErrs
           (newSysLocalsDsNoLP [x_ty, y_ty])
           (\[x_id, y_id] ->
@@ -425,7 +427,7 @@ dsExpr e@(SectionL _ expr op) = do
                                      core_op [Var x_id, Var y_id]))
 
       -- Postfix operator section
-      (_:_, _) -> do
+      (_:_, _) ->
         return $ mkCoreAppDs (text "sectionl" <+> ppr e) core_op x_core
 
       _ -> pprPanic "dsExpr(SectionL)" (ppr e)
@@ -462,11 +464,11 @@ dsExpr (ExplicitTuple _ tup_args boxity)
                         -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
 
 dsExpr (ExplicitSum types alt arity expr)
-  = do { dsWhenNoErrs (dsLExprNoLP expr)
-                      (\core_expr -> mkCoreConApps (sumDataCon alt arity)
-                                     (map (Type . getRuntimeRep) types ++
-                                      map Type types ++
-                                      [core_expr]) ) }
+  = dsWhenNoErrs (dsLExprNoLP expr)
+                 (\core_expr -> mkCoreConApps (sumDataCon alt arity)
+                                (map (Type . getRuntimeRep) types ++
+                                 map Type types ++
+                                 [core_expr]) )
 
 dsExpr (HsPragE _ prag expr) =
   ds_prag_expr prag expr
@@ -1189,12 +1191,12 @@ warnDiscardedDoBindings rhs rhs_ty
            -- Warn about discarding m a things in 'monadic' binding of the same type,
            -- but only if we didn't already warn due to Opt_WarnUnusedDoBind
            when warn_wrong $
-                do { case tcSplitAppTy_maybe norm_elt_ty of
-                         Just (elt_m_ty, _)
-                            | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty
-                            -> warnDs (Reason Opt_WarnWrongDoBind)
-                                      (badMonadBind rhs elt_ty)
-                         _ -> return () } } }
+                case tcSplitAppTy_maybe norm_elt_ty of
+                      Just (elt_m_ty, _)
+                         | m_ty `eqType` topNormaliseType fam_inst_envs elt_m_ty
+                         -> warnDs (Reason Opt_WarnWrongDoBind)
+                                   (badMonadBind rhs elt_ty)
+                      _ -> return () } }
 
   | otherwise   -- RHS does have type of form (m ty), which is weird
   = return ()   -- but at least this warning is irrelevant
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 6a9fa35111..12c9a49278 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -27,7 +27,7 @@ import GHC.Platform
 
 import {-#SOURCE#-} GHC.HsToCore.Expr (dsLExpr, dsSyntaxExpr)
 
-import GHC.Types.Basic ( Origin(..) )
+import GHC.Types.Basic ( Origin(..), isGenerated, Boxity(..) )
 import GHC.Types.SourceText
 import GHC.Driver.Session
 import GHC.Hs
@@ -61,7 +61,6 @@ import GHC.Utils.Misc
 import GHC.Types.Name
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
-import GHC.Types.Basic ( isGenerated, Boxity(..) )
 import GHC.Data.FastString
 import GHC.Types.Unique
 import GHC.Types.Unique.DFM
@@ -409,7 +408,7 @@ tidyEqnInfo _ (EqnInfo { eqn_pats = [] })
 
 tidyEqnInfo v eqn@(EqnInfo { eqn_pats = pat : pats, eqn_orig = orig })
   = do { (wrap, pat') <- tidy1 v orig pat
-       ; return (wrap, eqn { eqn_pats = do pat' : pats }) }
+       ; return (wrap, eqn { eqn_pats = pat' : pats }) }
 
 tidy1 :: Id                  -- The Id being scrutinised
       -> Origin              -- Was this a pattern the user wrote?
diff --git a/compiler/GHC/HsToCore/Match/Literal.hs b/compiler/GHC/HsToCore/Match/Literal.hs
index 70acb36724..7cf9f2e483 100644
--- a/compiler/GHC/HsToCore/Match/Literal.hs
+++ b/compiler/GHC/HsToCore/Match/Literal.hs
@@ -105,7 +105,7 @@ dsLit l = do
     HsString _ str   -> mkStringExprFS str
     HsInteger _ i _  -> return (mkIntegerExpr i)
     HsInt _ i        -> return (mkIntExpr platform (il_value i))
-    HsRat _ (FL _ _ val) ty -> do
+    HsRat _ (FL _ _ val) ty ->
       return (mkCoreConApps ratio_data_con [Type integer_ty, num, denom])
       where
         num   = mkIntegerExpr (numerator val)
@@ -223,7 +223,7 @@ warnAboutOverflowedLiterals dflags lit
 
     checkPositive :: Integer -> Name -> DsM ()
     checkPositive i tc
-      = when (i < 0) $ do
+      = when (i < 0) $
         warnDs (Reason Opt_WarnOverflowedLiterals)
                (vcat [ text "Literal" <+> integer i
                        <+> text "is negative but" <+> ppr tc
@@ -232,7 +232,7 @@ warnAboutOverflowedLiterals dflags lit
 
     check :: forall a. (Bounded a, Integral a) => Integer -> Name -> Proxy a -> DsM ()
     check i tc _proxy
-      = when (i < minB || i > maxB) $ do
+      = when (i < minB || i > maxB) $
         warnDs (Reason Opt_WarnOverflowedLiterals)
                (vcat [ text "Literal" <+> integer i
                        <+> text "is out of the" <+> ppr tc <+> ptext (sLit "range")
diff --git a/compiler/GHC/HsToCore/Pmc.hs b/compiler/GHC/HsToCore/Pmc.hs
index e409c1fcae..7af0d4605e 100644
--- a/compiler/GHC/HsToCore/Pmc.hs
+++ b/compiler/GHC/HsToCore/Pmc.hs
@@ -267,7 +267,7 @@ testRedSets :: RedSets -> DsM (Bool, Bool, OrdList SrcInfo)
 testRedSets RedSets { rs_cov = cov, rs_div = div, rs_bangs = bangs } = do
   is_covered  <- isInhabited cov
   may_diverge <- isInhabited div
-  red_bangs   <- flip mapMaybeM (fromOL bangs) $ \(nablas, bang) -> do
+  red_bangs   <- flip mapMaybeM (fromOL bangs) $ \(nablas, bang) ->
     isInhabited nablas >>= \case
       True  -> pure Nothing
       False -> pure (Just bang)
@@ -351,14 +351,14 @@ reportWarnings dflags ctx@(DsMatchContext kind loc) vars
       when (approx && (exists_u || exists_i)) $
         putSrcSpanDs loc (warnDs NoReason approx_msg)
 
-      when exists_b $ forM_ redundant_bangs $ \(SrcInfo (L l q)) -> do
+      when exists_b $ forM_ redundant_bangs $ \(SrcInfo (L l q)) ->
         putSrcSpanDs l (warnDs (Reason Opt_WarnRedundantBangPatterns)
                                (pprEqn q "has redundant bang"))
 
-      when exists_r $ forM_ redundant_rhss $ \(SrcInfo (L l q)) -> do
+      when exists_r $ forM_ redundant_rhss $ \(SrcInfo (L l q)) ->
         putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)
                                (pprEqn q "is redundant"))
-      when exists_i $ forM_ inaccessible_rhss $ \(SrcInfo (L l q)) -> do
+      when exists_i $ forM_ inaccessible_rhss $ \(SrcInfo (L l q)) ->
         putSrcSpanDs l (warnDs (Reason Opt_WarnOverlappingPatterns)
                                (pprEqn q "has inaccessible right hand side"))
 
diff --git a/compiler/GHC/HsToCore/Pmc/Desugar.hs b/compiler/GHC/HsToCore/Pmc/Desugar.hs
index f08774a647..98b23dab25 100644
--- a/compiler/GHC/HsToCore/Pmc/Desugar.hs
+++ b/compiler/GHC/HsToCore/Pmc/Desugar.hs
@@ -39,12 +39,11 @@ import GHC.Core.Coercion
 import GHC.Tc.Types.Evidence (HsWrapper(..), isIdHsWrapper)
 import {-# SOURCE #-} GHC.HsToCore.Expr (dsExpr, dsLExpr, dsSyntaxExpr)
 import {-# SOURCE #-} GHC.HsToCore.Binds (dsHsWrapper)
-import GHC.HsToCore.Utils (selectMatchVar)
+import GHC.HsToCore.Utils (isTrueLHsExpr, selectMatchVar)
 import GHC.HsToCore.Match.Literal (dsLit, dsOverLit)
 import GHC.HsToCore.Monad
 import GHC.Core.TyCo.Rep
 import GHC.Core.Type
-import GHC.HsToCore.Utils       (isTrueLHsExpr)
 import GHC.Data.Maybe
 import qualified GHC.LanguageExtensions as LangExt
 import GHC.Utils.Monad (concatMapM)
@@ -188,7 +187,7 @@ desugarPat x pat = case pat of
            , cpt_tvs     = ex_tvs
            , cpt_dicts   = dicts
            }
-         } -> do
+         } ->
     desugarConPatOut x con arg_tys ex_tvs dicts ps
 
   NPat ty (L _ olit) mb_neg _ -> do
@@ -363,7 +362,7 @@ desugarGuard guard = case guard of
 -- recursion, pattern bindings etc.
 -- See Note [Long-distance information for HsLocalBinds].
 desugarLocalBinds :: LHsLocalBinds GhcTc -> DsM [PmGrd]
-desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) = do
+desugarLocalBinds (L _ (HsValBinds _ (XValBindsLR (NValBinds binds _)))) =
   concatMapM (concatMapM go . bagToList) (map snd binds)
   where
     go :: LHsBind GhcTc -> DsM [PmGrd]
diff --git a/compiler/GHC/HsToCore/Pmc/Solver.hs b/compiler/GHC/HsToCore/Pmc/Solver.hs
index 235ed08492..326b532325 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver.hs
@@ -388,7 +388,7 @@ pmIsClosedType ty
 -- efficient.
 normaliseSourceTypeWHNF :: TyState -> Type -> DsM Type
 normaliseSourceTypeWHNF _     ty | isSourceTypeInWHNF ty = pure ty
-normaliseSourceTypeWHNF ty_st ty = do
+normaliseSourceTypeWHNF ty_st ty =
   pmTopNormaliseType ty_st ty >>= \case
     NoChange ty                -> pure ty
     NormalisedByConstraints ty -> pure ty
@@ -1223,7 +1223,7 @@ inhabitationTest fuel  old_ty_st nabla@MkNabla{ nabla_tm_st = ts } = do
   where
     nabla_not_dirty = nabla{ nabla_tm_st = ts{ts_dirty=emptyDVarSet} }
     test_one :: VarInfo -> MaybeT DsM VarInfo
-    test_one vi = do
+    test_one vi =
       lift (varNeedsTesting old_ty_st nabla vi) >>= \case
         True -> do
           -- tracPm "test_one" (ppr vi)
diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs
index b22d45d182..fef9d4c094 100644
--- a/compiler/GHC/HsToCore/Quote.hs
+++ b/compiler/GHC/HsToCore/Quote.hs
@@ -593,9 +593,9 @@ repFamilyResultSig (TyVarSig _ bndr) = do { bndr' <- repTyVarBndr bndr
 repFamilyResultSigToMaybeKind :: FamilyResultSig GhcRn
                               -> MetaM (Core (Maybe (M TH.Kind)))
 repFamilyResultSigToMaybeKind (NoSig _) =
-    do { coreNothingM kindTyConName }
+    coreNothingM kindTyConName
 repFamilyResultSigToMaybeKind (KindSig _ ki) =
-    do { coreJustM kindTyConName =<< repLTy ki }
+    coreJustM kindTyConName =<< repLTy ki
 repFamilyResultSigToMaybeKind TyVarSig{} =
     panic "repFamilyResultSigToMaybeKind: unexpected TyVarSig"
 
@@ -603,7 +603,7 @@ repFamilyResultSigToMaybeKind TyVarSig{} =
 repInjectivityAnn :: Maybe (LInjectivityAnn GhcRn)
                   -> MetaM (Core (Maybe TH.InjectivityAnn))
 repInjectivityAnn Nothing =
-    do { coreNothing injAnnTyConName }
+    coreNothing injAnnTyConName
 repInjectivityAnn (Just (L _ (InjectivityAnn lhs rhs))) =
     do { lhs'   <- lookupBinder (unLoc lhs)
        ; rhs1   <- mapM (lookupBinder . unLoc) rhs
@@ -884,14 +884,13 @@ repC (L _ (ConDeclH98 { con_name = con
                       , con_ex_tvs = con_tvs
                       , con_mb_cxt = mcxt
                       , con_args = args }))
-  = do { addHsTyVarBinds con_tvs $ \ ex_bndrs ->
+  = addHsTyVarBinds con_tvs $ \ ex_bndrs ->
          do { c'    <- repH98DataCon con args
             ; ctxt' <- repMbContext mcxt
             ; if not is_existential && isNothing mcxt
               then return c'
               else rep2 forallCName ([unC ex_bndrs, unC ctxt', unC c'])
             }
-       }
 
 repC (L _ (ConDeclGADT { con_g_ext  = imp_tvs
                        , con_names  = cons
diff --git a/compiler/GHC/Iface/Ext/Binary.hs b/compiler/GHC/Iface/Ext/Binary.hs
index 84ee0af60b..69aee26586 100644
--- a/compiler/GHC/Iface/Ext/Binary.hs
+++ b/compiler/GHC/Iface/Ext/Binary.hs
@@ -222,9 +222,7 @@ readHieFileHeader file bh0 = do
 
 readHieFileContents :: BinHandle -> NameCacheUpdater -> IO HieFile
 readHieFileContents bh0 ncu = do
-
-  dict  <- get_dictionary bh0
-
+  dict <- get_dictionary bh0
   -- read the symbol table so we are capable of reading the actual data
   bh1 <- do
       let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
@@ -236,8 +234,7 @@ readHieFileContents bh0 ncu = do
       return bh1'
 
   -- load the actual data
-  hiefile <- get bh1
-  return hiefile
+  get bh1
   where
     get_dictionary bin_handle = do
       dict_p <- get bin_handle
diff --git a/compiler/GHC/Iface/Ext/Fields.hs b/compiler/GHC/Iface/Ext/Fields.hs
index 1cc1e94012..37322303d8 100644
--- a/compiler/GHC/Iface/Ext/Fields.hs
+++ b/compiler/GHC/Iface/Ext/Fields.hs
@@ -49,7 +49,7 @@ instance Binary ExtensibleFields where
     n <- get bh :: IO Int
 
     -- Get the names and field pointers:
-    header_entries <- replicateM n $ do
+    header_entries <- replicateM n $
       (,) <$> get bh <*> get bh
 
     -- Seek to and get each field's payload:
diff --git a/compiler/GHC/Iface/Ext/Utils.hs b/compiler/GHC/Iface/Ext/Utils.hs
index 9245a11f7b..5166ddc6b2 100644
--- a/compiler/GHC/Iface/Ext/Utils.hs
+++ b/compiler/GHC/Iface/Ext/Utils.hs
@@ -194,9 +194,8 @@ compressTypes
 compressTypes asts = (a, arr)
   where
     (a, (HTS _ m i)) = flip runState initialHTS $
-      for asts $ \typ -> do
-        i <- getTypeIndex typ
-        return i
+      for asts $ \typ ->
+        getTypeIndex typ
     arr = A.array (0,i-1) (IM.toList m)
 
 recoverFullType :: TypeIndex -> A.Array TypeIndex HieTypeFlat -> HieTypeFix
diff --git a/compiler/GHC/Iface/Load.hs b/compiler/GHC/Iface/Load.hs
index 16ca152edc..55c3b0ce2a 100644
--- a/compiler/GHC/Iface/Load.hs
+++ b/compiler/GHC/Iface/Load.hs
@@ -471,7 +471,7 @@ loadInterface doc_str mod from
         let
             loc_doc = text loc
         in
-        initIfaceLcl (mi_semantic_module iface) loc_doc (mi_boot iface) $ do
+        initIfaceLcl (mi_semantic_module iface) loc_doc (mi_boot iface) $
 
         dontLeakTheHPT $ do
 
diff --git a/compiler/GHC/Iface/Recomp.hs b/compiler/GHC/Iface/Recomp.hs
index c810911509..a21b6dac07 100644
--- a/compiler/GHC/Iface/Recomp.hs
+++ b/compiler/GHC/Iface/Recomp.hs
@@ -283,7 +283,7 @@ checkPlugins hsc iface = liftIO $ do
     pluginRecompileToRecompileRequired old_fingerprint new_fingerprint pr
 
 fingerprintPlugins :: HscEnv -> IO Fingerprint
-fingerprintPlugins hsc_env = do
+fingerprintPlugins hsc_env =
   fingerprintPlugins' $ plugins (hsc_dflags hsc_env)
 
 fingerprintPlugins' :: [PluginWithArgs] -> IO Fingerprint
@@ -448,7 +448,7 @@ checkMergedSignatures mod_summary iface = do
 -- Returns (RecompBecause <textual reason>) if recompilation is required.
 checkDependencies :: HscEnv -> ModSummary -> ModIface -> IfG RecompileRequired
 checkDependencies hsc_env summary iface
- = do
+ =
    checkList $
      [ checkList (map dep_missing (ms_imps summary ++ ms_srcimps summary))
      , do
@@ -618,8 +618,7 @@ checkModUsage this_pkg UsageHomeModule{
        recompile <- checkModuleFingerprint reason old_mod_hash new_mod_hash
        if not (recompileRequired recompile)
          then return UpToDate
-         else do
-
+         else
            -- CHECK EXPORT LIST
            checkMaybeHash reason maybe_old_export_hash new_export_hash
                (text "  Export list changed") $ do
@@ -874,7 +873,7 @@ addFingerprints hsc_env iface0
        extend_hash_env :: OccEnv (OccName,Fingerprint)
                        -> (Fingerprint,IfaceDecl)
                        -> IO (OccEnv (OccName,Fingerprint))
-       extend_hash_env env0 (hash,d) = do
+       extend_hash_env env0 (hash,d) =
           return (foldr (\(b,fp) env -> extendOccEnv env b (b,fp)) env0
                  (ifaceDeclFingerprints hash d))
 
@@ -1379,14 +1378,13 @@ mkHashFun hsc_env eps name
         MASSERT2( isExternalName name, ppr name )
         iface <- case lookupIfaceByModule hpt pit mod of
                   Just iface -> return iface
-                  Nothing -> do
+                  Nothing ->
                       -- This can occur when we're writing out ifaces for
                       -- requirements; we didn't do any /real/ typechecking
                       -- so there's no guarantee everything is loaded.
                       -- Kind of a heinous hack.
-                      iface <- initIfaceLoad hsc_env . withException
-                            $ loadInterface (text "lookupVers2") mod ImportBySystem
-                      return iface
+                      initIfaceLoad hsc_env . withException
+                        $ loadInterface (text "lookupVers2") mod ImportBySystem
         return $ snd (mi_hash_fn (mi_final_exts iface) occ `orElse`
                   pprPanic "lookupVers1" (ppr mod <+> ppr occ))
 
diff --git a/compiler/GHC/Iface/Recomp/Binary.hs b/compiler/GHC/Iface/Recomp/Binary.hs
index 8a72a1dcb3..083ad431af 100644
--- a/compiler/GHC/Iface/Recomp/Binary.hs
+++ b/compiler/GHC/Iface/Recomp/Binary.hs
@@ -35,8 +35,7 @@ computeFingerprint :: (Binary a)
 computeFingerprint put_nonbinding_name a = do
     bh <- fmap set_user_data $ openBinMem (3*1024) -- just less than a block
     put_ bh a
-    fp <- fingerprintBinMem bh
-    return fp
+    fingerprintBinMem bh
   where
     set_user_data bh =
       setUserData bh $ newWriteState put_nonbinding_name putNameLiterally putFS
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 749914821a..4bd9867617 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -103,7 +103,7 @@ failWithRn doc = do
 -- when loading an interface to merge it into a requirement.)
 rnModIface :: HscEnv -> [(ModuleName, Module)] -> Maybe NameShape
            -> ModIface -> IO (Either ErrorMessages ModIface)
-rnModIface hsc_env insts nsubst iface = do
+rnModIface hsc_env insts nsubst iface =
     initRnIface hsc_env iface insts nsubst $ do
         mod <- rnModule (mi_module iface)
         sig_of <- case mi_sig_of iface of
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index e6fc3a8bc0..27d64c88e5 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -2140,10 +2140,10 @@ instance Binary IfaceBang where
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return IfNoBang
-              1 -> do return IfStrict
-              2 -> do return IfUnpack
-              _ -> do { a <- get bh; return (IfUnpackCo a) }
+              0 -> return IfNoBang
+              1 -> return IfStrict
+              2 -> return IfUnpack
+              _ -> IfUnpackCo <$> get bh
 
 instance Binary IfaceSrcBang where
     put_ bh (IfSrcBang a1 a2) =
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 57889754fe..e87998dd37 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -858,15 +858,15 @@ instance Binary IfaceBndr where
                       return (IfaceTvBndr ab)
 
 instance Binary IfaceOneShot where
-    put_ bh IfaceNoOneShot = do
+    put_ bh IfaceNoOneShot =
             putByte bh 0
-    put_ bh IfaceOneShot = do
+    put_ bh IfaceOneShot =
             putByte bh 1
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return IfaceNoOneShot
-              _ -> do return IfaceOneShot
+              0 -> return IfaceNoOneShot
+              _ -> return IfaceOneShot
 
 -- ----------------------------- Printing IfaceType ------------------------------------
 
@@ -1905,7 +1905,7 @@ instance Binary IfaceType where
                        return (IfaceLitTy n)
 
 instance Binary IfaceMCoercion where
-  put_ bh IfaceMRefl = do
+  put_ bh IfaceMRefl =
           putByte bh 1
   put_ bh (IfaceMCo co) = do
           putByte bh 2
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs
index b382165834..6a4861c727 100644
--- a/compiler/GHC/IfaceToCore.hs
+++ b/compiler/GHC/IfaceToCore.hs
@@ -400,7 +400,7 @@ typecheckIfacesForMerging mod ifaces tc_env_var =
     -- OK, now typecheck each ModIface using this environment
     details <- forM ifaces $ \iface -> do
         -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
-        type_env <- fixM $ \type_env -> do
+        type_env <- fixM $ \type_env ->
             setImplicitEnvM type_env $ do
                 decls <- tcIfaceDecls ignore_prags (mi_decls iface)
                 return (mkNameEnv decls)
@@ -440,7 +440,7 @@ typecheckIfaceForInstantiate nsubst iface =
                         (mi_boot iface) nsubst $ do
     ignore_prags <- goptM Opt_IgnoreInterfacePragmas
     -- See Note [Resolving never-exported Names] in GHC.IfaceToCore
-    type_env <- fixM $ \type_env -> do
+    type_env <- fixM $ \type_env ->
         setImplicitEnvM type_env $ do
             decls     <- tcIfaceDecls ignore_prags (mi_decls iface)
             return (mkNameEnv decls)
@@ -1256,10 +1256,9 @@ tcIfaceAnnotation (IfaceAnnotation target serialized) = do
     }
 
 tcIfaceAnnTarget :: IfaceAnnTarget -> IfL (AnnTarget Name)
-tcIfaceAnnTarget (NamedTarget occ) = do
-    name <- lookupIfaceTop occ
-    return $ NamedTarget name
-tcIfaceAnnTarget (ModuleTarget mod) = do
+tcIfaceAnnTarget (NamedTarget occ) =
+    NamedTarget <$> lookupIfaceTop occ
+tcIfaceAnnTarget (ModuleTarget mod) =
     return $ ModuleTarget mod
 
 {-
diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs
index d9f2964638..fdf854ad8e 100644
--- a/compiler/GHC/Parser/Header.hs
+++ b/compiler/GHC/Parser/Header.hs
@@ -189,7 +189,7 @@ lazyGetToks popts filename handle = do
   loc  = mkRealSrcLoc (mkFastString filename) 1 1
 
   lazyLexBuf :: Handle -> PState -> Bool -> Int -> IO [Located Token]
-  lazyLexBuf handle state eof size = do
+  lazyLexBuf handle state eof size =
     case unP (lexer False return) state of
       POk state' t -> do
         -- pprTrace "lazyLexBuf" (text (show (buffer state'))) (return ())
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 8e85c9493e..84aa3e09bc 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -810,7 +810,7 @@ mkRuleTyVarBndrs = fmap (fmap cvt_one)
 -- See note [Parsing explicit foralls in Rules] in Parser.y
 checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P ()
 checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName)
-  where check (L loc (Unqual occ)) = do
+  where check (L loc (Unqual occ)) =
           -- TODO: don't use string here, OccName has a Unique/FastString
           when ((occNameString occ ==) `any` ["forall","family","role"])
             (addFatalError $ Error (ErrParseErrorOnInput occ) [] loc)
@@ -878,8 +878,7 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV ()
 (checkExpBlockArguments, checkCmdBlockArguments) = (checkExpr, checkCmd)
   where
     checkExpr :: LHsExpr GhcPs -> PV ()
-    checkExpr expr = do
-     case unLoc expr of
+    checkExpr expr = case unLoc expr of
       HsDo _ (DoExpr m) _  -> check (ErrDoInFunAppExpr m)     expr
       HsDo _ (MDoExpr m) _ -> check (ErrMDoInFunAppExpr m)    expr
       HsLam {}             -> check ErrLambdaInFunAppExpr     expr
@@ -1458,7 +1457,7 @@ instance DisambECP (HsExpr GhcPs) where
   mkHsLetPV l bs c = return $ L l (HsLet noExtField bs c)
   type InfixOp (HsExpr GhcPs) = HsExpr GhcPs
   superInfixOp m = m
-  mkHsOpAppPV l e1 op e2 = do
+  mkHsOpAppPV l e1 op e2 =
     return $ L l $ OpApp noExtField e1 op e2
   mkHsCasePV l e mg = return $ L l (HsCase noExtField e mg)
   mkHsLamCasePV l mg = return $ L l (HsLamCase noExtField mg)
diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 9215ef26fc..953d3c2c9b 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -885,7 +885,7 @@ rnMethodBindLHS :: Bool -> Name
                 -> LHsBindsLR GhcRn GhcPs
                 -> RnM (LHsBindsLR GhcRn GhcPs)
 rnMethodBindLHS _ cls (L loc bind@(FunBind { fun_id = name })) rest
-  = setSrcSpan loc $ do
+  = setSrcSpan loc $
     do { sel_name <- wrapLocM (lookupInstDeclBndr cls (text "method")) name
                      -- We use the selector name as the binder
        ; let bind' = bind { fun_id = sel_name, fun_ext = noExtField }
@@ -1034,7 +1034,7 @@ renameSig _ctxt sig@(CompleteMatchSig _ s (L l bf) mty)
        new_mty  <- traverse lookupLocatedOccRn mty
 
        this_mod <- fmap tcg_mod getGblEnv
-       unless (any (nameIsLocalOrFrom this_mod . unLoc) new_bf) $ do
+       unless (any (nameIsLocalOrFrom this_mod . unLoc) new_bf) $
          -- Why 'any'? See Note [Orphan COMPLETE pragmas]
          addErrCtxt (text "In" <+> ppr sig) $ failWithTc orphanError
 
@@ -1173,20 +1173,20 @@ rnMatch :: Outputable (body GhcPs) => HsMatchContext GhcRn
         -> RnM (LMatch GhcRn (Located (body GhcRn)), FreeVars)
 rnMatch ctxt rnBody = wrapLocFstM (rnMatch' ctxt rnBody)
 
+-- Note that there are no local fixity decls for matches
 rnMatch' :: Outputable (body GhcPs) => HsMatchContext GhcRn
          -> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
          -> Match GhcPs (Located (body GhcPs))
          -> RnM (Match GhcRn (Located (body GhcRn)), FreeVars)
-rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss })
-  = do  { -- Note that there are no local fixity decls for matches
-        ; rnPats ctxt pats      $ \ pats' -> do
+rnMatch' ctxt rnBody (Match { m_ctxt = mf, m_pats = pats, m_grhss = grhss }) =
+  rnPats ctxt pats $ \ pats' -> do
         { (grhss', grhss_fvs) <- rnGRHSs ctxt rnBody grhss
         ; let mf' = case (ctxt, mf) of
-                      (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ })
-                                            -> mf { mc_fun = L lf funid }
-                      _                     -> ctxt
+                      (FunRhs { mc_fun = L _ funid }, FunRhs { mc_fun = L lf _ }) ->
+                           mf { mc_fun = L lf funid }
+                      _ -> ctxt
         ; return (Match { m_ext = noExtField, m_ctxt = mf', m_pats = pats'
-                        , m_grhss = grhss'}, grhss_fvs ) }}
+                        , m_grhss = grhss'}, grhss_fvs ) }
 
 emptyCaseErr :: HsMatchContext GhcRn -> SDoc
 emptyCaseErr ctxt = hang (text "Empty list of alternatives in" <+> pp_ctxt)
diff --git a/compiler/GHC/Rename/Expr.hs b/compiler/GHC/Rename/Expr.hs
index 14218b01f6..b38b4679b1 100644
--- a/compiler/GHC/Rename/Expr.hs
+++ b/compiler/GHC/Rename/Expr.hs
@@ -108,16 +108,16 @@ finishHsVar (L l name)
       ; return (HsVar noExtField (L l name), unitFV name) }
 
 rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
-rnUnboundVar v
- = do { if isUnqual v
-        then -- Treat this as a "hole"
-             -- Do not fail right now; instead, return HsUnboundVar
-             -- and let the type checker report the error
-             return (HsUnboundVar noExtField (rdrNameOcc v), emptyFVs)
+rnUnboundVar v =
+  if isUnqual v
+  then -- Treat this as a "hole"
+       -- Do not fail right now; instead, return HsUnboundVar
+       -- and let the type checker report the error
+       return (HsUnboundVar noExtField (rdrNameOcc v), emptyFVs)
 
-        else -- Fail immediately (qualified name)
-             do { n <- reportUnboundName v
-                ; return (HsVar noExtField (noLoc n), emptyFVs) } }
+  else -- Fail immediately (qualified name)
+       do { n <- reportUnboundName v
+          ; return (HsVar noExtField (noLoc n), emptyFVs) }
 
 rnExpr (HsVar _ (L l v))
   = do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields
@@ -847,10 +847,10 @@ rnStmt ctxt rnBody (L loc (BindStmt _ pat body)) thing_inside
         -- but it does not matter because the names are unique
 
 rnStmt _ _ (L loc (LetStmt _ (L l binds))) thing_inside
-  = do  { rnLocalBindsAndThen binds $ \binds' bind_fvs -> do
+  =     rnLocalBindsAndThen binds $ \binds' bind_fvs -> do
         { (thing, fvs) <- thing_inside (collectLocalBinders binds')
         ; return ( ([(L loc (LetStmt noExtField (L l binds')), bind_fvs)], thing)
-                 , fvs) }  }
+                 , fvs) }
 
 rnStmt ctxt rnBody (L loc (RecStmt { recS_stmts = rec_stmts })) thing_inside
   = do  { (return_op, fvs1)  <- lookupQualifiedDoStmtName ctxt returnMName
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index f815cd5c4a..d535f008ae 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -449,8 +449,8 @@ checkCanonicalInstances cls poly_ty mbinds = do
     --  * Warn if '(*>)' is defined backwards (i.e. @(*>) = (>>)@).
     --
     checkCanonicalMonadInstances refURL
-      | cls == applicativeClassName  = do
-          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+      | cls == applicativeClassName =
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $
               case mbind of
                   FunBind { fun_id = L _ name
                           , fun_matches = mg }
@@ -464,8 +464,8 @@ checkCanonicalInstances cls poly_ty mbinds = do
 
                   _ -> return ()
 
-      | cls == monadClassName  = do
-          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+      | cls == monadClassName =
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $
               case mbind of
                   FunBind { fun_id = L _ name
                           , fun_matches = mg }
@@ -495,8 +495,8 @@ checkCanonicalInstances cls poly_ty mbinds = do
     --  * Warn if '(<>)' is defined backwards (i.e. @(<>) = mappend@).
     --
     checkCanonicalMonoidInstances refURL
-      | cls == semigroupClassName  = do
-          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+      | cls == semigroupClassName =
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $
               case mbind of
                   FunBind { fun_id      = L _ name
                           , fun_matches = mg }
@@ -506,8 +506,8 @@ checkCanonicalInstances cls poly_ty mbinds = do
 
                   _ -> return ()
 
-      | cls == monoidClassName  = do
-          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $ do
+      | cls == monoidClassName =
+          forM_ (bagToList mbinds) $ \(L loc mbind) -> setSrcSpan loc $
               case mbind of
                   FunBind { fun_id = L _ name
                           , fun_matches = mg }
@@ -531,7 +531,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
     isAliasMG _ = Nothing
 
     -- got "lhs = rhs" but expected something different
-    addWarnNonCanonicalMethod1 refURL flag lhs rhs = do
+    addWarnNonCanonicalMethod1 refURL flag lhs rhs =
         addWarn (Reason flag) $ vcat
                        [ text "Noncanonical" <+>
                          quotes (text (lhs ++ " = " ++ rhs)) <+>
@@ -545,7 +545,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
                        ]
 
     -- expected "lhs = rhs" but got something else
-    addWarnNonCanonicalMethod2 refURL flag lhs rhs = do
+    addWarnNonCanonicalMethod2 refURL flag lhs rhs =
         addWarn (Reason flag) $ vcat
                        [ text "Noncanonical" <+>
                          quotes (text lhs) <+>
diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs
index ac8117e4a1..cde4fe6d4a 100644
--- a/compiler/GHC/Rename/Names.hs
+++ b/compiler/GHC/Rename/Names.hs
@@ -1025,7 +1025,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items))
         -- different parents).  See Note [Dealing with imports]
     lookup_ie :: IE GhcPs
               -> IELookupM ([(IE GhcRn, AvailInfo)], [IELookupWarning])
-    lookup_ie ie = handle_bad_import $ do
+    lookup_ie ie = handle_bad_import $
       case ie of
         IEVar _ (L l n) -> do
             (name, avail, _) <- lookup_name ie $ ieWrappedName n
diff --git a/compiler/GHC/Rename/Splice.hs b/compiler/GHC/Rename/Splice.hs
index c18074097d..48378ba670 100644
--- a/compiler/GHC/Rename/Splice.hs
+++ b/compiler/GHC/Rename/Splice.hs
@@ -37,17 +37,16 @@ import Control.Monad    ( unless, when )
 
 import {-# SOURCE #-} GHC.Rename.Expr ( rnLExpr )
 
-import GHC.Tc.Utils.Env     ( checkWellStaged )
-import GHC.Builtin.Names.TH ( liftName )
+import GHC.Tc.Utils.Env     ( checkWellStaged, tcMetaTy )
 
 import GHC.Driver.Session
 import GHC.Data.FastString
 import GHC.Utils.Error  ( dumpIfSet_dyn_printer, DumpFormat (..) )
 import GHC.Utils.Panic
-import GHC.Tc.Utils.Env ( tcMetaTy )
 import GHC.Driver.Hooks
-import GHC.Builtin.Names.TH ( quoteExpName, quotePatName, quoteDecName, quoteTypeName
-                            , decsQTyConName, expQTyConName, patQTyConName, typeQTyConName, )
+import GHC.Builtin.Names.TH ( decsQTyConName, expQTyConName, liftName
+                            , patQTyConName, quoteDecName, quoteExpName
+                            , quotePatName, quoteTypeName, typeQTyConName)
 
 import {-# SOURCE #-} GHC.Tc.Gen.Expr   ( tcCheckPolyExpr )
 import {-# SOURCE #-} GHC.Tc.Gen.Splice
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index a29a8b6602..68d453a68f 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -366,8 +366,8 @@ checkUnusedRecordWildcard :: SrcSpan
                           -> FreeVars
                           -> Maybe [Name]
                           -> RnM ()
-checkUnusedRecordWildcard _ _ Nothing    = return ()
-checkUnusedRecordWildcard loc _ (Just [])  = do
+checkUnusedRecordWildcard _ _ Nothing     = return ()
+checkUnusedRecordWildcard loc _ (Just []) =
   -- Add a new warning if the .. pattern binds no variables
   setSrcSpan loc $ warnRedundantRecordWildcard
 checkUnusedRecordWildcard loc fvs (Just dotdot_names) =
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 337cd24d80..db0c9928ce 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE CPP, MagicHash, RecordWildCards, BangPatterns #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
 
 {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
 
@@ -436,7 +438,7 @@ resumeExec canLogSpan step
                  , resumeBindings = bindings, resumeFinalIds = final_ids
                  , resumeApStack = apStack, resumeBreakInfo = mb_brkpt
                  , resumeSpan = span
-                 , resumeHistory = hist } -> do
+                 , resumeHistory = hist } ->
                withVirtualCWD $ do
                 status <- liftIO $ GHCi.resumeStmt hsc_env (isStep step) fhv
                 let prevHistoryLst = fromListBL 50 hist
@@ -630,8 +632,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do
            [id | id <- tmp_ids
                , not $ noSkolems id
                , (occNameFS.nameOccName.idName) id /= result_fs]
-   hsc_env' <- foldM improveTypes hsc_env (map idName incompletelyTypedIds)
-   return hsc_env'
+   foldM improveTypes hsc_env (map idName incompletelyTypedIds)
     where
      noSkolems = noFreeVarsOfType . idType
      improveTypes hsc_env@HscEnv{hsc_IC=ic} name = do
@@ -870,7 +871,7 @@ getInfo allInfo name
 
 -- | Returns all names in scope in the current interactive context
 getNamesInScope :: GhcMonad m => m [Name]
-getNamesInScope = withSession $ \hsc_env -> do
+getNamesInScope = withSession $ \hsc_env ->
   return (map gre_name (globalRdrEnvElts (ic_rn_gbl_env (hsc_IC hsc_env))))
 
 -- | Returns all 'RdrName's in scope in the current interactive
@@ -917,7 +918,7 @@ isImport pflags stmt =
 
 -- | Returns @True@ if passed string is a declaration but __/not a splice/__.
 isDecl :: ParserOpts -> String -> Bool
-isDecl pflags stmt = do
+isDecl pflags stmt =
   case parseThing Parser.parseDeclaration pflags stmt of
     Lexer.POk _ thing ->
       case unLoc thing of
@@ -1011,7 +1012,7 @@ exprType mode expr = withSession $ \hsc_env -> do
 
 -- | Get the kind of a  type
 typeKind  :: GhcMonad m => Bool -> String -> m (Type, Kind)
-typeKind normalise str = withSession $ \hsc_env -> do
+typeKind normalise str = withSession $ \hsc_env ->
    liftIO $ hscKcType hsc_env normalise str
 
 -- ----------------------------------------------------------------------------
@@ -1062,8 +1063,8 @@ typeKind normalise str = withSession $ \hsc_env -> do
 
 -- Find all instances that match a provided type
 getInstancesForType :: GhcMonad m => Type -> m [ClsInst]
-getInstancesForType ty = withSession $ \hsc_env -> do
-  liftIO $ runInteractiveHsc hsc_env $ do
+getInstancesForType ty = withSession $ \hsc_env ->
+  liftIO $ runInteractiveHsc hsc_env $
     ioMsgMaybe $ runTcInteractive hsc_env $ do
       -- Bring class and instances from unqualified modules into scope, this fixes #16793.
       loadUnqualIfaces hsc_env (hsc_IC hsc_env)
@@ -1204,7 +1205,7 @@ checkForExistence clsInst mb_inst_tys = do
 -- | Parse an expression, the parsed expression can be further processed and
 -- passed to compileParsedExpr.
 parseExpr :: GhcMonad m => String -> m (LHsExpr GhcPs)
-parseExpr expr = withSession $ \hsc_env -> do
+parseExpr expr = withSession $ \hsc_env ->
   liftIO $ runInteractiveHsc hsc_env $ hscParseExpr expr
 
 -- | Compile an expression, run it, and deliver the resulting HValue.
diff --git a/compiler/GHC/Runtime/Heap/Inspect.hs b/compiler/GHC/Runtime/Heap/Inspect.hs
index 34c55760ac..8de6a0d39d 100644
--- a/compiler/GHC/Runtime/Heap/Inspect.hs
+++ b/compiler/GHC/Runtime/Heap/Inspect.hs
@@ -1019,7 +1019,7 @@ cvReconstructType hsc_env max_depth old_ty hval = runTR_maybe hsc_env $ do
         traceTR (text "Constr1" <+> ppr dcname)
         (mb_dc, _) <- tryTc (tcLookupDataCon dcname)
         case mb_dc of
-          Nothing-> do
+          Nothing->
             forM pArgs $ \x -> do
               tv <- newVar liftedTypeKind
               return (tv, x)
diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs
index 6cd00efdd2..5213b02a4f 100644
--- a/compiler/GHC/Runtime/Interpreter.hs
+++ b/compiler/GHC/Runtime/Interpreter.hs
@@ -191,7 +191,7 @@ iservCmd hsc_env msg = withInterp hsc_env $ \case
   InternalInterp     -> run msg -- Just run it directly
 #endif
   (ExternalInterp c i) -> withIServ_ c i $ \iserv ->
-    uninterruptibleMask_ $ do -- Note [uninterruptibleMask_]
+    uninterruptibleMask_ $ -- Note [uninterruptibleMask_]
       iservCall iserv msg
 
 
@@ -223,7 +223,7 @@ hscInterp hsc_env = case hsc_interp hsc_env of
 withIServ
   :: (ExceptionMonad m)
   => IServConfig -> IServ -> (IServInstance -> m (IServInstance, a)) -> m a
-withIServ conf (IServ mIServState) action = do
+withIServ conf (IServ mIServState) action =
   MC.mask $ \restore -> do
     state <- liftIO $ takeMVar mIServState
 
@@ -286,7 +286,7 @@ resumeStmt hsc_env step resume_ctxt = do
   handleEvalStatus hsc_env status
 
 abandonStmt :: HscEnv -> ForeignRef (ResumeContext [HValueRef]) -> IO ()
-abandonStmt hsc_env resume_ctxt = do
+abandonStmt hsc_env resume_ctxt =
   withForeignRef resume_ctxt $ \rhv ->
     iservCmd hsc_env (AbandonStmt rhv)
 
@@ -300,24 +300,24 @@ handleEvalStatus hsc_env status =
       EvalComplete alloc <$> addFinalizer res
  where
   addFinalizer (EvalException e) = return (EvalException e)
-  addFinalizer (EvalSuccess rs) = do
+  addFinalizer (EvalSuccess rs)  =
     EvalSuccess <$> mapM (mkFinalizedHValue hsc_env) rs
 
 -- | Execute an action of type @IO ()@
 evalIO :: HscEnv -> ForeignHValue -> IO ()
-evalIO hsc_env fhv = do
+evalIO hsc_env fhv =
   liftIO $ withForeignRef fhv $ \fhv ->
     iservCmd hsc_env (EvalIO fhv) >>= fromEvalResult
 
 -- | Execute an action of type @IO String@
 evalString :: HscEnv -> ForeignHValue -> IO String
-evalString hsc_env fhv = do
+evalString hsc_env fhv =
   liftIO $ withForeignRef fhv $ \fhv ->
     iservCmd hsc_env (EvalString fhv) >>= fromEvalResult
 
 -- | Execute an action of type @String -> IO String@
 evalStringToIOString :: HscEnv -> ForeignHValue -> String -> IO String
-evalStringToIOString hsc_env fhv str = do
+evalStringToIOString hsc_env fhv str =
   liftIO $ withForeignRef fhv $ \fhv ->
     iservCmd hsc_env (EvalStringToString fhv str) >>= fromEvalResult
 
@@ -379,12 +379,12 @@ newBreakArray hsc_env size = do
   mkFinalizedHValue hsc_env breakArray
 
 enableBreakpoint :: HscEnv -> ForeignRef BreakArray -> Int -> Bool -> IO ()
-enableBreakpoint hsc_env ref ix b = do
+enableBreakpoint hsc_env ref ix b =
   withForeignRef ref $ \breakarray ->
     iservCmd hsc_env (EnableBreakpoint breakarray ix b)
 
 breakpointStatus :: HscEnv -> ForeignRef BreakArray -> Int -> IO Bool
-breakpointStatus hsc_env ref ix = do
+breakpointStatus hsc_env ref ix =
   withForeignRef ref $ \breakarray ->
     iservCmd hsc_env (BreakpointStatus breakarray ix)
 
@@ -408,7 +408,7 @@ seqHValue hsc_env ref =
 
 -- | Process the result of a Seq or ResumeSeq message.             #2950
 handleSeqHValueStatus :: HscEnv -> EvalStatus () -> IO (EvalResult ())
-handleSeqHValueStatus hsc_env eval_status = do
+handleSeqHValueStatus hsc_env eval_status =
   case eval_status of
     (EvalBreak is_exception _ ix mod_uniq resume_ctxt _) -> do
       -- A breakpoint was hit; inform the user and tell them
diff --git a/compiler/GHC/Runtime/Linker.hs b/compiler/GHC/Runtime/Linker.hs
index 4203f741c6..dd3c29caa5 100644
--- a/compiler/GHC/Runtime/Linker.hs
+++ b/compiler/GHC/Runtime/Linker.hs
@@ -243,7 +243,7 @@ withExtendedLinkEnv dl new_env action
         -- lose those changes (we might have linked a new module or
         -- package), so the reset action only removes the names we
         -- added earlier.
-          reset_old_env = liftIO $ do
+          reset_old_env = liftIO $
             modifyPLS_ dl $ \pls ->
                 let cur = closure_env pls
                     new = delListFromNameEnv cur (map fst new_env)
@@ -313,7 +313,7 @@ linkCmdLineLibs :: HscEnv -> IO ()
 linkCmdLineLibs hsc_env = do
   let dl = hsc_dynLinker hsc_env
   initDynLinker hsc_env
-  modifyPLS_ dl $ \pls -> do
+  modifyPLS_ dl $ \pls ->
     linkCmdLineLibs' hsc_env pls
 
 linkCmdLineLibs' :: HscEnv -> PersistentLinkerState -> IO PersistentLinkerState
@@ -915,7 +915,7 @@ dynLinkObjs hsc_env pls objs = do
 
                     -- If resolving failed, unload all our
                     -- object modules and carry on
-                    if succeeded ok then do
+                    if succeeded ok then
                             return (pls1, Succeeded)
                       else do
                             pls2 <- unload_wkr hsc_env [] pls1
@@ -1259,7 +1259,7 @@ linkPackages hsc_env new_pkgs = do
   -- a lock.
   initDynLinker hsc_env
   let dl = hsc_dynLinker hsc_env
-  modifyPLS_ dl $ \pls -> do
+  modifyPLS_ dl $ \pls ->
     linkPackages' hsc_env new_pkgs pls
 
 linkPackages' :: HscEnv -> [UnitId] -> PersistentLinkerState
diff --git a/compiler/GHC/Runtime/Loader.hs b/compiler/GHC/Runtime/Loader.hs
index 2a97e24edd..3b487e7b1a 100644
--- a/compiler/GHC/Runtime/Loader.hs
+++ b/compiler/GHC/Runtime/Loader.hs
@@ -80,8 +80,7 @@ initializePlugins hsc_env df
   | otherwise
   = do loadedPlugins <- loadPlugins (hsc_env { hsc_dflags = df })
        let df' = df { cachedPlugins = loadedPlugins }
-       df'' <- withPlugins df' runDflagsPlugin df'
-       return df''
+       withPlugins df' runDflagsPlugin df'
 
   where argumentsForPlugin p = map snd . filter ((== lpModuleName p) . fst)
         runDflagsPlugin p opts dynflags = dynflagsPlugin p opts dynflags
diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs
index 8abd6fc67d..27e63f9313 100644
--- a/compiler/GHC/Stg/Lift.hs
+++ b/compiler/GHC/Stg/Lift.hs
@@ -202,11 +202,11 @@ liftRhs
 liftRhs mb_former_fvs rhs@(StgRhsCon ccs con args)
   = ASSERT2(isNothing mb_former_fvs, text "Should never lift a constructor" $$ pprStgRhs panicStgPprOpts rhs)
     StgRhsCon ccs con <$> traverse liftArgs args
-liftRhs Nothing (StgRhsClosure _ ccs upd infos body) = do
+liftRhs Nothing (StgRhsClosure _ ccs upd infos body) =
   -- This RHS wasn't lifted.
   withSubstBndrs (map binderInfoBndr infos) $ \bndrs' ->
     StgRhsClosure noExtFieldSilent ccs upd bndrs' <$> liftExpr body
-liftRhs (Just former_fvs) (StgRhsClosure _ ccs upd infos body) = do
+liftRhs (Just former_fvs) (StgRhsClosure _ ccs upd infos body) =
   -- This RHS was lifted. Insert extra binders for @former_fvs@.
   withSubstBndrs (map binderInfoBndr infos) $ \bndrs' -> do
     let bndrs'' = dVarSetElems former_fvs ++ bndrs'
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index f6c8176a92..eb56a6ad09 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -178,12 +178,10 @@ cgLetNoEscapeClosure
 
 cgLetNoEscapeClosure bndr cc_slot _unused_cc args body
   = do platform <- getPlatform
-       return ( lneIdInfo platform bndr args
-              , code )
+       return ( lneIdInfo platform bndr args, code )
   where
-   code = forkLneBody $ do {
-            ; withNewTickyCounterLNE (idName bndr) args $ do
-            ; restoreCurrentCostCentre cc_slot
+   code = forkLneBody $ withNewTickyCounterLNE (idName bndr) args $ do
+            { restoreCurrentCostCentre cc_slot
             ; arg_regs <- bindArgsToRegs args
             ; void $ noEscapeHeapCheck arg_regs (tickyEnterLNE >> cgExpr body) }
 
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 6c811ba9cc..62b9785ed6 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -650,7 +650,7 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do
      tickyHeapCheck
      emitAssign hpReg bump_hp
      emit =<< mkCmmIfThen' hp_oflo (alloc_n <*> mkBranch gc_id) (Just False)
-    else do
+    else
       when (checkYield && not (gopt Opt_OmitYields dflags)) $ do
          -- Yielding if HpLim == 0
          let yielding = CmmMachOp (mo_wordEq platform)
diff --git a/compiler/GHC/StgToCmm/Monad.hs b/compiler/GHC/StgToCmm/Monad.hs
index 556c1c6ffd..915b57eae0 100644
--- a/compiler/GHC/StgToCmm/Monad.hs
+++ b/compiler/GHC/StgToCmm/Monad.hs
@@ -734,7 +734,7 @@ emitTick = emitCgStmt . CgStmt . CmmTick
 emitUnwind :: [(GlobalReg, Maybe CmmExpr)] -> FCode ()
 emitUnwind regs = do
   dflags <- getDynFlags
-  when (debugLevel dflags > 0) $ do
+  when (debugLevel dflags > 0) $
      emitCgStmt $ CgStmt $ CmmUnwind regs
 
 emitAssign :: CmmReg  -> CmmExpr -> FCode ()
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 4a58873992..a6f2dcb6da 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -266,7 +266,7 @@ emitPrimOp dflags primop = case primop of
 
 -- First we handle various awkward cases specially.
 
-  ParOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  ParOp -> \[arg] -> opIntoRegs $ \[res] ->
     -- for now, just implement this in a C function
     -- later, we might want to inline it.
     emitCCall
@@ -293,13 +293,13 @@ emitPrimOp dflags primop = case primop of
        | otherwise                  = CmmLit (zeroCLit platform)
     emitAssign (CmmLocal res) val
 
-  GetCurrentCCSOp -> \[_] -> opIntoRegs $ \[res] -> do
+  GetCurrentCCSOp -> \[_] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) cccsExpr
 
-  MyThreadIdOp -> \[] -> opIntoRegs $ \[res] -> do
+  MyThreadIdOp -> \[] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) currentTSOExpr
 
-  ReadMutVarOp -> \[mutv] -> opIntoRegs $ \[res] -> do
+  ReadMutVarOp -> \[mutv] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) (cmmLoadIndexW platform mutv (fixedHdrSizeW profile) (gcWord platform))
 
   WriteMutVarOp -> \[mutv, var] -> opIntoRegs $ \res@[] -> do
@@ -320,7 +320,7 @@ emitPrimOp dflags primop = case primop of
 
 --  #define sizzeofByteArrayzh(r,a) \
 --     r = ((StgArrBytes *)(a))->bytes
-  SizeofByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  SizeofByteArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emit $ mkAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform))
 
 --  #define sizzeofMutableByteArrayzh(r,a) \
@@ -329,31 +329,31 @@ emitPrimOp dflags primop = case primop of
 
 --  #define getSizzeofMutableByteArrayzh(r,a) \
 --      r = ((StgArrBytes *)(a))->bytes
-  GetSizeofMutableByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  GetSizeofMutableByteArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform))
 
 
 --  #define touchzh(o)                  /* nothing */
-  TouchOp -> \args@[_] -> opIntoRegs $ \res@[] -> do
+  TouchOp -> \args@[_] -> opIntoRegs $ \res@[] ->
     emitPrimCall res MO_Touch args
 
 --  #define byteArrayContentszh(r,a) r = BYTE_ARR_CTS(a)
-  ByteArrayContents_Char -> \[arg] -> opIntoRegs $ \[res] -> do
+  ByteArrayContents_Char -> \[arg] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) (cmmOffsetB platform arg (arrWordsHdrSize profile))
 
 --  #define stableNameToIntzh(r,s)   (r = ((StgStableName *)s)->sn)
-  StableNameToIntOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  StableNameToIntOp -> \[arg] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) (cmmLoadIndexW platform arg (fixedHdrSizeW profile) (bWord platform))
 
-  ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opIntoRegs $ \[res] -> do
+  ReallyUnsafePtrEqualityOp -> \[arg1, arg2] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) (CmmMachOp (mo_wordEq platform) [arg1,arg2])
 
 --  #define addrToHValuezh(r,a) r=(P_)a
-  AddrToAnyOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  AddrToAnyOp -> \[arg] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) arg
 
 --  #define hvalueToAddrzh(r, a) r=(W_)a
-  AnyToAddrOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  AnyToAddrOp -> \[arg] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) arg
 
 {- Freezing arrays-of-ptrs requires changing an info table, for the
@@ -366,70 +366,70 @@ emitPrimOp dflags primop = case primop of
 --        SET_INFO((StgClosure *)a,&stg_MUT_ARR_PTRS_FROZEN_DIRTY_info);
 --        r = a;
 --      }
-  UnsafeFreezeArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  UnsafeFreezeArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emit $ catAGraphs
       [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
         mkAssign (CmmLocal res) arg ]
-  UnsafeFreezeArrayArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  UnsafeFreezeArrayArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emit $ catAGraphs
       [ setInfo arg (CmmLit (CmmLabel mkMAP_FROZEN_DIRTY_infoLabel)),
         mkAssign (CmmLocal res) arg ]
-  UnsafeFreezeSmallArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  UnsafeFreezeSmallArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emit $ catAGraphs
       [ setInfo arg (CmmLit (CmmLabel mkSMAP_FROZEN_DIRTY_infoLabel)),
         mkAssign (CmmLocal res) arg ]
 
 --  #define unsafeFreezzeByteArrayzh(r,a)       r=(a)
-  UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  UnsafeFreezeByteArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emitAssign (CmmLocal res) arg
 
 -- Reading/writing pointer arrays
 
-  ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  ReadArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  IndexArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  IndexArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  WriteArrayOp -> \[obj, ix, v] -> opIntoRegs $ \[] -> do
+  WriteArrayOp -> \[obj, ix, v] -> opIntoRegs $ \[] ->
     doWritePtrArrayOp obj ix v
 
-  IndexArrayArrayOp_ByteArray -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  IndexArrayArrayOp_ByteArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  IndexArrayArrayOp_ArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  IndexArrayArrayOp_ArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  ReadArrayArrayOp_ByteArray -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  ReadArrayArrayOp_ByteArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  ReadArrayArrayOp_MutableByteArray -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  ReadArrayArrayOp_MutableByteArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  ReadArrayArrayOp_ArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  ReadArrayArrayOp_ArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  ReadArrayArrayOp_MutableArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  ReadArrayArrayOp_MutableArrayArray -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadPtrArrayOp res obj ix
-  WriteArrayArrayOp_ByteArray -> \[obj,ix,v] -> opIntoRegs $ \[] -> do
+  WriteArrayArrayOp_ByteArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
     doWritePtrArrayOp obj ix v
-  WriteArrayArrayOp_MutableByteArray -> \[obj,ix,v] -> opIntoRegs $ \[] -> do
+  WriteArrayArrayOp_MutableByteArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
     doWritePtrArrayOp obj ix v
-  WriteArrayArrayOp_ArrayArray -> \[obj,ix,v] -> opIntoRegs $ \[] -> do
+  WriteArrayArrayOp_ArrayArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
     doWritePtrArrayOp obj ix v
-  WriteArrayArrayOp_MutableArrayArray -> \[obj,ix,v] -> opIntoRegs $ \[] -> do
+  WriteArrayArrayOp_MutableArrayArray -> \[obj,ix,v] -> opIntoRegs $ \[] ->
     doWritePtrArrayOp obj ix v
 
-  ReadSmallArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  ReadSmallArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadSmallPtrArrayOp res obj ix
-  IndexSmallArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] -> do
+  IndexSmallArrayOp -> \[obj, ix] -> opIntoRegs $ \[res] ->
     doReadSmallPtrArrayOp res obj ix
-  WriteSmallArrayOp -> \[obj,ix,v] -> opIntoRegs $ \[] -> do
+  WriteSmallArrayOp -> \[obj,ix,v] -> opIntoRegs $ \[] ->
     doWriteSmallPtrArrayOp obj ix v
 
 -- Getting the size of pointer arrays
 
-  SizeofArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  SizeofArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emit $ mkAssign (CmmLocal res) (cmmLoadIndexW platform arg
       (fixedHdrSizeW profile + bytesToWordsRoundUp platform (pc_OFFSET_StgMutArrPtrs_ptrs (platformConstants platform)))
         (bWord platform))
   SizeofMutableArrayOp -> emitPrimOp dflags SizeofArrayOp
   SizeofArrayArrayOp -> emitPrimOp dflags SizeofArrayOp
   SizeofMutableArrayArrayOp -> emitPrimOp dflags SizeofArrayOp
-  SizeofSmallArrayOp -> \[arg] -> opIntoRegs $ \[res] -> do
+  SizeofSmallArrayOp -> \[arg] -> opIntoRegs $ \[res] ->
     emit $ mkAssign (CmmLocal res)
      (cmmLoadIndexW platform arg
      (fixedHdrSizeW profile + bytesToWordsRoundUp platform (pc_OFFSET_StgSmallMutArrPtrs_ptrs (platformConstants platform)))
@@ -440,409 +440,409 @@ emitPrimOp dflags primop = case primop of
 
 -- IndexXXXoffAddr
 
-  IndexOffAddrOp_Char -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Char -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_8ToWord platform)) b8 res args
-  IndexOffAddrOp_WideChar -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_WideChar -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_32ToWord platform)) b32 res args
-  IndexOffAddrOp_Int -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Int -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  IndexOffAddrOp_Word -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Word -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  IndexOffAddrOp_Addr -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Addr -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  IndexOffAddrOp_Float -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Float -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing f32 res args
-  IndexOffAddrOp_Double -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Double -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing f64 res args
-  IndexOffAddrOp_StablePtr -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_StablePtr -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  IndexOffAddrOp_Int8 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Int8 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_s_8ToWord platform)) b8  res args
-  IndexOffAddrOp_Int16 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Int16 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_s_16ToWord platform)) b16 res args
-  IndexOffAddrOp_Int32 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Int32 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_s_32ToWord platform)) b32 res args
-  IndexOffAddrOp_Int64 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Int64 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing b64 res args
-  IndexOffAddrOp_Word8 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Word8 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_8ToWord platform)) b8  res args
-  IndexOffAddrOp_Word16 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Word16 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_16ToWord platform)) b16 res args
-  IndexOffAddrOp_Word32 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Word32 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_32ToWord platform)) b32 res args
-  IndexOffAddrOp_Word64 -> \args -> opIntoRegs $ \res -> do
+  IndexOffAddrOp_Word64 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing b64 res args
 
 -- ReadXXXoffAddr, which are identical, for our purposes, to IndexXXXoffAddr.
 
-  ReadOffAddrOp_Char -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Char -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_8ToWord platform)) b8 res args
-  ReadOffAddrOp_WideChar -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_WideChar -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_32ToWord platform)) b32 res args
-  ReadOffAddrOp_Int -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Int -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  ReadOffAddrOp_Word -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Word -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  ReadOffAddrOp_Addr -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Addr -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  ReadOffAddrOp_Float -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Float -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing f32 res args
-  ReadOffAddrOp_Double -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Double -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing f64 res args
-  ReadOffAddrOp_StablePtr -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_StablePtr -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing (bWord platform) res args
-  ReadOffAddrOp_Int8 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Int8 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_s_8ToWord platform)) b8  res args
-  ReadOffAddrOp_Int16 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Int16 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_s_16ToWord platform)) b16 res args
-  ReadOffAddrOp_Int32 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Int32 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_s_32ToWord platform)) b32 res args
-  ReadOffAddrOp_Int64 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Int64 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing b64 res args
-  ReadOffAddrOp_Word8 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Word8 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_8ToWord platform)) b8  res args
-  ReadOffAddrOp_Word16 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Word16 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_16ToWord platform)) b16 res args
-  ReadOffAddrOp_Word32 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Word32 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   (Just (mo_u_32ToWord platform)) b32 res args
-  ReadOffAddrOp_Word64 -> \args -> opIntoRegs $ \res -> do
+  ReadOffAddrOp_Word64 -> \args -> opIntoRegs $ \res ->
     doIndexOffAddrOp   Nothing b64 res args
 
 -- IndexXXXArray
 
-  IndexByteArrayOp_Char -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Char -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_8ToWord platform)) b8 res args
-  IndexByteArrayOp_WideChar -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_WideChar -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_32ToWord platform)) b32 res args
-  IndexByteArrayOp_Int -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Int -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  IndexByteArrayOp_Word -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  IndexByteArrayOp_Addr -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Addr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  IndexByteArrayOp_Float -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Float -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing f32 res args
-  IndexByteArrayOp_Double -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Double -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing f64 res args
-  IndexByteArrayOp_StablePtr -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_StablePtr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  IndexByteArrayOp_Int8 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Int8 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_s_8ToWord platform)) b8  res args
-  IndexByteArrayOp_Int16 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Int16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_s_16ToWord platform)) b16  res args
-  IndexByteArrayOp_Int32 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Int32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_s_32ToWord platform)) b32  res args
-  IndexByteArrayOp_Int64 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Int64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing b64  res args
-  IndexByteArrayOp_Word8 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_8ToWord platform)) b8  res args
-  IndexByteArrayOp_Word16 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_16ToWord platform)) b16  res args
-  IndexByteArrayOp_Word32 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_32ToWord platform)) b32  res args
-  IndexByteArrayOp_Word64 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing b64  res args
 
 -- ReadXXXArray, identical to IndexXXXArray.
 
-  ReadByteArrayOp_Char -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Char -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_8ToWord platform)) b8 res args
-  ReadByteArrayOp_WideChar -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_WideChar -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_32ToWord platform)) b32 res args
-  ReadByteArrayOp_Int -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Int -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  ReadByteArrayOp_Word -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  ReadByteArrayOp_Addr -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Addr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  ReadByteArrayOp_Float -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Float -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing f32 res args
-  ReadByteArrayOp_Double -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Double -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing f64 res args
-  ReadByteArrayOp_StablePtr -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_StablePtr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing (bWord platform) res args
-  ReadByteArrayOp_Int8 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Int8 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_s_8ToWord platform)) b8  res args
-  ReadByteArrayOp_Int16 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Int16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_s_16ToWord platform)) b16  res args
-  ReadByteArrayOp_Int32 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Int32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_s_32ToWord platform)) b32  res args
-  ReadByteArrayOp_Int64 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Int64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing b64  res args
-  ReadByteArrayOp_Word8 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_8ToWord platform)) b8  res args
-  ReadByteArrayOp_Word16 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_16ToWord platform)) b16  res args
-  ReadByteArrayOp_Word32 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   (Just (mo_u_32ToWord platform)) b32  res args
-  ReadByteArrayOp_Word64 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOp   Nothing b64  res args
 
 -- IndexWord8ArrayAsXXX
 
-  IndexByteArrayOp_Word8AsChar -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsChar -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_8ToWord platform)) b8 b8 res args
-  IndexByteArrayOp_Word8AsWideChar -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsWideChar -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_32ToWord platform)) b32 b8 res args
-  IndexByteArrayOp_Word8AsInt -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsInt -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  IndexByteArrayOp_Word8AsWord -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsWord -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  IndexByteArrayOp_Word8AsAddr -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsAddr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  IndexByteArrayOp_Word8AsFloat -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsFloat -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing f32 b8 res args
-  IndexByteArrayOp_Word8AsDouble -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsDouble -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing f64 b8 res args
-  IndexByteArrayOp_Word8AsStablePtr -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsStablePtr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  IndexByteArrayOp_Word8AsInt16 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsInt16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_s_16ToWord platform)) b16 b8 res args
-  IndexByteArrayOp_Word8AsInt32 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsInt32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_s_32ToWord platform)) b32 b8 res args
-  IndexByteArrayOp_Word8AsInt64 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsInt64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing b64 b8 res args
-  IndexByteArrayOp_Word8AsWord16 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsWord16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_16ToWord platform)) b16 b8 res args
-  IndexByteArrayOp_Word8AsWord32 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsWord32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_32ToWord platform)) b32 b8 res args
-  IndexByteArrayOp_Word8AsWord64 -> \args -> opIntoRegs $ \res -> do
+  IndexByteArrayOp_Word8AsWord64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing b64 b8 res args
 
 -- ReadInt8ArrayAsXXX, identical to IndexInt8ArrayAsXXX
 
-  ReadByteArrayOp_Word8AsChar -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsChar -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_8ToWord platform)) b8 b8 res args
-  ReadByteArrayOp_Word8AsWideChar -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsWideChar -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_32ToWord platform)) b32 b8 res args
-  ReadByteArrayOp_Word8AsInt -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsInt -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  ReadByteArrayOp_Word8AsWord -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsWord -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  ReadByteArrayOp_Word8AsAddr -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsAddr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  ReadByteArrayOp_Word8AsFloat -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsFloat -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing f32 b8 res args
-  ReadByteArrayOp_Word8AsDouble -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsDouble -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing f64 b8 res args
-  ReadByteArrayOp_Word8AsStablePtr -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsStablePtr -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing (bWord platform) b8 res args
-  ReadByteArrayOp_Word8AsInt16 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsInt16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_s_16ToWord platform)) b16 b8 res args
-  ReadByteArrayOp_Word8AsInt32 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsInt32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_s_32ToWord platform)) b32 b8 res args
-  ReadByteArrayOp_Word8AsInt64 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsInt64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing b64 b8 res args
-  ReadByteArrayOp_Word8AsWord16 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsWord16 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_16ToWord platform)) b16 b8 res args
-  ReadByteArrayOp_Word8AsWord32 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsWord32 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   (Just (mo_u_32ToWord platform)) b32 b8 res args
-  ReadByteArrayOp_Word8AsWord64 -> \args -> opIntoRegs $ \res -> do
+  ReadByteArrayOp_Word8AsWord64 -> \args -> opIntoRegs $ \res ->
     doIndexByteArrayOpAs   Nothing b64 b8 res args
 
 -- WriteXXXoffAddr
 
-  WriteOffAddrOp_Char -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Char -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo8 platform))  b8 res args
-  WriteOffAddrOp_WideChar -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_WideChar -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo32 platform)) b32 res args
-  WriteOffAddrOp_Int -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Int -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing (bWord platform) res args
-  WriteOffAddrOp_Word -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Word -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing (bWord platform) res args
-  WriteOffAddrOp_Addr -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Addr -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing (bWord platform) res args
-  WriteOffAddrOp_Float -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Float -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing f32 res args
-  WriteOffAddrOp_Double -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Double -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing f64 res args
-  WriteOffAddrOp_StablePtr -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_StablePtr -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing (bWord platform) res args
-  WriteOffAddrOp_Int8 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Int8 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo8 platform))  b8 res args
-  WriteOffAddrOp_Int16 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Int16 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo16 platform)) b16 res args
-  WriteOffAddrOp_Int32 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Int32 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo32 platform)) b32 res args
-  WriteOffAddrOp_Int64 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Int64 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing b64 res args
-  WriteOffAddrOp_Word8 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Word8 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo8 platform))  b8 res args
-  WriteOffAddrOp_Word16 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Word16 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo16 platform)) b16 res args
-  WriteOffAddrOp_Word32 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Word32 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp (Just (mo_WordTo32 platform)) b32 res args
-  WriteOffAddrOp_Word64 -> \args -> opIntoRegs $ \res -> do
+  WriteOffAddrOp_Word64 -> \args -> opIntoRegs $ \res ->
     doWriteOffAddrOp Nothing b64 res args
 
 -- WriteXXXArray
 
-  WriteByteArrayOp_Char -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Char -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo8 platform))  b8 res args
-  WriteByteArrayOp_WideChar -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_WideChar -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo32 platform)) b32 res args
-  WriteByteArrayOp_Int -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Int -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing (bWord platform) res args
-  WriteByteArrayOp_Word -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing (bWord platform) res args
-  WriteByteArrayOp_Addr -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Addr -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing (bWord platform) res args
-  WriteByteArrayOp_Float -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Float -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing f32 res args
-  WriteByteArrayOp_Double -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Double -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing f64 res args
-  WriteByteArrayOp_StablePtr -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_StablePtr -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing (bWord platform) res args
-  WriteByteArrayOp_Int8 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Int8 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo8 platform))  b8 res args
-  WriteByteArrayOp_Int16 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Int16 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo16 platform)) b16 res args
-  WriteByteArrayOp_Int32 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Int32 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo32 platform)) b32 res args
-  WriteByteArrayOp_Int64 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Int64 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b64 res args
-  WriteByteArrayOp_Word8 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo8 platform))  b8  res args
-  WriteByteArrayOp_Word16 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word16 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo16 platform)) b16 res args
-  WriteByteArrayOp_Word32 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word32 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo32 platform)) b32 res args
-  WriteByteArrayOp_Word64 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word64 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b64 res args
 
 -- WriteInt8ArrayAsXXX
 
-  WriteByteArrayOp_Word8AsChar -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsChar -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo8 platform))  b8 res args
-  WriteByteArrayOp_Word8AsWideChar -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsWideChar -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo32 platform)) b8 res args
-  WriteByteArrayOp_Word8AsInt -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsInt -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsWord -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsWord -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsAddr -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsAddr -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsFloat -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsFloat -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsDouble -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsDouble -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsStablePtr -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsStablePtr -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsInt16 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsInt16 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo16 platform)) b8 res args
-  WriteByteArrayOp_Word8AsInt32 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsInt32 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo32 platform)) b8 res args
-  WriteByteArrayOp_Word8AsInt64 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsInt64 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
-  WriteByteArrayOp_Word8AsWord16 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsWord16 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo16 platform)) b8 res args
-  WriteByteArrayOp_Word8AsWord32 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsWord32 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp (Just (mo_WordTo32 platform)) b8 res args
-  WriteByteArrayOp_Word8AsWord64 -> \args -> opIntoRegs $ \res -> do
+  WriteByteArrayOp_Word8AsWord64 -> \args -> opIntoRegs $ \res ->
     doWriteByteArrayOp Nothing b8 res args
 
 -- Copying and setting byte arrays
-  CopyByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opIntoRegs $ \[] -> do
+  CopyByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opIntoRegs $ \[] ->
     doCopyByteArrayOp src src_off dst dst_off n
-  CopyMutableByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opIntoRegs $ \[] -> do
+  CopyMutableByteArrayOp -> \[src,src_off,dst,dst_off,n] -> opIntoRegs $ \[] ->
     doCopyMutableByteArrayOp src src_off dst dst_off n
-  CopyByteArrayToAddrOp -> \[src,src_off,dst,n] -> opIntoRegs $ \[] -> do
+  CopyByteArrayToAddrOp -> \[src,src_off,dst,n] -> opIntoRegs $ \[] ->
     doCopyByteArrayToAddrOp src src_off dst n
-  CopyMutableByteArrayToAddrOp -> \[src,src_off,dst,n] -> opIntoRegs $ \[] -> do
+  CopyMutableByteArrayToAddrOp -> \[src,src_off,dst,n] -> opIntoRegs $ \[] ->
     doCopyMutableByteArrayToAddrOp src src_off dst n
-  CopyAddrToByteArrayOp -> \[src,dst,dst_off,n] -> opIntoRegs $ \[] -> do
+  CopyAddrToByteArrayOp -> \[src,dst,dst_off,n] -> opIntoRegs $ \[] ->
     doCopyAddrToByteArrayOp src dst dst_off n
-  SetByteArrayOp -> \[ba,off,len,c] -> opIntoRegs $ \[] -> do
+  SetByteArrayOp -> \[ba,off,len,c] -> opIntoRegs $ \[] ->
     doSetByteArrayOp ba off len c
 
 -- Comparing byte arrays
-  CompareByteArraysOp -> \[ba1,ba1_off,ba2,ba2_off,n] -> opIntoRegs $ \[res] -> do
+  CompareByteArraysOp -> \[ba1,ba1_off,ba2,ba2_off,n] -> opIntoRegs $ \[res] ->
     doCompareByteArraysOp res ba1 ba1_off ba2 ba2_off n
 
-  BSwap16Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BSwap16Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBSwapCall res w W16
-  BSwap32Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BSwap32Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBSwapCall res w W32
-  BSwap64Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BSwap64Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBSwapCall res w W64
-  BSwapOp -> \[w] -> opIntoRegs $ \[res] -> do
+  BSwapOp -> \[w] -> opIntoRegs $ \[res] ->
     emitBSwapCall res w (wordWidth platform)
 
-  BRev8Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BRev8Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBRevCall res w W8
-  BRev16Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BRev16Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBRevCall res w W16
-  BRev32Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BRev32Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBRevCall res w W32
-  BRev64Op -> \[w] -> opIntoRegs $ \[res] -> do
+  BRev64Op -> \[w] -> opIntoRegs $ \[res] ->
     emitBRevCall res w W64
-  BRevOp -> \[w] -> opIntoRegs $ \[res] -> do
+  BRevOp -> \[w] -> opIntoRegs $ \[res] ->
     emitBRevCall res w (wordWidth platform)
 
 -- Population count
-  PopCnt8Op -> \[w] -> opIntoRegs $ \[res] -> do
+  PopCnt8Op -> \[w] -> opIntoRegs $ \[res] ->
     emitPopCntCall res w W8
-  PopCnt16Op -> \[w] -> opIntoRegs $ \[res] -> do
+  PopCnt16Op -> \[w] -> opIntoRegs $ \[res] ->
     emitPopCntCall res w W16
-  PopCnt32Op -> \[w] -> opIntoRegs $ \[res] -> do
+  PopCnt32Op -> \[w] -> opIntoRegs $ \[res] ->
     emitPopCntCall res w W32
-  PopCnt64Op -> \[w] -> opIntoRegs $ \[res] -> do
+  PopCnt64Op -> \[w] -> opIntoRegs $ \[res] ->
     emitPopCntCall res w W64
-  PopCntOp -> \[w] -> opIntoRegs $ \[res] -> do
+  PopCntOp -> \[w] -> opIntoRegs $ \[res] ->
     emitPopCntCall res w (wordWidth platform)
 
 -- Parallel bit deposit
-  Pdep8Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pdep8Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPdepCall res src mask W8
-  Pdep16Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pdep16Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPdepCall res src mask W16
-  Pdep32Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pdep32Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPdepCall res src mask W32
-  Pdep64Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pdep64Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPdepCall res src mask W64
-  PdepOp -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  PdepOp -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPdepCall res src mask (wordWidth platform)
 
 -- Parallel bit extract
-  Pext8Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pext8Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPextCall res src mask W8
-  Pext16Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pext16Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPextCall res src mask W16
-  Pext32Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pext32Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPextCall res src mask W32
-  Pext64Op -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  Pext64Op -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPextCall res src mask W64
-  PextOp -> \[src, mask] -> opIntoRegs $ \[res] -> do
+  PextOp -> \[src, mask] -> opIntoRegs $ \[res] ->
     emitPextCall res src mask (wordWidth platform)
 
 -- count leading zeros
-  Clz8Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Clz8Op -> \[w] -> opIntoRegs $ \[res] ->
     emitClzCall res w W8
-  Clz16Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Clz16Op -> \[w] -> opIntoRegs $ \[res] ->
     emitClzCall res w W16
-  Clz32Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Clz32Op -> \[w] -> opIntoRegs $ \[res] ->
     emitClzCall res w W32
-  Clz64Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Clz64Op -> \[w] -> opIntoRegs $ \[res] ->
     emitClzCall res w W64
-  ClzOp -> \[w] -> opIntoRegs $ \[res] -> do
+  ClzOp -> \[w] -> opIntoRegs $ \[res] ->
     emitClzCall res w (wordWidth platform)
 
 -- count trailing zeros
-  Ctz8Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Ctz8Op -> \[w] -> opIntoRegs $ \[res] ->
     emitCtzCall res w W8
-  Ctz16Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Ctz16Op -> \[w] -> opIntoRegs $ \[res] ->
     emitCtzCall res w W16
-  Ctz32Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Ctz32Op -> \[w] -> opIntoRegs $ \[res] ->
     emitCtzCall res w W32
-  Ctz64Op -> \[w] -> opIntoRegs $ \[res] -> do
+  Ctz64Op -> \[w] -> opIntoRegs $ \[res] ->
     emitCtzCall res w W64
-  CtzOp -> \[w] -> opIntoRegs $ \[res] -> do
+  CtzOp -> \[w] -> opIntoRegs $ \[res] ->
     emitCtzCall res w (wordWidth platform)
 
 -- Unsigned int to floating point conversions
-  WordToFloatOp -> \[w] -> opIntoRegs $ \[res] -> do
+  WordToFloatOp -> \[w] -> opIntoRegs $ \[res] ->
     emitPrimCall [res] (MO_UF_Conv W32) [w]
-  WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] -> do
+  WordToDoubleOp -> \[w] -> opIntoRegs $ \[res] ->
     emitPrimCall [res] (MO_UF_Conv W64) [w]
 
 -- Atomic operations
@@ -1003,59 +1003,59 @@ emitPrimOp dflags primop = case primop of
     ty = vecCmmCat vcat w
 
 -- Prefetch
-  PrefetchByteArrayOp3         -> \args -> opIntoRegs $ \[] -> do
+  PrefetchByteArrayOp3         -> \args -> opIntoRegs $ \[] ->
     doPrefetchByteArrayOp 3  args
-  PrefetchMutableByteArrayOp3  -> \args -> opIntoRegs $ \[] -> do
+  PrefetchMutableByteArrayOp3  -> \args -> opIntoRegs $ \[] ->
     doPrefetchMutableByteArrayOp 3  args
-  PrefetchAddrOp3              -> \args -> opIntoRegs $ \[] -> do
+  PrefetchAddrOp3              -> \args -> opIntoRegs $ \[] ->
     doPrefetchAddrOp  3  args
-  PrefetchValueOp3             -> \args -> opIntoRegs $ \[] -> do
+  PrefetchValueOp3             -> \args -> opIntoRegs $ \[] ->
     doPrefetchValueOp 3 args
 
-  PrefetchByteArrayOp2         -> \args -> opIntoRegs $ \[] -> do
+  PrefetchByteArrayOp2         -> \args -> opIntoRegs $ \[] ->
     doPrefetchByteArrayOp 2  args
-  PrefetchMutableByteArrayOp2  -> \args -> opIntoRegs $ \[] -> do
+  PrefetchMutableByteArrayOp2  -> \args -> opIntoRegs $ \[] ->
     doPrefetchMutableByteArrayOp 2  args
-  PrefetchAddrOp2              -> \args -> opIntoRegs $ \[] -> do
+  PrefetchAddrOp2              -> \args -> opIntoRegs $ \[] ->
     doPrefetchAddrOp 2  args
-  PrefetchValueOp2             -> \args -> opIntoRegs $ \[] -> do
+  PrefetchValueOp2             -> \args -> opIntoRegs $ \[] ->
     doPrefetchValueOp 2 args
-  PrefetchByteArrayOp1         -> \args -> opIntoRegs $ \[] -> do
+  PrefetchByteArrayOp1         -> \args -> opIntoRegs $ \[] ->
     doPrefetchByteArrayOp 1  args
-  PrefetchMutableByteArrayOp1  -> \args -> opIntoRegs $ \[] -> do
+  PrefetchMutableByteArrayOp1  -> \args -> opIntoRegs $ \[] ->
     doPrefetchMutableByteArrayOp 1  args
-  PrefetchAddrOp1              -> \args -> opIntoRegs $ \[] -> do
+  PrefetchAddrOp1              -> \args -> opIntoRegs $ \[] ->
     doPrefetchAddrOp 1  args
-  PrefetchValueOp1             -> \args -> opIntoRegs $ \[] -> do
+  PrefetchValueOp1             -> \args -> opIntoRegs $ \[] ->
     doPrefetchValueOp 1 args
 
-  PrefetchByteArrayOp0         -> \args -> opIntoRegs $ \[] -> do
+  PrefetchByteArrayOp0         -> \args -> opIntoRegs $ \[] ->
     doPrefetchByteArrayOp 0  args
-  PrefetchMutableByteArrayOp0  -> \args -> opIntoRegs $ \[] -> do
+  PrefetchMutableByteArrayOp0  -> \args -> opIntoRegs $ \[] ->
     doPrefetchMutableByteArrayOp 0  args
-  PrefetchAddrOp0              -> \args -> opIntoRegs $ \[] -> do
+  PrefetchAddrOp0              -> \args -> opIntoRegs $ \[] ->
     doPrefetchAddrOp 0  args
-  PrefetchValueOp0             -> \args -> opIntoRegs $ \[] -> do
+  PrefetchValueOp0             -> \args -> opIntoRegs $ \[] ->
     doPrefetchValueOp 0 args
 
 -- Atomic read-modify-write
-  FetchAddByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] -> do
+  FetchAddByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] ->
     doAtomicRMW res AMO_Add mba ix (bWord platform) n
-  FetchSubByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] -> do
+  FetchSubByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] ->
     doAtomicRMW res AMO_Sub mba ix (bWord platform) n
-  FetchAndByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] -> do
+  FetchAndByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] ->
     doAtomicRMW res AMO_And mba ix (bWord platform) n
-  FetchNandByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] -> do
+  FetchNandByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] ->
     doAtomicRMW res AMO_Nand mba ix (bWord platform) n
-  FetchOrByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] -> do
+  FetchOrByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] ->
     doAtomicRMW res AMO_Or mba ix (bWord platform) n
-  FetchXorByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] -> do
+  FetchXorByteArrayOp_Int -> \[mba, ix, n] -> opIntoRegs $ \[res] ->
     doAtomicRMW res AMO_Xor mba ix (bWord platform) n
-  AtomicReadByteArrayOp_Int -> \[mba, ix] -> opIntoRegs $ \[res] -> do
+  AtomicReadByteArrayOp_Int -> \[mba, ix] -> opIntoRegs $ \[res] ->
     doAtomicReadByteArray res mba ix (bWord platform)
-  AtomicWriteByteArrayOp_Int -> \[mba, ix, val] -> opIntoRegs $ \[] -> do
+  AtomicWriteByteArrayOp_Int -> \[mba, ix, val] -> opIntoRegs $ \[] ->
     doAtomicWriteByteArray mba ix (bWord platform) val
-  CasByteArrayOp_Int -> \[mba, ix, old, new] -> opIntoRegs $ \[res] -> do
+  CasByteArrayOp_Int -> \[mba, ix, old, new] -> opIntoRegs $ \[res] ->
     doCasByteArray res mba ix (bWord platform) old new
 
 -- The rest just translate straightforwardly
@@ -2170,7 +2170,7 @@ vecElemProjectCast _        _        _   =  Nothing
 
 checkVecCompatibility :: DynFlags -> PrimOpVecCat -> Length -> Width -> FCode ()
 checkVecCompatibility dflags vcat l w = do
-    when (backend dflags /= LLVM) $ do
+    when (backend dflags /= LLVM) $
         sorry $ unlines ["SIMD vector instructions require the LLVM back-end."
                          ,"Please use -fllvm."]
     check vecWidth vcat l w
@@ -2933,7 +2933,7 @@ doCasByteArray res mba idx idx_ty old new = do
 
 -- | Emit a call to @memcpy@.
 emitMemcpyCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
-emitMemcpyCall dst src n align = do
+emitMemcpyCall dst src n align =
     emitPrimCall
         [ {-no results-} ]
         (MO_Memcpy (alignmentBytes align))
@@ -2941,7 +2941,7 @@ emitMemcpyCall dst src n align = do
 
 -- | Emit a call to @memmove@.
 emitMemmoveCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
-emitMemmoveCall dst src n align = do
+emitMemmoveCall dst src n align =
     emitPrimCall
         [ {- no results -} ]
         (MO_Memmove (alignmentBytes align))
@@ -2950,7 +2950,7 @@ emitMemmoveCall dst src n align = do
 -- | Emit a call to @memset@.  The second argument must fit inside an
 -- unsigned char.
 emitMemsetCall :: CmmExpr -> CmmExpr -> CmmExpr -> Alignment -> FCode ()
-emitMemsetCall dst c n align = do
+emitMemsetCall dst c n align =
     emitPrimCall
         [ {- no results -} ]
         (MO_Memset (alignmentBytes align))
@@ -2974,56 +2974,56 @@ emitMemcmpCall res ptr1 ptr2 n align = do
         (MO_Memcmp align)
         [ ptr1, ptr2, n ]
 
-    unless is32Bit $ do
+    unless is32Bit $
       emit $ mkAssign (CmmLocal res)
                       (CmmMachOp
                          (mo_s_32ToWord platform)
                          [(CmmReg (CmmLocal cres))])
 
 emitBSwapCall :: LocalReg -> CmmExpr -> Width -> FCode ()
-emitBSwapCall res x width = do
+emitBSwapCall res x width =
     emitPrimCall
         [ res ]
         (MO_BSwap width)
         [ x ]
 
 emitBRevCall :: LocalReg -> CmmExpr -> Width -> FCode ()
-emitBRevCall res x width = do
+emitBRevCall res x width =
     emitPrimCall
         [ res ]
         (MO_BRev width)
         [ x ]
 
 emitPopCntCall :: LocalReg -> CmmExpr -> Width -> FCode ()
-emitPopCntCall res x width = do
+emitPopCntCall res x width =
     emitPrimCall
         [ res ]
         (MO_PopCnt width)
         [ x ]
 
 emitPdepCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
-emitPdepCall res x y width = do
+emitPdepCall res x y width =
     emitPrimCall
         [ res ]
         (MO_Pdep width)
         [ x, y ]
 
 emitPextCall :: LocalReg -> CmmExpr -> CmmExpr -> Width -> FCode ()
-emitPextCall res x y width = do
+emitPextCall res x y width =
     emitPrimCall
         [ res ]
         (MO_Pext width)
         [ x, y ]
 
 emitClzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
-emitClzCall res x width = do
+emitClzCall res x width =
     emitPrimCall
         [ res ]
         (MO_Clz width)
         [ x ]
 
 emitCtzCall :: LocalReg -> CmmExpr -> Width -> FCode ()
-emitCtzCall res x width = do
+emitCtzCall res x width =
     emitPrimCall
         [ res ]
         (MO_Ctz width)
diff --git a/compiler/GHC/StgToCmm/Prof.hs b/compiler/GHC/StgToCmm/Prof.hs
index 355cc6a781..473e240a54 100644
--- a/compiler/GHC/StgToCmm/Prof.hs
+++ b/compiler/GHC/StgToCmm/Prof.hs
@@ -186,7 +186,7 @@ enterCostCentreThunk closure =
 
 enterCostCentreFun :: CostCentreStack -> CmmExpr -> FCode ()
 enterCostCentreFun ccs closure =
-  ifProfiling $ do
+  ifProfiling $
     if isCurrentCCS ccs
        then do platform <- getPlatform
                emitRtsCall rtsUnitId (fsLit "enterFunCCS")
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 190202efb9..dbb4481d72 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -608,7 +608,7 @@ whenUpdRemSetEnabled code = do
 -- remembered set.
 emitUpdRemSetPush :: CmmExpr   -- ^ value of pointer which was overwritten
                   -> FCode ()
-emitUpdRemSetPush ptr = do
+emitUpdRemSetPush ptr =
     emitRtsCall
       rtsUnitId
       (fsLit "updateRemembSetPushClosure_")
@@ -618,7 +618,7 @@ emitUpdRemSetPush ptr = do
 
 emitUpdRemSetPushThunk :: CmmExpr -- ^ the thunk
                        -> FCode ()
-emitUpdRemSetPushThunk ptr = do
+emitUpdRemSetPushThunk ptr =
     emitRtsCall
       rtsUnitId
       (fsLit "updateRemembSetPushThunk_")
diff --git a/compiler/GHC/SysTools/ExtraObj.hs b/compiler/GHC/SysTools/ExtraObj.hs
index 9208c3870d..1b728fb067 100644
--- a/compiler/GHC/SysTools/ExtraObj.hs
+++ b/compiler/GHC/SysTools/ExtraObj.hs
@@ -79,7 +79,7 @@ mkExtraObj dflags extn xs
 --
 mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath
 mkExtraObjToLinkIntoBinary dflags = do
-  when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do
+  when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $
      putLogMsg dflags NoReason SevInfo noSrcSpan
          $ withPprStyle defaultUserStyle
          (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$
diff --git a/compiler/GHC/SysTools/Info.hs b/compiler/GHC/SysTools/Info.hs
index fec6ecff15..fe848cbb12 100644
--- a/compiler/GHC/SysTools/Info.hs
+++ b/compiler/GHC/SysTools/Info.hs
@@ -119,9 +119,9 @@ getLinkerInfo' dflags = do
   let platform = targetPlatform dflags
       os = platformOS platform
       (pgm,args0) = pgm_l dflags
-      args1     = map Option (getOpts dflags opt_l)
-      args2     = args0 ++ args1
-      args3     = filter notNull (map showOpt args2)
+      args1       = map Option (getOpts dflags opt_l)
+      args2       = args0 ++ args1
+      args3       = filter notNull (map showOpt args2)
 
       -- Try to grab the info from the process output.
       parseLinkerInfo stdo _stde _exitc
@@ -142,68 +142,67 @@ getLinkerInfo' dflags = do
           return (GnuGold [Option "-Wl,--no-as-needed"])
 
         | any ("LLD" `isPrefixOf`) stdo =
-          return (LlvmLLD $ map Option [
-                                      -- see Note [ELF needed shared libs]
-                                      "-Wl,--no-as-needed"])
+          return (LlvmLLD $ map Option [ --see Note [ELF needed shared libs]
+                                        "-Wl,--no-as-needed"])
 
          -- Unknown linker.
         | otherwise = fail "invalid --version output, or linker is unsupported"
 
   -- Process the executable call
-  info <- catchIO (do
-             case os of
-               OSSolaris2 ->
-                 -- Solaris uses its own Solaris linker. Even all
-                 -- GNU C are recommended to configure with Solaris
-                 -- linker instead of using GNU binutils linker. Also
-                 -- all GCC distributed with Solaris follows this rule
-                 -- precisely so we assume here, the Solaris linker is
-                 -- used.
-                 return $ SolarisLD []
-               OSAIX ->
-                 -- IBM AIX uses its own non-binutils linker as well
-                 return $ AixLD []
-               OSDarwin ->
-                 -- Darwin has neither GNU Gold or GNU LD, but a strange linker
-                 -- that doesn't support --version. We can just assume that's
-                 -- what we're using.
-                 return $ DarwinLD []
-               OSMinGW32 ->
-                 -- GHC doesn't support anything but GNU ld on Windows anyway.
-                 -- Process creation is also fairly expensive on win32, so
-                 -- we short-circuit here.
-                 return $ GnuLD $ map Option
-                   [ -- Reduce ld memory usage
-                     "-Wl,--hash-size=31"
-                   , "-Wl,--reduce-memory-overheads"
-                     -- Emit gcc stack checks
-                     -- Note [Windows stack usage]
-                   , "-fstack-check"
-                     -- Force static linking of libGCC
-                     -- Note [Windows static libGCC]
-                   , "-static-libgcc" ]
-               _ -> do
-                 -- In practice, we use the compiler as the linker here. Pass
-                 -- -Wl,--version to get linker version info.
-                 (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
-                                        (["-Wl,--version"] ++ args3)
-                                        c_locale_env
-                 -- Split the output by lines to make certain kinds
-                 -- of processing easier. In particular, 'clang' and 'gcc'
-                 -- have slightly different outputs for '-Wl,--version', but
-                 -- it's still easy to figure out.
-                 parseLinkerInfo (lines stdo) (lines stde) exitc
-            )
-            (\err -> do
-                debugTraceMsg dflags 2
-                    (text "Error (figuring out linker information):" <+>
-                     text (show err))
-                errorMsg dflags $ hang (text "Warning:") 9 $
-                  text "Couldn't figure out linker information!" $$
-                  text "Make sure you're using GNU ld, GNU gold" <+>
-                  text "or the built in OS X linker, etc."
-                return UnknownLD)
-  return info
+  catchIO (
+    case os of
+      OSSolaris2 ->
+        -- Solaris uses its own Solaris linker. Even all
+        -- GNU C are recommended to configure with Solaris
+        -- linker instead of using GNU binutils linker. Also
+        -- all GCC distributed with Solaris follows this rule
+        -- precisely so we assume here, the Solaris linker is
+        -- used.
+        return $ SolarisLD []
+      OSAIX ->
+        -- IBM AIX uses its own non-binutils linker as well
+        return $ AixLD []
+      OSDarwin ->
+        -- Darwin has neither GNU Gold or GNU LD, but a strange linker
+        -- that doesn't support --version. We can just assume that's
+        -- what we're using.
+        return $ DarwinLD []
+      OSMinGW32 ->
+        -- GHC doesn't support anything but GNU ld on Windows anyway.
+        -- Process creation is also fairly expensive on win32, so
+        -- we short-circuit here.
+        return $ GnuLD $ map Option
+          [ -- Reduce ld memory usage
+            "-Wl,--hash-size=31"
+          , "-Wl,--reduce-memory-overheads"
+            -- Emit gcc stack checks
+            -- Note [Windows stack usage]
+          , "-fstack-check"
+            -- Force static linking of libGCC
+            -- Note [Windows static libGCC]
+          , "-static-libgcc" ]
+      _ -> do
+        -- In practice, we use the compiler as the linker here. Pass
+        -- -Wl,--version to get linker version info.
+        (exitc, stdo, stde) <- readProcessEnvWithExitCode pgm
+                               (["-Wl,--version"] ++ args3)
+                               c_locale_env
+        -- Split the output by lines to make certain kinds
+        -- of processing easier. In particular, 'clang' and 'gcc'
+        -- have slightly different outputs for '-Wl,--version', but
+        -- it's still easy to figure out.
+        parseLinkerInfo (lines stdo) (lines stde) exitc
+    )
+    (\err -> do
+        debugTraceMsg dflags 2
+            (text "Error (figuring out linker information):" <+>
+             text (show err))
+        errorMsg dflags $ hang (text "Warning:") 9 $
+          text "Couldn't figure out linker information!" $$
+          text "Make sure you're using GNU ld, GNU gold" <+>
+          text "or the built in OS X linker, etc."
+        return UnknownLD
+    )
 
 -- Grab compiler info and cache it in DynFlags.
 getCompilerInfo :: DynFlags -> IO CompilerInfo
@@ -244,19 +243,19 @@ getCompilerInfo' dflags = do
         | otherwise = fail $ "invalid -v output, or compiler is unsupported: " ++ unlines stde
 
   -- Process the executable call
-  info <- catchIO (do
-                (exitc, stdo, stde) <-
-                    readProcessEnvWithExitCode pgm ["-v"] c_locale_env
-                -- Split the output by lines to make certain kinds
-                -- of processing easier.
-                parseCompilerInfo (lines stdo) (lines stde) exitc
-            )
-            (\err -> do
-                debugTraceMsg dflags 2
-                    (text "Error (figuring out C compiler information):" <+>
-                     text (show err))
-                errorMsg dflags $ hang (text "Warning:") 9 $
-                  text "Couldn't figure out C compiler information!" $$
-                  text "Make sure you're using GNU gcc, or clang"
-                return UnknownCC)
-  return info
+  catchIO (do
+      (exitc, stdo, stde) <-
+          readProcessEnvWithExitCode pgm ["-v"] c_locale_env
+      -- Split the output by lines to make certain kinds
+      -- of processing easier.
+      parseCompilerInfo (lines stdo) (lines stde) exitc
+      )
+      (\err -> do
+          debugTraceMsg dflags 2
+              (text "Error (figuring out C compiler information):" <+>
+               text (show err))
+          errorMsg dflags $ hang (text "Warning:") 9 $
+            text "Couldn't figure out C compiler information!" $$
+            text "Make sure you're using GNU gcc, or clang"
+          return UnknownCC
+      )
diff --git a/compiler/GHC/SysTools/Process.hs b/compiler/GHC/SysTools/Process.hs
index 009723f795..62f3f0d258 100644
--- a/compiler/GHC/SysTools/Process.hs
+++ b/compiler/GHC/SysTools/Process.hs
@@ -203,7 +203,7 @@ runSomethingFiltered
   :: DynFlags -> (String->String) -> String -> String -> [Option]
   -> Maybe FilePath -> Maybe [(String,String)] -> IO ()
 
-runSomethingFiltered dflags filter_fn phase_name pgm args mb_cwd mb_env = do
+runSomethingFiltered dflags filter_fn phase_name pgm args mb_cwd mb_env =
     runSomethingWith dflags phase_name pgm args $ \real_args -> do
         r <- builderMainLoop dflags filter_fn pgm real_args mb_cwd mb_env
         return (r,())
@@ -325,12 +325,12 @@ readerProc chan hdl filter_fn =
         loop (l:ls) in_err     =
                 case in_err of
                   Just err@(BuildError srcLoc msg)
-                    | leading_whitespace l -> do
+                    | leading_whitespace l ->
                         loop ls (Just (BuildError srcLoc (msg $$ text l)))
                     | otherwise -> do
                         writeChan chan err
                         checkError l ls
-                  Nothing -> do
+                  Nothing ->
                         checkError l ls
                   _ -> panic "readerProc/loop"
 
diff --git a/compiler/GHC/SysTools/Tasks.hs b/compiler/GHC/SysTools/Tasks.hs
index 4e78f52f34..8b6bd70bbd 100644
--- a/compiler/GHC/SysTools/Tasks.hs
+++ b/compiler/GHC/SysTools/Tasks.hs
@@ -191,9 +191,8 @@ runClang dflags args = traceToolCommand dflags "clang" $ do
       args1 = map Option (getOpts dflags opt_a)
       args2 = args0 ++ args1 ++ args
   mb_env <- getGccEnv args2
-  catch (do
-        runSomethingFiltered dflags id "Clang (Assembler)" clang args2 Nothing mb_env
-    )
+  catch
+    (runSomethingFiltered dflags id "Clang (Assembler)" clang args2 Nothing mb_env)
     (\(err :: SomeException) -> do
         errorMsg dflags $
             text ("Error running clang! you need clang installed to use the" ++
diff --git a/compiler/GHC/Tc/Deriv.hs b/compiler/GHC/Tc/Deriv.hs
index 7661000723..9e9adbb961 100644
--- a/compiler/GHC/Tc/Deriv.hs
+++ b/compiler/GHC/Tc/Deriv.hs
@@ -26,11 +26,10 @@ import GHC.Tc.Types.Origin
 import GHC.Core.Predicate
 import GHC.Tc.Deriv.Infer
 import GHC.Tc.Deriv.Utils
-import GHC.Tc.Validity( allDistinctTyVars )
 import GHC.Tc.TyCl.Class( instDeclCtxt3, tcATDefault )
 import GHC.Tc.Utils.Env
 import GHC.Tc.Deriv.Generate
-import GHC.Tc.Validity( checkValidInstHead )
+import GHC.Tc.Validity( allDistinctTyVars, checkValidInstHead )
 import GHC.Core.InstEnv
 import GHC.Tc.Utils.Instantiate
 import GHC.Core.FamInstEnv
diff --git a/compiler/GHC/Tc/Deriv/Infer.hs b/compiler/GHC/Tc/Deriv/Infer.hs
index eb81587eb7..d65564d1da 100644
--- a/compiler/GHC/Tc/Deriv/Infer.hs
+++ b/compiler/GHC/Tc/Deriv/Infer.hs
@@ -368,8 +368,7 @@ inferConstraintsAnyclass
                     ; return (mkThetaOrigin (mkDerivOrigin wildcard) TypeLevel
                                 meth_tvs dm_tvs meth_theta (tau_eq:dm_theta)) }
 
-       ; theta_origins <- lift $ mapM do_one_meth gen_dms
-       ; return theta_origins }
+       ; lift $ mapM do_one_meth gen_dms }
 
 -- Like 'inferConstraints', but used only for @GeneralizedNewtypeDeriving@ and
 -- @DerivingVia@. Since both strategies generate code involving 'coerce', the
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index 298ea5b138..15ca20b738 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -513,8 +513,7 @@ tcExpr (HsMultiIf _ alts) res_ty
   where match_ctxt = MC { mc_what = IfAlt, mc_body = tcBody }
 
 tcExpr (HsDo _ do_or_lc stmts) res_ty
-  = do { expr' <- tcDoStmts do_or_lc stmts res_ty
-       ; return expr' }
+  = tcDoStmts do_or_lc stmts res_ty
 
 tcExpr (HsProc x pat cmd) res_ty
   = do  { (pat', cmd', coi) <- tcProc pat cmd res_ty
@@ -1691,7 +1690,7 @@ checkClosedInStaticForm name = do
     checkClosed type_env n = checkLoop type_env (unitNameSet n) n
 
     checkLoop :: TcTypeEnv -> NameSet -> Name -> Maybe NotClosedReason
-    checkLoop type_env visited n = do
+    checkLoop type_env visited n =
       -- The @visited@ set is an accumulating parameter that contains the set of
       -- visited nodes, so we avoid repeating cycles in the traversal.
       case lookupNameEnv type_env n of
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 9c67345b7f..889923743c 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -77,7 +77,6 @@ import GHC.Tc.Types.Origin
 import GHC.Core.Predicate
 import GHC.Tc.Types.Constraint
 import GHC.Tc.Utils.Env
-import GHC.Tc.Utils.Instantiate( tcInstInvisibleTyBinders )
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Validity
 import GHC.Tc.Utils.Unify
@@ -87,7 +86,8 @@ import GHC.Tc.Utils.Zonk
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr
 import GHC.Tc.Utils.TcType
-import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBindersN, tcInstInvisibleTyBinder )
+import GHC.Tc.Utils.Instantiate ( tcInstInvisibleTyBinders, tcInstInvisibleTyBindersN,
+                                  tcInstInvisibleTyBinder )
 import GHC.Core.Type
 import GHC.Builtin.Types.Prim
 import GHC.Types.Name.Env
diff --git a/compiler/GHC/Tc/Instance/Class.hs b/compiler/GHC/Tc/Instance/Class.hs
index 2e94d477b1..d15777cc5f 100644
--- a/compiler/GHC/Tc/Instance/Class.hs
+++ b/compiler/GHC/Tc/Instance/Class.hs
@@ -15,14 +15,14 @@ import GHC.Prelude
 
 import GHC.Driver.Session
 
+
 import GHC.Tc.Utils.Env
 import GHC.Tc.Utils.Monad
 import GHC.Tc.Utils.TcType
-import GHC.Tc.Utils.Instantiate( tcInstType )
+import GHC.Tc.Utils.Instantiate(instDFunType, tcInstType)
 import GHC.Tc.Instance.Typeable
 import GHC.Tc.Utils.TcMType
 import GHC.Tc.Types.Evidence
-import GHC.Tc.Utils.Instantiate( instDFunType )
 import GHC.Tc.Instance.Family( tcGetFamInstEnvs, tcInstNewTyCon_maybe, tcLookupDataFamInst )
 import GHC.Rename.Env( addUsedGRE )
 
diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs
index 94582b00a9..40a59f965d 100644
--- a/compiler/GHC/Tc/Module.hs
+++ b/compiler/GHC/Tc/Module.hs
@@ -2852,7 +2852,7 @@ loadUnqualIfaces :: HscEnv -> InteractiveContext -> TcM ()
 -- This is so that we can accurately report the instances for
 -- something
 loadUnqualIfaces hsc_env ictxt
-  = initIfaceTcRn $ do
+  = initIfaceTcRn $
     mapM_ (loadSysInterface doc) (moduleSetElts (mkModuleSet unqual_mods))
   where
     home_unit = hsc_home_unit hsc_env
@@ -3044,7 +3044,7 @@ withTcPlugins hsc_env m =
                 (solvers,stops) <- unzip `fmap` mapM (startPlugin ev_binds_var) plugins
                 -- This ensures that tcPluginStop is called even if a type
                 -- error occurs during compilation (Fix of #10078)
-                eitherRes <- tryM $ do
+                eitherRes <- tryM $
                   updGblEnv (\e -> e { tcg_tc_plugins = solvers }) m
                 mapM_ (flip runTcPluginM ev_binds_var) stops
                 case eitherRes of
@@ -3066,7 +3066,7 @@ withHoleFitPlugins hsc_env m =
     plugins -> do (plugins,stops) <- unzip `fmap` mapM startPlugin plugins
                   -- This ensures that hfPluginStop is called even if a type
                   -- error occurs during compilation.
-                  eitherRes <- tryM $ do
+                  eitherRes <- tryM $
                     updGblEnv (\e -> e { tcg_hf_plugins = plugins }) m
                   sequence_ stops
                   case eitherRes of
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index 7f4bcdf871..bf7e9b239e 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -1831,7 +1831,6 @@ solveImplication imp@(Implic { ic_tclvl  = tclvl
 
        ; return (floated_eqs, res_implic) }
 
-  where
     -- TcLevels must be strictly increasing (see (ImplicInv) in
     -- Note [TcLevel and untouchable type variables] in GHC.Tc.Utils.TcType),
     -- and in fact I think they should always increase one level at a time.
@@ -2245,8 +2244,6 @@ approximateWC float_past_equalities wc
     float_wc trapping_tvs (WC { wc_simple = simples, wc_impl = implics })
       = filterBag (is_floatable trapping_tvs) simples `unionBags`
         concatMapBag (float_implic trapping_tvs) implics
-      where
-
     float_implic :: TcTyCoVarSet -> Implication -> Cts
     float_implic trapping_tvs imp
       | float_past_equalities || ic_no_eqs imp
diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs
index ad276aa5d2..baa132c2b6 100644
--- a/compiler/GHC/Tc/Solver/Interact.hs
+++ b/compiler/GHC/Tc/Solver/Interact.hs
@@ -15,23 +15,21 @@ import GHC.Types.Basic ( SwapFlag(..), isSwapped,
                          infinity, IntWithInf, intGtLimit )
 import GHC.Tc.Solver.Canonical
 import GHC.Tc.Solver.Flatten
-import GHC.Tc.Utils.Unify( canSolveByUnification )
+import GHC.Tc.Utils.Unify ( canSolveByUnification )
 import GHC.Types.Var.Set
 import GHC.Core.Type as Type
 import GHC.Core.Coercion        ( BlockSubstFlag(..) )
 import GHC.Core.InstEnv         ( DFunInstType )
-import GHC.Core.Coercion.Axiom  ( sfInteractTop, sfInteractInert )
 
 import GHC.Types.Var
 import GHC.Tc.Utils.TcType
-import GHC.Builtin.Names ( coercibleTyConKey,
-                   heqTyConKey, eqTyConKey, ipClassKey )
-import GHC.Core.Coercion.Axiom ( TypeEqn, CoAxiom(..), CoAxBranch(..), fromBranches )
+import GHC.Builtin.Names ( coercibleTyConKey, heqTyConKey, eqTyConKey, ipClassKey )
+import GHC.Core.Coercion.Axiom ( CoAxBranch (..), CoAxiom (..), TypeEqn, fromBranches, sfInteractInert, sfInteractTop )
 import GHC.Core.Class
 import GHC.Core.TyCon
 import GHC.Tc.Instance.FunDeps
 import GHC.Tc.Instance.Family
-import GHC.Tc.Instance.Class( InstanceWhat(..), safeOverlap )
+import GHC.Tc.Instance.Class ( InstanceWhat(..), safeOverlap )
 import GHC.Core.FamInstEnv
 import GHC.Core.Unify ( tcUnifyTyWithTFs, ruleMatchTyKiX )
 
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs
index 1d8ccb7933..311eadc72e 100644
--- a/compiler/GHC/Tc/Solver/Monad.hs
+++ b/compiler/GHC/Tc/Solver/Monad.hs
@@ -3616,8 +3616,7 @@ emitNewDerivedEq loc role ty1 ty2
 
 newDerivedNC :: CtLoc -> TcPredType -> TcS CtEvidence
 newDerivedNC loc pred
-  = do { -- checkReductionDepth loc pred
-       ; return (CtDerived { ctev_pred = pred, ctev_loc = loc }) }
+  = return $ CtDerived { ctev_pred = pred, ctev_loc = loc }
 
 -- --------- Check done in GHC.Tc.Solver.Interact.selectNewWorkItem???? ---------
 -- | Checks if the depth of the given location is too much. Fails if
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index e470b21ce6..014a5027a4 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -813,7 +813,6 @@ mkPatSynBuilderId dir (L _ name)
              builder_id'    = modifyIdInfo (`setLevityInfoWithType` pat_ty) builder_id
 
        ; return (Just (builder_id', need_dummy_arg)) }
-  where
 
 tcPatSynBuilderBind :: PatSynBind GhcRn GhcRn
                     -> TcM (LHsBinds GhcTc)
diff --git a/compiler/GHC/Tc/TyCl/Utils.hs b/compiler/GHC/Tc/TyCl/Utils.hs
index 8755fbf762..b9fb54cc9f 100644
--- a/compiler/GHC/Tc/TyCl/Utils.hs
+++ b/compiler/GHC/Tc/TyCl/Utils.hs
@@ -201,7 +201,7 @@ checkTyConIsAcyclic tc m = SynCycleM $ \s ->
 -- the corresponding @LTyClDecl Name@ for each 'TyCon', so we
 -- can give better error messages.
 checkSynCycles :: Unit -> [TyCon] -> [LTyClDecl GhcRn] -> TcM ()
-checkSynCycles this_uid tcs tyclds = do
+checkSynCycles this_uid tcs tyclds =
     case runSynCycleM (mapM_ (go emptyTyConSet []) tcs) emptyTyConSet of
         Left (loc, err) -> setSrcSpan loc $ failWithTc err
         Right _  -> return ()
@@ -775,8 +775,7 @@ addTyConsToGblEnv tyclss
     do { traceTc "tcAddTyCons" $ vcat
             [ text "tycons" <+> ppr tyclss
             , text "implicits" <+> ppr implicit_things ]
-       ; gbl_env <- tcRecSelBinds (mkRecSelBinds tyclss)
-       ; return gbl_env }
+       ; tcRecSelBinds (mkRecSelBinds tyclss) }
  where
    implicit_things = concatMap implicitTyConThings tyclss
    def_meth_ids    = mkDefaultMethodIds tyclss
diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs
index f44f10b3a6..127723d4f7 100644
--- a/compiler/GHC/Tc/Types/Evidence.hs
+++ b/compiler/GHC/Tc/Types/Evidence.hs
@@ -69,8 +69,7 @@ import GHC.Core.Ppr ()   -- Instance OutputableBndr TyVar
 import GHC.Tc.Utils.TcType
 import GHC.Core.Type
 import GHC.Core.TyCon
-import GHC.Core.DataCon( DataCon, dataConWrapId )
-import GHC.Core.Class( Class )
+import GHC.Core.DataCon ( DataCon, dataConWrapId )
 import GHC.Builtin.Names
 import GHC.Types.Var.Env
 import GHC.Types.Var.Set
@@ -79,7 +78,7 @@ import GHC.Types.Name
 import GHC.Data.Pair
 
 import GHC.Core
-import GHC.Core.Class ( classSCSelId )
+import GHC.Core.Class (Class, classSCSelId )
 import GHC.Core.FVs   ( exprSomeFreeVars )
 
 import GHC.Utils.Misc
diff --git a/compiler/GHC/Tc/Utils/Env.hs b/compiler/GHC/Tc/Utils/Env.hs
index 7755d3370d..61d0cdcd47 100644
--- a/compiler/GHC/Tc/Utils/Env.hs
+++ b/compiler/GHC/Tc/Utils/Env.hs
@@ -520,14 +520,15 @@ tcExtendNameTyVarEnv :: [(Name,TcTyVar)] -> TcM r -> TcM r
 tcExtendNameTyVarEnv binds thing_inside
   -- this should be used only for explicitly mentioned scoped variables.
   -- thus, no coercion variables
-  = do { tc_extend_local_env NotTopLevel
-                    [(name, ATyVar name tv) | (name, tv) <- binds] $
-         tcExtendBinderStack tv_binds $
-         thing_inside }
+  = tc_extend_local_env NotTopLevel names $
+        tcExtendBinderStack tv_binds $
+        thing_inside
   where
     tv_binds :: [TcBinder]
     tv_binds = [TcTvBndr name tv | (name,tv) <- binds]
 
+    names = [(name, ATyVar name tv) | (name, tv) <- binds]
+
 isTypeClosedLetBndr :: Id -> Bool
 -- See Note [Bindings with closed types] in GHC.Tc.Types
 isTypeClosedLetBndr = noFreeVarsOfType . idType
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index 5416e29692..6940d161d6 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -11,31 +11,31 @@
 -}
 
 module GHC.Tc.Utils.Instantiate (
-       topSkolemise,
-       topInstantiate, instantiateSigma,
-       instCall, instDFunType, instStupidTheta, instTyVarsWith,
-       newWanted, newWanteds,
+     topSkolemise,
+     topInstantiate, instantiateSigma,
+     instCall, instDFunType, instStupidTheta, instTyVarsWith,
+     newWanted, newWanteds,
 
-       tcInstType, tcInstTypeBndrs,
-       tcInstSkolTyVars, tcInstSkolTyVarsX, tcInstSkolTyVarsAt,
-       tcSkolDFunType, tcSuperSkolTyVars, tcInstSuperSkolTyVarsX,
+     tcInstType, tcInstTypeBndrs,
+     tcInstSkolTyVars, tcInstSkolTyVarsX, tcInstSkolTyVarsAt,
+     tcSkolDFunType, tcSuperSkolTyVars, tcInstSuperSkolTyVarsX,
 
-       freshenTyVarBndrs, freshenCoVarBndrsX,
+     freshenTyVarBndrs, freshenCoVarBndrsX,
 
-       tcInstInvisibleTyBindersN, tcInstInvisibleTyBinders, tcInstInvisibleTyBinder,
+     tcInstInvisibleTyBindersN, tcInstInvisibleTyBinders, tcInstInvisibleTyBinder,
 
-       newOverloadedLit, mkOverLit,
+     newOverloadedLit, mkOverLit,
 
-       newClsInst,
-       tcGetInsts, tcGetInstEnvs, getOverlapFlag,
-       tcExtendLocalInstEnv,
-       instCallConstraints, newMethodFromName,
-       tcSyntaxName,
+     newClsInst,
+     tcGetInsts, tcGetInstEnvs, getOverlapFlag,
+     tcExtendLocalInstEnv,
+     instCallConstraints, newMethodFromName,
+     tcSyntaxName,
 
-       -- Simple functions over evidence variables
-       tyCoVarsOfWC,
-       tyCoVarsOfCt, tyCoVarsOfCts,
-    ) where
+     -- Simple functions over evidence variables
+     tyCoVarsOfWC,
+     tyCoVarsOfCt, tyCoVarsOfCts,
+  ) where
 
 #include "HsVersions.h"
 
@@ -50,13 +50,12 @@ import GHC.Hs
 
 import GHC.Core.InstEnv
 import GHC.Core.Predicate
-import GHC.Core    ( isOrphan )
+import GHC.Core ( Expr(..), isOrphan ) -- For the Coercion constructor
 import GHC.Core.Type
 import GHC.Core.Multiplicity
 import GHC.Core.TyCo.Rep
 import GHC.Core.TyCo.Ppr ( debugPprType )
 import GHC.Core.Class( Class )
-import GHC.Core( Expr(..) )  -- For the Coercion constructor
 import GHC.Core.DataCon
 
 import {-# SOURCE #-}   GHC.Tc.Gen.Expr( tcCheckPolyExpr, tcSyntaxOp )
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index e42fe42799..a040cca093 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -746,14 +746,14 @@ formatTraceMsg :: String -> SDoc -> SDoc
 formatTraceMsg herald doc = hang (text herald) 2 doc
 
 traceOptTcRn :: DumpFlag -> SDoc -> TcRn ()
-traceOptTcRn flag doc = do
+traceOptTcRn flag doc =
   whenDOptM flag $
     dumpTcRn False (dumpOptionsFromFlag flag) "" FormatText doc
 {-# INLINE traceOptTcRn #-} -- see Note [INLINE conditional tracing utilities]
 
 -- | Dump if the given 'DumpFlag' is set.
 dumpOptTcRn :: DumpFlag -> String -> DumpFormat -> SDoc -> TcRn ()
-dumpOptTcRn flag title fmt doc = do
+dumpOptTcRn flag title fmt doc =
   whenDOptM flag $
     dumpTcRn False (dumpOptionsFromFlag flag) title fmt doc
 {-# INLINE dumpOptTcRn #-} -- see Note [INLINE conditional tracing utilities]
@@ -2053,43 +2053,43 @@ failIfM msg
         ; failM }
 
 --------------------
-forkM_maybe :: SDoc -> IfL a -> IfL (Maybe a)
--- Run thing_inside in an interleaved thread.
+
+-- | Run thing_inside in an interleaved thread.
 -- It shares everything with the parent thread, so this is DANGEROUS.
 --
 -- It returns Nothing if the computation fails
 --
 -- It's used for lazily type-checking interface
--- signatures, which is pretty benign
-
+-- signatures, which is pretty benign.
+--
+-- See Note [Masking exceptions in forkM_maybe]
+forkM_maybe :: SDoc -> IfL a -> IfL (Maybe a)
 forkM_maybe doc thing_inside
- = do { -- see Note [Masking exceptions in forkM_maybe]
-      ; unsafeInterleaveM $ uninterruptibleMaskM_ $
-        do { traceIf (text "Starting fork {" <+> doc)
-           ; mb_res <- tryM $
-                       updLclEnv (\env -> env { if_loc = if_loc env $$ doc }) $
-                       thing_inside
-           ; case mb_res of
-                Right r  -> do  { traceIf (text "} ending fork" <+> doc)
-                                ; return (Just r) }
-                Left exn -> do {
-
-                    -- Bleat about errors in the forked thread, if -ddump-if-trace is on
-                    -- Otherwise we silently discard errors. Errors can legitimately
-                    -- happen when compiling interface signatures (see tcInterfaceSigs)
-                      whenDOptM Opt_D_dump_if_trace $ do
-                          dflags <- getDynFlags
-                          let msg = hang (text "forkM failed:" <+> doc)
-                                       2 (text (show exn))
-                          liftIO $ putLogMsg dflags
-                                             NoReason
-                                             SevFatal
-                                             noSrcSpan
-                                             $ withPprStyle defaultErrStyle msg
-
-                    ; traceIf (text "} ending fork (badly)" <+> doc)
-                    ; return Nothing }
-        }}
+ = unsafeInterleaveM $ uninterruptibleMaskM_ $
+    do { traceIf (text "Starting fork {" <+> doc)
+       ; mb_res <- tryM $
+                   updLclEnv (\env -> env { if_loc = if_loc env $$ doc }) $
+                   thing_inside
+       ; case mb_res of
+            Right r  -> do  { traceIf (text "} ending fork" <+> doc)
+                            ; return (Just r) }
+            Left exn -> do {
+                -- Bleat about errors in the forked thread, if -ddump-if-trace is on
+                -- Otherwise we silently discard errors. Errors can legitimately
+                -- happen when compiling interface signatures (see tcInterfaceSigs)
+                  whenDOptM Opt_D_dump_if_trace $ do
+                      dflags <- getDynFlags
+                      let msg = hang (text "forkM failed:" <+> doc)
+                                   2 (text (show exn))
+                      liftIO $ putLogMsg dflags
+                                         NoReason
+                                         SevFatal
+                                         noSrcSpan
+                                         $ withPprStyle defaultErrStyle msg
+
+                ; traceIf (text "} ending fork (badly)" <+> doc)
+                ; return Nothing }
+    }
 
 forkM :: SDoc -> IfL a -> IfL a
 forkM doc thing_inside
diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs
index 0130989940..26325cf7bc 100644
--- a/compiler/GHC/ThToHs.hs
+++ b/compiler/GHC/ThToHs.hs
@@ -1019,7 +1019,7 @@ cvtl e = wrapL (cvt e)
                               -- constructor names - see #14627.
                               { s' <- vcName s
                               ; return $ HsVar noExtField (noLoc s') }
-    cvt (LabelE s)       = do { return $ HsOverLabel noExtField Nothing (fsLit s) }
+    cvt (LabelE s)       = return $ HsOverLabel noExtField Nothing (fsLit s)
     cvt (ImplicitParamVarE n) = do { n' <- ipName n; return $ HsIPVar noExtField n' }
 
 {- | #16895 Ensure an infix expression's operator is a variable/constructor.
@@ -1497,7 +1497,7 @@ cvtTypeKind ty_str ty
                 tys'
            ListT
              | Just normals <- m_normals
-             , [x'] <- normals -> do
+             , [x'] <- normals ->
                 returnL (HsListTy noExtField x')
              | otherwise
              -> mk_apps
@@ -1584,8 +1584,7 @@ cvtTypeKind ty_str ty
                           -- in Language.Haskell.TH.Syntax
               | Just normals <- m_normals
               , [ty1, L _ (HsExplicitListTy _ ip tys2)] <- normals
-              -> do
-                  returnL (HsExplicitListTy noExtField ip (ty1:tys2))
+              -> returnL (HsExplicitListTy noExtField ip (ty1:tys2))
               | otherwise
               -> mk_apps
                  (HsTyVar noExtField IsPromoted (noLoc (getRdrName consDataCon)))
diff --git a/compiler/GHC/Types/Basic.hs b/compiler/GHC/Types/Basic.hs
index 0f6f728da6..3b2f1a3140 100644
--- a/compiler/GHC/Types/Basic.hs
+++ b/compiler/GHC/Types/Basic.hs
@@ -525,15 +525,15 @@ instance Outputable RecFlag where
   ppr NonRecursive = text "NonRecursive"
 
 instance Binary RecFlag where
-    put_ bh Recursive = do
+    put_ bh Recursive =
             putByte bh 0
-    put_ bh NonRecursive = do
+    put_ bh NonRecursive =
             putByte bh 1
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return Recursive
-              _ -> do return NonRecursive
+              0 -> return Recursive
+              _ -> return NonRecursive
 
 {-
 ************************************************************************
@@ -819,9 +819,9 @@ instance Binary TupleSort where
     get bh = do
       h <- getByte bh
       case h of
-        0 -> do return BoxedTuple
-        1 -> do return UnboxedTuple
-        _ -> do return ConstraintTuple
+        0 -> return BoxedTuple
+        1 -> return UnboxedTuple
+        _ -> return ConstraintTuple
 
 
 tupleSortBoxity :: TupleSort -> Boxity
@@ -1483,11 +1483,11 @@ instance Outputable Activation where
    ppr FinalActive        = text "[final]"
 
 instance Binary Activation where
-    put_ bh NeverActive = do
+    put_ bh NeverActive =
             putByte bh 0
-    put_ bh FinalActive = do
+    put_ bh FinalActive =
             putByte bh 1
-    put_ bh AlwaysActive = do
+    put_ bh AlwaysActive =
             putByte bh 2
     put_ bh (ActiveBefore src aa) = do
             putByte bh 3
@@ -1500,9 +1500,9 @@ instance Binary Activation where
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return NeverActive
-              1 -> do return FinalActive
-              2 -> do return AlwaysActive
+              0 -> return NeverActive
+              1 -> return FinalActive
+              2 -> return AlwaysActive
               3 -> do src <- get bh
                       aa <- get bh
                       return (ActiveBefore src aa)
diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs
index 0bb615a1c4..61f6b87c88 100644
--- a/compiler/GHC/Types/CostCentre.hs
+++ b/compiler/GHC/Types/CostCentre.hs
@@ -317,7 +317,7 @@ costCentreSrcSpan :: CostCentre -> SrcSpan
 costCentreSrcSpan = cc_loc
 
 instance Binary CCFlavour where
-    put_ bh CafCC = do
+    put_ bh CafCC =
             putByte bh 0
     put_ bh (ExprCC i) = do
             putByte bh 1
@@ -331,10 +331,10 @@ instance Binary CCFlavour where
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return CafCC
+              0 -> return CafCC
               1 -> ExprCC <$> get bh
               2 -> DeclCC <$> get bh
-              _ -> HpcCC <$> get bh
+              _ -> HpcCC  <$> get bh
 
 instance Binary CostCentre where
     put_ bh (NormalCC aa ab ac _ad) = do
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index b01bb8f444..f84e3c0bc2 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -1950,8 +1950,8 @@ out how deeply we can unpack x, or that we do not have to pass y.
 -}
 
 instance Binary StrDmd where
-  put_ bh HyperStr     = do putByte bh 0
-  put_ bh HeadStr      = do putByte bh 1
+  put_ bh HyperStr     = putByte bh 0
+  put_ bh HeadStr      = putByte bh 1
   put_ bh (SCall s)    = do putByte bh 2
                             put_ bh s
   put_ bh (SProd sx)   = do putByte bh 3
@@ -1959,17 +1959,17 @@ instance Binary StrDmd where
   get bh = do
          h <- getByte bh
          case h of
-           0 -> do return HyperStr
-           1 -> do return HeadStr
+           0 -> return HyperStr
+           1 -> return HeadStr
            2 -> do s  <- get bh
                    return (SCall s)
            _ -> do sx <- get bh
                    return (SProd sx)
 
 instance Binary ArgStr where
-    put_ bh Lazy         = do
+    put_ bh Lazy =
             putByte bh 0
-    put_ bh (Str s)    = do
+    put_ bh (Str s) = do
             putByte bh 1
             put_ bh s
 
@@ -1981,8 +1981,8 @@ instance Binary ArgStr where
                       return $ Str s
 
 instance Binary Count where
-    put_ bh One  = do putByte bh 0
-    put_ bh Many = do putByte bh 1
+    put_ bh One  = putByte bh 0
+    put_ bh Many = putByte bh 1
 
     get  bh = do h <- getByte bh
                  case h of
@@ -1990,9 +1990,9 @@ instance Binary Count where
                    _ -> return Many
 
 instance Binary ArgUse where
-    put_ bh Abs          = do
+    put_ bh Abs =
             putByte bh 0
-    put_ bh (Use c u)    = do
+    put_ bh (Use c u) = do
             putByte bh 1
             put_ bh c
             put_ bh u
@@ -2001,16 +2001,14 @@ instance Binary ArgUse where
             h <- getByte bh
             case h of
               0 -> return Abs
-              _ -> do c  <- get bh
-                      u  <- get bh
-                      return $ Use c u
+              _ -> Use <$> get bh <*> get bh
 
 instance Binary UseDmd where
-    put_ bh Used         = do
+    put_ bh Used =
             putByte bh 0
-    put_ bh UHead        = do
+    put_ bh UHead =
             putByte bh 1
-    put_ bh (UCall c u)    = do
+    put_ bh (UCall c u) = do
             putByte bh 2
             put_ bh c
             put_ bh u
@@ -2031,17 +2029,11 @@ instance Binary UseDmd where
 
 instance (Binary s, Binary u) => Binary (JointDmd s u) where
     put_ bh (JD { sd = x, ud = y }) = do put_ bh x; put_ bh y
-    get  bh = do
-              x <- get bh
-              y <- get bh
-              return $ JD { sd = x, ud = y }
+    get  bh = JD <$> get bh <*> get bh
 
 instance Binary StrictSig where
-    put_ bh (StrictSig aa) = do
-            put_ bh aa
-    get bh = do
-          aa <- get bh
-          return (StrictSig aa)
+    put_ bh (StrictSig aa) = put_ bh aa
+    get bh = StrictSig <$> get bh
 
 instance Binary DmdType where
   -- Ignore DmdEnv when spitting out the DmdType
diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs
index 52fe3837b7..cb624c6c99 100644
--- a/compiler/GHC/Types/Error.hs
+++ b/compiler/GHC/Types/Error.hs
@@ -159,9 +159,8 @@ getSeverityColour _          = const mempty
 
 getCaretDiagnostic :: Severity -> SrcSpan -> IO MsgDoc
 getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty
-getCaretDiagnostic severity (RealSrcSpan span _) = do
+getCaretDiagnostic severity (RealSrcSpan span _) =
   caretDiagnostic <$> getSrcLine (srcSpanFile span) row
-
   where
     getSrcLine fn i =
       getLine i (unpackFS fn)
diff --git a/compiler/GHC/Types/Fixity.hs b/compiler/GHC/Types/Fixity.hs
index fb8807ab9d..1eca7592c5 100644
--- a/compiler/GHC/Types/Fixity.hs
+++ b/compiler/GHC/Types/Fixity.hs
@@ -57,18 +57,18 @@ instance Outputable FixityDirection where
     ppr InfixN = text "infix"
 
 instance Binary FixityDirection where
-    put_ bh InfixL = do
+    put_ bh InfixL =
             putByte bh 0
-    put_ bh InfixR = do
+    put_ bh InfixR =
             putByte bh 1
-    put_ bh InfixN = do
+    put_ bh InfixN =
             putByte bh 2
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return InfixL
-              1 -> do return InfixR
-              _ -> do return InfixN
+              0 -> return InfixL
+              1 -> return InfixR
+              _ -> return InfixN
 
 ------------------------
 maxPrecedence, minPrecedence :: Int
diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs
index bf10a9a197..0951016524 100644
--- a/compiler/GHC/Types/ForeignCall.hs
+++ b/compiler/GHC/Types/ForeignCall.hs
@@ -266,18 +266,18 @@ instance Binary ForeignCall where
     get bh = do aa <- get bh; return (CCall aa)
 
 instance Binary Safety where
-    put_ bh PlaySafe = do
+    put_ bh PlaySafe =
             putByte bh 0
-    put_ bh PlayInterruptible = do
+    put_ bh PlayInterruptible =
             putByte bh 1
-    put_ bh PlayRisky = do
+    put_ bh PlayRisky =
             putByte bh 2
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return PlaySafe
-              1 -> do return PlayInterruptible
-              _ -> do return PlayRisky
+              0 -> return PlaySafe
+              1 -> return PlayInterruptible
+              _ -> return PlayRisky
 
 instance Binary CExportSpec where
     put_ bh (CExportStatic ss aa ab) = do
@@ -308,7 +308,7 @@ instance Binary CCallTarget where
             put_ bh aa
             put_ bh ab
             put_ bh ac
-    put_ bh DynamicTarget = do
+    put_ bh DynamicTarget =
             putByte bh 1
     get bh = do
             h <- getByte bh
@@ -318,27 +318,27 @@ instance Binary CCallTarget where
                       ab <- get bh
                       ac <- get bh
                       return (StaticTarget ss aa ab ac)
-              _ -> do return DynamicTarget
+              _ -> return DynamicTarget
 
 instance Binary CCallConv where
-    put_ bh CCallConv = do
+    put_ bh CCallConv =
             putByte bh 0
-    put_ bh StdCallConv = do
+    put_ bh StdCallConv =
             putByte bh 1
-    put_ bh PrimCallConv = do
+    put_ bh PrimCallConv =
             putByte bh 2
-    put_ bh CApiConv = do
+    put_ bh CApiConv =
             putByte bh 3
-    put_ bh JavaScriptCallConv = do
+    put_ bh JavaScriptCallConv =
             putByte bh 4
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return CCallConv
-              1 -> do return StdCallConv
-              2 -> do return PrimCallConv
-              3 -> do return CApiConv
-              _ -> do return JavaScriptCallConv
+              0 -> return CCallConv
+              1 -> return StdCallConv
+              2 -> return PrimCallConv
+              3 -> return CApiConv
+              _ -> return JavaScriptCallConv
 
 instance Binary CType where
     put_ bh (CType s mh fs) = do put_ bh s
diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs
index 6fea5e2fdb..461f4ac70a 100644
--- a/compiler/GHC/Types/Literal.hs
+++ b/compiler/GHC/Types/Literal.hs
@@ -207,7 +207,7 @@ instance Binary LitNumType where
 instance Binary Literal where
     put_ bh (LitChar aa)     = do putByte bh 0; put_ bh aa
     put_ bh (LitString ab)   = do putByte bh 1; put_ bh ab
-    put_ bh (LitNullAddr)    = do putByte bh 2
+    put_ bh (LitNullAddr)    = putByte bh 2
     put_ bh (LitFloat ah)    = do putByte bh 3; put_ bh ah
     put_ bh (LitDouble ai)   = do putByte bh 4; put_ bh ai
     put_ bh (LitLabel aj mb fod)
@@ -219,7 +219,7 @@ instance Binary Literal where
         = do putByte bh 6
              put_ bh nt
              put_ bh i
-    put_ bh (LitRubbish)     = do putByte bh 7
+    put_ bh (LitRubbish) = putByte bh 7
     get bh = do
             h <- getByte bh
             case h of
@@ -229,8 +229,7 @@ instance Binary Literal where
               1 -> do
                     ab <- get bh
                     return (LitString ab)
-              2 -> do
-                    return (LitNullAddr)
+              2 -> return (LitNullAddr)
               3 -> do
                     ah <- get bh
                     return (LitFloat ah)
@@ -246,8 +245,7 @@ instance Binary Literal where
                     nt <- get bh
                     i  <- get bh
                     return (LitNumber nt i)
-              _ -> do
-                    return (LitRubbish)
+              _ -> return (LitRubbish)
 
 instance Outputable Literal where
     ppr = pprLiteral id
diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs
index b3d3b0855d..d2e4127010 100644
--- a/compiler/GHC/Types/Name/Occurrence.hs
+++ b/compiler/GHC/Types/Name/Occurrence.hs
@@ -906,21 +906,21 @@ tidyOccName env occ@(OccName occ_sp fs)
 -}
 
 instance Binary NameSpace where
-    put_ bh VarName = do
+    put_ bh VarName =
             putByte bh 0
-    put_ bh DataName = do
+    put_ bh DataName =
             putByte bh 1
-    put_ bh TvName = do
+    put_ bh TvName =
             putByte bh 2
-    put_ bh TcClsName = do
+    put_ bh TcClsName =
             putByte bh 3
     get bh = do
             h <- getByte bh
             case h of
-              0 -> do return VarName
-              1 -> do return DataName
-              2 -> do return TvName
-              _ -> do return TcClsName
+              0 -> return VarName
+              1 -> return DataName
+              2 -> return TvName
+              _ -> return TcClsName
 
 instance Binary OccName where
     put_ bh (OccName aa ab) = do
diff --git a/compiler/GHC/Types/Name/Reader.hs b/compiler/GHC/Types/Name/Reader.hs
index d1a071dd93..0e6c9ead94 100644
--- a/compiler/GHC/Types/Name/Reader.hs
+++ b/compiler/GHC/Types/Name/Reader.hs
@@ -959,18 +959,17 @@ pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)]
 --   see 'GHC.Tc.Gen.Export.exports_from_avail'
 pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres
 
+-- | isBuiltInSyntax filter out names for built-in syntax They
+-- just clutter up the environment (esp tuples), and the
+-- parser will generate Exact RdrNames for them, so the
+-- cluttered envt is no use.  Really, it's only useful for
+-- GHC.Base and GHC.Tuple.
 pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt)
 pickBothGRE mod gre@(GRE { gre_name = n })
   | isBuiltInSyntax n                = Nothing
   | Just gre1 <- pickQualGRE mod gre
   , Just gre2 <- pickUnqualGRE   gre = Just (gre1, gre2)
   | otherwise                        = Nothing
-  where
-        -- isBuiltInSyntax filter out names for built-in syntax They
-        -- just clutter up the environment (esp tuples), and the
-        -- parser will generate Exact RdrNames for them, so the
-        -- cluttered envt is no use.  Really, it's only useful for
-        -- GHC.Base and GHC.Tuple.
 
 -- Building GlobalRdrEnvs
 
diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs
index da5c589024..5f038f5d83 100644
--- a/compiler/GHC/Unit/Finder.hs
+++ b/compiler/GHC/Unit/Finder.hs
@@ -407,28 +407,16 @@ findPackageModule_ hsc_env mod pkg_conf =
 -- -----------------------------------------------------------------------------
 -- General path searching
 
-searchPathExts
-  :: [FilePath]         -- paths to search
-  -> InstalledModule             -- module name
-  -> [ (
-        FileExt,                                -- suffix
-        FilePath -> BaseName -> IO ModLocation  -- action
-       )
-     ]
-  -> IO InstalledFindResult
-
-searchPathExts paths mod exts
-   = do result <- search to_search
-{-
-        hPutStrLn stderr (showSDoc $
-                vcat [text "Search" <+> ppr mod <+> sep (map (text. fst) exts)
-                    , nest 2 (vcat (map text paths))
-                    , case result of
-                        Succeeded (loc, p) -> text "Found" <+> ppr loc
-                        Failed fs          -> text "not found"])
--}
-        return result
-
+searchPathExts :: [FilePath]      -- paths to search
+               -> InstalledModule -- module name
+               -> [ (
+                     FileExt,                                -- suffix
+                     FilePath -> BaseName -> IO ModLocation  -- action
+                    )
+                  ]
+               -> IO InstalledFindResult
+
+searchPathExts paths mod exts = search to_search
   where
     basename = moduleNameSlashes (moduleName mod)
 
@@ -451,8 +439,8 @@ searchPathExts paths mod exts
 
 mkHomeModLocationSearched :: DynFlags -> ModuleName -> FileExt
                           -> FilePath -> BaseName -> IO ModLocation
-mkHomeModLocationSearched dflags mod suff path basename = do
-   mkHomeModLocation2 dflags mod (path </> basename) suff
+mkHomeModLocationSearched dflags mod suff path basename =
+  mkHomeModLocation2 dflags mod (path </> basename) suff
 
 -- -----------------------------------------------------------------------------
 -- Constructing a home module location
diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs
index 83bc565b6f..b7e0235730 100644
--- a/compiler/GHC/Unit/Module/ModIface.hs
+++ b/compiler/GHC/Unit/Module/ModIface.hs
@@ -1,9 +1,7 @@
-{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 module GHC.Unit.Module.ModIface
diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs
index 78f96c90f3..1d770de9f1 100644
--- a/compiler/GHC/Unit/State.hs
+++ b/compiler/GHC/Unit/State.hs
@@ -715,7 +715,7 @@ readUnitDatabase printer cfg conf_file = do
                           <+> text conf_dir <> text ", treating"
                           <+> text "package database as empty"
               return []
-            else do
+            else
               throwGhcExceptionIO $ InstallationError $
                 "there is no package.cache in " ++ conf_dir ++
                 " even though package database is not empty"
diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs
index aa725b429c..b2f3ce0c50 100644
--- a/compiler/GHC/Unit/Types.hs
+++ b/compiler/GHC/Unit/Types.hs
@@ -349,7 +349,7 @@ instance Binary Unit where
   put_ bh (VirtUnit indef_uid) = do
     putByte bh 1
     put_ bh indef_uid
-  put_ bh HoleUnit = do
+  put_ bh HoleUnit =
     putByte bh 2
   get bh = do b <- getByte bh
               case b of
diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs
index dbc2cdc195..1579eeb5a8 100644
--- a/compiler/GHC/Utils/Binary.hs
+++ b/compiler/GHC/Utils/Binary.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs
index 2db4672f07..25da8be3de 100644
--- a/compiler/GHC/Utils/Error.hs
+++ b/compiler/GHC/Utils/Error.hs
@@ -1,6 +1,5 @@
 {-# LANGUAGE BangPatterns    #-}
 {-# LANGUAGE CPP             #-}
-{-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE RankNTypes      #-}
 
 {-
@@ -124,10 +123,6 @@ orValid IsValid _ = IsValid
 orValid _       v = v
 
 -- -----------------------------------------------------------------------------
--- Basic error messages: just render a message with a source location.
-
-
--- -----------------------------------------------------------------------------
 -- Collecting up messages for later ordering and printing.
 
 mk_err_msg :: DynFlags -> Severity -> SrcSpan -> PrintUnqualified -> ErrDoc -> ErrMsg
@@ -536,42 +531,42 @@ withTiming' :: MonadIO m
             -> m a          -- ^ The body of the phase to be timed
             -> m a
 withTiming' dflags what force_result prtimings action
-  = do if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags
-          then do whenPrintTimings $
-                    logInfo dflags $ withPprStyle defaultUserStyle $
-                      text "***" <+> what <> colon
-                  let ctx = initDefaultSDocContext dflags
-                  eventBegins ctx what
-                  alloc0 <- liftIO getAllocationCounter
-                  start <- liftIO getCPUTime
-                  !r <- action
-                  () <- pure $ force_result r
-                  eventEnds ctx what
-                  end <- liftIO getCPUTime
-                  alloc1 <- liftIO getAllocationCounter
-                  -- recall that allocation counter counts down
-                  let alloc = alloc0 - alloc1
-                      time = realToFrac (end - start) * 1e-9
-
-                  when (verbosity dflags >= 2 && prtimings == PrintTimings)
-                      $ liftIO $ logInfo dflags $ withPprStyle defaultUserStyle
-                          (text "!!!" <+> what <> colon <+> text "finished in"
-                           <+> doublePrec 2 time
-                           <+> text "milliseconds"
-                           <> comma
-                           <+> text "allocated"
-                           <+> doublePrec 3 (realToFrac alloc / 1024 / 1024)
-                           <+> text "megabytes")
-
-                  whenPrintTimings $
-                      dumpIfSet_dyn dflags Opt_D_dump_timings "" FormatText
-                          $ text $ showSDocOneLine ctx
-                          $ hsep [ what <> colon
-                                 , text "alloc=" <> ppr alloc
-                                 , text "time=" <> doublePrec 3 time
-                                 ]
-                  pure r
-           else action
+  = if verbosity dflags >= 2 || dopt Opt_D_dump_timings dflags
+    then do whenPrintTimings $
+              logInfo dflags $ withPprStyle defaultUserStyle $
+                text "***" <+> what <> colon
+            let ctx = initDefaultSDocContext dflags
+            eventBegins ctx what
+            alloc0 <- liftIO getAllocationCounter
+            start <- liftIO getCPUTime
+            !r <- action
+            () <- pure $ force_result r
+            eventEnds ctx what
+            end <- liftIO getCPUTime
+            alloc1 <- liftIO getAllocationCounter
+            -- recall that allocation counter counts down
+            let alloc = alloc0 - alloc1
+                time = realToFrac (end - start) * 1e-9
+
+            when (verbosity dflags >= 2 && prtimings == PrintTimings)
+                $ liftIO $ logInfo dflags $ withPprStyle defaultUserStyle
+                    (text "!!!" <+> what <> colon <+> text "finished in"
+                     <+> doublePrec 2 time
+                     <+> text "milliseconds"
+                     <> comma
+                     <+> text "allocated"
+                     <+> doublePrec 3 (realToFrac alloc / 1024 / 1024)
+                     <+> text "megabytes")
+
+            whenPrintTimings $
+                dumpIfSet_dyn dflags Opt_D_dump_timings "" FormatText
+                    $ text $ showSDocOneLine ctx
+                    $ hsep [ what <> colon
+                           , text "alloc=" <> ppr alloc
+                           , text "time=" <> doublePrec 3 time
+                           ]
+            pure r
+     else action
 
     where whenPrintTimings = liftIO . when (prtimings == PrintTimings)
           eventBegins ctx w = do
@@ -776,8 +771,8 @@ type TraceAction = forall a. DynFlags -> String -> SDoc -> a -> a
 
 -- | Default action for 'dumpAction' hook
 defaultDumpAction :: DumpAction
-defaultDumpAction dflags sty dumpOpt title _fmt doc = do
-   dumpSDocWithStyle sty dflags dumpOpt title doc
+defaultDumpAction dflags sty dumpOpt title _fmt doc =
+  dumpSDocWithStyle sty dflags dumpOpt title doc
 
 -- | Default action for 'traceAction' hook
 defaultTraceAction :: TraceAction
diff --git a/compiler/GHC/Utils/Exception.hs b/compiler/GHC/Utils/Exception.hs
index 49fa19bd47..46c1f9d37d 100644
--- a/compiler/GHC/Utils/Exception.hs
+++ b/compiler/GHC/Utils/Exception.hs
@@ -3,14 +3,13 @@
 
 module GHC.Utils.Exception
     (
-    module Control.Exception,
+    module CE,
     module GHC.Utils.Exception
     )
     where
 
 import GHC.Prelude
 
-import Control.Exception
 import Control.Exception as CE
 import Control.Monad.IO.Class
 import Control.Monad.Catch
diff --git a/compiler/GHC/Utils/GlobalVars.hs b/compiler/GHC/Utils/GlobalVars.hs
index 5556a7e4f1..f169d07161 100644
--- a/compiler/GHC/Utils/GlobalVars.hs
+++ b/compiler/GHC/Utils/GlobalVars.hs
@@ -95,7 +95,7 @@ global :: a -> IORef a
 global a = unsafePerformIO (newIORef a)
 
 consIORef :: IORef [a] -> a -> IO ()
-consIORef var x = do
+consIORef var x =
   atomicModifyIORef' var (\xs -> (x:xs,()))
 
 globalM :: IO a -> IORef a
diff --git a/compiler/GHC/Utils/Misc.hs b/compiler/GHC/Utils/Misc.hs
index 7436487739..07d4b721ff 100644
--- a/compiler/GHC/Utils/Misc.hs
+++ b/compiler/GHC/Utils/Misc.hs
@@ -1281,7 +1281,7 @@ getModificationUTCTime = getModificationTime
 -- check existence & modification time at the same time
 
 modificationTimeIfExists :: FilePath -> IO (Maybe UTCTime)
-modificationTimeIfExists f = do
+modificationTimeIfExists f =
   (do t <- getModificationUTCTime f; return (Just t))
         `catchIO` \e -> if isDoesNotExistError e
                         then return Nothing