[commit: packages/containers] cleaned_bugfix394, master, merge-doc-target, merge-fixes-5.9, revert-408-bugfix_394: Data.Map.Internal.mergeA: corrected the floating out of g1 (e6fc53d)
git at git.haskell.org
git at git.haskell.org
Mon Apr 17 21:45:46 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/e6fc53dec18dfab2efc9e5bc281834117b930ec8
>---------------------------------------------------------------
commit e6fc53dec18dfab2efc9e5bc281834117b930ec8
Author: wren gayle romano <wren at community.haskell.org>
Date: Mon Sep 5 15:46:22 2016 -0700
Data.Map.Internal.mergeA: corrected the floating out of g1
>---------------------------------------------------------------
e6fc53dec18dfab2efc9e5bc281834117b930ec8
Data/Map/Internal.hs | 25 +++++++++++++------------
1 file changed, 13 insertions(+), 12 deletions(-)
diff --git a/Data/Map/Internal.hs b/Data/Map/Internal.hs
index 8787f63..a888b44 100644
--- a/Data/Map/Internal.hs
+++ b/Data/Map/Internal.hs
@@ -2450,24 +2450,25 @@ merge g1 g2 f m1 m2 = runIdentity $
-- 'mergeA' to define custom combining functions.
--
-- @since 0.5.8
-mergeA :: (Applicative f, Ord k)
- => WhenMissing f k a c -- ^ What to do with keys in @m1@ but not @m2@
- -> WhenMissing f k b c -- ^ What to do with keys in @m2@ but not @m1@
- -> WhenMatched f k a b c -- ^ What to do with keys in both @m1@ and @m2@
- -> Map k a -- ^ Map @m1@
- -> Map k b -- ^ Map @m2@
- -> f (Map k c)
mergeA
- WhenMissing{missingSubtree = g1}
- WhenMissing{missingSubtree = g2}
+ :: (Applicative f, Ord k)
+ => WhenMissing f k a c -- ^ What to do with keys in @m1@ but not @m2@
+ -> WhenMissing f k b c -- ^ What to do with keys in @m2@ but not @m1@
+ -> WhenMatched f k a b c -- ^ What to do with keys in both @m1@ and @m2@
+ -> Map k a -- ^ Map @m1@
+ -> Map k b -- ^ Map @m2@
+ -> f (Map k c)
+mergeA
+ WhenMissing{missingSubtree = g1t, missingKey = g1k}
+ WhenMissing{missingSubtree = g2t}
(WhenMatched f) = go
where
- go t1 Tip = g1 t1
- go Tip t2 = g2 t2
+ go t1 Tip = g1t t1
+ go Tip t2 = g2t 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 <*> g1 kx x1 <*> r1r2
+ <$> l1l2 <*> g1k 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