    {-# LANGUAGE CPP #-}
    {-# LANGUAGE BangPatterns #-}

    #include "containers.h"

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Utils.Containers.Internal.BitQueue
    -- Copyright   :  (c) David Feuer 2016
    -- License     :  BSD-style
    -- Maintainer  :  libraries@haskell.org
    -- Portability :  portable
    --
    -- = WARNING
    --
    -- This module is considered __internal__.
    --
    -- The Package Versioning Policy __does not apply__.
    --
    -- The contents of this module may change __in any way whatsoever__
    -- and __without any warning__ between minor versions of this package.
    --
    -- Authors importing this module are expected to track development
    -- closely.
    --
    -- = Description
    --
    -- An extremely light-weight, fast, and limited representation of a string of
    -- up to (2*WORDSIZE - 2) bits. In fact, there are two representations,
    -- misleadingly named bit queue builder and bit queue. The builder supports
    -- only `emptyQB`, creating an empty builder, and `snocQB`, enqueueing a bit.
    -- The bit queue builder is then turned into a bit queue using `buildQ`, after
    -- which bits can be removed one by one using `unconsQ`. If the size limit is
    -- exceeded, further operations will silently produce nonsense.
    -----------------------------------------------------------------------------

    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

    -- A bit queue builder. We represent a double word using two words
    -- because we don't currently have access to proper double words.
    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

    -- Intended for debugging.
    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])

    -- | Create an empty bit queue builder. This is represented as a single guard
    -- bit in the most significant position.
    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 #-}

    -- Shift the double word to the right by one bit.
    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 #-}

    -- | Enqueue a bit. This works by shifting the queue right one bit,
    -- then setting the most significant bit as requested.
    {-# 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

    -- | Convert a bit queue builder to a bit queue. This shifts in a new
    -- guard bit on the left, and shifts right until the old guard bit falls
    -- off.
    {-# 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

    -- Test if the queue is empty, which occurs when theres
    -- nothing left but a guard bit in the least significant
    -- place.
    nullQ :: BitQueue -> Bool
    nullQ :: BitQueue -> Bool
    nullQ (BQ (BQB Word
    0 Word
    1)) = Bool
    True
    nullQ BitQueue
    _ = Bool
    False
    {-# INLINE nullQ #-}

    -- | Dequeue an element, or discover the queue is empty.
    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 #-}

    -- | Convert a bit queue to a list of bits by unconsing.
    -- This is used to test that the queue functions properly.
    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