Commit 64c0af75 authored by Michal Terepeta's avatar Michal Terepeta Committed by Ben Gamari

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's avatarMichal Terepeta <michal.terepeta@gmail.com>

Test Plan: ./validate

Reviewers: bgamari, simonmar

Reviewed By: bgamari

Subscribers: rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4463
parent 9bccfcdb
......@@ -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)
......
......@@ -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
......
......@@ -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@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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
--
......
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