module Haskus.Format.Binary.BitSet
( BitSet
, CBitSet (..)
, null
, empty
, singleton
, insert
, delete
, toBits
, fromBits
, member
, elem
, notMember
, elems
, intersection
, union
, unions
, fromListToBits
, toListFromBits
, fromList
, toList
)
where
import Prelude hiding (null,elem)
import qualified GHC.Exts as Ext
import Data.Foldable (foldl')
import Haskus.Format.Binary.Bits
import Haskus.Format.Binary.Storable
newtype BitSet b a = BitSet b deriving (Eq,Ord,Storable)
instance (Show a, CBitSet a, FiniteBits b) => Show (BitSet b a) where
show b = "fromList " ++ show (toList b)
null :: (FiniteBits b) => BitSet b a -> Bool
null (BitSet b) = b == zeroBits
empty :: (FiniteBits b) => BitSet b a
empty = BitSet zeroBits
singleton :: (Bits b, CBitSet a) => a -> BitSet b a
singleton e = BitSet $ setBit zeroBits (toBitOffset e)
insert :: (Bits b, CBitSet a) => BitSet b a -> a -> BitSet b a
insert (BitSet b) e = BitSet $ setBit b (toBitOffset e)
delete :: (Bits b, CBitSet a) => BitSet b a -> a -> BitSet b a
delete (BitSet b) e = BitSet $ clearBit b (toBitOffset e)
toBits :: BitSet b a -> b
toBits (BitSet b) = b
fromBits :: (CBitSet a, FiniteBits b) => b -> BitSet b a
fromBits = BitSet
member :: (CBitSet a, FiniteBits b) => BitSet b a -> a -> Bool
member (BitSet b) e = testBit b (toBitOffset e)
elem :: (CBitSet a, FiniteBits b) => a -> BitSet b a -> Bool
elem e (BitSet b) = testBit b (toBitOffset e)
notMember :: (CBitSet a, FiniteBits b) => BitSet b a -> a -> Bool
notMember b e = not (member b e)
elems :: (CBitSet a, FiniteBits b) => BitSet b a -> [a]
elems (BitSet b) = go b
where
go !c
| c == zeroBits = []
| otherwise = let e = countTrailingZeros c in fromBitOffset e : go (clearBit c e)
intersection :: FiniteBits b => BitSet b a -> BitSet b a -> BitSet b a
intersection (BitSet b1) (BitSet b2) = BitSet (b1 .&. b2)
union :: FiniteBits b => BitSet b a -> BitSet b a -> BitSet b a
union (BitSet b1) (BitSet b2) = BitSet (b1 .|. b2)
unions :: FiniteBits b => [BitSet b a] -> BitSet b a
unions = foldl' union empty
class CBitSet a where
toBitOffset :: a -> Int
default toBitOffset :: Enum a => a -> Int
toBitOffset = fromEnum
fromBitOffset :: Int -> a
default fromBitOffset :: Enum a => Int -> a
fromBitOffset = toEnum
instance CBitSet Int where
toBitOffset = id
fromBitOffset = id
fromListToBits :: (CBitSet a, FiniteBits b, Foldable m) => m a -> b
fromListToBits = toBits . fromList
toListFromBits :: (CBitSet a, FiniteBits b) => b -> [a]
toListFromBits = toList . BitSet
toList :: (CBitSet a, FiniteBits b) => BitSet b a -> [a]
toList = elems
fromList :: (CBitSet a, FiniteBits b, Foldable m) => m a -> BitSet b a
fromList = foldl' insert (BitSet zeroBits)
instance (FiniteBits b, CBitSet a) => Ext.IsList (BitSet b a) where
type Item (BitSet b a) = a
fromList = fromList
toList = toList