shoudl probably rethink approach...

This commit is contained in:
Yehowshua Immanuel 2025-04-09 20:58:13 -04:00
parent b4c7537a85
commit 076d3aed43

View file

@ -10,20 +10,56 @@ import Arbiter
clientRequest :: Arbiter.ArbiterClient_IFC -> Action clientRequest :: Arbiter.ArbiterClient_IFC -> Action
clientRequest ifc = ifc.request clientRequest ifc = ifc.request
mkBus :: Vector numClients (BusClient inFlightTransactions) busRequestToAddr :: BusRequest -> Addr
busRequestToAddr req = case req of
BusReadRequest (ReadRequest addr _) -> addr
WriteReadRequest (WriteRequest addr _) -> addr
mkBus :: (Addr -> Integer)
-> Vector numClients (BusClient inFlightTransactions)
-> Vector numServers (BusServer inFlightTransactions numClients) -> Vector numServers (BusServer inFlightTransactions numClients)
-> Module Empty -> Module Empty
mkBus clientVec serverVec = do mkBus addrToServerTranslation clientVec serverVec = do
tagEngineByClient :: Vector numClients (TagEngine inFlightTransactions) tagEngineByClientVec :: Vector numClients (TagEngine inFlightTransactions)
tagEngineByClient <- replicateM mkTagEngine tagEngineByClientVec <- replicateM mkTagEngine
arbiterByServer :: Vector numServers (Arbiter_IFC numClients) arbiterByServerVec :: Vector numServers (Arbiter_IFC numClients)
arbiterByServer <- replicateM (mkArbiter False) arbiterByServerVec <- replicateM (mkArbiter False)
-- statically determinate criteria
let
clientIdx :: Integer = 0
selectedClient ::(BusClient inFlightTransactions)
selectedClient = (select clientVec clientIdx)
selectedTagEngine = (select tagEngineByClientVec clientIdx)
addRules |> addRules |>
rules rules
"placeholder rule": when True ==> do "placeholder rule": when True ==> do
let selectedArbiter = (select arbiterByServer 0) let selectedServerArbiter = (select arbiterByServerVec 0)
mapM_ clientRequest selectedArbiter.clients mapM_ clientRequest selectedServerArbiter.clients
"connect request client 0":
when True
==> do
tag <- selectedTagEngine.requestTag
busRequest :: BusRequest
busRequest <- selectedClient.dequeueRequest tag
-- let
-- addr = busRequestToAddr busRequest
-- targetServerIdx = addrToServerTranslation addr
-- targetServer = (select serverVec targetServerIdx)
-- targetServerArbiter = (select arbiterByServerVec targetServerIdx)
-- targetServerArbiter.request
-- if targetServerArbiter.grant
-- then targetServer.enqueueRequest (tag, busRequest)
-- else action {}
-- targetServer
action {}
return $ interface Empty { } return $ interface Empty { }