[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Data.Map.Internal.mergeA: floated out the missingSubtree progection of g1 (c3bd2be)

git at git.haskell.org git at git.haskell.org
Mon Apr 17 21:45:44 UTC 2017


Repository : ssh://git@git.haskell.org/containers

On branches: cleaned_bugfix394,master,merge-doc-target,merge-fixes-5.9,revert-408-bugfix_394
Link       : http://git.haskell.org/packages/containers.git/commitdiff/c3bd2bebeb14db03da8e64f141141838ebc9da25

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

commit c3bd2bebeb14db03da8e64f141141838ebc9da25
Author: wren gayle romano <wren at community.haskell.org>
Date:   Mon Sep 5 14:55:35 2016 -0700

    Data.Map.Internal.mergeA: floated out the missingSubtree progection of g1


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

c3bd2bebeb14db03da8e64f141141838ebc9da25
 Data/Map/Internal.hs | 9 ++++++---
 1 file changed, 6 insertions(+), 3 deletions(-)

diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index 7d09eb9..8787f63 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -2457,14 +2457,17 @@ mergeA :: (Applicative f, Ord k)
               -> Map k a -- ^ Map @m1@
               -> Map k b -- ^ Map @m2@
               -> f (Map k c)
-mergeA g1 WhenMissing{missingSubtree = g2} (WhenMatched f) = go
+mergeA
+    WhenMissing{missingSubtree = g1}
+    WhenMissing{missingSubtree = g2}
+    (WhenMatched f) = go
   where
-    go t1 Tip = missingSubtree g1 t1
+    go t1 Tip = g1 t1
     go Tip t2 = g2 t2
     go (Bin _ kx x1 l1 r1) t2 = case splitLookup kx t2 of
       (l2, mx2, r2) -> case mx2 of
           Nothing -> (\l' mx' r' -> maybe link2 (link kx) mx' l' r')
-                        <$> l1l2 <*> missingKey g1 kx x1 <*> r1r2
+                        <$> l1l2 <*> g1 kx x1 <*> r1r2
           Just x2 -> (\l' mx' r' -> maybe link2 (link kx) mx' l' r')
                         <$> l1l2 <*> f kx x1 x2 <*> r1r2
         where



More information about the ghc-commits mailing list