Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b19776e51d99f9264c9449952950f5f6071a0aa3 >--------------------------------------------------------------- commit b19776e51d99f9264c9449952950f5f6071a0aa3 Author: Milan Straka <[email protected]> Date: Fri Apr 27 11:30:13 2012 +0200 Improve {Map, Set}.intersection. Use the hedge-intersection algorithm, similar to hedge-union and hedge-difference. Depending on inputs, this causes up to 80% speedup. Also remove Set.splitLookup, which was used only to define intersection. >--------------------------------------------------------------- Data/Map/Base.hs | 23 ++++++++++++++--------- Data/Set/Base.hs | 48 ++++++++++++++++++++---------------------------- 2 files changed, 34 insertions(+), 37 deletions(-) diff --git a/Data/Map/Base.hs b/Data/Map/Base.hs index 900099e..ae22b51 100644 --- a/Data/Map/Base.hs +++ b/Data/Map/Base.hs @@ -1401,19 +1401,24 @@ hedgeDiffWithKey f blo bhi t (Bin _ kx x l r) intersection :: Ord k => Map k a -> Map k b -> Map k a intersection Tip _ = Tip intersection _ Tip = Tip -intersection t1@(Bin s1 k1 x1 l1 r1) t2@(Bin s2 k2 _ l2 r2) = - if s1 >= s2 then - case splitLookupWithKey k2 t1 of - (lt, Just (k, x), gt) -> join k x (intersection lt l2) (intersection gt r2) - (lt, Nothing, gt) -> merge (intersection lt l2) (intersection gt r2) - else - case splitLookup k1 t2 of - (lt, Just _, gt) -> join k1 x1 (intersection l1 lt) (intersection r1 gt) - (lt, Nothing, gt) -> merge (intersection l1 lt) (intersection r1 gt) +intersection t1 t2 = hedgeInt NothingS NothingS t1 t2 #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE intersection #-} #endif +hedgeInt :: Ord k => MaybeS k -> MaybeS k -> Map k a -> Map k b -> Map k a +hedgeInt _ _ _ Tip = Tip +hedgeInt _ _ Tip _ = Tip +hedgeInt blo bhi (Bin _ kx x l r) t2 + = let l' = (hedgeInt blo bmi l (trim blo bmi t2)) + r' = (hedgeInt bmi bhi r (trim bmi bhi t2)) + in if kx `member` t2 then join kx x l' r' else merge l' r' + where + bmi = JustS kx +#if __GLASGOW_HASKELL__ >= 700 +{-# INLINABLE hedgeInt #-} +#endif + -- | /O(n+m)/. Intersection with a combining function. -- -- > intersectionWith (++) (fromList [(5, "a"), (3, "b")]) (fromList [(5, "A"), (7, "C")]) == singleton 5 "aA" diff --git a/Data/Set/Base.hs b/Data/Set/Base.hs index d72c161..a8573c7 100644 --- a/Data/Set/Base.hs +++ b/Data/Set/Base.hs @@ -621,23 +621,24 @@ hedgeDiff blo bhi t (Bin _ x l r) intersection :: Ord a => Set a -> Set a -> Set a intersection Tip _ = Tip intersection _ Tip = Tip -intersection t1@(Bin s1 x1 l1 r1) t2@(Bin s2 x2 l2 r2) = - if s1 >= s2 then - let (lt,found,gt) = splitLookup x2 t1 - tl = intersection lt l2 - tr = intersection gt r2 - in case found of - Just x -> join x tl tr - Nothing -> merge tl tr - else let (lt,found,gt) = splitMember x1 t2 - tl = intersection l1 lt - tr = intersection r1 gt - in if found then join x1 tl tr - else merge tl tr +intersection t1 t2 = hedgeInt NothingS NothingS t1 t2 #if __GLASGOW_HASKELL__ >= 700 {-# INLINABLE intersection #-} #endif +hedgeInt :: Ord a => MaybeS a -> MaybeS a -> Set a -> Set a -> Set a +hedgeInt _ _ _ Tip = Tip +hedgeInt _ _ Tip _ = Tip +hedgeInt blo bhi (Bin _ x l r) t2 + = let l' = (hedgeInt blo bmi l (trim blo bmi t2)) + r' = (hedgeInt bmi bhi r (trim bmi bhi t2)) + in if x `member` t2 then join x l' r' else merge l' r' + where + bmi = JustS x +#if __GLASGOW_HASKELL__ >= 700 +{-# INLINABLE hedgeInt #-} +#endif + {-------------------------------------------------------------------- Filter and partition --------------------------------------------------------------------} @@ -1000,23 +1001,14 @@ split x (Bin _ y l r) -- | /O(log n)/. Performs a 'split' but also returns whether the pivot -- element was found in the original set. splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a) -splitMember x t = let (l,m,r) = splitLookup x t in - (l,maybe False (const True) m,r) -#if __GLASGOW_HASKELL__ >= 700 -{-# INLINABLE splitMember #-} -#endif - --- | /O(log n)/. Performs a 'split' but also returns the pivot --- element that was found in the original set. -splitLookup :: Ord a => a -> Set a -> (Set a,Maybe a,Set a) -splitLookup _ Tip = (Tip,Nothing,Tip) -splitLookup x (Bin _ y l r) +splitMember _ Tip = (Tip, False, Tip) +splitMember x (Bin _ y l r) = case compare x y of - LT -> let (lt,found,gt) = splitLookup x l in (lt,found,join y gt r) - GT -> let (lt,found,gt) = splitLookup x r in (join y l lt,found,gt) - EQ -> (l,Just y,r) + LT -> let (lt, found, gt) = splitMember x l in (lt, found, join y gt r) + GT -> let (lt, found, gt) = splitMember x r in (join y l lt, found, gt) + EQ -> (l, True, r) #if __GLASGOW_HASKELL__ >= 700 -{-# INLINABLE splitLookup #-} +{-# INLINABLE splitMember #-} #endif {-------------------------------------------------------------------- _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
