[commit: containers] master: Fix corner-cases which the tests uncovered (8f7af10)
Ian Lynagh
igloo at earth.li
Thu Feb 23 01:13:40 CET 2012
Repository : ssh://darcs.haskell.org//srv/darcs/packages/containers
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8f7af10487ac7ff452d43364974c5766d8a24e5b
>---------------------------------------------------------------
commit 8f7af10487ac7ff452d43364974c5766d8a24e5b
Author: Joachim Breitner <mail at joachim-breitner.de>
Date: Tue Sep 20 21:22:19 2011 +0200
Fix corner-cases which the tests uncovered
>---------------------------------------------------------------
Data/DenseIntSet.hs | 77 +++++++++++++++++++++++++++++++--------------------
1 files changed, 47 insertions(+), 30 deletions(-)
diff --git a/Data/DenseIntSet.hs b/Data/DenseIntSet.hs
index c4d30c9..dc27b7c 100644
--- a/Data/DenseIntSet.hs
+++ b/Data/DenseIntSet.hs
@@ -293,7 +293,7 @@ notMember :: Int -> IntSet -> Bool
notMember k = not . member k
checkTip :: Int -> Prefix -> BitMap -> Bool
-checkTip k kx bm = k .&. highBits == kx && bm `testBit` (k .&. lowBits)
+checkTip k kx bm = k .&. highTipBits == kx && bm `testBit` (k .&. lowTipBits)
{-# INLINE checkTip #-}
{--------------------------------------------------------------------
@@ -307,7 +307,7 @@ empty
-- | /O(1)/. A set of one element.
singleton :: Int -> IntSet
singleton x
- = Tip (x .&. highBits) (bit (x .&. lowBits))
+ = Tip (x .&. highTipBits) (bit (x .&. lowTipBits))
{--------------------------------------------------------------------
Insert
@@ -315,7 +315,7 @@ singleton x
-- | /O(min(n,W))/. Add a value to the set. There is no left- or right bias for
-- IntSets.
insert :: Int -> IntSet -> IntSet
-insert x = x `seq` insertBM (x .&. highBits) (bit (x .&. lowBits))
+insert x = x `seq` insertBM (x .&. highTipBits) (bit (x .&. lowTipBits))
insertBM :: Prefix -> BitMap -> IntSet -> IntSet
@@ -333,7 +333,7 @@ insertBM kx bm t = kx `seq` bm `seq`
-- | /O(min(n,W))/. Delete a value in the set. Returns the
-- original set when the value was not present.
delete :: Int -> IntSet -> IntSet
-delete x = x `seq` deleteBM (x .&. highBits) (bit (x .&. lowBits))
+delete x = x `seq` deleteBM (x .&. highTipBits) (bit (x .&. lowTipBits))
-- Deletes all values mentioned in the BitMap from the set.
deleteBM :: Prefix -> BitMap -> IntSet -> IntSet
@@ -502,11 +502,12 @@ isSubsetOf t1@(Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
else isSubsetOf t1 r2)
| otherwise = (p1==p2) && isSubsetOf l1 l2 && isSubsetOf r1 r2
isSubsetOf (Bin _ _ _ _) _ = False
-isSubsetOf (Tip kx1 bm1) (Tip kx2 bm2) = bm1 .&. complement bm2 == 0
+isSubsetOf (Tip kx1 bm1) (Tip kx2 bm2) = kx1 == kx2 && bm1 .&. complement bm2 == 0
isSubsetOf t1@(Tip kx bm) (Bin p m l r)
| nomatch kx p m = False
| zero kx m = isSubsetOf t1 l
| otherwise = isSubsetOf t1 r
+isSubsetOf (Tip _ _) Nil = False
isSubsetOf Nil _ = True
@@ -559,11 +560,11 @@ split x t
Tip kx' bm
| kx>kx' -> (t,Nil)
| kx<kx' -> (Nil,t)
- | otherwise -> (tip kx' (bm .&. 2^(bi-1)-1)
- ,tip kx' (bm .&. complement (2^bi-1)))
+ | otherwise -> (tip kx' (bm .&. lowBits bi)
+ ,tip kx' (bm .&. highBits (bi+1)))
Nil -> (Nil, Nil)
- where kx = x .&. highBits
- bi = x .&. lowBits
+ where kx = x .&. highTipBits
+ bi = x .&. lowTipBits
split' :: Int -> IntSet -> (IntSet,IntSet)
split' x t
@@ -576,11 +577,11 @@ split' x t
Tip kx' bm
| kx>kx' -> (t,Nil)
| kx<kx' -> (Nil,t)
- | otherwise -> (tip kx' (bm .&. 2^(bi-1)-1)
- ,tip kx' (bm .&. complement (2^bi-1)))
+ | otherwise -> (tip kx' (bm .&. lowBits bi)
+ ,tip kx' (bm .&. highBits (bi+1)))
Nil -> (Nil,Nil)
- where kx = x .&. highBits
- bi = x .&. lowBits
+ where kx = x .&. highTipBits
+ bi = x .&. lowTipBits
-- | /O(min(n,W))/. Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
@@ -595,12 +596,12 @@ splitMember x t
Tip kx' bm
| kx>kx' -> (t,False,Nil)
| kx<kx' -> (Nil,False,t)
- | otherwise -> (tip kx' (bm .&. 2^(bi-1)-1)
+ | otherwise -> (tip kx' (bm .&. lowBits bi)
,bm `testBit` bi
- ,tip kx' (bm .&. complement (2^bi-1)))
+ ,tip kx' (bm .&. highBits (bi+1)))
Nil -> (Nil,False,Nil)
- where kx = x .&. highBits
- bi = x .&. lowBits
+ where kx = x .&. highTipBits
+ bi = x .&. lowTipBits
splitMember' :: Int -> IntSet -> (IntSet,Bool,IntSet)
splitMember' x t
@@ -613,12 +614,12 @@ splitMember' x t
Tip kx' bm
| kx>kx' -> (t,False,Nil)
| kx<kx' -> (Nil,False,t)
- | otherwise -> (tip kx' (bm .&. 2^(bi-1)-1)
+ | otherwise -> (tip kx' (bm .&. lowBits bi)
,bm `testBit` bi
- ,tip kx' (bm .&. complement (2^bi-1)))
+ ,tip kx' (bm .&. highBits (bi+1)))
Nil -> (Nil,False,Nil)
- where kx = x .&. highBits
- bi = x .&. lowBits
+ where kx = x .&. highTipBits
+ bi = x .&. lowTipBits
{----------------------------------------------------------------------
Min/Max
@@ -840,21 +841,21 @@ fromAscList (x0 : xs0) = fromDistinctAscList (combineEq x0 xs0)
-- /The precondition (input list is strictly ascending) is not checked./
fromDistinctAscList :: [Int] -> IntSet
fromDistinctAscList [] = Nil
-fromDistinctAscList (z0 : zs0) = work (z0 .&. highBits) (bit (z0 .&. lowBits)) zs0 Nada
+fromDistinctAscList (z0 : zs0) = work (z0 .&. highTipBits) (bit (z0 .&. lowTipBits)) zs0 Nada
where
-- 'work' accumulates all values that go into one tip, before passing this Tip
-- to 'reduce'
work kx bm [] stk = finish kx (Tip kx bm) stk
- work kx bm (z:zs) stk | kx == z .&. highBits = work kx (bm `setBit` (z .&. lowBits)) zs stk
+ work kx bm (z:zs) stk | kx == z .&. highTipBits = work kx (bm `setBit` (z .&. lowTipBits)) zs stk
work kx bm (z:zs) stk = reduce z zs (branchMask z kx) kx (Tip kx bm) stk
- reduce z zs _ px tx Nada = work (z .&. highBits) (bit (z .&. lowBits)) zs (Push px tx Nada)
+ reduce z zs _ px tx Nada = work (z .&. highTipBits) (bit (z .&. lowTipBits)) zs (Push px tx Nada)
reduce z zs m px tx stk@(Push py ty stk') =
let mxy = branchMask px py
pxy = mask px mxy
in if shorter m mxy
then reduce z zs m pxy (Bin pxy mxy ty tx) stk'
- else work (z .&. highBits) (bit (z .&. lowBits)) zs (Push px tx stk)
+ else work (z .&. highTipBits) (bit (z .&. lowTipBits)) zs (Push px tx stk)
finish _ t Nada = t
finish px tx (Push py ty stk) = finish p (join py ty px tx) stk
@@ -1146,16 +1147,32 @@ highestBitMask x0
{----------------------------------------------------------------------
- [highBits] and [lowBits] are two bit masks. Low bits has just the last n bits
+ [highTipBits] and [lowTipBits] are two bit masks. Low bits has just the last n bits
set to 1, while high bits is the complement, and n is the word size of the
architecture. TODO: Does this work on s390?
----------------------------------------------------------------------}
-lowBits :: Int
-lowBits = (bitSize (undefined::Word))-1
+lowTipBits :: Int
+lowTipBits = (bitSize (undefined::Word))-1
+{-# INLINE lowTipBits #-}
-highBits :: Int
-highBits = complement lowBits
+highTipBits :: Int
+highTipBits = complement lowTipBits
+{-# INLINE highTipBits #-}
+
+{----------------------------------------------------------------------
+ [lowBits] and [highBits] are bitmaps where the lowest n bits are set to one
+ resp. zero
+----------------------------------------------------------------------}
+
+lowBits :: Int -> BitMap
+lowBits 0 = 0
+lowBits n = (1 `shiftL` n)-1
+{-# INLINE lowBits #-}
+
+highBits :: Int -> BitMap
+highBits n = complement (lowBits n)
+{-# INLINE highBits #-}
{----------------------------------------------------------------------
Folds over bitmaps. These are crucial for good speed in toList, filter,
More information about the Cvs-libraries
mailing list