[commit: packages/containers] master, revert-408-bugfix_394: reverted buggy optimization (bb06c50)

[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/bb06c501932f9c469b4794bb2bacefc0bcc2b5c0

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

commit bb06c501932f9c469b4794bb2bacefc0bcc2b5c0
Author: wren romano <wren at community.haskell.org>
Date:   Mon Feb 13 20:29:24 2017 -0800

    reverted buggy optimization


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

bb06c501932f9c469b4794bb2bacefc0bcc2b5c0
 Data/IntMap/Internal.hs    | 18 +++++++++++++-----
 tests/intmap-properties.hs | 12 ++++++++----
 2 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/Data/IntMap/Internal.hs b/Data/IntMap/Internal.hs
index 07d8171..4277eac 100644
--- a/Data/IntMap/Internal.hs
+++ b/Data/IntMap/Internal.hs
@@ -1132,11 +1132,19 @@ restrictKeys t1@(Bin _ _ _ _) (IntSet.Tip p2 bm2) =
         -- @t1'@, so we generate a mask for all the bitmaps of keys
         -- greater than or equal to this smallest-possible-key and
         -- only look at that subset of @bm2 at .
-        let p1_bit = shiftLL 1 (p1 .&. IntSet.suffixBitMask)
-            bitsLT = p1_bit - 1
-            bitsGE = complement bitsLT
-            bm2' = bm2 .&. bitsGE
-        in restrictBM t1' p2 bm2' (IntSet.suffixBitMask + 1)
+        let s1 :: IntSetPrefix
+            s1 = p1 .&. IntSet.suffixBitMask
+            s1_bitmap :: IntSetBitMap
+            s1_bitmap = shiftLL 1 s1
+            bitsLT_s1 :: IntSetBitMap
+            bitsLT_s1 = s1_bitmap - 1
+            bitsGE_s1 :: IntSetBitMap
+            bitsGE_s1 = complement bitsLT_s1
+
+            -- TODO(wrengr): in principle this should be sound to use in place of @bm2 at . But why isn't it working?
+            bm2' :: IntSetBitMap
+            bm2' = bm2 .&. bitsGE_s1
+        in restrictBM t1' p2 bm2 (IntSet.suffixBitMask + 1)
     t1' -> t1'
 restrictKeys (Bin _ _ _ _) IntSet.Nil = Nil
 restrictKeys t1@(Tip k1 _) t2
diff --git a/tests/intmap-properties.hs b/tests/intmap-properties.hs
index a6fbe2f..7cad004 100644
--- a/tests/intmap-properties.hs
+++ b/tests/intmap-properties.hs
@@ -805,17 +805,21 @@ prop_intersectionWithKeyModel xs ys
           ys' = List.nubBy ((==) `on` fst) ys
           f k l r = k + 2 * l + 3 * r
 
+-- TODO: the second argument should be simply an 'IntSet', but that
+-- runs afoul of our orphan instance.
 prop_restrictKeys :: IMap -> IMap -> Property
-prop_restrictKeys m s0 = m `restrictKeys` s === filterWithKey (\k _ -> k `IntSet.member` s) m
+prop_restrictKeys m s0 =
+    m `restrictKeys` s === filterWithKey (\k _ -> k `IntSet.member` s) m
   where
     s = keysSet s0
-    restricted = restrictKeys m s
 
+-- TODO: the second argument should be simply an 'IntSet', but that
+-- runs afoul of our orphan instance.
 prop_withoutKeys :: IMap -> IMap -> Property
-prop_withoutKeys m s0 = m `withoutKeys` s === filterWithKey (\k _ -> k `IntSet.notMember` s) m
+prop_withoutKeys m s0 =
+    m `withoutKeys` s === filterWithKey (\k _ -> k `IntSet.notMember` s) m
   where
     s = keysSet s0
-    reduced = withoutKeys m s
 
 prop_mergeWithKeyModel :: [(Int,Int)] -> [(Int,Int)] -> Bool
 prop_mergeWithKeyModel xs ys