module Data.BitSet.Generic
(
BitSet(..)
, (\\)
, empty
, singleton
, insert
, delete
, null
, size
, member
, notMember
, isSubsetOf
, isProperSubsetOf
, union
, difference
, intersection
, map
, foldl'
, foldr
, filter
, toList
, fromList
) 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)
import GHC.Exts (build)
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
import GHC.Exts (IsList)
import qualified GHC.Exts as Exts
#endif
import Text.Read (Read(..), Lexeme(..), lexP, prec, parens)
import qualified Data.List as List
newtype BitSet c a = BitSet { getBits :: c }
deriving (Eq, NFData, Storable, Ord, Typeable)
instance (Enum a, Read a, Bits c, Num c) => Read (BitSet c a) where
readPrec = parens . prec 10 $ do
Ident "fromList" <- lexP
fromList <$> readPrec
instance (Enum a, Show a, Bits c, Num c) => Show (BitSet c a) where
showsPrec p bs = showParen (p > 10) $
showString "fromList " . shows (toList bs)
instance (Enum a, Bits c, Num c) => Monoid (BitSet c a) where
mempty = empty
mappend = union
#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 707)
instance (Enum a, Bits c, Num c) => IsList (BitSet c a) where
type Item (BitSet c a) = a
fromList = fromList
toList = toList
#endif
null :: (Eq c, Num c) => BitSet c a -> Bool
null = (== 0) . getBits
size :: Bits c => BitSet c a -> Int
size = popCount . getBits
member :: (Enum a , Bits c) => a -> BitSet c a -> Bool
member x = (`testBit` fromEnum x) . getBits
notMember :: (Enum a, Bits c) => a -> BitSet c a -> Bool
notMember x = not . member x
isSubsetOf :: (Bits c, Eq c) => BitSet c a -> BitSet c a -> Bool
isSubsetOf (BitSet bits1) (BitSet bits2) = bits2 .|. bits1 == bits2
isProperSubsetOf :: (Bits c, Eq c) => BitSet c a -> BitSet c a -> Bool
isProperSubsetOf bs1 bs2 = bs1 `isSubsetOf` bs2 && bs1 /= bs2
empty :: (Enum a, Bits c, Num c) => BitSet c a
empty = BitSet 0
singleton :: (Enum a, Bits c, Num c) => a -> BitSet c a
singleton = BitSet . bit . fromEnum
insert :: (Enum a, Bits c) => a -> BitSet c a -> BitSet c a
insert x (BitSet bits) = BitSet $ bits `setBit` fromEnum x
delete :: (Enum a, Bits c) => a -> BitSet c a -> BitSet c a
delete x (BitSet bits ) = BitSet $ bits `clearBit` fromEnum x
union :: Bits c => BitSet c a -> BitSet c a -> BitSet c a
union (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .|. bits2
difference :: Bits c => BitSet c a -> BitSet c a -> BitSet c a
difference (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .&. complement bits2
(\\) :: Bits c => BitSet c a -> BitSet c a -> BitSet c a
(\\) = difference
intersection :: Bits c => BitSet c a -> BitSet c a -> BitSet c a
intersection (BitSet bits1) (BitSet bits2) = BitSet $ bits1 .&. bits2
map :: (Enum a, Enum b, Bits c, Num c) => (a -> b) -> BitSet c a -> BitSet c b
map f = foldl' (\bs -> (`insert` bs) . f) empty
foldl' :: (Enum a, Bits c) => (b -> a -> b) -> b -> BitSet c a -> b
foldl' f acc0 (BitSet bits) = go acc0 (popCount bits) 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 :: (Enum a, Bits c) => (a -> b -> b) -> b -> BitSet c a -> b
foldr f acc0 (BitSet bits) = go (popCount bits) 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) -> BitSet c a -> BitSet c a
filter f = foldl' (\bs x -> if f x then x `insert` bs else bs) empty
toList :: (Enum a, Bits c, Num c) => BitSet c a -> [a]
toList bs = build (\k z -> foldr k z bs)
fromList :: (Enum a, Bits c, Num c) => [a] -> BitSet c a
fromList = BitSet . List.foldl' (\i x -> i `setBit` fromEnum x) 0