Commit 5c804e5d authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan

Remove splitEithers, use partitionEithers from base

parent e3ae0eb8
...@@ -35,7 +35,7 @@ import Outputable ...@@ -35,7 +35,7 @@ import Outputable
import PprCore () import PprCore ()
import PprCmmExpr ( pprExpr ) import PprCmmExpr ( pprExpr )
import SrcLoc import SrcLoc
import Util import Util ( seqList )
import Hoopl.Block import Hoopl.Block
import Hoopl.Collections import Hoopl.Collections
...@@ -46,6 +46,7 @@ import Data.Maybe ...@@ -46,6 +46,7 @@ import Data.Maybe
import Data.List ( minimumBy, nubBy ) import Data.List ( minimumBy, nubBy )
import Data.Ord ( comparing ) import Data.Ord ( comparing )
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Either ( partitionEithers )
-- | Debug information about a block of code. Ticks scope over nested -- | Debug information about a block of code. Ticks scope over nested
-- blocks. -- blocks.
...@@ -100,7 +101,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes ...@@ -100,7 +101,7 @@ cmmDebugGen modLoc decls = map (blocksForScope Nothing) topScopes
-- Analyse tick scope structure: Each one is either a top-level -- Analyse tick scope structure: Each one is either a top-level
-- tick scope, or the child of another. -- tick scope, or the child of another.
(topScopes, childScopes) (topScopes, childScopes)
= splitEithers $ map (\a -> findP a a) $ Map.keys blockCtxs = partitionEithers $ map (\a -> findP a a) $ Map.keys blockCtxs
findP tsc GlobalScope = Left tsc -- top scope findP tsc GlobalScope = Left tsc -- top scope
findP tsc scp | scp' `Map.member` blockCtxs = Right (scp', tsc) findP tsc scp | scp' `Map.member` blockCtxs = Right (scp', tsc)
| otherwise = findP tsc scp' | otherwise = findP tsc scp'
......
...@@ -73,6 +73,7 @@ import qualified Data.IntMap as IntMap ...@@ -73,6 +73,7 @@ import qualified Data.IntMap as IntMap
import qualified FiniteMap as Map import qualified FiniteMap as Map
import Data.Ord import Data.Ord
import GHC.Stack.CCS import GHC.Stack.CCS
import Data.Either ( partitionEithers )
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- Generating byte code for a complete module -- Generating byte code for a complete module
...@@ -89,7 +90,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks ...@@ -89,7 +90,7 @@ byteCodeGen hsc_env this_mod binds tycs mb_modBreaks
(const ()) $ do (const ()) $ do
-- Split top-level binds into strings and others. -- Split top-level binds into strings and others.
-- See Note [generating code for top-level string literal bindings]. -- See Note [generating code for top-level string literal bindings].
let (strings, flatBinds) = splitEithers $ do let (strings, flatBinds) = partitionEithers $ do
(bndr, rhs) <- flattenBinds binds (bndr, rhs) <- flattenBinds binds
return $ case exprIsTickedString_maybe rhs of return $ case exprIsTickedString_maybe rhs of
Just str -> Left (bndr, str) Just str -> Left (bndr, str)
......
...@@ -73,6 +73,7 @@ import Control.Monad ...@@ -73,6 +73,7 @@ import Control.Monad
import Data.List ( isSuffixOf, intercalate ) import Data.List ( isSuffixOf, intercalate )
import Data.Maybe import Data.Maybe
import Data.Version import Data.Version
import Data.Either ( partitionEithers )
-- --------------------------------------------------------------------------- -- ---------------------------------------------------------------------------
-- Pre-process -- Pre-process
...@@ -453,7 +454,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do ...@@ -453,7 +454,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
-- first check object files and extra_ld_inputs -- first check object files and extra_ld_inputs
let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ] let extra_ld_inputs = [ f | FileOption _ f <- ldInputs dflags ]
e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs e_extra_times <- mapM (tryIO . getModificationUTCTime) extra_ld_inputs
let (errs,extra_times) = splitEithers e_extra_times let (errs,extra_times) = partitionEithers e_extra_times
let obj_times = map linkableTime linkables ++ extra_times let obj_times = map linkableTime linkables ++ extra_times
if not (null errs) || any (t <) obj_times if not (null errs) || any (t <) obj_times
then return True then return True
...@@ -469,7 +470,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do ...@@ -469,7 +470,7 @@ linkingNeeded dflags staticLink linkables pkg_deps = do
if any isNothing pkg_libfiles then return True else do if any isNothing pkg_libfiles then return True else do
e_lib_times <- mapM (tryIO . getModificationUTCTime) e_lib_times <- mapM (tryIO . getModificationUTCTime)
(catMaybes pkg_libfiles) (catMaybes pkg_libfiles)
let (lib_errs,lib_times) = splitEithers e_lib_times let (lib_errs,lib_times) = partitionEithers e_lib_times
if not (null lib_errs) || any (t <) lib_times if not (null lib_errs) || any (t <) lib_times
then return True then return True
else checkLinkInfo dflags pkg_deps exe_file else checkLinkInfo dflags pkg_deps exe_file
......
...@@ -79,6 +79,7 @@ import RnUnbound ...@@ -79,6 +79,7 @@ import RnUnbound
import RnUtils import RnUtils
import Data.Maybe (isJust) import Data.Maybe (isJust)
import qualified Data.Semigroup as Semi import qualified Data.Semigroup as Semi
import Data.Either ( partitionEithers )
{- {-
********************************************************* *********************************************************
...@@ -1436,7 +1437,7 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)] ...@@ -1436,7 +1437,7 @@ lookupLocalTcNames :: HsSigCtxt -> SDoc -> RdrName -> RnM [(RdrName, Name)]
-- See Note [Fixity signature lookup] -- See Note [Fixity signature lookup]
lookupLocalTcNames ctxt what rdr_name lookupLocalTcNames ctxt what rdr_name
= do { mb_gres <- mapM lookup (dataTcOccs rdr_name) = do { mb_gres <- mapM lookup (dataTcOccs rdr_name)
; let (errs, names) = splitEithers mb_gres ; let (errs, names) = partitionEithers mb_gres
; when (null names) $ addErr (head errs) -- Bleat about one only ; when (null names) $ addErr (head errs) -- Bleat about one only
; return names } ; return names }
where where
......
...@@ -25,7 +25,7 @@ module Util ( ...@@ -25,7 +25,7 @@ module Util (
mapFst, mapSnd, chkAppend, mapFst, mapSnd, chkAppend,
mapAndUnzip, mapAndUnzip3, mapAccumL2, mapAndUnzip, mapAndUnzip3, mapAccumL2,
nOfThem, filterOut, partitionWith, splitEithers, nOfThem, filterOut, partitionWith,
dropWhileEndLE, spanEnd, dropWhileEndLE, spanEnd,
...@@ -296,14 +296,6 @@ partitionWith f (x:xs) = case f x of ...@@ -296,14 +296,6 @@ partitionWith f (x:xs) = case f x of
Right c -> (bs, c:cs) Right c -> (bs, c:cs)
where (bs,cs) = partitionWith f xs where (bs,cs) = partitionWith f xs
splitEithers :: [Either a b] -> ([a], [b])
-- ^ Teases a list of 'Either's apart into two lists
splitEithers [] = ([],[])
splitEithers (e : es) = case e of
Left x -> (x:xs, ys)
Right y -> (xs, y:ys)
where (xs,ys) = splitEithers es
chkAppend :: [a] -> [a] -> [a] chkAppend :: [a] -> [a] -> [a]
-- Checks for the second argument being empty -- Checks for the second argument being empty
-- Used in situations where that situation is common -- Used in situations where that situation is common
......
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