content: {-|
  Copyright  :  (C) 2018, Google Inc.
  License    :  BSD2 (see the file LICENSE)
  Maintainer :  Christiaan Baaij <christiaan.baaij@gmail.com>
  -}
  
  module Clash.Annotations.BitRepresentation.Util
    ( bitOrigins
    , bitOrigins'
    , bitRanges
    , isContinuousMask
    , BitOrigin(..)
    , Bit(..)
    ) where
  
  
  import Clash.Annotations.BitRepresentation.Internal
    (DataRepr'(..), ConstrRepr'(..))
  import Data.Bits  (Bits, testBit, testBit, shiftR, (.|.))
  import Data.List  (findIndex, group, mapAccumL, uncons)
  import Data.Tuple (swap)
  
  data Bit
    -- | High
    = H
    -- | Low
    | L
    -- | Undefined
    | U
      deriving (Show,Eq)
  
  -- | Result of various utilty functions. Indicates the origin of a certain bit:
  -- either a literal from the constructor (or an undefined bit), or from a
  -- literal.
  data BitOrigin
    -- | Literal (high, low, undefind)
    = Lit [Bit]
    -- | Bits originate from a field. Field /fieldnr/ /from/ /downto/.
    | Field
        Int
        -- Field number
        Int
        -- Start bit (from..)
        Int
        -- End bit (inclusive, ..downto)
          deriving (Show)
  
  -- | Same as bitOrigins, but each item in result list represents a single bit.
  bitOrigins'
    :: DataRepr'
    -> ConstrRepr'
    -> [BitOrigin]
  bitOrigins' (DataRepr' _ size constrs) (ConstrRepr' _ _ mask value fields) =
    map bitOrigin (reverse [0..fromIntegral $ size - 1])
      where
        commonMask = foldl (.|.) 0 [m | ConstrRepr' _ _ m _ _ <- constrs]
  
        -- | Determine origin of single bit
        bitOrigin :: Int -> BitOrigin
        bitOrigin n =
          if testBit mask n then
            Lit [if testBit value n then H else L]
          else
            case findIndex (\fmask -> testBit fmask n) fields of
              Nothing ->
                if testBit commonMask n then
                  -- This bit is not used in this constructor, nor is it part of
                  -- a field. We cannot leave this value uninitialized though, as
                  -- this would result in undefined behavior when matching other
                  -- constructors. We therefore take a /default/ bit value.
                  Lit [if testBit value n then H else L]
                else
                  -- This bit is not used in this constructor, nor is it part of
                  -- a field, nor is it used in other constructors. It is safe to
                  -- leave this bit uninitialized.
                  Lit [U]
              Just fieldn ->
                let fieldbitn = length $ filter id
                                       $ take n
                                       $ bitsToBools (fields !! fieldn) in
                Field fieldn fieldbitn fieldbitn
  
  -- | Given a type size and one of its constructor this function will yield a
  -- specification of which bits the whole type is made up of. I.e., a
  -- construction plan on how to make the whole data structure, given its
  -- individual constructor fields.
  bitOrigins
    :: DataRepr'
    -> ConstrRepr'
    -> [BitOrigin]
  bitOrigins dataRepr constrRepr =
    mergeOrigins (bitOrigins' dataRepr constrRepr)
  
  -- | Merge consequtive Constructor and Field fields (if applicable).
  mergeOrigins :: [BitOrigin] -> [BitOrigin]
  mergeOrigins (Lit n : Lit n' : fs) =
    -- Literals can always be merged:
    mergeOrigins $ Lit (n ++ n') : fs
  mergeOrigins (Field n s e : Field n' s' e' : fs)
    -- Consequtive fields with same field number merged:
    | n == n'   = mergeOrigins $ Field n s e' : fs
    -- No merge:
    | otherwise = Field n s e : mergeOrigins (Field n' s' e' : fs)
  -- Base cases:
  mergeOrigins (x:fs) = x : mergeOrigins fs
  mergeOrigins []     = []
  
  -- | Convert a number to a list of its bits
  -- Output is ordered from least to most significant bit.
  -- Only outputs bits until the highest set bit.
  --
  -- @
  -- > map bitsToBools [0..2]
  -- [[],[True],[False,True]])
  -- @
  --
  -- This also works for variable sized number like Integer.
  -- But not for negative numbers, because negative Integers have infinite bits set.
  bitsToBools :: (Num a, Bits a, Ord a) => a -> [Bool]
  bitsToBools 0 = []
  bitsToBools n | n < 0 = error "Can't deal with negative bitmasks/values"
                | otherwise = testBit n 0 : bitsToBools (n `shiftR` 1)
  
  
  offsets
    :: Int
    -- ^ Offset
    -> [Bool]
    -- ^ Group
    -> (Int, (Int, [Bool]))
  offsets offset group' =
    (length group' + offset, (offset, group'))
  
  -- | Determine consecutively set bits in word. Will produce ranges from high
  -- to low. Examples:
  --
  --   bitRanges 0b10          == [(1,1)]
  --   bitRanges 0b101         == [(2,2),(0,0)]
  --   bitRanges 0b10011001111 == [(10,10),(7,6),(3,0)]
  --
  bitRanges :: Integer -> [(Int, Int)]
  bitRanges word = reverse $ map swap ranges
    where
      ranges  = map (\(ofs, grp) -> (ofs, ofs+length grp-1)) groups'
      groups' = filter (maybe False fst . uncons . snd) groups
      groups  = snd $ mapAccumL offsets 0 (group bits)
      bits    = bitsToBools word
  
  isContinuousMask :: Integer -> Bool
  isContinuousMask word =
    -- Use case expression so we avoid calculating all groups
    case bitRanges word of
      -- At least two groups:
      (_:_:_) -> False
      -- Zero or one group:
      _       -> True
  