{-# 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__.
--
-- This 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 Show

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

-- | Create an empty bit queue builder. This is represented as a single guard
-- bit in the most significant position.
emptyQB :: BitQueueB
emptyQB = BQB (1 `shiftLL` (wordSize - 1)) 0
{-# INLINE emptyQB #-}

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

-- | 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 bq b = case shiftQBR1 bq of
  BQB hi lo -> BQB (hi .|. (fromIntegral (fromEnum b) `shiftLL` (wordSize - 1))) 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 (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

-- 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 (BQ (BQB 0 1)) = True
nullQ _ = False
{-# INLINE nullQ #-}

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

-- | 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 bq = case unconsQ bq of
      Nothing -> []
      Just (hd, tl) -> hd : toListQ tl