[commit: containers] master: Improve Int{Set,Map}.fold*. (a7d02d5)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/a7d02d55385798a872daf6340fc29c762550d9ac

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

commit a7d02d55385798a872daf6340fc29c762550d9ac
Author: Milan Straka <fox at ucw.cz>
Date:   Sun Mar 4 16:26:38 2012 +0100

    Improve Int{Set,Map}.fold*.
    
    In the fold definitions, do not call go if the Bin constructor was
    matched during the test for negative numbers. Instead, manually inline
    that branch of go.
    
    Otherwise GHC optimizer does this for us -- it creates local definition
    of that branch of go and calls it. On my machine, it causes >200B growth
    of object file, for every fold.

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

 Data/IntMap/Base.hs |   24 ++++++++++++++++--------
 Data/IntSet.hs      |   12 ++++++++----
 2 files changed, 24 insertions(+), 12 deletions(-)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 2cda65f..0fd9eac 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -1385,7 +1385,8 @@ splitLookup k t =
 foldr :: (a -> b -> b) -> b -> IntMap a -> b
 foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z r) l
+            _ -> go z t
   where
     go z' Nil           = z'
     go z' (Tip _ x)     = f x z'
@@ -1398,7 +1399,8 @@ foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldr' :: (a -> b -> b) -> b -> IntMap a -> b
 foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z r) l
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'
@@ -1418,7 +1420,8 @@ foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldl :: (a -> b -> a) -> a -> IntMap b -> a
 foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z l) r
+            _ -> go z t
   where
     go z' Nil           = z'
     go z' (Tip _ x)     = f z' x
@@ -1431,7 +1434,8 @@ foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldl' :: (a -> b -> a) -> a -> IntMap b -> a
 foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z l) r
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'
@@ -1452,7 +1456,8 @@ foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldrWithKey :: (Int -> a -> b -> b) -> b -> IntMap a -> b
 foldrWithKey f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z r) l
+            _ -> go z t
   where
     go z' Nil           = z'
     go z' (Tip kx x)    = f kx x z'
@@ -1465,7 +1470,8 @@ foldrWithKey f z = \t ->      -- Use lambda t to be inlinable with two arguments
 foldrWithKey' :: (Int -> a -> b -> b) -> b -> IntMap a -> b
 foldrWithKey' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z r) l
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'
@@ -1486,7 +1492,8 @@ foldrWithKey' f z = \t ->      -- Use lambda t to be inlinable with two argument
 foldlWithKey :: (a -> Int -> b -> a) -> a -> IntMap b -> a
 foldlWithKey f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z l) r
+            _ -> go z t
   where
     go z' Nil           = z'
     go z' (Tip kx x)    = f z' kx x
@@ -1499,7 +1506,8 @@ foldlWithKey f z = \t ->      -- Use lambda t to be inlinable with two arguments
 foldlWithKey' :: (a -> Int -> b -> a) -> a -> IntMap b -> a
 foldlWithKey' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z l) r
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'
diff --git a/Data/IntSet.hs b/Data/IntSet.hs
index c22dbb4..f2ca853 100644
--- a/Data/IntSet.hs
+++ b/Data/IntSet.hs
@@ -716,7 +716,8 @@ fold = foldr
 foldr :: (Int -> b -> b) -> b -> IntSet -> b
 foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z r) l
+            _ -> go z t
   where
     go z' Nil           = z'
     go z' (Tip kx bm)   = foldrBits kx f z' bm
@@ -729,7 +730,8 @@ foldr f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldr' :: (Int -> b -> b) -> b -> IntSet -> b
 foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z l) r -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z r) l
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'
@@ -746,7 +748,8 @@ foldr' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldl :: (a -> Int -> a) -> a -> IntSet -> a
 foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z l) r
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'
@@ -760,7 +763,8 @@ foldl f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
 foldl' :: (a -> Int -> a) -> a -> IntSet -> a
 foldl' f z = \t ->      -- Use lambda t to be inlinable with two arguments only.
   case t of Bin _ m l r | m < 0 -> go (go z r) l -- put negative numbers before
-            _                   -> go z t
+                        | otherwise -> go (go z l) r
+            _ -> go z t
   where
     STRICT_1_OF_2(go)
     go z' Nil           = z'