[commit: packages/containers] master, revert-408-bugfix_394: cleaning up (5ce1687)

[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/5ce1687f163a24f8f13bc5d8054bfa42591772ef

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

commit 5ce1687f163a24f8f13bc5d8054bfa42591772ef
Author: wren romano <wren at community.haskell.org>
Date:   Thu Feb 16 18:07:29 2017 -0800

    cleaning up


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

5ce1687f163a24f8f13bc5d8054bfa42591772ef
 Data/IntMap/Internal.hs | 17 ++++++++++++-----
 1 file changed, 12 insertions(+), 5 deletions(-)

diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs
index 0dc0a47..17741b0 100644
--- a/Data/IntMap/Internal.hs
+++ b/Data/IntMap/Internal.hs
@@ -1124,12 +1124,14 @@ restrictKeys t1@(Bin p1 m1 l1 r1) t2@(IntSet.Bin p2 m2 l2 r2)
         | nomatch p1 p2 m2  = Nil
         | zero p1 m2        = restrictKeys t1 l2
         | otherwise         = restrictKeys t1 r2
-restrictKeys t1@(Bin _ _ _ _) (IntSet.Tip p2 bm2) =
+restrictKeys t1@(Bin p1 m1 _ _) (IntSet.Tip p2 bm2) =
+    let minbit = bitmapOf p1
+        ge_minbit = complement (minbit - 1)
+        maxbit = bitmapOf (p1 .|. (m1 .|. (m1 - 1)))
+        le_maxbit = maxbit .|. (maxbit - 1)
     -- 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)
+    in restrictBM (bm2 .&. ge_minbit .&. le_maxbit) (lookupPrefix p2 t1)
 restrictKeys (Bin _ _ _ _) IntSet.Nil = Nil
 restrictKeys t1@(Tip k1 _) t2
     | k1 `IntSet.member` t2 = t1
@@ -1157,7 +1159,7 @@ lookupPrefix _ Nil = Nil
 restrictBM :: IntSetBitMap -> IntMap a -> IntMap a
 restrictBM 0 _ = Nil
 restrictBM bm (Bin p m l r) =
-    let leftBits = shiftLL 1 ((p .|. m) .&. IntSet.suffixBitMask) - 1
+    let leftBits = bitmapOf (p .|. m) - 1
         bmL = bm .&. leftBits
         bmR = bm `xor` bmL -- = (bm .&. complement leftBits)
     in  bin p m (restrictBM bmL l) (restrictBM bmR r)
@@ -1168,6 +1170,11 @@ restrictBM bm t@(Tip k _)
 restrictBM _ Nil = Nil
 
 
+bitmapOf :: Int -> IntSetBitMap
+bitmapOf x = shiftLL 1 (x .&. IntSet.suffixBitMask)
+{-# INLINE bitmapOf #-}
+
+
 -- | /O(n+m)/. The intersection with a combining function.
 --
 -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA"