[commit: ghc] master: cmm/: Avoid using lazy left folds (64c0af7)
git at git.haskell.org
git at git.haskell.org
Tue Mar 6 18:33:35 UTC 2018
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/64c0af7517148316b259300b851b966cfbcf3eaf/ghc
>---------------------------------------------------------------
commit 64c0af7517148316b259300b851b966cfbcf3eaf
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date: Mon Mar 5 15:16:02 2018 -0500
cmm/: Avoid using lazy left folds
This basically replaces all uses of `foldl` with `foldl'`. I've looked
at all the call sites and there doesn't seem to be any reason to prefer
the lazy version.
Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com>
Test Plan: ./validate
Reviewers: bgamari, simonmar
Reviewed By: bgamari
Subscribers: rwbarton, thomie, carter
Differential Revision: https://phabricator.haskell.org/D4463
>---------------------------------------------------------------
64c0af7517148316b259300b851b966cfbcf3eaf
compiler/cmm/CmmBuildInfoTables.hs | 24 +++++++++++++-----------
compiler/cmm/CmmCommonBlockElim.hs | 3 ++-
compiler/cmm/CmmContFlowOpt.hs | 3 ++-
compiler/cmm/CmmLayoutStack.hs | 4 ++--
compiler/cmm/CmmProcPoint.hs | 9 +++++----
compiler/cmm/CmmSink.hs | 5 +++--
6 files changed, 27 insertions(+), 21 deletions(-)
diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index dc5cfd6..ae192e5 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -119,11 +119,13 @@ cafAnal cmmGraph = analyzeCmmBwd cafLattice cafTransfers cmmGraph mapEmpty
-- Description of the SRT for a given module.
-- Note that this SRT may grow as we greedily add new CAFs to it.
-data TopSRT = TopSRT { lbl :: CLabel
- , next_elt :: Int -- the next entry in the table
- , rev_elts :: [CLabel]
- , elt_map :: Map CLabel Int }
- -- map: CLabel -> its last entry in the table
+data TopSRT = TopSRT
+ { lbl :: CLabel
+ , next_elt :: {-# UNPACK #-} !Int -- the next entry in the table
+ , rev_elts :: [CLabel]
+ , elt_map :: !(Map CLabel Int) -- CLabel -> its last entry in the table
+ }
+
instance Outputable TopSRT where
ppr (TopSRT lbl next elts eltmap) =
text "TopSRT:" <+> ppr lbl
@@ -176,7 +178,7 @@ buildSRT dflags topSRT cafs =
do localSRTs <- procpointSRT dflags (lbl topSRT) (elt_map topSRT) cafs
return (topSRT, localSRTs)
in if cafs `lengthExceeds` maxBmpSize dflags then
- mkSRT (foldl add_if_missing topSRT cafs)
+ mkSRT (foldl' add_if_missing topSRT cafs)
else -- make sure all the cafs are near the bottom of the srt
mkSRT (add_if_too_far topSRT cafs)
add_if_missing srt caf =
@@ -269,14 +271,14 @@ localCAFInfo cafEnv proc@(CmmProc _ top_l _ (CmmGraph {g_entry=entry})) =
-- To do this replacement efficiently, we gather strongly connected
-- components, then we sort the components in topological order.
mkTopCAFInfo :: [(CAFSet, Maybe CLabel)] -> Map CLabel CAFSet
-mkTopCAFInfo localCAFs = foldl addToTop Map.empty g
+mkTopCAFInfo localCAFs = foldl' addToTop Map.empty g
where
- addToTop env (AcyclicSCC (l, cafset)) =
+ addToTop !env (AcyclicSCC (l, cafset)) =
Map.insert l (flatten env cafset) env
- addToTop env (CyclicSCC nodes) =
+ addToTop !env (CyclicSCC nodes) =
let (lbls, cafsets) = unzip nodes
- cafset = foldr Set.delete (foldl Set.union Set.empty cafsets) lbls
- in foldl (\env l -> Map.insert l (flatten env cafset) env) env lbls
+ cafset = Set.unions cafsets `Set.difference` Set.fromList lbls
+ in foldl' (\env l -> Map.insert l (flatten env cafset) env) env lbls
g = stronglyConnCompFromEdgedVerticesOrd
[ DigraphNode (l,cafs) l (Set.elems cafs)
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index ba3b1c8..fce8f7d 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -29,6 +29,7 @@ import UniqDFM
import qualified TrieMap as TM
import Unique
import Control.Arrow (first, second)
+import Data.List (foldl')
-- -----------------------------------------------------------------------------
-- Eliminate common blocks
@@ -173,7 +174,7 @@ hash_block block =
hash_tgt (ForeignTarget e _) = hash_e e
hash_tgt (PrimTarget _) = 31 -- lots of these
- hash_list f = foldl (\z x -> f x + z) (0::Word32)
+ hash_list f = foldl' (\z x -> f x + z) (0::Word32)
cvt = fromInteger . toInteger
diff --git a/compiler/cmm/CmmContFlowOpt.hs b/compiler/cmm/CmmContFlowOpt.hs
index 8863012..da365cf 100644
--- a/compiler/cmm/CmmContFlowOpt.hs
+++ b/compiler/cmm/CmmContFlowOpt.hs
@@ -24,6 +24,7 @@ import Panic
import Util
import Control.Monad
+import Data.List
-- Note [What is shortcutting]
@@ -177,7 +178,7 @@ blockConcat splitting_procs g at CmmGraph { g_entry = entry_id }
-- a map of blocks. We process each element from blocks and update
-- blockmap accordingly
blocks = postorderDfs g
- blockmap = foldr addBlock emptyBody blocks
+ blockmap = foldl' (flip addBlock) emptyBody blocks
-- Accumulator contains three components:
-- * map of blocks in a graph
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 2602dc8..3f16334 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -37,7 +37,7 @@ import qualified Data.Set as Set
import Control.Monad.Fix
import Data.Array as Array
import Data.Bits
-import Data.List (nub)
+import Data.List (nub, foldl')
{- Note [Stack Layout]
@@ -322,7 +322,7 @@ layout dflags procpoints liveness entry entry_args final_stackmaps final_sp_high
-- Sp = Sp + sp_off -- Sp adjustment goes here
-- last1 -- the last node
--
- let middle_pre = blockToList $ foldl blockSnoc middle0 middle1
+ let middle_pre = blockToList $ foldl' blockSnoc middle0 middle1
let final_blocks =
manifestSp dflags final_stackmaps stack0 sp0 final_sp_high
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 3459284..eeae960 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -330,7 +330,7 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
-- 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 insertBlock) blockEnv'' jumpBlocks
+ blockEnv''' = foldl' (flip insertBlock) blockEnv'' jumpBlocks
let g' = ofBlockMap ppId blockEnv'''
-- pprTrace "g' pre jumps" (ppr g') $ do
return (mapInsert ppId g' newGraphEnv)
@@ -373,9 +373,10 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
-- 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)
- (postorderDfs g)
- add_block_num (i, map) block = (i+1, mapInsert (entryLabel block) i map)
+ foldl' add_block_num (0::Int, mapEmpty :: LabelMap Int)
+ (postorderDfs 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)
diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs
index 464a041..487f0bc 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -24,6 +24,7 @@ import PprCmm ()
import qualified Data.IntSet as IntSet
import Data.List (partition)
import qualified Data.Set as Set
+import Data.List
import Data.Maybe
-- Compact sets for membership tests of local variables.
@@ -233,7 +234,7 @@ cmmSink dflags graph = ofBlockList (g_entry graph) $ sink mapEmpty $ blocks
live_rhs = foldRegsUsed dflags extendRegSet emptyRegSet rhs
- final_middle = foldl blockSnoc middle' dropped_last
+ final_middle = foldl' blockSnoc middle' dropped_last
sunk' = mapUnion sunk $
mapFromList [ (l, filterAssignments dflags (getLive l) assigs'')
@@ -343,7 +344,7 @@ walk dflags nodes assigs = go nodes emptyBlock assigs
(dropped, as') = dropAssignmentsSimple dflags
(\a -> conflicts dflags a node2) as1
- block' = foldl blockSnoc block dropped `blockSnoc` node2
+ block' = foldl' blockSnoc block dropped `blockSnoc` node2
--
More information about the ghc-commits
mailing list