module Data.BitSet.Generic
(
GBitSet
, (\\)
, empty
, singleton
, insert
, delete
, null
, size
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, union
, difference
, intersection
, map
, foldl'
, foldr
, filter
, toList
, fromList
, toBits
, unsafeFromBits
) where
import Prelude hiding (null, map, filter, foldr)
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData(..))
import Data.Bits (Bits, (.|.), (.&.), complement, bit,
testBit, setBit, clearBit, popCount)
import Data.Data (Typeable)
import Data.Monoid (Monoid(..), (<>))
import Foreign (Storable(..), castPtr)
import GHC.Exts (build)
import Text.Read (Read(..), Lexeme(..), lexP, prec, parens)
import qualified Data.Foldable as Foldable
import qualified Data.List as List
data GBitSet c a =
(Enum a, Bits c, Num c) =>
BitSet { _n :: !Int
, _bits :: !c
}
deriving Typeable
instance Eq c => Eq (GBitSet c a) where
BitSet { _n = n1, _bits = b1 } == BitSet { _n = n2, _bits = b2 } =
n1 == n2 && b1 == b2
instance Ord c => Ord (GBitSet c a) where
BitSet { _n = n1, _bits = b1 } `compare` BitSet { _n = n2, _bits = b2 } =
case compare n1 n2 of
EQ -> compare b1 b2
res -> res
instance (Enum a, Read a, Bits c, Num c) => Read (GBitSet c a) where
readPrec = parens . prec 10 $ do
Ident "fromList" <- lexP
fromList <$> readPrec
instance (Show a, Num c) => Show (GBitSet c a) where
showsPrec p bs = showParen (p > 10) $
showString "fromList " . shows (toList bs)
instance (Enum a, Bits c, Num c) => Monoid (GBitSet c a) where
mempty = empty
mappend = union
instance NFData c => NFData (GBitSet c a) where
rnf (BitSet { _n, _bits }) = rnf _n `seq` rnf _bits `seq` ()
instance (Bits c, Enum a, Num c, Storable c) => Storable (GBitSet c a) where
sizeOf = sizeOf . _bits
alignment = alignment . _bits
peek ptr = do
b <- peek $ castPtr ptr
return $! BitSet (popCount b) b
poke ptr = poke (castPtr ptr) . _bits
instance Num c => Foldable.Foldable (GBitSet c) where
#if MIN_VERSION_base(4, 6, 0)
foldl' = foldl'
#endif
foldr = foldr
foldMap f (BitSet { _n, _bits }) = go _n 0 where
go 0 _b = mempty
go !n b = if _bits `testBit` b
then f (toEnum b) <> go (pred n) (succ b)
else go n (succ b)
null :: GBitSet c a -> Bool
null (BitSet { _n = 0, _bits = 0 }) = True
null _bs = False
size :: GBitSet c a -> Int
size = _n
member :: (Enum a , Bits c) => a -> GBitSet c a -> Bool
member x = (`testBit` fromEnum x) . _bits
notMember :: (Enum a, Bits c) => a -> GBitSet c a -> Bool
notMember x = not . member x
isSubsetOf :: GBitSet c a -> GBitSet c a -> Bool
isSubsetOf (BitSet { _n = n1, _bits = b1 }) (BitSet { _n = n2, _bits = b2 }) =
n2 >= n1 && b2 .|. b1 == b2
isProperSubsetOf :: Eq c => GBitSet c a -> GBitSet c a -> Bool
isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2
empty :: (Enum a, Bits c, Num c) => GBitSet c a
empty = BitSet { _n = 0, _bits = 0 }
singleton :: (Enum a, Bits c, Num c) => a -> GBitSet c a
singleton x = BitSet { _n = 1, _bits = bit $! fromEnum x }
insert :: a -> GBitSet c a -> GBitSet c a
insert x bs@(BitSet { _bits }) =
let b = _bits `setBit` fromEnum x in bs { _n = popCount b, _bits = b }
delete :: a -> GBitSet c a -> GBitSet c a
delete x bs@(BitSet { _bits }) =
let b = _bits `clearBit` fromEnum x in bs { _n = popCount b, _bits = b }
union :: GBitSet c a -> GBitSet c a -> GBitSet c a
union (BitSet { _bits = b1 }) (BitSet { _bits = b2 }) =
let b = b1 .|. b2 in BitSet { _n = popCount b, _bits = b }
difference :: GBitSet c a -> GBitSet c a -> GBitSet c a
difference (BitSet { _bits = b1 }) (BitSet { _bits = b2 }) =
let b = b1 .&. complement b2 in BitSet { _n = popCount b, _bits = b }
(\\) :: GBitSet c a -> GBitSet c a -> GBitSet c a
(\\) = difference
intersection :: GBitSet c a -> GBitSet c a -> GBitSet c a
intersection (BitSet { _bits = b1 }) (BitSet { _bits = b2 }) =
BitSet { _n = popCount b, _bits = b }
where
b = b1 .&. b2
map :: (Enum a, Enum b, Bits c, Num c) => (a -> b) -> GBitSet c a -> GBitSet c b
map f = fromList . List.map f . toList
foldl' :: (b -> a -> b) -> b -> GBitSet c a -> b
foldl' f acc0 (BitSet { _n, _bits }) = go acc0 _n 0 where
go !acc 0 _b = acc
go !acc !n b = if _bits `testBit` b
then go (f acc $ toEnum b) (pred n) (succ b)
else go acc n (succ b)
foldr :: (a -> b -> b) -> b -> GBitSet c a -> b
foldr f acc0 (BitSet { _n, _bits }) = go _n 0 where
go 0 _b = acc0
go !n b = if _bits `testBit` b
then toEnum b `f` go (pred n) (succ b)
else go n (succ b)
filter :: (Enum a, Bits c, Num c) => (a -> Bool) -> GBitSet c a -> GBitSet c a
filter f = fromList . List.filter f . toList
toList :: Num c => GBitSet c a -> [a]
toList bs = build (\k z -> foldr k z bs)
fromList :: (Enum a, Bits c, Num c) => [a] -> GBitSet c a
fromList xs = BitSet { _n = popCount b, _bits = b } where
b = List.foldl' (\i x -> i `setBit` fromEnum x) 0 xs
toBits :: GBitSet c a -> c
toBits = _bits
unsafeFromBits :: (Enum a, Bits c, Num c) => c -> GBitSet c a
unsafeFromBits b = BitSet { _n = popCount b, _bits = b }