Commit 65b7256a authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Marge Bot

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

parent c8439fc7
......@@ -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
}
......
......@@ -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]
......
......@@ -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)
......
......@@ -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))
......
......@@ -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)
......
......@@ -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
......
......@@ -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"
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
{-
------------------------------------------------------------
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment