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

import Vector
import Util

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

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

mkTagEngine :: Module (TagEngine numTags)
mkTagEngine =
    do
        let reifiedNumTags = fromInteger |> valueOf numTags

        freeStackVec :: Vector numTags (Reg UIntLog2N(numTags))
        freeStackVec <- mapM (\i -> mkReg |> fromInteger i) genVector

        inUseVec :: Vector numTags (Reg Bool)
        inUseVec <- replicateM |> mkReg False

        stackPtr :: (Reg (Maybe(UIntLog2N(numTags))))
        stackPtr <- mkReg |> Just |> reifiedNumTags - 1

        debugOnce <- mkReg True

        addRules $
            rules
                "display": when (debugOnce == True) ==>
                    do
                        $display "freeStackVec : " (fshow |> readVReg freeStackVec)
                        $display "inUseVec : " (fshow |> readVReg inUseVec)
                        $display "stackPtr : " (fshow stackPtr)
                        debugOnce := False

        counter <- mkReg(0 :: UIntLog2N(numTags))
        return $
          interface TagEngine

            requestTag :: ActionValue UIntLog2N(numTags)
            requestTag =
                do
                    stackPtr := 
                        if sampledStackPtr == 0
                            then Nothing
                            else Just |> sampledStackPtr - 1
                    (select inUseVec sampledStackPtr) := True
                    return |> readReg (select freeStackVec sampledStackPtr)
                when
                    Just sampledStackPtr <- stackPtr

            retireTag :: UIntLog2N(numTags) -> Action
            retireTag tag = 
                do
                    let nextStackPtrUint = 
                            case stackPtr of
                                Nothing -> 0
                                Just n -> n + 1
                    (select inUseVec tag) := False
                    (select freeStackVec nextStackPtrUint) := tag
                    stackPtr := Just nextStackPtrUint
                -- when
                --     tag < (reifiedNumTags - 1),
                --     readReg (select inUseVec tag)