{-# LANGUAGE ScopedTypeVariables #-}{-# LANGUAGE MultiParamTypeClasses #-}-- | Here we create a simple guarded queue which allows guarding by equality-- according to an ordered key. Thus guards have three values,-- match anything, match nothing, and match this value.---- To simplify the implementation, we specify that an Eq match has higher-- priority than a MatchAnything match, and when we must choose between-- values for MatchAnything, do not necessarily choose the first-- (more likely the one with the lowest key value). But we do respect-- FIFO order when only Eq guards are involved.moduleEvents.EqGuard(EqGuardedChannel,-- the channelEqMatch(..),-- the guard.newEqGuardedChannel,-- construct a channel)whereimportUtil.ComputationimportEvents.GuardedEventsimportEvents.GuardedChannelsimportEvents.DeleteQueueimportEvents.FMQueuetypeEqGuardedChannelkeyvalue=GuardedChannel(EqMatchkey)(key,value)newEqGuardedChannel::Ordkey=>IO(EqGuardedChannelkeyvalue)newEqGuardedChannel=newEqGuardedChannelPrim(error"EqGuard.1")(error"EqGuard.2")newEqGuardedChannelPrim::Ordkey=>key->value->IO(EqGuardedChannelkeyvalue)-- The arguments to newEqGuardedChannelPrim are not looked at, but-- help us to avoid overloading woes.newEqGuardedChannelPrim(_::key)(_::value)=newGuardedChannel(error"newEq1"::(GQ(EqGuardQueuekey)(key,value)))(error"newEq2"::(VQ(EqValueQueuekeyvalue)))-- ---------------------------------------------------------------------- The Guard type-- --------------------------------------------------------------------dataEqMatchkey=Eq!key|EqMatchAny|EqMatchNoneinstanceOrdkey=>Guard(EqMatchkey)wherenullGuard=EqMatchAnyandGuardEqMatchAnyx=xandGuardEqMatchNonex=EqMatchNoneandGuardxEqMatchAny=xandGuardxEqMatchNone=EqMatchNoneandGuard(Eqkey1)(Eqkey2)=ifkey1==key2thenEqkey1elseEqMatchNone-- ---------------------------------------------------------------------- The value queue.-- --------------------------------------------------------------------newtypeOrdkey=>EqValueQueuekeyvaluevalueCont=EqValueQueue(FMQueuekey((key,value),valueCont))instanceOrdkey=>HasEmpty(EqValueQueuekeyvalue)wherenewEmpty=return(EqValueQueueemptyFMQueue)instanceOrdkey=>HasAdd(EqValueQueuekeyvalue)(key,value)whereadd(EqValueQueuefmQueue)keyValue@(key,value)valueCont=do(fmQueue2,invalidate)<-addFMQueuefmQueuekey(keyValue,valueCont)return(EqValueQueuefmQueue2,invalidate)instanceOrdkey=>HasRemove(EqValueQueuekeyvalue)(EqMatchkey)(key,value)whereremove(EqValueQueuefmQueue)EqMatchAny=do(removed,fmQueue0)<-removeFMQueueAnyfmQueuecaseremovedofNothing->return(Nothing,EqValueQueuefmQueue0)(Just(_,(keyValue,valueCont),fmQueue2))->return(Just(keyValue,valueCont,return(EqValueQueuefmQueue0)),EqValueQueuefmQueue2)remove(EqValueQueuefmQueue)(Eqkey)=do(removed,fmQueue0)<-removeFMQueuefmQueuekeycaseremovedofNothing->return(Nothing,EqValueQueuefmQueue0)(Just((keyValue,valueCont),fmQueue2))->return(Just(keyValue,valueCont,return(EqValueQueuefmQueue0)),EqValueQueuefmQueue2)-- ---------------------------------------------------------------------- The Guard Queue-- --------------------------------------------------------------------dataOrdkey=>EqGuardQueuekeyguardCont=EqGuardQueue{matchAnys::DeleteQueueguardCont,eqs::FMQueuekeyguardCont}instanceOrdkey=>HasEmpty(EqGuardQueuekey)wherenewEmpty=return(EqGuardQueue{matchAnys=emptyQueue,eqs=emptyFMQueue})instanceOrdkey=>HasAdd(EqGuardQueuekey)(EqMatchkey)whereaddguardQueueguardguardCont=caseguardofEqkey->doletfmQueue=eqsguardQueue(fmQueue2,invalidate)<-addFMQueuefmQueuekeyguardContreturn(guardQueue{eqs=fmQueue2},invalidate)EqMatchAny->doletdeleteQueue=matchAnysguardQueue(deleteQueue2,invalidate)<-addQueuedeleteQueueguardContdeleteQueue3<-cleanQueuedeleteQueue2return(guardQueue{matchAnys=deleteQueue2},invalidate)EqMatchNone->return(guardQueue,done)instanceOrdkey=>HasRemove(EqGuardQueuekey)(key,value)(EqMatchkey)whereremoveguardQueue(key,_)=doremoved<-removeFMQueue(eqsguardQueue)keycaseremovedof(Just(guardCont,fmQueue2),fmQueue0)->doletgqfmq=guardQueue{eqs=fmq}return(Just(Eqkey,guardCont,return(gqfmQueue0)),gqfmQueue2)(Nothing,fmQueue0)->doletmAs=matchAnysguardQueuegqdq=EqGuardQueue{matchAnys=dq,eqs=fmQueue0}removed2<-removeQueuemAscaseremoved2ofJust(guardCont,dqueue2,dqueue0)->return(Just(EqMatchAny,guardCont,return(gqdqueue0)),gqdqueue2)Nothing->return(Nothing,gqmAs)