[commit: containers] master: Improve heap-allocation in mergeWithKey'. (6f8344e)

[Paolo Capriotti]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6f8344ef7e22ba7dee1e97a86f976bbec29dcc50

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

commit 6f8344ef7e22ba7dee1e97a86f976bbec29dcc50
Author: Milan Straka <fox at ucw.cz>
Date:   Fri Apr 27 10:36:28 2012 +0200

    Improve heap-allocation in mergeWithKey'.
    
    Avoid allocating the closure for local function 'merge'.

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

 Data/IntMap/Base.hs |   28 ++++++++++++++--------------
 1 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/Data/IntMap/Base.hs b/Data/IntMap/Base.hs
index 1e90f6b..edf2dd0 100644
--- a/Data/IntMap/Base.hs
+++ b/Data/IntMap/Base.hs
@@ -969,23 +969,23 @@ 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 _) = 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 _) | k1 == k2 = f t1 t2
-                                | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
-            merge Nil = g2 t2
+    go t1'@(Bin _ _ _ _) t2'@(Tip k2' _) = merge t2' k2' t1'
+      where merge t2 k2 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 t2 k2 l1) (g1 r1)
+                                             | otherwise  = bin' p1 m1 (g1 l1) (merge t2 k2 r1)
+            merge t2 k2 t1@(Tip k1 _) | k1 == k2 = f t1 t2
+                                      | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+            merge t2 _  Nil = g2 t2
 
     go t1@(Bin _ _ _ _) Nil = g1 t1
 
-    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 _) | k1 == k2 = f t1 t2
-                                | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
-            merge Nil = g1 t1
+    go t1'@(Tip k1' _) t2' = merge t1' k1' t2'
+      where merge t1 k1 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 t1 k1 l2) (g2 r2)
+                                             | otherwise  = bin' p2 m2 (g2 l2) (merge t1 k1 r2)
+            merge t1 k1 t2@(Tip k2 _) | k1 == k2 = f t1 t2
+                                      | otherwise = maybe_join k1 (g1 t1) k2 (g2 t2)
+            merge t1 _  Nil = g1 t1
 
     go Nil t2 = g2 t2