-- |BitRepr.hs
-- Bit representation.

{-# LANGUAGE RankNTypes, GADTs, TypeFamilies, TypeOperators, TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses, OverlappingInstances #-}

module Hardware.HHDL.BitRepr where

import Data.Bits

import Hardware.HHDL.TyLeA

-------------------------------------------------------------------------------
-- Main class.

class Nat (BitVectorSize a) => BitRepr a where
	type BitVectorSize a

	-- |Convert value to an integer.
	toBitVector :: a -> Integer

	-- |Convert integer to value. Conversion should ignore any bits above
	-- "bitVectorSize result".
	fromBitVector :: Integer -> a

	-- |Size of value in bits.
	bitVectorSize :: a -> Int
	bitVectorSize a = i
		where
			getSize :: a -> BitVectorSize a
			getSize a = undefined
			i = fromNat (getSize a)

	-- |Mask for value's significant bits.
	-- In usual bit vectors they are all significant (default variant below).
	-- In algebraic types they aren't: data T = B Bool | W Word64.
	-- The mask for B x could ignore significant bits from Word64 in W.
	-- Right now it is not widely used, so it is safe to leave it as it is.
	bitMask :: a -> Integer
	bitMask a = shiftL 1 (bitVectorSize a) - 1


-------------------------------------------------------------------------------
-- Support definitions and type functions for algebraic types.
-- instances are generated by calling generateMakeMatches from TH.hs.

-- |How much bits do we need to pass arguments for any constructor?
type family ArgsBusSize a

-- |How much bits do we need for constructor selector?
type family SelectorBusSize a


-- Utility conversion function.
-- USed for toBitVector/fromBitVector implementations.
_toArgsBusSize :: a -> ArgsBusSize a
_toArgsBusSize = undefined

_toArgsBusSizeInt :: Nat (ArgsBusSize a) => a -> Int
_toArgsBusSizeInt = fromNat . _toArgsBusSize

_toSelBusSize :: a -> SelectorBusSize a
_toSelBusSize = undefined

_toSelBusSizeInt :: Nat (SelectorBusSize a) => a -> Int
_toSelBusSizeInt = fromNat . _toSelBusSize

_combineConstructorIndexArgs :: Integer -> Int -> Integer -> Integer
_combineConstructorIndexArgs argsVector shift ci = shiftL ci shift .|. argsVector

-- |Helper class that breaks some type checking dependencies and
-- allow for faster compilation.
class (Nat (ArgsBusSize a), Nat (SelectorBusSize a)) => AlgTypeBitEnc a where
	algTypeArgsBusSize :: a -> Int
	algTypeArgsBusSize a = fromNat (_toArgsBusSize a)

	algTypeArgsBusMask :: a -> Integer
	algTypeArgsBusMask a = shiftL 1 (algTypeArgsBusSize a) - 1

	algTypeSelectorBusSize :: a -> Int
	algTypeSelectorBusSize = _toSelBusSizeInt

	algTypeSelectorBusMask :: a -> Integer
	algTypeSelectorBusMask a = shiftL 1 (_toSelBusSizeInt a) - 1