Bus types typecheck!!!

This commit is contained in:
Yehowshua Immanuel 2025-04-08 23:36:54 -04:00
parent fe2fa21fcc
commit 989c4e9616
3 changed files with 27 additions and 17 deletions

View file

@ -21,11 +21,11 @@ mkTestTop = do
testType <- mkTestType testType <- mkTestType
return $ interface Empty { } return $ interface Empty { }
mkBus :: Vector numClients (BusClient (UInt (TLog numClients))) mkBus :: Vector numClients (BusClient inFlightTransactions)
-> Vector numServers (BusServer (UInt (TLog numClients)) clientTagType) -> Vector numServers (BusServer inFlightTransactions numClients)
-> Module Empty -> Module Empty
mkBus clientVec serverVec = do mkBus clientVec serverVec = do
tagEngineByClient :: Vector numClients (TagEngine (TLog numClients)) tagEngineByClient :: Vector numClients (TagEngine inFlightTransactions)
tagEngineByClient <- replicateM mkTagEngine tagEngineByClient <- replicateM mkTagEngine
return $ interface Empty { } return $ interface Empty { }

View file

@ -1,5 +1,5 @@
package BusTypes( package BusTypes(
Bus(..), ClientTagType,
BusClient(..), BusServer(..), BusClient(..), BusServer(..),
BusRequest(..), BusResponse(..), BusRequest(..), BusResponse(..),
ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..), ReadRequest(..), ReadResponse(..), WriteRequest(..), WriteResponse(..),
@ -8,6 +8,9 @@ package BusTypes(
import Types import Types
import Vector import Vector
import TagEngine
type ClientTagType a = (UInt (TLog a))
data BusError data BusError
= UnMapped = UnMapped
@ -68,25 +71,31 @@ data BusResponse
-- * From the client's perspective, the response should not be called -- * From the client's perspective, the response should not be called
-- by the arbiter until the client is ready to accept the response. -- by the arbiter until the client is ready to accept the response.
-- In other words, the response method should be guarded by the client. -- In other words, the response method should be guarded by the client.
interface (BusClient :: * -> *) transactionTagType = interface (BusClient :: # -> *) inFlightTransactions =
dequeueRequest :: transactionTagType -> ActionValue BusRequest dequeueRequest :: TagType inFlightTransactions
enqueueResponse :: (BusResponse, transactionTagType) -> Action -> ActionValue BusRequest
enqueueResponse :: (BusResponse, TagType inFlightTransactions)
-> Action
-- # BusServer.dequeueResponse -- # BusServer.dequeueResponse
-- * If the arbiter is able to successfully call `dequeueResponse`, then -- * If the arbiter is able to successfully call `dequeueResponse`, then
-- the BusServer's internal logici must update such that it understand -- the BusServer's internal logici must update such that it understand
-- the response has been handed off. -- the response has been handed off.
-- # BusServer.peekClientTagDestination -- # BusServer.peekClientTagDestination
-- * The arbiter looks at (peekClientTagDestination :: clientTagTye) to -- * The arbiter looks at (peekClientTagDestination :: clientTagType) to
-- determine whether or not it is currently safe whether to dequeue the -- determine whether or not it is currently safe whether to dequeue the
-- response as well as where to route the response should it dequeue the -- response as well as where to route the response should it dequeue the
-- response. -- response.
-- * `peekClientTagDestination` should be guarded on whether or not there is -- * `peekClientTagDestination` should be guarded on whether or not there is
-- a valid response available. -- a valid response available.
interface (BusServer :: * -> * -> *) transactionTagType clientTagType = interface (BusServer :: # -> # -> *) inFlightTransactions numClients =
enqueueRequest :: (transactionTagType, BusRequest) -> Action enqueueRequest :: (TagType inFlightTransactions, BusRequest)
dequeueResponse :: ActionValue (clientTagType, BusResponse, transactionTagType) -> Action
peekClientTagDestination :: clientTagTye dequeueResponse :: ActionValue (
ClientTagType numClients,
BusResponse, transactionTagType
)
peekClientTagDestination :: clientTagType
type Token = UInt 5 type Token = UInt 5
type Numeric = 5 type Numeric = 5

View file

@ -1,4 +1,5 @@
package TagEngine( package TagEngine(
TagType,
TagEngine(..), TagEngine(..),
Util.BasicResult(..), Util.BasicResult(..),
mkTagEngine) where mkTagEngine) where
@ -9,11 +10,11 @@ import FIFO
import FIFOF import FIFOF
import SpecialFIFOs import SpecialFIFOs
#define UIntLog2N(n) (UInt (TLog n)) type TagType a = (UInt (TLog a))
interface (TagEngine :: # -> *) numTags = interface (TagEngine :: # -> *) numTags =
requestTag :: ActionValue UIntLog2N(numTags) requestTag :: ActionValue (TagType numTags)
retireTag :: UIntLog2N(numTags) -> Action retireTag :: (TagType numTags) -> Action
-- The tag engine returns a tag that is unique for the duration of -- The tag engine returns a tag that is unique for the duration of
-- the lifetime of the tag. Useful when you need to tag transactions -- the lifetime of the tag. Useful when you need to tag transactions
@ -79,7 +80,7 @@ mkTagEngine = do
-- Interface -- Interface
return $ return $
interface TagEngine interface TagEngine
requestTag :: ActionValue UIntLog2N(numTags) requestTag :: ActionValue (TagType numTags)
requestTag = do requestTag = do
case initialTagDistributor of case initialTagDistributor of
Just 0 -> do Just 0 -> do
@ -100,7 +101,7 @@ mkTagEngine = do
-- so it is advisable that the caller of `retireTag` only attempt to retire valid tags. -- so it is advisable that the caller of `retireTag` only attempt to retire valid tags.
-- Internally, the tagEngine will keep a correct and consistent state since TagEngine -- Internally, the tagEngine will keep a correct and consistent state since TagEngine
-- validates tags before attempting to retire them. -- validates tags before attempting to retire them.
retireTag :: UIntLog2N(numTags) -> Action retireTag :: (TagType numTags) -> Action
retireTag tag = retireTag tag =
do do
let let