author Milan Straka Mon, 23 Apr 2012 08:53:49 +0000 (10:53 +0200) committer Milan Straka Mon, 23 Apr 2012 08:53:49 +0000 (10:53 +0200)
 Data/IntMap/Base.hs patch | blob | history Data/IntMap/Strict.hs patch | blob | history Data/Map/Base.hs patch | blob | history Data/Set.hs patch | blob | history

index f2ae1a8..d93d581 100644 (file)
@@ -829,8 +829,9 @@ intersectionWithKey f m1 m2
mergeWithKey :: (Key -> a -> b -> Maybe c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
-> IntMap a -> IntMap b -> IntMap c
mergeWithKey f g1 g2 = mergeWithKey' bin combine g1 g2
-  where combine (Tip k1 x1) (Tip _k2 x2) = case f k1 x1 x2 of Nothing -> Nil
-                                                              Just x -> Tip k1 x
+  where -- We use the lambda form to avoid non-exhaustive pattern matches warning.
+        combine = \(Tip k1 x1) (Tip _k2 x2) -> case f k1 x1 x2 of Nothing -> Nil
+                                                                  Just x -> Tip k1 x
{-# INLINE combine #-}
{-# INLINE mergeWithKey #-}

@@ -860,22 +861,22 @@ mergeWithKey' bin' f g1 g2 = go
| zero p1 m2        = bin' p2 m2 (go t1 l2) (g2 r2)
| otherwise         = bin' p2 m2 (g2 l2) (go t1 r2)

-    go t1'@(Bin _ _ _ _) t2@(Tip k2 x2) = merge t1'
+    go t1'@(Bin _ _ _ _) t2@(Tip k2 _) = merge t1'
where merge t1@(Bin p1 m1 l1 r1) | nomatch k2 p1 m1 = maybe_join p1 (g1 t1) k2 (g2 t2)
| zero k2 m1 = bin' p1 m1 (merge l1) (g1 r1)
| otherwise  = bin' p1 m1 (g1 l1) (merge r1)
-            merge t1@(Tip k1 x1) | k1 == k2 = f t1 t2
-                                 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+            merge t1@(Tip k1 _) | k1 == k2 = f t1 t2
+                                | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
merge Nil = g2 t2

go t1@(Bin _ _ _ _) Nil = g1 t1

-    go t1@(Tip k1 x1) t2' = merge t2'
+    go t1@(Tip k1 _) t2' = merge t2'
where merge t2@(Bin p2 m2 l2 r2) | nomatch k1 p2 m2 = maybe_join k1 (g1 t1) p2 (g2 t2)
| zero k1 m2 = bin' p2 m2 (merge l2) (g2 r2)
| otherwise  = bin' p2 m2 (g2 l2) (merge r2)
-            merge t2@(Tip k2 x2) | k1 == k2 = f t1 t2
-                                 | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+            merge t2@(Tip k2 _) | k1 == k2 = f t1 t2
+                                | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
merge Nil = g1 t1

go Nil t2 = g2 t2
index 77a8d10..1e985ab 100644 (file)
@@ -626,8 +626,9 @@ intersectionWithKey f m1 m2
mergeWithKey :: (Key -> a -> b -> Maybe c) -> (IntMap a -> IntMap c) -> (IntMap b -> IntMap c)
-> IntMap a -> IntMap b -> IntMap c
mergeWithKey f g1 g2 = mergeWithKey' bin combine g1 g2
-  where combine (Tip k1 x1) (Tip _k2 x2) = case f k1 x1 x2 of Nothing -> Nil
-                                                              Just x -> x `seq` Tip k1 x
+  where -- We use the lambda form to avoid non-exhaustive pattern matches warning.
+        combine = \(Tip k1 x1) (Tip _k2 x2) -> case f k1 x1 x2 of Nothing -> Nil
+                                                                  Just x -> x `seq` Tip k1 x
{-# INLINE combine #-}
{-# INLINE mergeWithKey #-}

index 2d7dd07..23ef38f 100644 (file)
@@ -425,7 +425,7 @@ member :: Ord k => k -> Map k a -> Bool
member k = k `seq` go
where
go Tip = False
-    go (Bin _ kx x l r) = case compare k kx of
+    go (Bin _ kx _ l r) = case compare k kx of
LT -> go l
GT -> go r
EQ -> True
@@ -901,7 +901,7 @@ deleteAt :: Int -> Map k a -> Map k a
deleteAt i t = i `seq`
case t of
Tip -> error "Map.deleteAt: index out of range"
-    Bin sx kx x l r -> case compare i sizeL of
+    Bin _ kx x l r -> case compare i sizeL of
LT -> balanceR kx x (deleteAt i l) r
GT -> balanceL kx x l (deleteAt (i-sizeL-1) r)
EQ -> glue l r
@@ -1651,8 +1651,8 @@ mapKeysMonotonic f (Bin sz k x l r) =
foldr :: (a -> b -> b) -> b -> Map k a -> b
foldr f z = go z
where
-    go z Tip             = z
-    go z (Bin _ _ x l r) = go (f x (go z r)) l
+    go z' Tip             = z'
+    go z' (Bin _ _ x l r) = go (f x (go z' r)) l
{-# INLINE foldr #-}

-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
@@ -1662,8 +1662,8 @@ foldr' :: (a -> b -> b) -> b -> Map k a -> b
foldr' f z = go z
where
STRICT_1_OF_2(go)
-    go z Tip             = z
-    go z (Bin _ _ x l r) = go (f x (go z r)) l
+    go z' Tip             = z'
+    go z' (Bin _ _ x l r) = go (f x (go z' r)) l
{-# INLINE foldr' #-}

-- | /O(n)/. Fold the values in the map using the given left-associative
@@ -1678,8 +1678,8 @@ foldr' f z = go z
foldl :: (a -> b -> a) -> a -> Map k b -> a
foldl f z = go z
where
-    go z Tip             = z
-    go z (Bin _ _ x l r) = go (f (go z l) x) r
+    go z' Tip             = z'
+    go z' (Bin _ _ x l r) = go (f (go z' l) x) r
{-# INLINE foldl #-}

-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
@@ -1689,8 +1689,8 @@ foldl' :: (a -> b -> a) -> a -> Map k b -> a
foldl' f z = go z
where
STRICT_1_OF_2(go)
-    go z Tip             = z
-    go z (Bin _ _ x l r) = go (f (go z l) x) r
+    go z' Tip             = z'
+    go z' (Bin _ _ x l r) = go (f (go z' l) x) r
{-# INLINE foldl' #-}

-- | /O(n)/. Fold the keys and values in the map using the given right-associative
@@ -1706,8 +1706,8 @@ foldl' f z = go z
foldrWithKey :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey f z = go z
where
-    go z Tip             = z
-    go z (Bin _ kx x l r) = go (f kx x (go z r)) l
+    go z' Tip             = z'
+    go z' (Bin _ kx x l r) = go (f kx x (go z' r)) l
{-# INLINE foldrWithKey #-}

-- | /O(n)/. A strict version of 'foldrWithKey'. Each application of the operator is
@@ -1717,8 +1717,8 @@ foldrWithKey' :: (k -> a -> b -> b) -> b -> Map k a -> b
foldrWithKey' f z = go z
where
STRICT_1_OF_2(go)
-    go z Tip              = z
-    go z (Bin _ kx x l r) = go (f kx x (go z r)) l
+    go z' Tip              = z'
+    go z' (Bin _ kx x l r) = go (f kx x (go z' r)) l
{-# INLINE foldrWithKey' #-}

-- | /O(n)/. Fold the keys and values in the map using the given left-associative
@@ -1734,8 +1734,8 @@ foldrWithKey' f z = go z
foldlWithKey :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey f z = go z
where
-    go z Tip              = z
-    go z (Bin _ kx x l r) = go (f (go z l) kx x) r
+    go z' Tip              = z'
+    go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r
{-# INLINE foldlWithKey #-}

-- | /O(n)/. A strict version of 'foldlWithKey'. Each application of the operator is
@@ -1745,8 +1745,8 @@ foldlWithKey' :: (a -> k -> b -> a) -> a -> Map k b -> a
foldlWithKey' f z = go z
where
STRICT_1_OF_2(go)
-    go z Tip              = z
-    go z (Bin _ kx x l r) = go (f (go z l) kx x) r
+    go z' Tip              = z'
+    go z' (Bin _ kx x l r) = go (f (go z' l) kx x) r
{-# INLINE foldlWithKey' #-}

{--------------------------------------------------------------------
index 1b208c9..ffc73ce 100644 (file)
@@ -608,8 +608,8 @@ fold = foldr
foldr :: (a -> b -> b) -> b -> Set a -> b
foldr f z = go z
where
-    go z Tip           = z
-    go z (Bin _ x l r) = go (f x (go z r)) l
+    go z' Tip           = z'
+    go z' (Bin _ x l r) = go (f x (go z' r)) l
{-# INLINE foldr #-}

-- | /O(n)/. A strict version of 'foldr'. Each application of the operator is
@@ -619,8 +619,8 @@ foldr' :: (a -> b -> b) -> b -> Set a -> b
foldr' f z = go z
where
STRICT_1_OF_2(go)
-    go z Tip           = z
-    go z (Bin _ x l r) = go (f x (go z r)) l
+    go z' Tip           = z'
+    go z' (Bin _ x l r) = go (f x (go z' r)) l
{-# INLINE foldr' #-}

-- | /O(n)/. Fold the elements in the set using the given left-associative
@@ -632,8 +632,8 @@ foldr' f z = go z
foldl :: (a -> b -> a) -> a -> Set b -> a
foldl f z = go z
where
-    go z Tip           = z
-    go z (Bin _ x l r) = go (f (go z l) x) r
+    go z' Tip           = z'
+    go z' (Bin _ x l r) = go (f (go z' l) x) r
{-# INLINE foldl #-}

-- | /O(n)/. A strict version of 'foldl'. Each application of the operator is
@@ -643,8 +643,8 @@ foldl' :: (a -> b -> a) -> a -> Set b -> a
foldl' f z = go z
where
STRICT_1_OF_2(go)
-    go z Tip           = z
-    go z (Bin _ x l r) = go (f (go z l) x) r
+    go z' Tip           = z'
+    go z' (Bin _ x l r) = go (f (go z' l) x) r
{-# INLINE foldl' #-}

{--------------------------------------------------------------------