{-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
#include "containers.h"
module Utils.Containers.Internal.BitQueue
( BitQueue
, BitQueueB
, emptyQB
, snocQB
, buildQ
, unconsQ
, toListQ
) where
#if !MIN_VERSION_base(4,8,0)
import Data.Word (Word)
#endif
import Utils.Containers.Internal.BitUtil (shiftLL, shiftRL, wordSize)
import Data.Bits ((.|.), (.&.), testBit)
#if MIN_VERSION_base(4,8,0)
import Data.Bits (countTrailingZeros)
#elif MIN_VERSION_base(4,5,0)
import Data.Bits (popCount)
#endif
#if !MIN_VERSION_base(4,5,0)
countTrailingZeros :: Word -> Int
countTrailingZeros x = go 0
where
go i | i >= wordSize = i
| testBit x i = i
| otherwise = go (i+1)
#elif !MIN_VERSION_base(4,8,0)
countTrailingZeros :: Word -> Int
countTrailingZeros x = popCount ((x .&. (-x)) - 1)
{-# INLINE countTrailingZeros #-}
#endif
data BitQueueB = BQB {-# UNPACK #-} !Word
{-# UNPACK #-} !Word
newtype BitQueue = BQ BitQueueB deriving Show
instance Show BitQueueB where
show (BQB hi lo) = "BQ"++
show (map (testBit hi) [(wordSize - 1),(wordSize - 2)..0]
++ map (testBit lo) [(wordSize - 1),(wordSize - 2)..0])
emptyQB :: BitQueueB
emptyQB = BQB (1 `shiftLL` (wordSize - 1)) 0
{-# INLINE emptyQB #-}
shiftQBR1 :: BitQueueB -> BitQueueB
shiftQBR1 (BQB hi lo) = BQB hi' lo' where
lo' = (lo `shiftRL` 1) .|. (hi `shiftLL` (wordSize - 1))
hi' = hi `shiftRL` 1
{-# INLINE shiftQBR1 #-}
{-# INLINE snocQB #-}
snocQB :: BitQueueB -> Bool -> BitQueueB
snocQB bq b = case shiftQBR1 bq of
BQB hi lo -> BQB (hi .|. (fromIntegral (fromEnum b) `shiftLL` (wordSize - 1))) lo
{-# INLINE buildQ #-}
buildQ :: BitQueueB -> BitQueue
buildQ (BQB hi 0) = BQ (BQB 0 lo') where
zeros = countTrailingZeros hi
lo' = ((hi `shiftRL` 1) .|. (1 `shiftLL` (wordSize - 1))) `shiftRL` zeros
buildQ (BQB hi lo) = BQ (BQB hi' lo') where
zeros = countTrailingZeros lo
lo1 = (lo `shiftRL` 1) .|. (hi `shiftLL` (wordSize - 1))
hi1 = (hi `shiftRL` 1) .|. (1 `shiftLL` (wordSize - 1))
lo' = (lo1 `shiftRL` zeros) .|. (hi1 `shiftLL` (wordSize - zeros))
hi' = hi1 `shiftRL` zeros
nullQ :: BitQueue -> Bool
nullQ (BQ (BQB 0 1)) = True
nullQ _ = False
{-# INLINE nullQ #-}
unconsQ :: BitQueue -> Maybe (Bool, BitQueue)
unconsQ q | nullQ q = Nothing
unconsQ (BQ bq@(BQB _ lo)) = Just (hd, BQ tl)
where
!hd = (lo .&. 1) /= 0
!tl = shiftQBR1 bq
{-# INLINE unconsQ #-}
toListQ :: BitQueue -> [Bool]
toListQ bq = case unconsQ bq of
Nothing -> []
Just (hd, tl) -> hd : toListQ tl