[commit: packages/containers] master, revert-408-bugfix_394: Finally fixed restrictBM! (36ea2ed)

[git at git.haskell.org]

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

On branches: master,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/36ea2edbdd85d191d4de026c7ba6a02460864c0b

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

commit 36ea2edbdd85d191d4de026c7ba6a02460864c0b
Author: wren romano <wren at community.haskell.org>
Date:   Thu Feb 16 17:51:16 2017 -0800

    Finally fixed restrictBM!


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

36ea2edbdd85d191d4de026c7ba6a02460864c0b
 Data/IntMap/Internal.hs | 46 ++++++----------------------------------------
 1 file changed, 6 insertions(+), 40 deletions(-)

diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs
index c987bdd..0dc0a47 100644
--- a/Data/IntMap/Internal.hs
+++ b/Data/IntMap/Internal.hs
@@ -1127,6 +1127,8 @@ restrictKeys t1@(Bin p1 m1 l1 r1) t2@(IntSet.Bin p2 m2 l2 r2)
 restrictKeys t1@(Bin _ _ _ _) (IntSet.Tip p2 bm2) =
     -- TODO(wrengr): should we manually inline/unroll 'lookupPrefix'
     -- and 'restrictBM' here, in order to avoid redundant case analyses?
+    -- TODO(wrengr): mask out the too-small and too-large keys
+    -- before entering 'restrictBM', for better IH.
     restrictBM bm2 (lookupPrefix p2 t1)
 restrictKeys (Bin _ _ _ _) IntSet.Nil = Nil
 restrictKeys t1@(Tip k1 _) t2
@@ -1153,19 +1155,12 @@ lookupPrefix _ Nil = Nil
 
 
 restrictBM :: IntSetBitMap -> IntMap a -> IntMap a
-{-
--- See note below about 'bitmapForBin'.
 restrictBM 0 _ = Nil
--}
 restrictBM bm (Bin p m l r) =
-    {-
-    -- Assuming 'bitmapForBin' actually worked correctly, this would let us short-circuit by hitting the 0 case above.
-    let m'  = intFromNat (natFromInt m `shiftRL` 1)
-        bmL = bitmapForBin p m'
-        bmR = bitmapForBin (p .|. m) m'
-    in bin p m (restrictBM bmL l) (restrictBM bmR r)
-    -}
-    bin p m (restrictBM bm l) (restrictBM bm r)
+    let leftBits = shiftLL 1 ((p .|. m) .&. IntSet.suffixBitMask) - 1
+        bmL = bm .&. leftBits
+        bmR = bm `xor` bmL -- = (bm .&. complement leftBits)
+    in  bin p m (restrictBM bmL l) (restrictBM bmR r)
 restrictBM bm t@(Tip k _)
     -- TODO(wrengr): need we manually inline 'IntSet.Member' here?
     | k `IntSet.member` IntSet.Tip (k .&. IntSet.prefixBitMask) bm = t
@@ -1173,35 +1168,6 @@ restrictBM bm t@(Tip k _)
 restrictBM _ Nil = Nil
 
 
-{-
--- TODO(wrengr): this is buggy somehow.
--- | Return an `IntSet`-bitmap for all keys that could possibly be
--- contained in an `IntMap`-`Bin` with the given prefix and switching
--- bit.
-bitmapForBin :: Prefix -> Mask -> IntSetBitMap
-bitmapForBin p m =
-    largeEnough .&. smallEnough
-    where
-    -- The bitmap containing only the smallest key possibly in the tree.
-    minbit :: IntSetBitMap
-    minbit = bitmapOf p
-    -- Bitmap of all keys greater than or equal to @minkey at .
-    largeEnough :: IntSetBitMap
-    largeEnough = complement (minbit - 1)
-    -- The bitmap containing only the largest key possibly in the tree.
-    maxbit :: IntSetBitMap
-    maxbit = bitmapOf (p .|. m .|. (m - 1))
-    -- Bitmap of all keys less than or equal to @maxkey at .
-    smallEnough :: IntSetBitMap
-    smallEnough = maxbit .|. (maxbit - 1)
-
-    bitmapOf :: Int -> IntSetBitMap
-    bitmapOf i = shiftLL 1 (i .&. IntSet.suffixBitMask)
-    {-# INLINE bitmapOf #-}
-{-# INLINE bitmapForBin #-}
--}
-
-
 -- | /O(n+m)/. The intersection with a combining function.
 --
 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"