{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

module Data.SparseArray
    ( SparseArray
    , Hashable, Hash, hash
    , Level, down, up, lastLevel
    , emptyArray, mkSingleton, mkPair
    , arrayLookup, arrayInsert, arrayUpdate, arrayDelete
    , arrayMapM, arrayFoldM', arrayToMaybe
    ) where

import Control.Monad.ST
import Data.Bits
import Data.Hashable (Hashable)
import qualified Data.Hashable as H
import Data.Primitive.Array hiding (emptyArray)
import Data.Word
import Prelude hiding (lookup, mapM)

-----------------------------------------------------------------------

data SparseArray a = SparseArray !Bitmap !(Array a)

type Bitmap = Word
type Hash   = Word
type Level  = Int

-----------------------------------------------------------------------

emptyArray :: SparseArray a
emptyArray :: SparseArray a
emptyArray = Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
0 Array a
forall a. Array a
arr
  where
    arr :: Array a
arr = (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
        MutableArray s a
marr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
0 a
forall a. HasCallStack => a
undefined
        MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr

{-# INLINE emptyArray #-}

mkSingleton :: Level -> Hash -> a -> SparseArray a
mkSingleton :: Int -> Bitmap -> a -> SparseArray a
mkSingleton Int
level Bitmap
h a
a = Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp Array a
arr
  where
    i :: Int
i   = Int -> Bitmap -> Int
index Int
level Bitmap
h
    bmp :: Bitmap
bmp = Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitmap
1 Int
i
    arr :: Array a
arr = (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
        MutableArray s a
marr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
1 a
a
        MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr

{-# INLINE mkSingleton #-}

mkPair :: Level -> Hash -> a -> Hash -> a -> Maybe (SparseArray a)
mkPair :: Int -> Bitmap -> a -> Bitmap -> a -> Maybe (SparseArray a)
mkPair Int
level Bitmap
h1 a
a1 Bitmap
h2 a
a2 =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
i1 Int
i2 of
        Ordering
LT -> SparseArray a -> Maybe (SparseArray a)
forall a. a -> Maybe a
Just (SparseArray a -> Maybe (SparseArray a))
-> SparseArray a -> Maybe (SparseArray a)
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp (a -> a -> Array a
forall a. a -> a -> Array a
pair a
a1 a
a2)
        Ordering
GT -> SparseArray a -> Maybe (SparseArray a)
forall a. a -> Maybe a
Just (SparseArray a -> Maybe (SparseArray a))
-> SparseArray a -> Maybe (SparseArray a)
forall a b. (a -> b) -> a -> b
$ Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp (a -> a -> Array a
forall a. a -> a -> Array a
pair a
a2 a
a1)
        Ordering
EQ -> Maybe (SparseArray a)
forall a. Maybe a
Nothing
  where
    i1 :: Int
i1  = Int -> Bitmap -> Int
index Int
level Bitmap
h1
    i2 :: Int
i2  = Int -> Bitmap -> Int
index Int
level Bitmap
h2
    bmp :: Bitmap
bmp = (Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitmap
1 Int
i1) Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. (Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
unsafeShiftL Bitmap
1 Int
i2)
    pair :: a -> a -> Array a
pair a
x a
y = (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
        MutableArray s a
marr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
2 a
forall a. HasCallStack => a
undefined
        MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
0 a
x
        MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
1 a
y
        MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr

{-# INLINE mkPair #-}

arrayLookup :: Level -> Hash -> SparseArray a -> Maybe a
arrayLookup :: Int -> Bitmap -> SparseArray a -> Maybe a
arrayLookup Int
level Bitmap
h (SparseArray Bitmap
bmp Array a
arr)
    | Bitmap
bmp Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
m Bitmap -> Bitmap -> Bool
forall a. Eq a => a -> a -> Bool
== Bitmap
0 = Maybe a
forall a. Maybe a
Nothing
    | Bool
otherwise      = a -> Maybe a
forall a. a -> Maybe a
Just (Array a -> Int -> a
forall a. Array a -> Int -> a
indexArray Array a
arr Int
i)
  where
    m :: Bitmap
m = Int -> Bitmap -> Bitmap
mask Int
level Bitmap
h
    i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
bmp Bitmap
m

{-# INLINE arrayLookup #-}

arrayInsert :: Level -> Hash -> a -> SparseArray a -> SparseArray a
arrayInsert :: Int -> Bitmap -> a -> SparseArray a -> SparseArray a
arrayInsert Int
level Bitmap
h a
a (SparseArray Bitmap
bmp Array a
arr) = Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp' Array a
arr'
  where
    n :: Int
n    = Bitmap -> Int
forall a. Bits a => a -> Int
popCount Bitmap
bmp
    m :: Bitmap
m    = Int -> Bitmap -> Bitmap
mask Int
level Bitmap
h
    i :: Int
i    = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
bmp Bitmap
m
    bmp' :: Bitmap
bmp' = Bitmap
bmp Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.|. Bitmap
m
    arr' :: Array a
arr' = (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
        MutableArray s a
marr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
forall a. HasCallStack => a
undefined
        MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
0 Array a
arr Int
0 Int
i
        MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
i a
a
        MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Array a
arr Int
i (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i)
        MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr

{-# INLINE arrayInsert #-}

arrayUpdate :: Level -> Hash -> a -> SparseArray a -> SparseArray a
arrayUpdate :: Int -> Bitmap -> a -> SparseArray a -> SparseArray a
arrayUpdate Int
level Bitmap
h a
a (SparseArray Bitmap
bmp Array a
arr) = Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp Array a
arr'
  where
    n :: Int
n = Bitmap -> Int
forall a. Bits a => a -> Int
popCount Bitmap
bmp
    m :: Bitmap
m = Int -> Bitmap -> Bitmap
mask Int
level Bitmap
h
    i :: Int
i = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
bmp Bitmap
m
    arr' :: Array a
arr' = (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
        MutableArray s a
marr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
forall a. HasCallStack => a
undefined
        MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
0 Array a
arr Int
0 Int
n
        MutableArray (PrimState (ST s)) a -> Int -> a -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
i a
a
        MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr

{-# INLINE arrayUpdate #-}

arrayDelete :: Level -> Hash -> SparseArray a -> SparseArray a
arrayDelete :: Int -> Bitmap -> SparseArray a -> SparseArray a
arrayDelete Int
level Bitmap
h (SparseArray Bitmap
bmp Array a
arr) = Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp' Array a
arr'
  where
    n :: Int
n    = Bitmap -> Int
forall a. Bits a => a -> Int
popCount Bitmap
bmp
    m :: Bitmap
m    = Int -> Bitmap -> Bitmap
mask Int
level Bitmap
h
    i :: Int
i    = Bitmap -> Bitmap -> Int
sparseIndex Bitmap
bmp Bitmap
m
    bmp' :: Bitmap
bmp' = Bitmap
bmp Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
`xor` Bitmap
m
    arr' :: Array a
arr' = (forall s. ST s (Array a)) -> Array a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Array a)) -> Array a)
-> (forall s. ST s (Array a)) -> Array a
forall a b. (a -> b) -> a -> b
$ do
        MutableArray s a
marr <- Int -> a -> ST s (MutableArray (PrimState (ST s)) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
forall a. HasCallStack => a
undefined
        MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
0 Array a
arr Int
0 Int
i
        MutableArray (PrimState (ST s)) a
-> Int -> Array a -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a
-> Int -> Array a -> Int -> Int -> m ()
copyArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr Int
i Array a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-(Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))
        MutableArray (PrimState (ST s)) a -> ST s (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray s a
MutableArray (PrimState (ST s)) a
marr

{-# INLINE arrayDelete #-}

arrayMapM :: (a -> IO a) -> SparseArray a -> IO (SparseArray a)
arrayMapM :: (a -> IO a) -> SparseArray a -> IO (SparseArray a)
arrayMapM a -> IO a
f = \(SparseArray Bitmap
bmp Array a
arr) -> do
    let n :: Int
n = Bitmap -> Int
forall a. Bits a => a -> Int
popCount Bitmap
bmp
    MutableArray RealWorld a
marr <- Int -> a -> IO (MutableArray (PrimState IO) a)
forall (m :: * -> *) a.
PrimMonad m =>
Int -> a -> m (MutableArray (PrimState m) a)
newArray Int
n a
forall a. HasCallStack => a
undefined
    Int -> Array a -> MutableArray RealWorld a -> Int -> IO ()
go Int
n Array a
arr MutableArray RealWorld a
marr Int
0
    Array a
arr' <- MutableArray (PrimState IO) a -> IO (Array a)
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> m (Array a)
unsafeFreezeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr
    SparseArray a -> IO (SparseArray a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bitmap -> Array a -> SparseArray a
forall a. Bitmap -> Array a -> SparseArray a
SparseArray Bitmap
bmp Array a
arr')
  where
    go :: Int -> Array a -> MutableArray RealWorld a -> Int -> IO ()
go Int
n Array a
arr MutableArray RealWorld a
marr Int
i
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Bool
otherwise = do
            a
x <- Array a -> Int -> IO a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
arr Int
i
            MutableArray (PrimState IO) a -> Int -> a -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MutableArray (PrimState m) a -> Int -> a -> m ()
writeArray MutableArray RealWorld a
MutableArray (PrimState IO) a
marr Int
i (a -> IO ()) -> IO a -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> IO a
f a
x
            Int -> Array a -> MutableArray RealWorld a -> Int -> IO ()
go Int
n Array a
arr MutableArray RealWorld a
marr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

{-# INLINE arrayMapM #-}

arrayFoldM' :: (b -> a -> IO b) -> b -> SparseArray a -> IO b
arrayFoldM' :: (b -> a -> IO b) -> b -> SparseArray a -> IO b
arrayFoldM' b -> a -> IO b
f b
z0 = \(SparseArray Bitmap
bmp Array a
arr) -> do
    let n :: Int
n = Bitmap -> Int
forall a. Bits a => a -> Int
popCount Bitmap
bmp
    Int -> Array a -> Int -> b -> IO b
go Int
n Array a
arr Int
0 b
z0
  where
    go :: Int -> Array a -> Int -> b -> IO b
go Int
n Array a
arr Int
i !b
z
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = b -> IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
z
        | Bool
otherwise = do
            a
x <- Array a -> Int -> IO a
forall (m :: * -> *) a. Monad m => Array a -> Int -> m a
indexArrayM Array a
arr Int
i
            Int -> Array a -> Int -> b -> IO b
go Int
n Array a
arr (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (b -> IO b) -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< b -> a -> IO b
f b
z a
x

{-# INLINE arrayFoldM' #-}

arrayToMaybe :: SparseArray a -> Maybe a
arrayToMaybe :: SparseArray a -> Maybe a
arrayToMaybe (SparseArray Bitmap
bmp Array a
arr) =
    case Bitmap -> Int
forall a. Bits a => a -> Int
popCount Bitmap
bmp of
        Int
1 -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Array a -> Int -> a
forall a. Array a -> Int -> a
indexArray Array a
arr Int
0
        Int
_ -> Maybe a
forall a. Maybe a
Nothing

{-# INLINE arrayToMaybe #-}

-----------------------------------------------------------------------

hash :: Hashable a => a -> Hash
hash :: a -> Bitmap
hash = Int -> Bitmap
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Bitmap) -> (a -> Int) -> a -> Bitmap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Hashable a => a -> Int
H.hash
{-# INLINE hash #-}

hashLength :: Int
hashLength :: Int
hashLength = Bitmap -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Bitmap
forall a. HasCallStack => a
undefined :: Word)
{-# INLINE hashLength #-}

bitsPerSubkey :: Int
bitsPerSubkey :: Int
bitsPerSubkey = Float -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float -> Int) -> (Int -> Float) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Float
forall a. Floating a => a -> a -> a
logBase (Float
2 :: Float) (Float -> Float) -> (Int -> Float) -> Int -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
hashLength
{-# INLINE bitsPerSubkey #-}

subkeyMask :: Bitmap
subkeyMask :: Bitmap
subkeyMask = Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
bitsPerSubkey Bitmap -> Bitmap -> Bitmap
forall a. Num a => a -> a -> a
- Bitmap
1
{-# INLINE subkeyMask #-}

down :: Level -> Level
down :: Int -> Int
down = Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
bitsPerSubkey
{-# INLINE down #-}

up :: Level -> Level
up :: Int -> Int
up = Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
bitsPerSubkey
{-# INLINE up #-}

lastLevel :: Level
lastLevel :: Int
lastLevel = Int
hashLength
{-# INLINE lastLevel #-}

index :: Level -> Hash -> Int
index :: Int -> Bitmap -> Int
index Int
level Bitmap
h = Bitmap -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bitmap -> Int) -> Bitmap -> Int
forall a b. (a -> b) -> a -> b
$ (Bitmap
h Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
level) Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
subkeyMask
{-# INLINE index #-}

-- when or-ed with a bitmap, determines if the hash is present
-- in the array at the given level of the trie
mask :: Level -> Hash -> Bitmap
mask :: Int -> Bitmap -> Bitmap
mask Int
level Bitmap
h = Bitmap
1 Bitmap -> Int -> Bitmap
forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int -> Bitmap -> Int
index Int
level Bitmap
h
{-# INLINE mask #-}

-- position in the array
sparseIndex :: Bitmap -> Bitmap -> Int
sparseIndex :: Bitmap -> Bitmap -> Int
sparseIndex Bitmap
bmp Bitmap
m = Bitmap -> Int
forall a. Bits a => a -> Int
popCount ((Bitmap
m Bitmap -> Bitmap -> Bitmap
forall a. Num a => a -> a -> a
- Bitmap
1) Bitmap -> Bitmap -> Bitmap
forall a. Bits a => a -> a -> a
.&. Bitmap
bmp)
{-# INLINE sparseIndex #-}