{-# LANGUAGE CPP              #-}

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE MagicHash           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

#ifndef BITVEC_THREADSAFE
module Data.Bit.Mutable
#else
module Data.Bit.MutableTS
#endif
  ( castFromWordsM
  , castToWordsM
  , cloneToWordsM

  , cloneToWords8M

  , zipInPlace
  , mapInPlace

  , invertInPlace
  , selectBitsInPlace
  , excludeBitsInPlace

  , reverseInPlace
  ) where

#include "MachDeps.h"

import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST
#ifndef BITVEC_THREADSAFE
import Data.Bit.Internal
#else
import Data.Bit.InternalTS
#endif
import Data.Bit.Utils
import Data.Bits
import Data.Primitive.ByteArray
import qualified Data.Vector.Primitive as P
import qualified Data.Vector.Unboxed as U
import qualified Data.Vector.Unboxed.Mutable as MU
import Data.Word

#ifdef WORDS_BIGENDIAN
import GHC.Exts
#endif

-- | Cast a vector of words to a vector of bits.
-- Cf. 'Data.Bit.castFromWords'.
--
-- @since 1.0.0.0
castFromWordsM :: MVector s Word -> MVector s Bit
castFromWordsM :: forall s. MVector s Word -> MVector s Bit
castFromWordsM (MU.MV_Word (P.MVector Int
off Int
len MutableByteArray s
ws)) =
  forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec (forall a. Bits a => a -> a
mulWordSize Int
off) (forall a. Bits a => a -> a
mulWordSize Int
len) MutableByteArray s
ws

-- | Try to cast a vector of bits to a vector of words.
-- It succeeds if the vector of bits is aligned.
-- Use 'cloneToWordsM' otherwise.
-- Cf. 'Data.Bit.castToWords'.
--
-- @since 1.0.0.0
castToWordsM :: MVector s Bit -> Maybe (MVector s Word)
castToWordsM :: forall s. MVector s Bit -> Maybe (MVector s Word)
castToWordsM (BitMVec Int
s Int
n MutableByteArray s
ws)
  | Int -> Bool
aligned Int
s, Int -> Bool
aligned Int
n
  = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall s. MVector s Word -> MVector s Word
MU.MV_Word forall a b. (a -> b) -> a -> b
$ forall s a. Int -> Int -> MutableByteArray s -> MVector s a
P.MVector (forall a. Bits a => a -> a
divWordSize Int
s) (forall a. Bits a => a -> a
divWordSize Int
n) MutableByteArray s
ws
  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Clone a vector of bits to a new unboxed vector of words.
-- If the bits don't completely fill the words, the last word will be zero-padded.
-- Cf. 'Data.Bit.cloneToWords'.
--
-- @since 1.0.0.0
cloneToWordsM
  :: PrimMonad m
  => MVector (PrimState m) Bit
  -> m (MVector (PrimState m) Word)
cloneToWordsM :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> m (MVector (PrimState m) Word)
cloneToWordsM MVector (PrimState m) Bit
v = do
  let lenBits :: Int
lenBits  = forall a s. Unbox a => MVector s a -> Int
MU.length MVector (PrimState m) Bit
v
      lenWords :: Int
lenWords = Int -> Int
nWords Int
lenBits
  w :: MVector (PrimState m) Bit
w@(BitMVec Int
_ Int
_ MutableByteArray (PrimState m)
arr) <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.unsafeNew (forall a. Bits a => a -> a
mulWordSize Int
lenWords)
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.unsafeCopy (forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
lenBits MVector (PrimState m) Bit
w) MVector (PrimState m) Bit
v
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set (forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
lenBits (forall a. Bits a => a -> a
mulWordSize Int
lenWords forall a. Num a => a -> a -> a
- Int
lenBits) MVector (PrimState m) Bit
w) (Bool -> Bit
Bit Bool
False)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s. MVector s Word -> MVector s Word
MU.MV_Word forall a b. (a -> b) -> a -> b
$ forall s a. Int -> Int -> MutableByteArray s -> MVector s a
P.MVector Int
0 Int
lenWords MutableByteArray (PrimState m)
arr
{-# INLINABLE cloneToWordsM #-}

-- | Clone a vector of bits to a new unboxed vector of 'Word8'.
-- If the bits don't completely fill the words, the last 'Word8' will be zero-padded.
-- Cf. 'Data.Bit.cloneToWords8'.
cloneToWords8M
  :: PrimMonad m
  => MVector (PrimState m) Bit
  -> m (MVector (PrimState m) Word8)
cloneToWords8M :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> m (MVector (PrimState m) Word8)
cloneToWords8M MVector (PrimState m) Bit
v = do
  let lenBits :: Int
lenBits  = forall a s. Unbox a => MVector s a -> Int
MU.length MVector (PrimState m) Bit
v
      -- Take care about big-endian architectures: allocate full words!
      actualLenBytes :: Int
actualLenBytes = (Int
lenBits forall a. Num a => a -> a -> a
+ Int
7) forall a. Bits a => a -> Int -> a
`shiftR` Int
3
      roundedLenBytes :: Int
roundedLenBytes = Int -> Int
wordsToBytes (Int -> Int
nWords Int
lenBits)
  ws :: MVector (PrimState m) Bit
ws@(BitMVec Int
_ Int
_ MutableByteArray (PrimState m)
arr) <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
MU.unsafeNew (Int
roundedLenBytes forall a. Bits a => a -> Int -> a
`shiftL` Int
3)
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> MVector (PrimState m) a -> m ()
MU.unsafeCopy (forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
0 Int
lenBits MVector (PrimState m) Bit
ws) MVector (PrimState m) Bit
v
  forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
MU.set (forall a s. Unbox a => Int -> Int -> MVector s a -> MVector s a
MU.slice Int
lenBits (Int
roundedLenBytes forall a. Bits a => a -> Int -> a
`shiftL` Int
3 forall a. Num a => a -> a -> a
- Int
lenBits) MVector (PrimState m) Bit
ws) (Bool -> Bit
Bit Bool
False)

#ifdef WORDS_BIGENDIAN
  forM_ [0..nWords lenBits - 1] $ \i -> do
    W# w <- readByteArray arr i
    writeByteArray arr i (W# (byteSwap# w))
#endif

  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s. MVector s Word8 -> MVector s Word8
MU.MV_Word8 forall a b. (a -> b) -> a -> b
$ forall s a. Int -> Int -> MutableByteArray s -> MVector s a
P.MVector Int
0 Int
actualLenBytes MutableByteArray (PrimState m)
arr
{-# INLINABLE cloneToWords8M #-}

-- | Zip two vectors with the given function,
-- rewriting the contents of the second argument.
-- Cf. 'Data.Bit.zipBits'.
--
-- Note: If one input is larger than the other, the remaining bits will be ignored.
--
-- >>> :set -XOverloadedLists
-- >>> import Data.Bits
-- >>> Data.Vector.Unboxed.modify (zipInPlace (.&.) [1,1,0]) [0,1,1]
-- [0,1,0]
--
-- __Warning__: if the immutable vector is shorter than the mutable one,
-- it is the caller's responsibility to trim the result:
--
-- >>> :set -XOverloadedLists
-- >>> import Data.Bits
-- >>> Data.Vector.Unboxed.modify (zipInPlace (.&.) [1,1,0]) [0,1,1,1,1,1]
-- [0,1,0,1,1,1] -- note trailing garbage
--
-- @since 1.0.0.0
zipInPlace
  :: forall m.
     PrimMonad m
  => (forall a . Bits a => a -> a -> a)
  -> Vector Bit
  -> MVector (PrimState m) Bit
  -> m ()
zipInPlace :: forall (m :: * -> *).
PrimMonad m =>
(forall a. Bits a => a -> a -> a)
-> Vector Bit -> MVector (PrimState m) Bit -> m ()
zipInPlace forall a. Bits a => a -> a -> a
f (BitVec Int
off Int
l ByteArray
xs) (BitMVec Int
off' Int
l' MutableByteArray (PrimState m)
ys) =
  Int -> Int -> Int -> m ()
go (Int
l forall a. Ord a => a -> a -> a
`min` Int
l') Int
off Int
off'
  where
    go :: Int -> Int -> Int -> m ()
    go :: Int -> Int -> Int -> m ()
go Int
len Int
offXs Int
offYs
      | Int
shft forall a. Eq a => a -> a -> Bool
== Int
0 =
        Int -> Int -> Int -> m ()
go' Int
len Int
offXs (forall a. Bits a => a -> a
divWordSize Int
offYs)
      | Int
len forall a. Ord a => a -> a -> Bool
<= Int
wordSize = do
        Word
y <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
vecYs Int
0
        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
vecYs Int
0 (forall a. Bits a => a -> a -> a
f Word
x Word
y)
      | Bool
otherwise = do
        Word
y <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
ys Int
base
        forall (m :: * -> *).
PrimMonad m =>
MutableByteArray (PrimState m) -> Int -> Word -> Word -> m ()
modifyByteArray MutableByteArray (PrimState m)
ys Int
base (Int -> Word
loMask Int
shft) (forall a. Bits a => a -> a -> a
f (Word
x forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shft) Word
y forall a. Bits a => a -> a -> a
.&. Int -> Word
hiMask Int
shft)
        Int -> Int -> Int -> m ()
go' (Int
len forall a. Num a => a -> a -> a
- Int
wordSize forall a. Num a => a -> a -> a
+ Int
shft) (Int
offXs forall a. Num a => a -> a -> a
+ Int
wordSize forall a. Num a => a -> a -> a
- Int
shft) (Int
base forall a. Num a => a -> a -> a
+ Int
1)
      where
        vecXs :: Vector Bit
vecXs = Int -> Int -> ByteArray -> Vector Bit
BitVec  Int
offXs Int
len ByteArray
xs
        vecYs :: MVector (PrimState m) Bit
vecYs = forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec Int
offYs Int
len MutableByteArray (PrimState m)
ys
        x :: Word
x     = Vector Bit -> Int -> Word
indexWord Vector Bit
vecXs Int
0
        shft :: Int
shft  = Int -> Int
modWordSize Int
offYs
        base :: Int
base  = forall a. Bits a => a -> a
divWordSize Int
offYs

    go' :: Int -> Int -> Int -> m ()
    go' :: Int -> Int -> Int -> m ()
go' Int
len Int
offXs Int
offYsW = do
      if Int
shft forall a. Eq a => a -> a -> Bool
== Int
0
        then Int -> m ()
loopAligned Int
offYsW
        else Int -> Word -> m ()
loop Int
offYsW (forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
xs Int
base)
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Int
modWordSize Int
len forall a. Eq a => a -> a -> Bool
/= Int
0) forall a b. (a -> b) -> a -> b
$ do
        let ix :: Int
ix = Int
len forall a. Num a => a -> a -> a
- Int -> Int
modWordSize Int
len
        let x :: Word
x = Vector Bit -> Int -> Word
indexWord Vector Bit
vecXs Int
ix
        Word
y <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
vecYs Int
ix
        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
vecYs Int
ix (forall a. Bits a => a -> a -> a
f Word
x Word
y)

      where

        vecXs :: Vector Bit
vecXs = Int -> Int -> ByteArray -> Vector Bit
BitVec  Int
offXs Int
len ByteArray
xs
        vecYs :: MVector (PrimState m) Bit
vecYs = forall s. Int -> Int -> MutableByteArray s -> MVector s Bit
BitMVec (forall a. Bits a => a -> a
mulWordSize Int
offYsW) Int
len MutableByteArray (PrimState m)
ys
        shft :: Int
shft  = Int -> Int
modWordSize Int
offXs
        shft' :: Int
shft' = Int
wordSize forall a. Num a => a -> a -> a
- Int
shft
        base :: Int
base  = forall a. Bits a => a -> a
divWordSize Int
offXs
        base0 :: Int
base0 = Int
base forall a. Num a => a -> a -> a
- Int
offYsW
        base1 :: Int
base1 = Int
base0 forall a. Num a => a -> a -> a
+ Int
1
        iMax :: Int
iMax  = forall a. Bits a => a -> a
divWordSize Int
len forall a. Num a => a -> a -> a
+ Int
offYsW

        loopAligned :: Int -> m ()
        loopAligned :: Int -> m ()
loopAligned !Int
i
          | Int
i forall a. Ord a => a -> a -> Bool
>= Int
iMax = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise =  do
            let x :: Word
x = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
xs (Int
base0 forall a. Num a => a -> a -> a
+ Int
i) :: Word
            Word
y <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
ys Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
ys Int
i (forall a. Bits a => a -> a -> a
f Word
x Word
y)
            Int -> m ()
loopAligned (Int
i forall a. Num a => a -> a -> a
+ Int
1)

        loop :: Int -> Word -> m ()
        loop :: Int -> Word -> m ()
loop !Int
i !Word
acc
          | Int
i forall a. Ord a => a -> a -> Bool
>= Int
iMax = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          | Bool
otherwise =  do
            let accNew :: Word
accNew = forall a. Prim a => ByteArray -> Int -> a
indexByteArray ByteArray
xs (Int
base1 forall a. Num a => a -> a -> a
+ Int
i)
                x :: Word
x = (Word
acc forall a. Bits a => a -> Int -> a
`unsafeShiftR` Int
shft) forall a. Bits a => a -> a -> a
.|. (Word
accNew forall a. Bits a => a -> Int -> a
`unsafeShiftL` Int
shft')
            Word
y <- forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> m a
readByteArray MutableByteArray (PrimState m)
ys Int
i
            forall a (m :: * -> *).
(Prim a, PrimMonad m) =>
MutableByteArray (PrimState m) -> Int -> a -> m ()
writeByteArray MutableByteArray (PrimState m)
ys Int
i (forall a. Bits a => a -> a -> a
f Word
x Word
y)
            Int -> Word -> m ()
loop (Int
i forall a. Num a => a -> a -> a
+ Int
1) Word
accNew

{-# SPECIALIZE zipInPlace :: (forall a. Bits a => a -> a -> a) -> Vector Bit -> MVector s Bit -> ST s () #-}
{-# INLINABLE zipInPlace #-}

-- | Apply a function to a mutable vector bitwise,
-- rewriting its contents.
-- Cf. 'Data.Bit.mapBits'.
--
-- >>> :set -XOverloadedLists
-- >>> import Data.Bits
-- >>> Data.Vector.Unboxed.modify (mapInPlace complement) [0,1,1]
-- [1,0,0]
--
-- @since 1.1.0.0
mapInPlace
  :: PrimMonad m
  => (forall a . Bits a => a -> a)
  -> U.MVector (PrimState m) Bit
  -> m ()
mapInPlace :: forall (m :: * -> *).
PrimMonad m =>
(forall a. Bits a => a -> a) -> MVector (PrimState m) Bit -> m ()
mapInPlace forall a. Bits a => a -> a
f = case (Bit -> Bool
unBit (forall a. Bits a => a -> a
f (Bool -> Bit
Bit Bool
False)), Bit -> Bool
unBit (forall a. Bits a => a -> a
f (Bool -> Bit
Bit Bool
True))) of
  (Bool
False, Bool
False) -> (forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
`MU.set` Bool -> Bit
Bit Bool
False)
  (Bool
False, Bool
True)  -> forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  (Bool
True, Bool
False)  -> forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> m ()
invertInPlace
  (Bool
True, Bool
True)   -> (forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> a -> m ()
`MU.set` Bool -> Bit
Bit Bool
True)
{-# SPECIALIZE mapInPlace :: (forall a. Bits a => a -> a) -> MVector s Bit -> ST s () #-}
{-# INLINE mapInPlace #-}

-- | Invert (flip) all bits in-place.
--
-- >>> :set -XOverloadedLists
-- >>> Data.Vector.Unboxed.modify invertInPlace [0,1,0,1,0]
-- [1,0,1,0,1]
--
-- @since 0.1
invertInPlace :: PrimMonad m => U.MVector (PrimState m) Bit -> m ()
invertInPlace :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> m ()
invertInPlace MVector (PrimState m) Bit
xs = do
  let n :: Int
n = forall a s. Unbox a => MVector s a -> Int
MU.length MVector (PrimState m) Bit
xs
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0, Int
wordSize .. Int
n forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
i
    forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
i (forall a. Bits a => a -> a
complement Word
x)
{-# SPECIALIZE invertInPlace :: U.MVector s Bit -> ST s () #-}

-- | Same as 'Data.Bit.selectBits', but extract
-- selected bits in-place. Returns the number of selected bits.
-- It is the caller's responsibility to trim the result to this number.
--
-- Note: If one input is larger than the other, the remaining bits will be ignored.
--
-- >>> :set -XOverloadedLists
-- >>> import Control.Monad.ST (runST)
-- >>> import qualified Data.Vector.Unboxed as U
-- >>> runST $ do { vec <- U.unsafeThaw [1,1,0,0,1]; n <- selectBitsInPlace [0,1,0,1,1] vec; U.take n <$> U.unsafeFreeze vec }
-- [1,0,1]
--
-- @since 0.1
selectBitsInPlace
  :: PrimMonad m => U.Vector Bit -> U.MVector (PrimState m) Bit -> m Int
selectBitsInPlace :: forall (m :: * -> *).
PrimMonad m =>
Vector Bit -> MVector (PrimState m) Bit -> m Int
selectBitsInPlace Vector Bit
is MVector (PrimState m) Bit
xs = Int -> Int -> m Int
loop Int
0 Int
0
 where
  !n :: Int
n = forall a. Ord a => a -> a -> a
min (forall a. Unbox a => Vector a -> Int
U.length Vector Bit
is) (forall a s. Unbox a => MVector s a -> Int
MU.length MVector (PrimState m) Bit
xs)
  loop :: Int -> Int -> m Int
loop !Int
i !Int
ct
    | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ct
    | Bool
otherwise = do
      Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
i
      let !(Int
nSet, Word
x') = Word -> Word -> (Int, Word)
selectWord (Int -> Word -> Word
masked (Int
n forall a. Num a => a -> a -> a
- Int
i) (Vector Bit -> Int -> Word
indexWord Vector Bit
is Int
i)) Word
x
      forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
ct Word
x'
      Int -> Int -> m Int
loop (Int
i forall a. Num a => a -> a -> a
+ Int
wordSize) (Int
ct forall a. Num a => a -> a -> a
+ Int
nSet)
{-# SPECIALIZE selectBitsInPlace :: U.Vector Bit -> U.MVector s Bit -> ST s Int #-}

-- | Same as 'Data.Bit.excludeBits', but extract
-- excluded bits in-place. Returns the number of excluded bits.
-- It is the caller's responsibility to trim the result to this number.
--
-- Note: If one input is larger than the other, the remaining bits will be ignored.
--
-- >>> :set -XOverloadedLists
-- >>> import Control.Monad.ST (runST)
-- >>> import qualified Data.Vector.Unboxed as U
-- >>> runST $ do { vec <- U.unsafeThaw [1,1,0,0,1]; n <- excludeBitsInPlace [0,1,0,1,1] vec; U.take n <$> U.unsafeFreeze vec }
-- [1,0]
--
-- @since 0.1
excludeBitsInPlace
  :: PrimMonad m => U.Vector Bit -> U.MVector (PrimState m) Bit -> m Int
excludeBitsInPlace :: forall (m :: * -> *).
PrimMonad m =>
Vector Bit -> MVector (PrimState m) Bit -> m Int
excludeBitsInPlace Vector Bit
is MVector (PrimState m) Bit
xs = Int -> Int -> m Int
loop Int
0 Int
0
 where
  !n :: Int
n = forall a. Ord a => a -> a -> a
min (forall a. Unbox a => Vector a -> Int
U.length Vector Bit
is) (forall a s. Unbox a => MVector s a -> Int
MU.length MVector (PrimState m) Bit
xs)
  loop :: Int -> Int -> m Int
loop !Int
i !Int
ct
    | Int
i forall a. Ord a => a -> a -> Bool
>= Int
n = forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
ct
    | Bool
otherwise = do
      Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
i
      let !(Int
nSet, Word
x') =
            Word -> Word -> (Int, Word)
selectWord (Int -> Word -> Word
masked (Int
n forall a. Num a => a -> a -> a
- Int
i) (forall a. Bits a => a -> a
complement (Vector Bit -> Int -> Word
indexWord Vector Bit
is Int
i))) Word
x
      forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
ct Word
x'
      Int -> Int -> m Int
loop (Int
i forall a. Num a => a -> a -> a
+ Int
wordSize) (Int
ct forall a. Num a => a -> a -> a
+ Int
nSet)
{-# SPECIALIZE excludeBitsInPlace :: U.Vector Bit -> U.MVector s Bit -> ST s Int #-}

-- | Reverse the order of bits in-place.
--
-- >>> :set -XOverloadedLists
-- >>> Data.Vector.Unboxed.modify reverseInPlace [1,1,0,1,0]
-- [0,1,0,1,1]
--
-- Consider using the [vector-rotcev](https://hackage.haskell.org/package/vector-rotcev) package
-- to reverse vectors in O(1) time.
--
-- @since 0.1
reverseInPlace :: PrimMonad m => U.MVector (PrimState m) Bit -> m ()
reverseInPlace :: forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> m ()
reverseInPlace MVector (PrimState m) Bit
xs
  | Int
len forall a. Eq a => a -> a -> Bool
== Int
0  = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = Int -> m ()
loop Int
0
  where
    len :: Int
len = forall a s. Unbox a => MVector s a -> Int
MU.length MVector (PrimState m) Bit
xs

    loop :: Int -> m ()
loop !Int
i
      | Int
i' forall a. Ord a => a -> a -> Bool
<= Int
j' = do
        Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
i
        Word
y <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
j'

        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
i  (Word -> Word
reverseWord Word
y)
        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
j' (Word -> Word
reverseWord Word
x)

        Int -> m ()
loop Int
i'
      | Int
i' forall a. Ord a => a -> a -> Bool
< Int
j = do
        let w :: Int
w = (Int
j forall a. Num a => a -> a -> a
- Int
i) forall a. Bits a => a -> Int -> a
`shiftR` Int
1
            k :: Int
k = Int
j forall a. Num a => a -> a -> a
- Int
w
        Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
i
        Word
y <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
k

        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
i (Int -> Word -> Word -> Word
meld Int
w (Int -> Word -> Word
reversePartialWord Int
w Word
y) Word
x)
        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
k (Int -> Word -> Word -> Word
meld Int
w (Int -> Word -> Word
reversePartialWord Int
w Word
x) Word
y)

        Int -> m ()
loop Int
i'
      | Bool
otherwise = do
        let w :: Int
w = Int
j forall a. Num a => a -> a -> a
- Int
i
        Word
x <- forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> m Word
readWord MVector (PrimState m) Bit
xs Int
i
        forall (m :: * -> *).
PrimMonad m =>
MVector (PrimState m) Bit -> Int -> Word -> m ()
writeWord MVector (PrimState m) Bit
xs Int
i (Int -> Word -> Word -> Word
meld Int
w (Int -> Word -> Word
reversePartialWord Int
w Word
x) Word
x)
     where
      !j :: Int
j  = Int
len forall a. Num a => a -> a -> a
- Int
i
      !i' :: Int
i' = Int
i forall a. Num a => a -> a -> a
+ Int
wordSize
      !j' :: Int
j' = Int
j forall a. Num a => a -> a -> a
- Int
wordSize
{-# SPECIALIZE reverseInPlace :: U.MVector s Bit -> ST s () #-}