-- Communicating Haskell Processes.-- Copyright (c) 2008, University of Kent.-- All rights reserved.-- -- Redistribution and use in source and binary forms, with or without-- modification, are permitted provided that the following conditions are-- met:---- * Redistributions of source code must retain the above copyright-- notice, this list of conditions and the following disclaimer.-- * Redistributions in binary form must reproduce the above copyright-- notice, this list of conditions and the following disclaimer in the-- documentation and/or other materials provided with the distribution.-- * Neither the name of the University of Kent nor the names of its-- contributors may be used to endorse or promote products derived from-- this software without specific prior written permission.---- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,-- THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR-- PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR-- CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.-- | A module containing broadcast channels (one-to-many). Whereas a one-to-any-- channel features one writer sending a /single/ value to /one/ (of many) readers, a-- one-to-many channel features one writer sending the /same/ value to /many/-- readers. So a one-to-any channel involves claiming the channel-end to ensure-- exclusivity, but a one-to-many channel involves enrolling on the channel-end-- (subscribing) before it can engage in communication.---- A communication on a one-to-many channel only takes place when the writer-- and all readers currently enrolled agree to communicate. What happens when-- the writer wants to communicate and no readers are enrolled is undefined-- (the writer may block, or may communicate happily to no-one).---- This module also contains reduce channels (added in version 1.1.1). Because-- in CHP channels must have the same type at both ends, we use the Monoid-- type-class. It is important to be aware that the order of mappends will be-- non-deterministic, and thus you should either use an mappend that is commutative-- or code around this restruction.---- For example, a common thing to do would be to use lists as the type for-- reduce channels, make each writer write a single item list (but more is-- possible), then use the list afterwards, but be aware that it is unordered.-- If it is important to have an ordered list, make each writer write a pair-- containing a (unique) index value and the real data, then sort by the index-- value and discard it.---- Since reduce channels were added after the initial library design, there-- is a slight complication: it is not possible to use newChannel (and all-- similar functions) with reduce channels because it is impossible to express-- the Monoid constraint for the Channel instance. Instead, you must use manyToOneChannel-- and manyToAnyChannel.moduleControl.Concurrent.CHP.BroadcastChannels(BroadcastChanin,BroadcastChanout,OneToManyChannel,AnyToManyChannel,oneToManyChannel,anyToManyChannel,oneToManyChannelWithLabel,anyToManyChannelWithLabel,ReduceChanin,ReduceChanout,ManyToOneChannel,ManyToAnyChannel,manyToOneChannel,manyToAnyChannel,manyToOneChannelWithLabel,manyToAnyChannelWithLabel)whereimportControl.Concurrent.STMimportControl.Monad.TransimportData.MonoidimportControl.Concurrent.CHP.BarriersimportControl.Concurrent.CHP.BaseimportControl.Concurrent.CHP.ChannelsimportControl.Concurrent.CHP.CSPimportControl.Concurrent.CHP.EnrollimportControl.Concurrent.CHP.EventimportControl.Concurrent.CHP.MuteximportControl.Concurrent.CHP.Traces.Base-- The general pattern of a broadcast channel is as follows:-- SYNC -> Agreement; the readers indicate they are all willing to read, and the-- writer indicates it is ready to write. Either side may ALT.---- After this synchronisation, the writer can write his data to the TVar, possibly-- following an extended action-- -- SYNC -> Reading; everyone syncs (no-one ALTs) to move to the reading phase---- After this synchronisation, the readers can all read the data from the TVar,-- and possibly complete an extended action---- SYNC -> Neutral; everyone syncs (no-one ALTs) to indicate one communication-- cycle has finished. After this the writer may proceed on their way (the-- main reason for needing a third sync).-- There used to be a warning that the first two constructors are never used, but they-- do need to be there for the Enum and Bounded instances...dataPhase=Agreement|Reading|Neutralderiving(Enum,Bounded,Eq)-- So I constructed this horrendous hack to suppress the warning:dontWarnMe::a->adontWarnMe=flipconst[Agreement,Reading,Neutral]newtypeBroadcastChannela=BC(PhasedBarrierPhase,TVara)-- | The reading end of a broadcast channel. You must enroll on it before-- you can read from it or poison it.newtypeBroadcastChanina=BI(BroadcastChannela)-- | The writing end of a broadcast channel.newtypeBroadcastChanouta=BO(BroadcastChannela)instanceEnrollableBroadcastChaninawhereenrollc@(BI(BC(b,_)))f=enrollb(\eb->waitForPhaseNeutraleb>>f(Enrolledc))resign(Enrolled(BI(BC(b,_))))m=dox<-resign(Enrolledb)mwaitForPhaseNeutral(Enrolledb)returnxinstanceWriteableChannelBroadcastChanoutwhereextWriteChannel(BO(BC(b,tv)))m=dosyncBarrierWith(indivRecJustChannelWrite)$Enrolledbm>>=liftIO.atomically.writeTVartvsyncBarrierWith(const$constNothing)$EnrolledbsyncBarrierWith(const$constNothing)$Enrolledbreturn()instanceReadableChannel(EnrolledBroadcastChanin)whereextReadChannel(Enrolled(BI(BC(b,tv))))f=dosyncBarrierWith(indivRecJustChannelRead)$EnrolledbsyncBarrierWith(const$constNothing)$Enrolledbx<-liftIO(atomically$readTVartv)y<-fxsyncBarrierWith(const$constNothing)$EnrolledbreturnyinstancePoisonable(BroadcastChanouta)wherepoison(BO(BC(b,_)))=poison$EnrolledbcheckForPoison(BO(BC(b,_)))=checkForPoison$EnrolledbinstancePoisonable(EnrolledBroadcastChanina)wherepoison(Enrolled(BI(BC(b,_))))=poison$EnrolledbcheckForPoison(Enrolled(BI(BC(b,_))))=checkForPoison$EnrolledbnewBroadcastChannel::CHP(BroadcastChannela)newBroadcastChannel=dontWarnMe{- see above -}$dodob@(Barrier(e,_,_))<-newPhasedBarrierNeutral-- Writer is always enrolled:liftIO$atomically$enrollEventetv<-liftIO$atomically$newTVarundefinedreturn$BC(b,tv)instanceChannelBroadcastChaninBroadcastChanoutwherenewChannel=liftCHP$doc@(BC(b,_))<-newBroadcastChannelreturn$Chan(getBarrierIdentifierb)(BIc)(BOc)instanceChannelBroadcastChanin(SharedBroadcastChanout)wherenewChannel=liftCHP$dom<-newMutexc<-newChannelreturn$Chan(getChannelIdentifierc)(readerc)(Shared(m,writerc))typeOneToManyChannel=ChanBroadcastChaninBroadcastChanouttypeAnyToManyChannel=ChanBroadcastChanin(SharedBroadcastChanout)oneToManyChannel::MonadCHPm=>m(OneToManyChannela)oneToManyChannel=newChannelanyToManyChannel::MonadCHPm=>m(AnyToManyChannela)anyToManyChannel=newChannel-- | Added in version 1.2.0.oneToManyChannelWithLabel::MonadCHPm=>String->m(OneToManyChannela)oneToManyChannelWithLabel=newChannelWithLabel-- | Added in version 1.2.0.anyToManyChannelWithLabel::MonadCHPm=>String->m(AnyToManyChannela)anyToManyChannelWithLabel=newChannelWithLabelnewtypeReduceChannela=GC(PhasedBarrierPhase,TVara,(a->a->a,a))-- | The reading end of a reduce channel.newtypeReduceChanina=GI(ReduceChannela)-- | The writing end of a reduce channel. You must enroll on it before-- you can read from it or poison it.newtypeReduceChanouta=GO(ReduceChannela)instanceEnrollableReduceChanoutawhereenrollc@(GO(GC(b,_,_)))f=enrollb(\eb->waitForPhaseNeutraleb>>f(Enrolledc))resign(Enrolled(GO(GC(b,_,_))))m=dox<-resign(Enrolledb)mwaitForPhaseNeutral(Enrolledb)returnxinstanceWriteableChannel(EnrolledReduceChanout)whereextWriteChannel(Enrolled(GO(GC(b,tv,(f,_)))))m=dosyncBarrierWith(indivRecJustChannelWrite)$Enrolledbm>>=liftIO.atomically.\x->readTVartv>>=writeTVartv.fxsyncBarrierWith(const$constNothing)$EnrolledbsyncBarrierWith(const$constNothing)$Enrolledbreturn()instanceReadableChannelReduceChaninwhereextReadChannel(GI(GC(b,tv,(_,empty))))f=dosyncBarrierWith(indivRecJustChannelRead)$EnrolledbsyncBarrierWith(const$constNothing)$Enrolledbx<-liftIO(atomically$readTVartv)y<-fxliftIO(atomically$writeTVartvempty)syncBarrierWith(const$constNothing)$EnrolledbreturnyinstancePoisonable(EnrolledReduceChanouta)wherepoison(Enrolled(GO(GC(b,_,_))))=poison$EnrolledbcheckForPoison(Enrolled(GO(GC(b,_,_))))=checkForPoison$EnrolledbinstancePoisonable(ReduceChanina)wherepoison(GI(GC(b,_,_)))=poison$EnrolledbcheckForPoison(GI(GC(b,_,_)))=checkForPoison$EnrolledbnewReduceChannel::Monoida=>CHP(ReduceChannela)newReduceChannel=dontWarnMe{- see above -}$dodob@(Barrier(e,_,_))<-newPhasedBarrierNeutral-- Writer is always enrolled:liftIO$atomically$enrollEventetv<-liftIO$atomically$newTVarmemptyreturn$GC(b,tv,(mappend,mempty))typeManyToOneChannel=ChanReduceChaninReduceChanouttypeManyToAnyChannel=Chan(SharedReduceChanin)ReduceChanoutmanyToOneChannel::(Monoida,MonadCHPm)=>m(ManyToOneChannela)manyToOneChannel=doc@(GC(b,_,_))<-liftCHPnewReduceChannelreturn$Chan(getBarrierIdentifierb)(GIc)(GOc)manyToAnyChannel::(Monoida,MonadCHPm)=>m(ManyToAnyChannela)manyToAnyChannel=dom<-newMutexc<-manyToOneChannelreturn$Chan(getChannelIdentifierc)(Shared(m,readerc))(writerc)manyToOneChannelWithLabel::(Monoida,MonadCHPm)=>String->m(ManyToOneChannela)manyToOneChannelWithLabell=doc<-manyToOneChannelliftCHP.liftPoison.liftTrace$labelUnique(getChannelIdentifierc)lreturncmanyToAnyChannelWithLabel::(Monoida,MonadCHPm)=>String->m(ManyToAnyChannela)manyToAnyChannelWithLabell=doc<-manyToAnyChannelliftCHP.liftPoison.liftTrace$labelUnique(getChannelIdentifierc)lreturnc