Use concatMap(M) instead of `concat . map` and the monadic variant

compiler/GHC/ByteCode/Asm.hs

@@ -101,7 +101,7 @@ assembleBCOs hsc_env proto_bcos tycons top_strs modbreaks = do
   return CompiledByteCode
     { bc_bcos = bcos'
     , bc_itbls =  itblenv
-    , bc_ffis = concat (map protoBCOFFIs proto_bcos)
+    , bc_ffis = concatMap protoBCOFFIs proto_bcos
     , bc_strs = top_strs ++ ptrs
     , bc_breaks = modbreaks
     }

compiler/GHC/Cmm/Switch/Implement.hs

@@ -13,6 +13,7 @@ import GHC.Cmm.Utils
 import GHC.Cmm.Switch
 import UniqSupply
 import DynFlags
+import MonadUtils (concatMapM)
 
 --
 -- This module replaces Switch statements as generated by the Stg -> Cmm
@@ -35,7 +36,7 @@ cmmImplementSwitchPlans dflags g
     -- Switch generation done by backend (LLVM/C)
     | targetSupportsSwitch (hscTarget dflags) = return g
     | otherwise = do
-    blocks' <- concat `fmap` mapM (visitSwitches dflags) (toBlockList g)
+    blocks' <- concatMapM (visitSwitches dflags) (toBlockList g)
     return $ ofBlockList (g_entry g) blocks'
 
 visitSwitches :: DynFlags -> CmmBlock -> UniqSM [CmmBlock]

compiler/GHC/CoreToByteCode.hs

@@ -1116,7 +1116,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
           binds = Map.toList p
           -- NB: unboxed tuple cases bind the scrut binder to the same offset
           -- as one of the alt binders, so we have to remove any duplicates here:
-          rel_slots = nub $ map fromIntegral $ concat (map spread binds)
+          rel_slots = nub $ map fromIntegral $ concatMap spread binds
           spread (id, offset) | isFollowableArg (bcIdArgRep id) = [ rel_offset ]
                               | otherwise                      = []
                 where rel_offset = trunc16W $ bytesToWords dflags (d - offset)

compiler/GHC/HsToCore/PmCheck.hs

@@ -59,6 +59,7 @@ import Type
 import GHC.HsToCore.Utils       (isTrueLHsExpr)
 import Maybes
 import qualified GHC.LanguageExtensions as LangExt
+import MonadUtils (concatMapM)
 
 import Control.Monad (when, forM_, zipWithM)
 import Data.List (elemIndex)
@@ -625,7 +626,7 @@ translateMatch _ _ (L _ (XMatch _)) = panic "translateMatch"
 translateLGRHS :: FamInstEnvs -> SrcSpan -> [LPat GhcTc] -> LGRHS GhcTc (LHsExpr GhcTc) -> DsM GrdTree
 translateLGRHS fam_insts match_loc pats (L _loc (GRHS _ gs _)) =
   -- _loc apparently points to the match separator that comes after the guards..
-  mkGrdTreeRhs loc_sdoc . concat <$> mapM (translateGuard fam_insts . unLoc) gs
+  mkGrdTreeRhs loc_sdoc <$> concatMapM (translateGuard fam_insts . unLoc) gs
     where
       loc_sdoc
         | null gs   = L match_loc (sep (map ppr pats))

compiler/GHC/Iface/Load.hs

@@ -751,9 +751,7 @@ loadDecls :: Bool
           -> [(Fingerprint, IfaceDecl)]
           -> IfL [(Name,TyThing)]
 loadDecls ignore_prags ver_decls
-   = do { thingss <- mapM (loadDecl ignore_prags) ver_decls
-        ; return (concat thingss)
-        }
+   = concatMapM (loadDecl ignore_prags) ver_decls
 
 loadDecl :: Bool                    -- Don't load pragmas into the decl pool
           -> (Fingerprint, IfaceDecl)

compiler/GHC/Runtime/Eval.hs

@@ -1158,7 +1158,7 @@ findMatchingInstances ty = do
   ies@(InstEnvs {ie_global = ie_global, ie_local = ie_local}) <- tcGetInstEnvs
   let allClasses = instEnvClasses ie_global ++ instEnvClasses ie_local
 
-  concat <$> mapM (\cls -> do
+  concatMapM (\cls -> do
     let (matches, _, _) = lookupInstEnv True ies cls [ty]
     return matches) allClasses
 

compiler/GHC/Stg/Stats.hs

@@ -78,7 +78,7 @@ showStgStats :: [StgTopBinding] -> String
 
 showStgStats prog
   = "STG Statistics:\n\n"
-    ++ concat (map showc (Map.toList (gatherStgStats prog)))
+    ++ concatMap showc (Map.toList (gatherStgStats prog))
   where
     showc (x,n) = (showString (s x) . shows n) "\n"
 

compiler/main/DriverPipeline.hs

@@ -1534,7 +1534,7 @@ runPhase (RealPhase LlvmLlc) input_fn dflags
               then map SysTools.Option $ words llvmOpts
               else []
 
-    defaultOptions = map SysTools.Option . concat . fmap words . snd
+    defaultOptions = map SysTools.Option . concatMap words . snd
                    $ unzip (llvmOptions dflags)
 
 
@@ -1948,7 +1948,7 @@ linkStaticLib dflags o_files dep_packages = do
   (when output_exists) $ removeFile full_output_fn
 
   pkg_cfgs <- getPreloadPackagesAnd dflags dep_packages
-  archives <- concat <$> mapM (collectArchives dflags) pkg_cfgs
+  archives <- concatMapM (collectArchives dflags) pkg_cfgs
 
   ar <- foldl mappend
         <$> (Archive <$> mapM loadObj modules)

compiler/main/HscMain.hs

@@ -1271,12 +1271,12 @@ markUnsafeInfer tcg_env whyUnsafe = do
                                     (vcat $ pprErrMsgBagWithLoc whyUnsafe) $+$
                                     (vcat $ badInsts $ tcg_insts tcg_env)
                          ]
