{-# LANGUAGE KindSignatures
, GADTs
, ScopedTypeVariables
, PatternSignatures
, MultiParamTypeClasses
, FunctionalDependencies
, FlexibleInstances
, UndecidableInstances
, TypeFamilies
, FlexibleContexts
#-}{-
Pid.hs
Copyright 2008 Matthew Sackman <matthew@wellquite.org>
This file is part of Session Types for Haskell.
Session Types for Haskell is free software: you can redistribute it
and/or modify it under the terms of the GNU General Public License
as published by the Free Software Foundation, either version 3 of
the License, or (at your option) any later version.
Session Types for Haskell is distributed in the hope that it will
be useful, but WITHOUT ANY WARRANTY; without even the implied
warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with Session Types for Haskell.
If not, see <http://www.gnu.org/licenses/>.
-}-- | Defines what a 'Pid' is and provides functionality to create new-- sessions / channels to a given pid. Obviously this is /safe/ in-- some way - in particular, a Pid carries about with it the set of-- Session Types it is willing to use. This means that you can't try-- to start any old Session Type with any given Pid. However, it-- doesn't mean that given an acceptable Session Type, the other-- thread will ever actually get around to agreeing to create the new-- session / channel with you.moduleControl.Concurrent.Session.Pid(makePid,rootPid,iPidToPid,myPid,BuildPidTyMap(..),BuildInvertedSessionsSet(..),CreateSession(..),PidEq(..),MultiReceive(MultiReceiveNil),(~|||~),multiReceive)whereimportControl.Concurrent.Session.Base.BoolimportControl.Concurrent.Session.Base.NumberimportControl.Concurrent.Session.Base.MapimportControl.Concurrent.Session.Base.ListimportControl.Concurrent.Session.SessionTypeimportControl.Concurrent.Session.TypesimportControl.Concurrent.Session.RuntimeimportControl.ConcurrentimportData.Map(Map)importqualifiedData.MapasMapimportData.MaybemakePid::InternalPidprogprog'invertedSessionsOsessionsToIdxOidxsToPairStructsO->invertedSessionsN->TyMapsessionsToIdxNidxsToPairStructsN->(InternalPidprogprog'invertedSessionsOsessionsToIdxOidxsToPairStructsO,InternalPidprogprog'invertedSessionsNsessionsToIdxNidxsToPairStructsN)makePid(IPidorig@(Pid__)(p:ps))_childTM=((IPidorigps),child)wherechild=IPid(PidpchildTM)[x:p|x<-[0..]]makePid(IPid_[])__=error"Out of pids. Interesting."rootPid::(Dualprogprog',DualTprog~prog')=>TyMapsessionsToIdxidxsToPairStructs->invertedSessions->prog->InternalPidprogprog'invertedSessionssessionsToIdxidxsToPairStructsrootPidtm__=IPid(Pid[0]tm)[[x,0]|x<-[0..]]myPid::InterleavedChain(InternalPidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)fromfrom(Pidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)myPid=InterleavedChain$\px->return(iPidToPidp,x,p)classBuildPidTyMapprogstlsttymap|progstlst->tymapwheretypeBuildPidTyMapTprogstlstbuildPidTyMap::prog->stlst->IOtymapinstance(BuildPidTyMap'progstlst(TyMapNilNil)tymap)=>BuildPidTyMapprogstlsttymapwheretypeBuildPidTyMapTprogstlst=BuildPidTyMapT'progstlst(TyMapNilNil)buildPidTyMapprogstlst=buildPidTyMap'progstlstemptyMapclassBuildPidTyMap'progstlisttymap1tymap2|progstlisttymap1->tymap2wheretypeBuildPidTyMapT'progstlisttymap1buildPidTyMap'::prog->stlist->tymap1->IOtymap2instanceBuildPidTyMap'progNilaccaccwheretypeBuildPidTyMapT'progNilacc=accbuildPidTyMap'__m=returnm-- this instance reverses the stList in the keys of the map. So if the stList is sorted then this will be reverse . sortedinstance(BuildPidTyMap'prognxt(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue'),MapInsert(TyMapkeyToIdx'idxToValue')init(MVar(Map(RawPid,RawPid)(MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil))))))(TyMapkeyToIdx''idxToValue''),TyListnxt)=>BuildPidTyMap'prog(Cons(init,False)nxt)(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx''idxToValue'')wheretypeBuildPidTyMapT'prog(Cons(init,False)nxt)(TyMapkeyToIdxidxToValue)-- so we stick on the front of what we receive incoming. Thus the first elem ends up at the end of the map. Matching below.=BuildPidTyMapT'prognxt(TyMap(ConsinitkeyToIdx)-- HERE LIES TROUBLE! -- the use of DualT to make the inverse may be dangerous(Cons((MVar(Map(RawPid,RawPid)-- plus this is cheating as I'm using knowledge of how mapInsert works(MVar(PairStructinitprog(DualTprog)-- to avoid rewriting lists in type families((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))))))idxToValue))buildPidTyMap'proglstm=do{m'<-buildPidTyMap'prognxtm;mvar<-newMVarMap.empty;return$fmvarm'-- inserting adds at the end. So the first elem will be last in the map}where(init,FF)=tyHeadlstnxt=tyTaillstf::(MVar(Map(RawPid,RawPid)(MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil))))))->TyMapkeyToIdx'idxToValue'->TyMapkeyToIdx''idxToValue''fmvar=mapInsertinitmvarinstance(BuildPidTyMap'prognxt(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue'),TyListnxt)=>BuildPidTyMap'prog(Cons(init,True)nxt)(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue')wheretypeBuildPidTyMapT'prog(Cons(init,True)nxt)(TyMapkeyToIdxidxToValue)=BuildPidTyMapT'prognxt(TyMapkeyToIdxidxToValue)buildPidTyMap'proglstm=buildPidTyMap'prog(tyTaillst)mclassBuildInvertedSessionsSetstlistset|stlist->setwheretypeBuildInvertedSessionsSetTstlistbuildInvertedSessionsSet::stlist->setinstanceBuildInvertedSessionsSetNilNilwheretypeBuildInvertedSessionsSetTNil=NilbuildInvertedSessionsSet_=nilinstance(BuildInvertedSessionsSetnxtset)=>BuildInvertedSessionsSet(Cons(init,False)nxt)setwheretypeBuildInvertedSessionsSetT(Cons(init,False)nxt)=BuildInvertedSessionsSetTnxtbuildInvertedSessionsSetlst=buildInvertedSessionsSet(tyTaillst)instance(BuildInvertedSessionsSetnxtset,TyListset)=>BuildInvertedSessionsSet(Cons(init,True)nxt)(Consinitset)wheretypeBuildInvertedSessionsSetT(Cons(init,True)nxt)=Consinit(BuildInvertedSessionsSetTnxt)buildInvertedSessionsSetlst=cons(fst.tyHead$lst).buildInvertedSessionsSet.tyTail$lstinstance(Expandprognxtnxt',ExpandPidprog(SendPidinvertidxs)expandedSendPid)=>Expandprog(Cons(SendPidinvertidxs)nxt)(ConsexpandedSendPidnxt')wheretypeExpandTprog(Cons(SendPidinvertidxs)nxt)=Cons(ExpandPidTprog(SendPidinvertidxs))(ExpandTprognxt)instance(Expandprognxtnxt',ExpandPidprog(RecvPidinvertidxs)expandedRecvPid)=>Expandprog(Cons(RecvPidinvertidxs)nxt)(ConsexpandedRecvPidnxt')wheretypeExpandTprog(Cons(RecvPidinvertidxs)nxt)=Cons(ExpandPidTprog(RecvPidinvertidxs))(ExpandTprognxt)classExpandPidprogpidexpanded|progpid->expandedwheretypeExpandPidTprogpidinstance(Dualprogprog',BuildInvertedSessionsSetidxsinvertedSessions,BuildPidTyMapprogidxs(TyMapsessionsToIdxidxsToPairStructs))=>ExpandPidprog(SendPidFalseidxs)(Send(SpecialPid,(Pidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)))wheretypeExpandPidTprog(SendPidFalseidxs)=Send(SpecialPid,(Pidprog(DualTprog)(BuildInvertedSessionsSetTidxs)(LHS(BuildPidTyMapTprogidxs))(RHS(BuildPidTyMapTprogidxs))))instance(Dualprogprog',BuildInvertedSessionsSetidxsinvertedSessions,BuildPidTyMapprog'idxs(TyMapsessionsToIdxidxsToPairStructs))=>ExpandPidprog(SendPidTrueidxs)(Send(SpecialPid,(Pidprog'proginvertedSessionssessionsToIdxidxsToPairStructs)))wheretypeExpandPidTprog(SendPidTrueidxs)=Send(SpecialPid,(Pid(DualTprog)prog(BuildInvertedSessionsSetTidxs)(LHS(BuildPidTyMapT(DualTprog)idxs))(RHS(BuildPidTyMapT(DualTprog)idxs))))instance(Dualprogprog',BuildInvertedSessionsSetidxsinvertedSessions,BuildPidTyMapprogidxs(TyMapsessionsToIdxidxsToPairStructs))=>ExpandPidprog(RecvPidFalseidxs)(Recv(SpecialPid,(Pidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)))wheretypeExpandPidTprog(RecvPidFalseidxs)=Recv(SpecialPid,(Pidprog(DualTprog)(BuildInvertedSessionsSetTidxs)(LHS(BuildPidTyMapTprogidxs))(RHS(BuildPidTyMapTprogidxs))))instance(Dualprogprog',BuildInvertedSessionsSetidxsinvertedSessions,BuildPidTyMapprog'idxs(TyMapsessionsToIdxidxsToPairStructs))=>ExpandPidprog(RecvPidTrueidxs)(Recv(SpecialPid,(Pidprog'proginvertedSessionssessionsToIdxidxsToPairStructs)))wheretypeExpandPidTprog(RecvPidTrueidxs)=Recv(SpecialPid,(Pid(DualTprog)prog(BuildInvertedSessionsSetTidxs)(LHS(BuildPidTyMapT(DualTprog)idxs))(RHS(BuildPidTyMapT(DualTprog)idxs))))typefamilyLHSthingtypeinstanceLHS(TyMapsessionsToIdxidxsToPairStructs)=sessionsToIdxtypefamilyRHSthingtypeinstanceRHS(TyMapsessionsToIdxidxsToPairStructs)=idxsToPairStructs-- TyMap :: (init, InvertBool) -> MVar (Map (RawPid, RawPid) (MVar PairStruct init prog progOut progIn (fromO, fromI)))-- | Provides the ability to make a new session / channel with the-- given Pid. Supply the index to the Session Type, whether or not-- you're locally inverting (dualing) the Session Type, and the Pid,-- and so long as the Pid supports the dual of your local Session-- Type, this will block until the Pid gets around to servicing you.-- Thus this is a synchronous operation and both Pids must know of-- each other to create a new session / channel between them.classCreateSessioninvertinitprogprog'sessionsToIdxMesessionsToIdxThemidxsToPairStructsMeidxsToPairStructsThemkeyToIdxMeidxToValueMekeyToIdxMe'idxToValueMe'idxOfTheminvertedSessionsMeinvertedSessionsThemwherecreateSession::init->invert->Pidprogprog'invertedSessionsThemsessionsToIdxThemidxsToPairStructsThem->InterleavedChain(InternalPidprogprog'invertedSessionsMesessionsToIdxMeidxsToPairStructsMe)(TyMapkeyToIdxMeidxToValueMe)(TyMapkeyToIdxMe'idxToValueMe')idxOfTheminstanceforallinitprogprog'fromOfromIprogOutprogInsessionsToIdxMesessionsToIdxThemidxsToPairStructsMeidxsToPairStructsThemkeyToIdxMeidxToValueMekeyToIdxMe'idxToValueMe'idxOfThemcurrentcurrent'invertedSessionsMeinvertedSessionsThem.(ProgramToMVarsOutgoingTprogprog~progOut,ProgramToMVarsOutgoingTprog'prog'~progIn,SWellFormedConfiginit(D0E)prog,SWellFormedConfiginit(D0E)prog',TyListIndexprogOutinit(MVar(ProgramCell(CellfromO))),TyListIndexprogIninit(MVar(ProgramCell(CellfromI))),TyListIndexproginitcurrent',Expandprogcurrent'current,MapLookup(TyMapsessionsToIdxMeidxsToPairStructsMe)init(MVar(Map(RawPid,RawPid)(MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))))),TyListMemberinvertedSessionsTheminitTrue,MapSize(TyMapkeyToIdxMeidxToValueMe)idxOfThem,MapInsert(TyMapkeyToIdxMeidxToValueMe)idxOfThem(SessionStateprogprog'(current,fromO,fromI))(TyMapkeyToIdxMe'idxToValueMe'))=>CreateSessionFalseinitprogprog'sessionsToIdxMesessionsToIdxThemidxsToPairStructsMeidxsToPairStructsThemkeyToIdxMeidxToValueMekeyToIdxMe'idxToValueMe'idxOfTheminvertedSessionsMeinvertedSessionsThemwherecreateSessioninitFF(PidremotePid_)=InterleavedChain$\ipid@(IPid(PidlocalPidlocalSTMap)_)mp->do{letpidFuncMapMVar::MVar(Map(RawPid,RawPid)(MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))))=mapLookuplocalSTMapinit;pidFuncMap<-takeMVarpidFuncMapMVar;emptyMVar::MVar(TyMapkeyToIdxMe'idxToValueMe')<-newEmptyMVar;psMVar::MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))<-caseMap.lookup(localPid,remotePid)pidFuncMapofNothing->do{empty<-newEmptyMVar;putMVarpidFuncMapMVar(Map.insert(localPid,remotePid)emptypidFuncMap);returnempty}(Justmv)->do{putMVarpidFuncMapMVarpidFuncMap;returnmv};letidxOfThem::idxOfThem=mapSizempps::PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil))=PSlocalPid(fidxOfThemmpemptyMVar);putMVarpsMVarps;mp'<-takeMVaremptyMVar;return(idxOfThem,mp',ipid)}wheref::idxOfThem->(TyMapkeyToIdxMeidxToValueMe)->MVar(TyMapkeyToIdxMe'idxToValueMe')->SessionStateprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil))->IO()fidxOfThemmpmvlocalST=do{((),localST')<-runSessionChainsjumplocalST;putMVarmv(mapInsertidxOfThemlocalST'mp)}instanceforallinitprogprog'fromOfromIprogOutprogInsessionsToIdxMesessionsToIdxThemidxsToPairStructsMeidxsToPairStructsThemkeyToIdxMeidxToValueMekeyToIdxMe'idxToValueMe'idxOfThemcurrentcurrent'currentUXcurrentUX'invertedSessionsMeinvertedSessionsThem.(ProgramToMVarsOutgoingTprogprog~progOut,ProgramToMVarsOutgoingTprog'prog'~progIn,ProgramToMVarsOutgoingprogprogprogOut,ProgramToMVarsOutgoingprog'prog'progIn,SWellFormedConfiginit(D0E)prog,SWellFormedConfiginit(D0E)prog',TyListIndexprogOutinit(MVar(ProgramCell(CellfromO))),TyListIndexprogIninit(MVar(ProgramCell(CellfromI))),TyListIndexproginitcurrentUX,ExpandprogcurrentUXcurrent,TyListIndexprog'initcurrentUX',Expandprog'currentUX'current',MapLookup(TyMapsessionsToIdxThemidxsToPairStructsThem)init(MVar(Map(RawPid,RawPid)(MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))))),TyListMemberinvertedSessionsMeinitTrue,MapSize(TyMapkeyToIdxMeidxToValueMe)idxOfThem,MapInsert(TyMapkeyToIdxMeidxToValueMe)idxOfThem(SessionStateprog'prog(current',fromI,fromO))(TyMapkeyToIdxMe'idxToValueMe'))=>CreateSessionTrueinitprogprog'sessionsToIdxMesessionsToIdxThemidxsToPairStructsMeidxsToPairStructsThemkeyToIdxMeidxToValueMekeyToIdxMe'idxToValueMe'idxOfTheminvertedSessionsMeinvertedSessionsThemwherecreateSessioninitTT(PidremotePidremoteSTMap)=InterleavedChain$\ipid@(IPid(PidlocalPid_)_)mp->do{letpidFuncMapMVar::MVar(Map(RawPid,RawPid)(MVar(PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))))=mapLookupremoteSTMapinit;pidFuncMap<-takeMVarpidFuncMapMVar;mvarsOut<-programToMVarsOutgoingprogprog;mvarsIn<-programToMVarsOutgoingprog'prog';aNotify<-newMVarNothing;bNotify<-newMVarNothing;let(theirST::SessionStateprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))=SessionStatemvarsOutmvarsInundefinedaNotifyundefinedbNotifyundefined(myST::SessionStateprog'prog((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil)))=SessionStatemvarsInmvarsOutundefinedbNotifyundefinedaNotifyundefinedidxOfThem::idxOfThem=mapSizemp;caseMap.lookup(remotePid,localPid)pidFuncMapofNothing->do{newEmptyMVar<-newEmptyMVar;putMVarpidFuncMapMVar(Map.insert(remotePid,localPid)newEmptyMVarpidFuncMap);ps<-takeMVarnewEmptyMVar;modifyMVar_pidFuncMapMVar(return.Map.delete(remotePid,localPid));funpstheirST}(JustfullMVar)->do{ps<-takeMVarfullMVar;putMVarpidFuncMapMVar(Map.delete(remotePid,localPid)pidFuncMap);funpstheirST};((),myST')<-runSessionChainsjumpmyST;return(idxOfThem,mapInsertidxOfThemmyST'mp,ipid)}whereprog=undefined::progprog'=undefined::prog'fun::PairStructinitprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil))->SessionStateprogprog'((Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil),(Cons(Jumpinit)Nil))->IO()fun(PS_f)theirST=ftheirSTdataMultiReceive::*->*->*->*->*->*->*->*->*->*->*->*whereMultiReceiveNil::MultiReceiveNilprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'resMultiReceiveCons::(ch,InterleavedChain(InternalPidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue')res)->MultiReceivechsprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'res->MultiReceive(Conschchs)progprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'res(~|||~)::(MapLookup(TyMapkeyToIdxidxToValue)ch(SessionStateprogSprogS'((Cons(Recv(sp,t))nxt),fromO,(Constnxt'))))=>(ch,InterleavedChain(InternalPidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue')res)->MultiReceivechsprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'res->MultiReceive(Conschchs)progprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'res(~|||~)(ch,func)nxt=MultiReceiveCons(ch,func)nxtinfixr5~|||~multiReceive::forallchslenkeyToIdxidxToValueprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdx'idxToValue'res.(TyListLengthchslen,SmallerThanBool(D0E)lenTrue,SetIncomingNotify(TyMapkeyToIdxidxToValue)chs,FindNonEmptyIncoming(TyMapkeyToIdxidxToValue)chs,TypeNumberToIntlen)=>(MultiReceivechsprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'res)->InterleavedChain(InternalPidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue')resmultiReceivefunctions=InterleavedChain$\ipidmp->do{notifyChan<-newChan;chMaybe<-setIncomingNotifynotifyChanmp0chs;casechMaybeof(Justidx)->do{unsetIncomingNotifympchsidx;runInterleavedChain(walkMultiReceivesidxfunctions)ipidmp}Nothing->blockOnNotifyChanipidnotifyChanmpfunctions}wherechs=undefined::chschsCount=tyNumToInt.tyListLength$chsblockOnNotifyChanipidchanmpfunctions=do{readChanchan;unsetIncomingNotifympchschsCount;idx<-findNonEmptyIncomingmp0chs;runInterleavedChain(walkMultiReceivesidxfunctions)ipidmp}classSetIncomingNotifympidxswheresetIncomingNotify::Chan()->mp->Int->idxs->IO(MaybeInt)unsetIncomingNotify::mp->idxs->Int->IO()instanceSetIncomingNotifympNilwheresetIncomingNotify____=returnNothingunsetIncomingNotify___=return()instanceforallkeyToIdxidxToValueidxprogprog'currentfromOfromInxt.(MapLookup(TyMapkeyToIdxidxToValue)idx(SessionStateprogprog'(current,fromO,fromI)),SetIncomingNotify(TyMapkeyToIdxidxToValue)nxt,TypeNumberToIntidx)=>SetIncomingNotify(TyMapkeyToIdxidxToValue)(Considxnxt)wheresetIncomingNotifychanmpaccidxs=do{letst=mapLookupmpidx;isEmpty<-setIncomingNotify'chanst;ifisEmptythensetIncomingNotifychanmp(acc+1)idxs'elsereturn.return$acc}whereidxs'=tyTailidxsidx=tyHeadidxssetIncomingNotify'::Chan()->SessionStateprogprog'(current,fromO,fromI)->IOBoolsetIncomingNotify'chan(SessionState_____inNotifyMVarincoming)=do{swapMVarinNotifyMVar(Justchan);isEmptyMVarincoming}unsetIncomingNotifympidxscount=do{letst=mapLookupmpidx;unsetIncomingNotify'st;if0==countthenreturn()elseunsetIncomingNotifympidxs'(count-1)}whereidx=tyHeadidxsidxs'=tyTailidxsunsetIncomingNotify'::SessionStateprogprog'(current,fromO,fromI)->IO()unsetIncomingNotify'(SessionState_____inNotifyMVar_)=do{swapMVarinNotifyMVarNothing;return()}classWalkMultiReceiveschsprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'reswherewalkMultiReceives::Int->MultiReceivechsprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'res->InterleavedChain(InternalPidprogprog'invertedSessionssessionsToIdxidxsToPairStructs)(TyMapkeyToIdxidxToValue)(TyMapkeyToIdx'idxToValue')resinstanceWalkMultiReceiveschsprogprog'invertedSessionssessionsToIdxidxsToPairStructskeyToIdxidxToValuekeyToIdx'idxToValue'reswherewalkMultiReceives0(MultiReceiveCons(_,func)_)=funcwalkMultiReceivesn(MultiReceiveCons_nxt)=walkMultiReceives(n-1)nxtwalkMultiReceives__=error"The Truly Impossible Happened."classFindNonEmptyIncomingmpidxswherefindNonEmptyIncoming::mp->Int->idxs->IOIntinstanceFindNonEmptyIncomingmpNilwherefindNonEmptyIncoming___=error"Wasn't expecting to run out of channels in multiReceive!"instanceforallkeyToIdxidxToValueidxnxtprogprog'currentfromOfromI.(FindNonEmptyIncoming(TyMapkeyToIdxidxToValue)nxt,MapLookup(TyMapkeyToIdxidxToValue)idx(SessionStateprogprog'(current,fromO,fromI)),TypeNumberToIntidx)=>FindNonEmptyIncoming(TyMapkeyToIdxidxToValue)(Considxnxt)wherefindNonEmptyIncomingmpaccidxs=do{letst=mapLookupmpidx;isEmpty<-checkIfEmptyst;ifisEmptythenfindNonEmptyIncomingmp(acc+1)idxs'elsereturnacc}whereidxs'=tyTailidxsidx=tyHeadidxscheckIfEmpty::SessionStateprogprog'(current,fromO,fromI)->IOBoolcheckIfEmpty(SessionState______incoming)=isEmptyMVarincoming