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 <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
