module Data.Vector.Bit
(
Bit(..)
, _Bit
, BitVector(..)
, _BitVector
, rank
, null
, size
, singleton
, empty
, UM.MVector(MV_Bit)
, U.Vector(V_Bit)
) where
import Control.Lens as L
import Control.Monad
import Data.Bits
import Data.Data
import Data.Vector.Array
import Data.Vector.Internal.Check as Ck
import Data.Word
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as UM
import Prelude hiding (null)
#define BOUNDS_CHECK(f) (Ck.f __FILE__ __LINE__ Ck.Bounds)
newtype Bit = Bit { getBit :: Bool }
deriving (Show,Read,Eq,Ord,Enum,Bounded,Data,Typeable)
_Bit :: Iso' Bit Bool
_Bit = iso getBit Bit
instance Arrayed Bit
instance UM.Unbox Bit
data instance UM.MVector s Bit = MV_Bit !Int !(UM.MVector s Word64)
instance GM.MVector U.MVector Bit where
basicLength (MV_Bit n _) = n
basicUnsafeSlice i n (MV_Bit _ u) = MV_Bit n $ GM.basicUnsafeSlice i (wds n) u
basicOverlaps (MV_Bit _ v1) (MV_Bit _ v2) = GM.basicOverlaps v1 v2
basicUnsafeNew n = do
v <- GM.basicUnsafeNew (wds n)
return $ MV_Bit n v
basicUnsafeReplicate n (Bit b) = do
v <- GM.basicUnsafeReplicate (wds n) (if b then 1 else 0)
return $ MV_Bit n v
basicUnsafeRead (MV_Bit _ u) i = do
w <- GM.basicUnsafeRead u (wd i)
return $ Bit $ testBit w (bt i)
basicUnsafeWrite (MV_Bit _ u) i (Bit b) = do
let wn = wd i
w <- GM.basicUnsafeRead u wn
GM.basicUnsafeWrite u wn $ if b then setBit w (bt i) else clearBit w (bt i)
basicClear (MV_Bit _ u) = GM.basicClear u
basicSet (MV_Bit _ u) (Bit b) = GM.basicSet u $ if b then 1 else 0
basicUnsafeCopy (MV_Bit _ u1) (MV_Bit _ u2) = GM.basicUnsafeCopy u1 u2
basicUnsafeMove (MV_Bit _ u1) (MV_Bit _ u2) = GM.basicUnsafeMove u1 u2
basicUnsafeGrow (MV_Bit _ u) n = liftM (MV_Bit n) (GM.basicUnsafeGrow u (wds n))
data instance U.Vector Bit = V_Bit !Int !(U.Vector Word64)
instance G.Vector U.Vector Bit where
basicLength (V_Bit n _) = n
basicUnsafeFreeze (MV_Bit n u) = liftM (V_Bit n) (G.basicUnsafeFreeze u)
basicUnsafeThaw (V_Bit n u) = liftM (MV_Bit n) (G.basicUnsafeThaw u)
basicUnsafeSlice i n (V_Bit _ u) = V_Bit n (G.basicUnsafeSlice i (wds n) u)
basicUnsafeIndexM (V_Bit _ u) i = do
w <- G.basicUnsafeIndexM u (wd i)
return $ Bit $ testBit w (bt i)
basicUnsafeCopy (MV_Bit _ mu) (V_Bit _ u) = G.basicUnsafeCopy mu u
elemseq _ b z = b `seq` z
#define BOUNDS_CHECK(f) (Ck.f __FILE__ __LINE__ Ck.Bounds)
data BitVector = BitVector !Int !(Array Bit) !(U.Vector Int)
deriving (Eq,Ord,Show,Read)
_BitVector :: Iso' BitVector (Array Bit)
_BitVector = iso (\(BitVector _ v _) -> v) $ \v@(V_Bit n ws) -> BitVector n v $ G.scanl (\a b -> a + popCount b) 0 ws
rank :: BitVector -> Int -> Int
rank (BitVector n (V_Bit _ ws) ps) i
= BOUNDS_CHECK(checkIndex) "rank" i n
$ (ps U.! w) + popCount ((ws U.! w) .&. (bit (bt i + 1) 1))
where w = wd i
empty :: BitVector
empty = _BitVector # G.empty
null :: BitVector -> Bool
null (BitVector n _ _) = n == 0
size :: BitVector -> Int
size (BitVector n _ _) = n
type instance Index BitVector = Int
singleton :: Bool -> BitVector
singleton True = true1
singleton False = false1
true1 :: BitVector
true1 = _BitVector # U.singleton (Bit True)
false1 :: BitVector
false1 = _BitVector # U.singleton (Bit False)
wds :: Int -> Int
wds x = unsafeShiftR (x + 63) 6
wd :: Int -> Int
wd x = unsafeShiftR x 6
bt :: Int -> Int
bt x = x .&. 63