Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers On branch : master
http://hackage.haskell.org/trac/ghc/changeset/73328131d9573d0b1d2cd2d18abad7399368e816 >--------------------------------------------------------------- commit 73328131d9573d0b1d2cd2d18abad7399368e816 Author: Milan Straka <[email protected]> Date: Sat Apr 14 18:44:37 2012 +0200 Improve IntSet.{union, difference, intersection}. Incorporate improvements achieved in IntMap implementation by using mergeWithKey' -- i.e., reorder and modify pattern matches of combining functions, to play nicely with pattern match compiler. Also improve the ``Tip vs Bin'' case handling. >--------------------------------------------------------------- Data/IntSet.hs | 57 +++++++++++++++++++++++++++++-------------------------- 1 files changed, 30 insertions(+), 27 deletions(-) diff --git a/Data/IntSet.hs b/Data/IntSet.hs index af2117c..5596e1b 100644 --- a/Data/IntSet.hs +++ b/Data/IntSet.hs @@ -395,10 +395,10 @@ union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | zero p1 m2 = Bin p2 m2 (union t1 l2) r2 | otherwise = Bin p2 m2 l2 (union t1 r2) +union t@(Bin _ _ _ _) (Tip kx bm) = insertBM kx bm t +union t@(Bin _ _ _ _) Nil = t union (Tip kx bm) t = insertBM kx bm t -union t (Tip kx bm) = insertBM kx bm t -union Nil t = t -union t Nil = t +union Nil t = t {-------------------------------------------------------------------- @@ -420,15 +420,18 @@ difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | zero p1 m2 = difference t1 l2 | otherwise = difference t1 r2 -difference Nil _ = Nil +difference t@(Bin _ _ _ _) (Tip kx bm) = deleteBM kx bm t +difference t@(Bin _ _ _ _) Nil = t -difference t1@(Tip kx _) (Bin p2 m2 l2 r2) - | nomatch kx p2 m2 = t1 - | zero kx m2 = difference t1 l2 - | otherwise = difference t1 r2 +difference t1@(Tip kx bm) t2 = differenceTip t2 + where differenceTip (Bin p2 m2 l2 r2) | nomatch kx p2 m2 = t1 + | zero kx m2 = differenceTip l2 + | otherwise = differenceTip r2 + differenceTip (Tip kx2 bm2) | kx == kx2 = tip kx (bm .&. complement bm2) + | otherwise = t1 + differenceTip Nil = t1 -difference t (Tip kx bm) = deleteBM kx bm t -difference t Nil = t +difference Nil _ = Nil @@ -451,25 +454,25 @@ intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2) | zero p1 m2 = intersection t1 l2 | otherwise = intersection t1 r2 -intersection t1 (Tip kx bm) = intersectBM kx bm t1 -intersection (Tip kx bm) t2 = intersectBM kx bm t2 +intersection t1@(Bin _ _ _ _) (Tip kx2 bm2) = intersectBM t1 + where intersectBM (Bin p1 m1 l1 r1) | nomatch kx2 p1 m1 = Nil + | zero kx2 m1 = intersectBM l1 + | otherwise = intersectBM r1 + intersectBM (Tip kx1 bm1) | kx1 == kx2 = tip kx1 (bm1 .&. bm2) + | otherwise = Nil + intersectBM Nil = Nil -intersection Nil _ = Nil -intersection _ Nil = Nil - --- The intersection of one tip with a map -intersectBM :: Prefix -> BitMap -> IntSet -> IntSet -STRICT_1_OF_3(intersectBM) -STRICT_2_OF_3(intersectBM) -intersectBM kx bm (Bin p2 m2 l2 r2) - | nomatch kx p2 m2 = Nil - | zero kx m2 = intersectBM kx bm l2 - | otherwise = intersectBM kx bm r2 -intersectBM kx bm (Tip kx' bm') - | kx == kx' = tip kx (bm .&. bm') - | otherwise = Nil -intersectBM _ _ Nil = Nil +intersection (Bin _ _ _ _) Nil = Nil +intersection (Tip kx1 bm1) t2 = intersectBM t2 + where intersectBM (Bin p2 m2 l2 r2) | nomatch kx1 p2 m2 = Nil + | zero kx1 m2 = intersectBM l2 + | otherwise = intersectBM r2 + intersectBM (Tip kx2 bm2) | kx1 == kx2 = tip kx1 (bm1 .&. bm2) + | otherwise = Nil + intersectBM Nil = Nil + +intersection Nil _ = Nil {-------------------------------------------------------------------- Subset _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
