[commit: ghc] master: Bitmap: Use foldl' instead of foldr (b1726c1)

git at git.haskell.org git at git.haskell.org
Tue Jan 17 21:37:41 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/b1726c1194f1ed35dffc83304260b3b29abd0c53/ghc

>---------------------------------------------------------------

commit b1726c1194f1ed35dffc83304260b3b29abd0c53
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Wed Jan 11 16:33:40 2017 -0500

    Bitmap: Use foldl' instead of foldr
    
    These are producing StgWords so foldl' is the natural choice. I'm not
    sure how I didn't notice this when I wrote D1041.
    
    Test Plan: Validate
    
    Reviewers: austin, simonmar
    
    Reviewed By: simonmar
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D2955
    
    GHC Trac Issues: #7450


>---------------------------------------------------------------

b1726c1194f1ed35dffc83304260b3b29abd0c53
 compiler/cmm/Bitmap.hs | 10 +++++++---
 1 file changed, 7 insertions(+), 3 deletions(-)

diff --git a/compiler/cmm/Bitmap.hs b/compiler/cmm/Bitmap.hs
index 22ec6ee..a5cff38 100644
--- a/compiler/cmm/Bitmap.hs
+++ b/compiler/cmm/Bitmap.hs
@@ -22,6 +22,7 @@ import SMRep
 import DynFlags
 import Util
 
+import Data.Foldable (foldl')
 import Data.Bits
 
 {-|
@@ -39,7 +40,10 @@ mkBitmap dflags stuff = chunkToBitmap dflags chunk : mkBitmap dflags rest
 
 chunkToBitmap :: DynFlags -> [Bool] -> StgWord
 chunkToBitmap dflags chunk =
-  foldr (.|.) (toStgWord dflags 0) [ toStgWord dflags 1 `shiftL` n | (True,n) <- zip chunk [0..] ]
+  foldl' (.|.) (toStgWord dflags 0) [ oneAt n | (True,n) <- zip chunk [0..] ]
+  where
+    oneAt :: Int -> StgWord
+    oneAt i = toStgWord dflags 1 `shiftL` i
 
 -- | Make a bitmap where the slots specified are the /ones/ in the bitmap.
 -- eg. @[0,1,3], size 4 ==> 0xb at .
@@ -61,7 +65,7 @@ intsToBitmap dflags size = go 0
     go !pos slots
       | size <= pos = []
       | otherwise =
-        (foldr (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) :
+        (foldl' (.|.) (toStgWord dflags 0) (map (\i->oneAt (i - pos)) these)) :
           go (pos + word_sz) rest
       where
         (these,rest) = span (< (pos + word_sz)) slots
@@ -87,7 +91,7 @@ intsToReverseBitmap dflags size = go 0
     go !pos slots
       | size <= pos = []
       | otherwise =
-        (foldr xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) :
+        (foldl' xor (toStgWord dflags init) (map (\i->oneAt (i - pos)) these)) :
           go (pos + word_sz) rest
       where
         (these,rest) = span (< (pos + word_sz)) slots



More information about the ghc-commits mailing list