diff options
| -rw-r--r-- | compiler/cmm/CmmBuildInfoTables.hs | 24 | ||||
| -rw-r--r-- | compiler/cmm/CmmCommonBlockElim.hs | 3 | ||||
| -rw-r--r-- | compiler/cmm/CmmContFlowOpt.hs | 3 | ||||
| -rw-r--r-- | compiler/cmm/CmmLayoutStack.hs | 4 | ||||
| -rw-r--r-- | compiler/cmm/CmmProcPoint.hs | 9 | ||||
| -rw-r--r-- | 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 dc5cfd6ee0..ae192e504c 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 ba3b1c8a53..fce8f7dae8 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 8863012f20..da365cfe7f 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@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 2602dc8d14..3f1633404c 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 3459284c0b..eeae96083a 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 464a041c1e..487f0bc244 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 -- |