Use strict foldlswip/foldl

5 files changed, 18 insertions, 18 deletions

diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index dafaea3156..9adbe26758 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -171,7 +171,7 @@ buildSRT dflags topSRT cafs =
                  do localSRTs <- procpointSRT dflags (lbl topSRT) (elt_map topSRT) cafs
                     return (topSRT, localSRTs)
            in if length cafs > 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 =
@@ -264,14 +264,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)) =
           Map.insert l (flatten env cafset) env
         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  = foldr Set.delete (Set.unions cafsets) lbls
+          in foldl' (\env l -> Map.insert l (flatten env cafset) env) env lbls
 
         g = stronglyConnCompFromEdgedVertices
               [ ((l,cafs), l, Set.elems cafs) | (cafs, Just l) <- localCAFs ]
diff --git a/compiler/cmm/CmmCommonBlockElim.hs b/compiler/cmm/CmmCommonBlockElim.hs
index 6c4742edad..fdba55cc25 100644
--- a/compiler/cmm/CmmCommonBlockElim.hs
+++ b/compiler/cmm/CmmCommonBlockElim.hs
@@ -168,7 +168,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 = sum . map f
 
         cvt = fromInteger . toInteger
 
diff --git a/compiler/cmm/CmmLayoutStack.hs b/compiler/cmm/CmmLayoutStack.hs
index 25a0ad6169..6e0fd692d2 100644
--- a/compiler/cmm/CmmLayoutStack.hs
+++ b/compiler/cmm/CmmLayoutStack.hs
@@ -31,7 +31,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')
 import Control.Monad (liftM)
 
 import Prelude hiding ((<*>))
@@ -274,7 +274,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 middle1 middle2
+       let middle_pre = blockToList $ foldl' blockSnoc middle1 middle2
 
            final_blocks = manifestSp dflags final_stackmaps stack0 sp0 final_sp_high entry0
                               middle_pre sp_off last1 fixup_blocks
diff --git a/compiler/cmm/CmmProcPoint.hs b/compiler/cmm/CmmProcPoint.hs
index 0e772c41d0..3518249d6b 100644
--- a/compiler/cmm/CmmProcPoint.hs
+++ b/compiler/cmm/CmmProcPoint.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, DisambiguateRecordFields #-}
+{-# LANGUAGE GADTs, DisambiguateRecordFields, BangPatterns #-}
 
 module CmmProcPoint
     ( ProcPointSet, Status(..)
@@ -19,7 +19,7 @@ import CmmUtils
 import CmmInfo
 import CmmLive (cmmGlobalLiveness)
 import CmmSwitch
-import Data.List (sortBy)
+import Data.List (sortBy, foldl')
 import Maybes
 import Control.Monad
 import Outputable
@@ -215,7 +215,7 @@ extendPPSet platform g blocks procPoints =
        case newPoints of
            []  -> return procPoints'
            pps -> extendPPSet g blocks
-                    (foldl extendBlockSet procPoints' pps)
+                    (foldl' extendBlockSet procPoints' pps)
 -}
        case newPoint of
          Just id ->
@@ -276,8 +276,8 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
                       where block_lbl = blockLbl pp
 
          procLabels :: LabelMap (CLabel, Maybe CLabel)
-         procLabels = foldl add_label mapEmpty
-                            (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
+         procLabels = foldl' add_label mapEmpty
+                             (filter (flip mapMember (toBlockMap g)) (setElems procPoints))
 
      -- In each new graph, add blocks jumping off to the new procedures,
      -- and replace branches to procpoints with branches to the jump-off blocks
@@ -318,7 +318,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)
@@ -360,8 +360,8 @@ splitAtProcPoints dflags entry_label callPPs procPoints procMap
      -- The C back end expects to see return continuations before the
      -- call sites.  Here, we sort them in reverse order -- it gets
      -- reversed later.
-     let (_, block_order) = foldl add_block_num (0::Int, emptyBlockMap) (postorderDfs g)
-         add_block_num (i, map) block = (i+1, mapInsert (entryLabel block) i map)
+     let (_, block_order) = foldl' add_block_num (0::Int, emptyBlockMap) (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 7279013e60..17f31f9df2 100644
--- a/compiler/cmm/CmmSink.hs
+++ b/compiler/cmm/CmmSink.hs
@@ -16,7 +16,7 @@ import DynFlags
 import UniqFM
 import PprCmm ()
 
-import Data.List (partition)
+import Data.List (partition, foldl')
 import qualified Data.Set as Set
 import Data.Maybe
 
@@ -211,7 +211,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'')
@@ -321,7 +321,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
 
 
 --