{-# 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)
#else
import Data.Bits (popCount)
#endif
#if !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 Int -> BitQueue -> ShowS
[BitQueue] -> ShowS
BitQueue -> String
(Int -> BitQueue -> ShowS)
-> (BitQueue -> String) -> ([BitQueue] -> ShowS) -> Show BitQueue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BitQueue] -> ShowS
$cshowList :: [BitQueue] -> ShowS
show :: BitQueue -> String
$cshow :: BitQueue -> String
showsPrec :: Int -> BitQueue -> ShowS
$cshowsPrec :: Int -> BitQueue -> ShowS
Show
instance Show BitQueueB where
show :: BitQueueB -> String
show (BQB Word
hi Word
lo) = String
"BQ"String -> ShowS
forall a. [a] -> [a] -> [a]
++
[Bool] -> String
forall a. Show a => a -> String
show ((Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word
hi) [(Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1),(Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)..Int
0]
[Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ (Int -> Bool) -> [Int] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (Word -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word
lo) [(Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1),(Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)..Int
0])
emptyQB :: BitQueueB
emptyQB :: BitQueueB
emptyQB = Word -> Word -> BitQueueB
BQB (Word
1 Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Word
0
{-# INLINE emptyQB #-}
shiftQBR1 :: BitQueueB -> BitQueueB
shiftQBR1 :: BitQueueB -> BitQueueB
shiftQBR1 (BQB Word
hi Word
lo) = Word -> Word -> BitQueueB
BQB Word
hi' Word
lo' where
lo' :: Word
lo' = (Word
lo Word -> Int -> Word
`shiftRL` Int
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
hi Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
hi' :: Word
hi' = Word
hi Word -> Int -> Word
`shiftRL` Int
1
{-# INLINE shiftQBR1 #-}
{-# INLINE snocQB #-}
snocQB :: BitQueueB -> Bool -> BitQueueB
snocQB :: BitQueueB -> Bool -> BitQueueB
snocQB BitQueueB
bq Bool
b = case BitQueueB -> BitQueueB
shiftQBR1 BitQueueB
bq of
BQB Word
hi Word
lo -> Word -> Word -> BitQueueB
BQB (Word
hi Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bool -> Int
forall a. Enum a => a -> Int
fromEnum Bool
b) Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Word
lo
{-# INLINE buildQ #-}
buildQ :: BitQueueB -> BitQueue
buildQ :: BitQueueB -> BitQueue
buildQ (BQB Word
hi Word
0) = BitQueueB -> BitQueue
BQ (Word -> Word -> BitQueueB
BQB Word
0 Word
lo') where
zeros :: Int
zeros = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
hi
lo' :: Word
lo' = ((Word
hi Word -> Int -> Word
`shiftRL` Int
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
1 Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))) Word -> Int -> Word
`shiftRL` Int
zeros
buildQ (BQB Word
hi Word
lo) = BitQueueB -> BitQueue
BQ (Word -> Word -> BitQueueB
BQB Word
hi' Word
lo') where
zeros :: Int
zeros = Word -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros Word
lo
lo1 :: Word
lo1 = (Word
lo Word -> Int -> Word
`shiftRL` Int
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
hi Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
hi1 :: Word
hi1 = (Word
hi Word -> Int -> Word
`shiftRL` Int
1) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
1 Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
lo' :: Word
lo' = (Word
lo1 Word -> Int -> Word
`shiftRL` Int
zeros) Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. (Word
hi1 Word -> Int -> Word
`shiftLL` (Int
wordSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
zeros))
hi' :: Word
hi' = Word
hi1 Word -> Int -> Word
`shiftRL` Int
zeros
nullQ :: BitQueue -> Bool
nullQ :: BitQueue -> Bool
nullQ (BQ (BQB Word
0 Word
1)) = Bool
True
nullQ BitQueue
_ = Bool
False
{-# INLINE nullQ #-}
unconsQ :: BitQueue -> Maybe (Bool, BitQueue)
unconsQ :: BitQueue -> Maybe (Bool, BitQueue)
unconsQ BitQueue
q | BitQueue -> Bool
nullQ BitQueue
q = Maybe (Bool, BitQueue)
forall a. Maybe a
Nothing
unconsQ (BQ bq :: BitQueueB
bq@(BQB Word
_ Word
lo)) = (Bool, BitQueue) -> Maybe (Bool, BitQueue)
forall a. a -> Maybe a
Just (Bool
hd, BitQueueB -> BitQueue
BQ BitQueueB
tl)
where
!hd :: Bool
hd = (Word
lo Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
1) Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
/= Word
0
!tl :: BitQueueB
tl = BitQueueB -> BitQueueB
shiftQBR1 BitQueueB
bq
{-# INLINE unconsQ #-}
toListQ :: BitQueue -> [Bool]
toListQ :: BitQueue -> [Bool]
toListQ BitQueue
bq = case BitQueue -> Maybe (Bool, BitQueue)
unconsQ BitQueue
bq of
Maybe (Bool, BitQueue)
Nothing -> []
Just (Bool
hd, BitQueue
tl) -> Bool
hd Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: BitQueue -> [Bool]
toListQ BitQueue
tl