-    badFlags df   = concat $ map (badFlag df) unsafeFlagsForInfer
+    badFlags df   = concatMap (badFlag df) unsafeFlagsForInfer
     badFlag df (str,loc,on,_)
         | on df     = [mkLocMessage SevOutput (loc df) $
                             text str <+> text "is not allowed in Safe Haskell"]
         | otherwise = []
-    badInsts insts = concat $ map badInst insts
+    badInsts insts = concatMap badInst insts
 
     checkOverlap (NoOverlap _) = False
     checkOverlap _             = True

compiler/nativeGen/RegAlloc/Graph/ArchBase.hs

@@ -21,11 +21,13 @@ module RegAlloc.Graph.ArchBase (
         bound,
         squeese
 ) where
+
 import GhcPrelude
 
 import UniqSet
 import UniqFM
 import Unique
+import MonadUtils (concatMapM)
 
 
 -- Some basic register classes.
@@ -152,7 +154,7 @@ squeese regsOfClass regAlias classN countCs
 
 -- | powerset (for lists)
 powersetL :: [a] -> [[a]]
-powersetL       = map concat . mapM (\x -> [[],[x]])
+powersetL       = concatMapM (\x -> [[],[x]])
 
 
 -- | powersetLS (list of sets)

compiler/nativeGen/RegAlloc/Liveness.hs

@@ -719,7 +719,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
         sccs = stronglyConnCompG g2
 
         getOutEdges :: Instruction instr => [instr] -> [BlockId]
-        getOutEdges instrs = concat $ map jumpDestsOfInstr instrs
+        getOutEdges instrs = concatMap jumpDestsOfInstr instrs
 
         -- This is truly ugly, but I don't see a good alternative.
         -- Digraph just has the wrong API.  We want to identify nodes

compiler/typecheck/TcBinds.hs

@@ -301,7 +301,7 @@ tcHsBootSigs :: [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> TcM [Id]
 -- signatures in it.  The renamer checked all this
 tcHsBootSigs binds sigs
   = do  { checkTc (null binds) badBootDeclErr
-        ; concat <$> mapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
+        ; concatMapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
   where
     tc_boot_sig (TypeSig _ lnames hs_ty) = mapM f lnames
       where

compiler/typecheck/TcClassDcl.hs

@@ -115,11 +115,11 @@ tcClassSigs :: Name                -- Name of the class
 tcClassSigs clas sigs def_methods
   = do { traceTc "tcClassSigs 1" (ppr clas)
 
-       ; gen_dm_prs <- concat <$> mapM (addLocM tc_gen_sig) gen_sigs
+       ; gen_dm_prs <- concatMapM (addLocM tc_gen_sig) gen_sigs
        ; let gen_dm_env :: NameEnv (SrcSpan, Type)
              gen_dm_env = mkNameEnv gen_dm_prs
 
-       ; op_info <- concat <$> mapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs
+       ; op_info <- concatMapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs
 
        ; let op_names = mkNameSet [ n | (n,_,_) <- op_info ]
        ; sequence_ [ failWithTc (badMethodErr clas n)

compiler/typecheck/TcRnExports.hs

@@ -256,7 +256,7 @@ exports_from_avail Nothing rdr_env _imports _this_mod
 
 exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
   = do ie_avails <- accumExports do_litem rdr_items
-       let final_exports = nubAvails (concat (map snd ie_avails)) -- Combine families
+       let final_exports = nubAvails (concatMap snd ie_avails) -- Combine families
        return (Just ie_avails, final_exports)
   where
     do_litem :: ExportAccum -> LIE GhcPs

compiler/typecheck/TcValidity.hs

@@ -2838,7 +2838,7 @@ fvType (CastTy ty _)         = fvType ty
 fvType (CoercionTy {})       = []
 
 fvTypes :: [Type] -> [TyVar]
-fvTypes tys                = concat (map fvType tys)
+fvTypes tys                = concatMap fvType tys
 
 sizeType :: Type -> Int
 -- Size of a type: the number of variables and constructors

compiler/utils/Digraph.hs

@@ -422,7 +422,7 @@ type IntGraph = G.Graph
 
 -- Data.Tree has flatten for Tree, but nothing for Forest
 preorderF           :: Forest a -> [a]
-preorderF ts         = concat (map flatten ts)
+preorderF ts         = concatMap flatten ts
 
 {-
 ------------------------------------------------------------

compiler/utils/GraphColor.hs

@@ -324,7 +324,7 @@ selectColor colors graph u
         -- the prefs of our neighbors
         colors_neighbor_prefs
                         = mkUniqSet
-                        $ concat $ map nodePreference nsConflicts
+                        $ concatMap nodePreference nsConflicts
 
         -- colors that are still valid for us
         colors_ok_ex    = minusUniqSet colors_avail (nodeExclusions node)