{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__
{-# LANGUAGE MagicHash #-}
#endif
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Safe #-}
#endif
#include "containers.h"
module Utils.Containers.Internal.BitUtil
( bitcount
, highestBitMask
, shiftLL
, shiftRL
, wordSize
) where
#if !MIN_VERSION_base(4,8,0)
import Data.Bits ((.|.), xor)
#endif
import Data.Bits (popCount, unsafeShiftL, unsafeShiftR
#if MIN_VERSION_base(4,8,0)
, countLeadingZeros
#endif
)
#if MIN_VERSION_base(4,7,0)
import Data.Bits (finiteBitSize)
#else
import Data.Bits (bitSize)
#endif
#if !MIN_VERSION_base (4,8,0)
import Data.Word (Word)
#endif
bitcount :: Int -> Word -> Int
bitcount :: Int -> Word -> Int
bitcount Int
a Word
x = Int
a forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int
popCount Word
x
{-# INLINE bitcount #-}
highestBitMask :: Word -> Word
#if MIN_VERSION_base(4,8,0)
highestBitMask :: Word -> Word
highestBitMask Word
w = Word -> Int -> Word
shiftLL Word
1 (Int
wordSize forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- forall b. FiniteBits b => b -> Int
countLeadingZeros Word
w)
#else
highestBitMask x1 = let x2 = x1 .|. x1 `shiftRL` 1
x3 = x2 .|. x2 `shiftRL` 2
x4 = x3 .|. x3 `shiftRL` 4
x5 = x4 .|. x4 `shiftRL` 8
x6 = x5 .|. x5 `shiftRL` 16
#if !(defined(__GLASGOW_HASKELL__) && WORD_SIZE_IN_BITS==32)
x7 = x6 .|. x6 `shiftRL` 32
in x7 `xor` (x7 `shiftRL` 1)
#else
in x6 `xor` (x6 `shiftRL` 1)
#endif
#endif
{-# INLINE highestBitMask #-}
shiftRL, shiftLL :: Word -> Int -> Word
shiftRL :: Word -> Int -> Word
shiftRL = forall a. Bits a => a -> Int -> a
unsafeShiftR
shiftLL :: Word -> Int -> Word
shiftLL = forall a. Bits a => a -> Int -> a
unsafeShiftL
{-# INLINE wordSize #-}
wordSize :: Int
#if MIN_VERSION_base(4,7,0)
wordSize :: Int
wordSize = forall b. FiniteBits b => b -> Int
finiteBitSize (Word
0 :: Word)
#else
wordSize = bitSize (0 :: Word)
#endif