{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies  #-}

module HaskellWorks.Data.PackedVector.PackedVector64
  ( PackedVector64(..)
  , empty
  , fromList
  , toList
  ) where

import Control.DeepSeq
import Data.Int
import Data.Word
import GHC.Generics
import HaskellWorks.Data.AtIndex
import HaskellWorks.Data.Bits.BitWise
import HaskellWorks.Data.Bits.LoBitsSized
import HaskellWorks.Data.PackedVector.Internal
import HaskellWorks.Data.Positioning
import HaskellWorks.Data.Unsign
import Prelude                                 hiding (length)

import qualified Data.Vector.Storable as DVS

data PackedVector64 = PackedVector64
  { swBuffer    :: !(DVS.Vector Word64)
  , swBitSize   :: !Word
  , swBufferLen :: !Int
  } deriving (Eq, Show, Generic)

instance NFData PackedVector64

empty :: PackedVector64
empty =
  PackedVector64
  { swBuffer    = DVS.empty
  , swBufferLen = 0
  , swBitSize   = 1
  }

instance Container PackedVector64 where
  type Elem PackedVector64 = Word64

instance Length PackedVector64 where
  length = fromIntegral . swBufferLen
  {-# INLINE length #-}

instance AtIndex PackedVector64 where
  atIndex v i =
    let bitSize     = fromIntegral (swBitSize v) :: Count
        bitIndex    = fromIntegral (swBitSize v) * i
        (q, r)      = bitIndex `quotRem` 64
        vv          = swBuffer v
    in if r <= 64 - fromIntegral bitSize
      then -- Not crossing boundary
        ((vv !!! q) .>. unsign r) .&. loBitsSized bitSize
      else -- Crossing boundary
        let loBitsSize  = 64 - toCount r
            hiBitsSize  = bitSize - loBitsSize
            loBits      = ((vv !!! q) .>. unsign r) .&. loBitsSized loBitsSize
            hiBits      = if r > 64 - fromIntegral bitSize then (vv !!! (q + 1)) .&. loBitsSized hiBitsSize else 0
        in  loBits .|. (hiBits .<. loBitsSize)
  (!!!)       = atIndex
  {-# INLINE (!!!)   #-}
  {-# INLINE atIndex #-}

fromList :: Count -> [Word64] -> PackedVector64
fromList wl ws =
  PackedVector64
  { swBuffer    = DVS.fromList (packBits wl ws)
  , swBufferLen = fromIntegral (length ws)
  , swBitSize   = fromIntegral wl
  }

toList :: PackedVector64 -> [Word64]
toList v = unpackBits (swBufferLen v) (fromIntegral (swBitSize v)) (DVS.toList (swBuffer v))