From 83e98f5e638803ede7cd38fa32bca0cfe57201f0 Mon Sep 17 00:00:00 2001
From: David Feuer <David.Feuer@gmail.com>
Date: Mon, 6 Feb 2017 18:16:43 -0500
Subject: [PATCH] Fix restrictKeys and withoutKeys for IntMap
Merges the fix from master.
---
Data/IntMap/Base.hs | 42 +++++++++-----------------------------
containers.cabal | 2 +-
tests/intmap-properties.hs | 2 ++
3 files changed, 13 insertions(+), 33 deletions(-)
diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 1f26af72..60ad0d15 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -1000,24 +1000,14 @@ withoutKeys = go
| zero p1 m2 = bin p2 m2 (go t1 l2) Nil
| otherwise = bin p2 m2 Nil (go t1 r2)
- go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip k2' _) = merge t2' k2' t1'
- where merge t2 k2 t1@(Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = t1
- | zero k2 m1 = binCheckLeft p1 m1 (merge t2 k2 l1) r1
- | otherwise = binCheckRight p1 m1 l1 (merge t2 k2 r1)
- merge _ k2 t1@(Tip k1 _) | k1 == k2 = Nil
- | otherwise = t1
- merge _ _ Nil = Nil
+ go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip _ _) =
+ filterWithKey (\k _ -> k `IntSet.notMember` t2') t1'
go t1@(Bin _ _ _ _) IntSet.Nil = t1
- go t1'@(Tip k1' _) t2' = merge t1' k1' t2'
- where merge t1 k1 (IntSet.Bin p2 m2 l2 r2) | nomatch k1 p2 m2 = t1
- | zero k1 m2 = bin p2 m2 (merge t1 k1 l2) Nil
- | otherwise = bin p2 m2 Nil (merge t1 k1 r2)
- merge t1 k1 (IntSet.Tip k2 _) | k1 == k2 = Nil
- | otherwise = t1
- merge t1 _ IntSet.Nil = t1
-
+ go t1'@(Tip k1' _) t2'
+ | k1' `IntSet.member` t2' = Nil
+ | otherwise = t1'
go Nil _ = Nil
@@ -1055,25 +1045,13 @@ restrictKeys = go
| zero p1 m2 = bin p2 m2 (go t1 l2) Nil
| otherwise = bin p2 m2 Nil (go t1 r2)
- go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip k2' _) = merge t2' k2' t1'
- where merge t2 k2 (Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = Nil
- | zero k2 m1 = bin p1 m1 (merge t2 k2 l1) Nil
- | otherwise = bin p1 m1 Nil (merge t2 k2 r1)
- merge _ k2 t1@(Tip k1 _) | k1 == k2 = t1
- | otherwise = Nil
- merge _ _ Nil = Nil
-
+ go t1'@(Bin _ _ _ _) t2'@(IntSet.Tip _ _) =
+ filterWithKey (\k _ -> k `IntSet.member` t2') t1'
go (Bin _ _ _ _) IntSet.Nil = Nil
- go t1'@(Tip k1' _) t2' = merge t1' k1' t2'
- where merge t1 k1 (IntSet.Bin p2 m2 l2 r2)
- | nomatch k1 p2 m2 = Nil
- | zero k1 m2 = bin p2 m2 (merge t1 k1 l2) Nil
- | otherwise = bin p2 m2 Nil (merge t1 k1 r2)
- merge t1 k1 (IntSet.Tip k2 _) | k1 == k2 = t1
- | otherwise = Nil
- merge _ _ IntSet.Nil = Nil
-
+ go t1'@(Tip k1' _) t2'
+ | k1' `IntSet.member` t2' = t1'
+ | otherwise = Nil
go Nil _ = Nil
-- | /O(n+m)/. The intersection with a combining function.
diff --git a/containers.cabal b/containers.cabal
index 46b45563..a2606d2b 100644
--- a/containers.cabal
+++ b/containers.cabal
@@ -1,5 +1,5 @@
name: containers
-version: 0.5.8.1
+version: 0.5.8.2
license: BSD3
license-file: LICENSE
maintainer: libraries@haskell.org
diff --git a/tests/intmap-properties.hs b/tests/intmap-properties.hs
index 21ee9f69..a6fbe2fd 100644
--- a/tests/intmap-properties.hs
+++ b/tests/intmap-properties.hs
@@ -167,6 +167,8 @@ main = defaultMain
, testProperty "foldl'" prop_foldl'
, testProperty "keysSet" prop_keysSet
, testProperty "fromSet" prop_fromSet
+ , testProperty "restrictKeys" prop_restrictKeys
+ , testProperty "withoutKeys" prop_withoutKeys
]
apply2 :: Fun (a, b) c -> a -> b -> c
--
GitLab