package TagEngine(
    TagEngine(..),
    mkTagEngine) where

import Vector
import Util

#define UIntLog2N(n) (UInt (TLog n))

data Tag numTags
    = Next UIntLog2N(numTags)
    | Freed
    | Tail
    deriving (Bits, Eq, FShow)

data TagPtr numTags
    = SomeTagPtr UIntLog2N(numTags)
    | None
    deriving (Bits, Eq, FShow)

interface (TagEngine :: # -> *) numTags =
    requestTag :: ActionValue UIntLog2N(numTags)
    retireTag  :: UIntLog2N(numTags) -> Action

instance FShow (Reg (Tag numTags)) where
    fshow value = fshow (readReg value)

initTagNext :: Integer -> Module(Reg (Tag numTags))
initTagNext i = do
    t :: Reg (Tag numTags)
    t <- mkReg (Next (fromInteger i))
    return t

initTagTail :: Module(Reg (Tag numTags))
initTagTail = do
    t :: Reg (Tag numTags)
    t <- mkReg Tail
    return t

initTagVec :: Module(Vector numTags (Reg (Tag numTags)))
initTagVec =
    let
        lastIdx :: Integer = (fromInteger |> valueOf numTags) - 1
        initByIdx currIdx =
            if (currIdx < lastIdx)
                then initTagNext (currIdx + 1)
                else initTagTail
    in
        mapM initByIdx genVector

mkTagEngine :: Module (TagEngine numTags)
mkTagEngine =
    do
        tagVec :: Vector numTags (Reg (Tag numTags))
        tagVec <- initTagVec

        head :: Reg(TagPtr(numTags)) <- mkReg(SomeTagPtr(0))
        tail :: Reg(TagPtr(numTags)) <- mkReg(SomeTagPtr(lastIdx))

        debugOnce <- mkReg True

        addRules $
            rules
                "display": when (debugOnce == True) ==>
                    do
                        $display (fshow tagVec)
                        debugOnce := False

        counter <- mkReg(0 :: UIntLog2N(numTags))
        return $
          interface TagEngine
            requestTag :: ActionValue UIntLog2N(numTags)
            requestTag =
                do
                    let currHeadPtr :: UIntLog2N(numTags) =
                            case head of
                                SomeTagPtr ptr -> ptr
                                -- we technically will never hit this arm
                                -- due to when guard `SomeTagPtr ptr <- head`
                                None -> 0
                    let currHead :: (Reg (Tag numTags)) = (select tagVec currHeadPtr)
                    let nextHeadPtr :: UIntLog2N(numTags) =
                            case currHead of
                                Next ptr -> ptr
                                -- TODO : handle tail correctly
                                Tail -> 0
                    currHead := Freed
                    head := SomeTagPtr(nextHeadPtr)
                    return nextHeadPtr
                when
                    SomeTagPtr ptr <- head
            retireTag :: UIntLog2N(numTags) -> Action
            retireTag tag = do
                -- placeholder
                counter := 0
    where
        lastIdx :: UIntLog2N(numTags) = (fromInteger |> valueOf numTags) - 1