module Data.BitSet.Dynamic
(
FasterInteger
, 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 Data.Bits (Bits(..))
import GHC.Base (Int(..), divInt#, modInt#)
import GHC.Exts (popCnt#)
import GHC.Integer.GMP.Internals (Integer(..))
import GHC.Prim (State#, RealWorld, Int#, Word#, ByteArray#,
(+#), (==#), (>=#), (<#), negateInt#,
word2Int#, int2Word#, plusWord#, realWorld#,
newByteArray#, copyByteArray#, writeWordArray#,
indexWordArray#, unsafeFreezeByteArray#, sizeofByteArray#)
import GHC.Word (Word(..))
import Control.DeepSeq (NFData(..))
import Data.BitSet.Generic (GBitSet)
import qualified Data.BitSet.Generic as GS
newtype FasterInteger = FasterInteger { unFI :: Integer }
deriving (Read, Show, Eq, Ord, Enum, Integral, Num, Real, NFData)
instance Bits FasterInteger where
FasterInteger x .&. FasterInteger y = FasterInteger $ x .&. y
FasterInteger x .|. FasterInteger y = FasterInteger $ x .|. y
FasterInteger x `xor` FasterInteger y = FasterInteger $ x `xor` y
complement = FasterInteger . complement . unFI
shift (FasterInteger x) = FasterInteger . shift x
rotate (FasterInteger x) = FasterInteger . rotate x
bit = FasterInteger . bit
testBit (FasterInteger x) i = testBitInteger x i
setBit (FasterInteger x) = FasterInteger . setBit x
clearBit (FasterInteger x) = FasterInteger . clearBitInteger x
popCount (FasterInteger x) = I# (word2Int# (popCountInteger x))
bitSize = bitSize . unFI
isSigned = isSigned . unFI
type BitSet = GBitSet FasterInteger
null :: BitSet a -> Bool
null = GS.null
size :: BitSet a -> Int
size = GS.size
member :: Enum a => a -> BitSet a -> Bool
member = GS.member
notMember :: Enum a => a -> BitSet a -> Bool
notMember = GS.notMember
isSubsetOf :: BitSet a -> BitSet a -> Bool
isSubsetOf = GS.isSubsetOf
isProperSubsetOf :: BitSet a -> BitSet a -> Bool
isProperSubsetOf = GS.isProperSubsetOf
empty :: Enum a => BitSet a
empty = GS.empty
singleton :: Enum a => a -> BitSet a
singleton = GS.singleton
insert :: a -> BitSet a -> BitSet a
insert = GS.insert
delete :: a -> BitSet a -> BitSet a
delete = GS.delete
union :: BitSet a -> BitSet a -> BitSet a
union = GS.union
difference :: BitSet a -> BitSet a -> BitSet a
difference = GS.difference
(\\) :: BitSet a -> BitSet a -> BitSet a
(\\) = difference
intersection :: BitSet a -> BitSet a -> BitSet a
intersection = GS.intersection
map :: (Enum a, Enum b) => (a -> b) -> BitSet a -> BitSet b
map = GS.map
foldl' :: (b -> a -> b) -> b -> BitSet a -> b
foldl' = GS.foldl'
foldr :: (a -> b -> b) -> b -> BitSet a -> b
foldr = GS.foldr
filter :: Enum a => (a -> Bool) -> BitSet a -> BitSet a
filter = GS.filter
toList :: BitSet a -> [a]
toList = GS.toList
fromList :: Enum a => [a] -> BitSet a
fromList = GS.fromList
popCountInteger :: Integer -> Word#
popCountInteger (S# i#) = popCnt# (int2Word# i#)
popCountInteger (J# s# d#) = go 0# (int2Word# 0#) where
go i acc =
if i ==# s#
then acc
else go (i +# 1#) $ acc `plusWord#` popCnt# (indexWordArray# d# i)
#include "MachDeps.h"
#ifndef WORD_SIZE_IN_BITS
#error WORD_SIZE_IN_BITS not defined!
#endif
divModInt# :: Int# -> Int# -> (# Int#, Int# #)
divModInt# x y = (# d, m #) where
!d = x `divInt#` y
!m = x `modInt#` y
abs# :: Int# -> Int#
abs# x = if x <# 0# then negateInt# x else x
testBitInteger :: Integer -> Int -> Bool
testBitInteger (S# i#) b = I# i# `testBit` b
testBitInteger (J# s# d#) (I# b#) =
if b# <# 0# || block# >=# abs# s#
then False
else W# (indexWordArray# d# block#) `testBit` I# offset#
where
(# !block#, !offset# #) = b# `divModInt#` WORD_SIZE_IN_BITS#
clearBitInteger :: Integer -> Int -> Integer
clearBitInteger (S# i#) b = S# i# `clearBit` b
clearBitInteger i@(J# s# d0#) (I# b#) =
if b# <# 0# || block# >=# abs# s#
then i
else J# s# (go realWorld#)
where
(# !block#, !offset# #) = b# `divModInt#` WORD_SIZE_IN_BITS#
go :: State# RealWorld -> ByteArray#
go state0 =
let !n = sizeofByteArray# d0#
(# state1, !d1 #) = newByteArray# n state0
state2 = copyByteArray# d0# 0# d1 0# n state1
!(W# chunk) = W# (indexWordArray# d0# block#) `clearBit` I# offset#
state3 = writeWordArray# d1 block# chunk state2
(# _state4, d2 #) = unsafeFreezeByteArray# d1 state3
in d2