[commit: containers] : Try to improve foldrBit (for toMap) (c5c1c6a)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/c5c1c6ae7ee6c067ad9b55b66e8b05dc234fa0a0

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

commit c5c1c6ae7ee6c067ad9b55b66e8b05dc234fa0a0
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sun Sep 18 23:16:45 2011 +0200

    Try to improve foldrBit (for toMap)

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

 Data/DenseIntSet.hs |   27 ++++++++++++++++-----------
 1 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/Data/DenseIntSet.hs b/Data/DenseIntSet.hs
index a8ffdd2..7883c7f 100644
--- a/Data/DenseIntSet.hs
+++ b/Data/DenseIntSet.hs
@@ -50,6 +50,7 @@ module Data.DenseIntSet (
               IntSet          -- instance Eq,Show
 #else
               IntSet(..)      -- instance Eq,Show
+            , foldrBits
 #endif
 
             -- * Operators
@@ -153,6 +154,7 @@ import Data.Word
 -- We do not use BangPatterns, because they are not in any standard and we
 -- want the compilers to be compiled by as many compilers as possible.
 #define STRICT_1_OF_2(fn) fn arg _ | arg `seq` False = undefined
+#define STRICT_1_OF_3(fn) fn arg _ _ | arg `seq` False = undefined
 #define STRICT_2_OF_3(fn) fn _ arg _ | arg `seq` False = undefined
 
 infixl 9 \\{-This comment teaches CPP correct behaviour -}
@@ -1149,27 +1151,30 @@ foldlBits :: Int -> (a -> Int -> a) -> a -> Word -> a
 foldlBits shift f = go shift
   where STRICT_2_OF_3(go)
         go bi acc 0 = acc
-        go bi acc n | n `testBit` 0 = go (succ bi) (f acc bi) (n `shiftRL` 1)
-                    | otherwise     = go (succ bi)    acc     (n `shiftRL` 1)
+        go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1)
+                    | otherwise     = go (bi + 1)    acc     (n `shiftRL` 1)
 
 foldl'Bits :: Int -> (a -> Int -> a) -> a -> Word -> a
 foldl'Bits shift f = go shift
-  where STRICT_2_OF_3(go)
+  where STRICT_1_OF_3(go)
+        STRICT_2_OF_3(go)
         go bi acc 0 = acc
-        go bi acc n | n `testBit` 0 = go (succ bi) (f acc bi) (n `shiftRL` 1)
-                    | otherwise     = go (succ bi)    acc     (n `shiftRL` 1)
+        go bi acc n | n `testBit` 0 = go (bi + 1) (f acc bi) (n `shiftRL` 1)
+                    | otherwise     = go (bi + 1)    acc     (n `shiftRL` 1)
 
 foldrBits :: Int -> (Int -> a -> a) -> a -> Word -> a
-foldrBits shift f x = go shift
-  where go bi 0 = x
-        go bi n | n `testBit` 0 = f bi (go (succ bi) (n `shiftRL` 1))
-                | otherwise     =       go (succ bi) (n `shiftRL` 1)
+foldrBits shift f x bm = let lb = lowestBitSet bm 
+                         in  go (shift+lb) (bm `shiftRL` lb)
+  where STRICT_1_OF_2(go)
+        go bi 0 = x
+        go bi n | n `testBit` 0 = f bi (go (bi + 1) (n `shiftRL` 1))
+                | otherwise     =       go (bi + 1) (n `shiftRL` 1)
 
 foldr'Bits :: Int -> (Int -> a -> a) -> a -> Word -> a
 foldr'Bits shift f x = go shift
   where go bi 0 = x
-        go bi n | n `testBit` 0 = f bi $! go (succ bi) (n `shiftRL` 1)
-                | otherwise     =         go (succ bi) (n `shiftRL` 1)
+        go bi n | n `testBit` 0 = f bi $! go (bi + 1) (n `shiftRL` 1)
+                | otherwise     =         go (bi + 1) (n `shiftRL` 1)
 
 lowestBitSet :: Word -> Int
 lowestBitSet n0 =