module Data.BitSet.Generic
(
GBitSet(..)
, (\\)
, empty
, singleton
, insert
, delete
, null
, size
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, union
, unions
, difference
, intersection
, map
, filter
, toList
, fromList
) where
import Prelude hiding (null, map, filter)
import Control.Applicative ((<$>))
import Control.DeepSeq (NFData(..))
import Data.Bits (Bits, (.|.), (.&.), complement, bit,
testBit, setBit, clearBit, popCount)
import Data.Data (Typeable)
import Data.Function (on)
import Data.Monoid (Monoid(..), (<>))
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 (GBitSet c a) where
(==) = (==) `on` _n
instance Ord (GBitSet c a) where
compare = compare `on` _n
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
mconcat = unions
instance NFData c => NFData (GBitSet c a) where
rnf (BitSet { _n, _bits }) = rnf _n `seq` rnf _bits `seq` ()
instance Num c => Foldable.Foldable (GBitSet c) where
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 { _bits }) = _bits == 0
size :: GBitSet c a -> Int
size = _n
member :: a -> GBitSet c a -> Bool
member x (BitSet { _bits }) = _bits `testBit` fromEnum x
notMember :: 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 }
unions :: (Enum a, Bits c, Num c) => [GBitSet c a] -> GBitSet c a
unions = List.foldl' union empty
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
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 = Foldable.toList
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 -> setBit i (fromEnum x)) 0 xs