Bus types typecheck!!!
This commit is contained in:
parent
fe2fa21fcc
commit
989c4e9616
|
@ -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 { }
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue