From d697a6c253462caf791aadb42a56fd2044427b6a Mon Sep 17 00:00:00 2001
From: Stefan Holdermans <stefan@holdermans.nl>
Date: Sat, 23 Sep 2023 22:13:51 +0200
Subject: [PATCH] Refactor uses of `partitionEithers . map`
This patch changes occurences of the idiom
`partitionEithers (map f xs)` by the simpler form
`partitionWith f xs` where `partitionWith` is the utility function
defined in `GHC.Utils.Misc`.
Resolves: #23953
---
compiler/GHC/Cmm/DebugBlock.hs | 5 ++---
compiler/GHC/HsToCore/Pmc/Solver.hs | 3 +--
compiler/GHC/Linker/Deps.hs | 3 +--
compiler/GHC/Runtime/Eval.hs | 3 +--
compiler/GHC/StgToJS/Expr.hs | 7 ++++---
compiler/GHC/StgToJS/Sinker.hs | 4 ++--
compiler/GHC/Unit/Module/Graph.hs | 4 ++--
7 files changed, 13 insertions(+), 16 deletions(-)
diff --git a/compiler/GHC/Cmm/DebugBlock.hs b/compiler/GHC/Cmm/DebugBlock.hs
index a889f4c796ce..41e8487cc8af 100644
--- a/compiler/GHC/Cmm/DebugBlock.hs
+++ b/compiler/GHC/Cmm/DebugBlock.hs
@@ -47,7 +47,7 @@ import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.SrcLoc
import GHC.Types.Tickish
-import GHC.Utils.Misc ( seqList )
+import GHC.Utils.Misc ( partitionWith, seqList )
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Collections
@@ -58,7 +58,6 @@ import Data.Maybe
import Data.List ( minimumBy, nubBy )
import Data.Ord ( comparing )
import qualified Data.Map as Map
-import Data.Either ( partitionEithers )
-- | Debug information about a block of code. Ticks scope over nested
-- blocks.
@@ -110,7 +109,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
-- Analyse tick scope structure: Each one is either a top-level
-- tick scope, or the child of another.
(topScopes, childScopes)
- = partitionEithers $ map (\a -> findP a a) $ Map.keys blockCtxs
+ = partitionWith (\a -> findP a a) $ Map.keys blockCtxs
findP tsc GlobalScope = Left tsc -- top scope
findP tsc scp | scp' `Map.member` blockCtxs = Right (scp', tsc)
| otherwise = findP tsc scp'
diff --git a/compiler/GHC/HsToCore/Pmc/Solver.hs b/compiler/GHC/HsToCore/Pmc/Solver.hs
index bd6fef4f0b38..be9c28861135 100644
--- a/compiler/GHC/HsToCore/Pmc/Solver.hs
+++ b/compiler/GHC/HsToCore/Pmc/Solver.hs
@@ -91,7 +91,6 @@ import Control.Monad (foldM, forM, guard, mzero, when, filterM)
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict
import Data.Coerce
-import Data.Either (partitionEithers)
import Data.Foldable (foldlM, minimumBy, toList)
import Data.Monoid (Any(..))
import Data.List (sortBy, find)
@@ -608,7 +607,7 @@ addPhiCts nabla cts = runMaybeT $ do
inhabitationTest initFuel (nabla_ty_st nabla) nabla''
partitionPhiCts :: PhiCts -> ([PredType], [PhiCt])
-partitionPhiCts = partitionEithers . map to_either . toList
+partitionPhiCts = partitionWith to_either . toList
where
to_either (PhiTyCt pred_ty) = Left pred_ty
to_either ct = Right ct
diff --git a/compiler/GHC/Linker/Deps.hs b/compiler/GHC/Linker/Deps.hs
index a4ba125124d9..2ababf048ec1 100644
--- a/compiler/GHC/Linker/Deps.hs
+++ b/compiler/GHC/Linker/Deps.hs
@@ -55,7 +55,6 @@ import Control.Applicative
import qualified Data.Set as Set
import qualified Data.Map as M
import Data.List (isSuffixOf)
-import Data.Either
import System.FilePath
import System.Directory
@@ -131,7 +130,7 @@ get_link_deps opts pls maybe_normal_osuf span mods = do
let
-- 2. Exclude ones already linked
-- Main reason: avoid findModule calls in get_linkable
- (mods_needed, links_got) = partitionEithers (map split_mods mods_s)
+ (mods_needed, links_got) = partitionWith split_mods mods_s
pkgs_needed = eltsUDFM $ getUniqDSet pkgs_s `minusUDFM` pkgs_loaded pls
split_mods mod =
diff --git a/compiler/GHC/Runtime/Eval.hs b/compiler/GHC/Runtime/Eval.hs
index 1802b98f565d..7d1a034a26c1 100644
--- a/compiler/GHC/Runtime/Eval.hs
+++ b/compiler/GHC/Runtime/Eval.hs
@@ -130,7 +130,6 @@ import Control.Monad
import Control.Monad.Catch as MC
import Data.Array
import Data.Dynamic
-import Data.Either
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.List (find,intercalate)
@@ -808,7 +807,7 @@ findGlobalRdrEnv :: HscEnv -> [InteractiveImport]
findGlobalRdrEnv hsc_env imports
= do { idecls_env <- hscRnImportDecls hsc_env idecls
-- This call also loads any orphan modules
- ; return $ case partitionEithers (map mkEnv imods) of
+ ; return $ case partitionWith mkEnv imods of
(err : _, _) -> Left err
([], imods_env0) ->
-- Need to rehydrate the 'GlobalRdrEnv' to recover the 'GREInfo's.
diff --git a/compiler/GHC/StgToJS/Expr.hs b/compiler/GHC/StgToJS/Expr.hs
index 76ba0f3d2dec..cb0f6ddb286c 100644
--- a/compiler/GHC/StgToJS/Expr.hs
+++ b/compiler/GHC/StgToJS/Expr.hs
@@ -496,9 +496,10 @@ optimizeFree offset ids = do
l = length ids'
slots <- drop offset . take l . (++repeat SlotUnknown) <$> getSlots
let slm = M.fromList (zip slots [0..])
- (remaining, fixed) = partitionEithers $
- map (\inp@(i,n) -> maybe (Left inp) (\j -> Right (i,n,j,True))
- (M.lookup (SlotId i n) slm)) ids'
+ (remaining, fixed) = partitionWith (\inp@(i,n) -> maybe (Left inp)
+ (\j -> Right (i,n,j,True))
+ (M.lookup (SlotId i n) slm))
+ ids'
takenSlots = S.fromList (fmap (\(_,_,x,_) -> x) fixed)
freeSlots = filter (`S.notMember` takenSlots) [0..l-1]
remaining' = zipWith (\(i,n) j -> (i,n,j,False)) remaining freeSlots
diff --git a/compiler/GHC/StgToJS/Sinker.hs b/compiler/GHC/StgToJS/Sinker.hs
index b769199ee971..7c104767e65f 100644
--- a/compiler/GHC/StgToJS/Sinker.hs
+++ b/compiler/GHC/StgToJS/Sinker.hs
@@ -15,10 +15,10 @@ import GHC.Unit.Module
import GHC.Types.Literal
import GHC.Data.Graph.Directed
+import GHC.Utils.Misc (partitionWith)
import GHC.StgToJS.Utils
import Data.Char
-import Data.Either
import Data.List (partition)
import Data.Maybe
@@ -38,7 +38,7 @@ sinkPgm m pgm = (sunk, map StgTopLifted pgm'' ++ stringLits)
where
selectLifted (StgTopLifted b) = Left b
selectLifted x = Right x
- (pgm', stringLits) = partitionEithers (map selectLifted pgm)
+ (pgm', stringLits) = partitionWith selectLifted pgm
(sunk, pgm'') = sinkPgm' m pgm'
sinkPgm'
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index f138c40f8dee..059cebf7b52f 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -58,6 +58,7 @@ import GHC.Types.SourceFile ( hscSourceString )
import GHC.Unit.Module.ModSummary
import GHC.Unit.Types
import GHC.Utils.Outputable
+import GHC.Utils.Misc ( partitionWith )
import System.FilePath
import qualified Data.Map as Map
@@ -68,7 +69,6 @@ import GHC.Unit.Module
import GHC.Linker.Static.Utils
import Data.Bifunctor
-import Data.Either
import Data.Function
import Data.List (sort)
import GHC.Data.List.SetOps
@@ -336,7 +336,7 @@ moduleGraphNodes drop_hs_boot_nodes summaries =
(graphFromEdgedVerticesUniq nodes, lookup_node)
where
-- Map from module to extra boot summary dependencies which need to be merged in
- (boot_summaries, nodes) = bimap Map.fromList id $ partitionEithers (map go numbered_summaries)
+ (boot_summaries, nodes) = bimap Map.fromList id $ partitionWith go numbered_summaries
where
go (s, key) =
--
GitLab