-- 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 a few miscellaneous items that can't go in Control.Concurrent.CHP.Base-- because they would form a cyclic module link. Not publicly visible.-- TODO rename this module.moduleControl.Concurrent.CHP.CSPwhereimportControl.Concurrent.STMimportControl.ExceptionimportControl.Monad.ReaderimportControl.Monad.WriterimportControl.Monad.TransimportData.ListimportqualifiedData.MapasMapimportData.UniqueimportSystem.IOimportControl.Concurrent.CHP.AltimportControl.Concurrent.CHP.BaseimportqualifiedControl.Concurrent.CHP.EventasEventimportControl.Concurrent.CHP.EnrollimportControl.Concurrent.CHP.GuardimportControl.Concurrent.CHP.Traces.Base-- First engages in event, then executes the body. The returned value is suitable-- for use in an altbuildOnEventPoison::(Unique->(Unique->(Integer,Event.RecordedEventType))->[RecordedIndivEventUnique])->Event.Event->EventActions->CHPa->CHPabuildOnEventPoisonrecEeactbody=liftPoison(AltableT(Right[(theGuard,returnTrue)])(returnFalse))>>=\b->ifbthenbodyelsealt[liftPoison$AltableT(Right[(theGuard,return())])(return())]>>bodywheretheGuard=EventGuard(recE(Event.getEventUniquee))act[e]scopeBlock::CHPa->(a->CHPb)->IO()->CHPbscopeBlockstartbodyerrorEnd=dox<-starttr<-liftPoison$liftTraceasky<-liftIO$bracketOnError(return())(consterrorEnd)$const$runReaderT(pullOutStandard(wrapPoison$bodyx))trcheckPoisonywrapIndiv::(Unique->(Unique->Integer)->String->[RecordedIndivEventUnique])->Unique->(Unique->(Integer,Event.RecordedEventType))->[RecordedIndivEventUnique]wrapIndivrecEulu=recEu(fst.lu)(Event.getEventTypeVal$snd$luu)-- | Synchronises on the given barrier. You must be enrolled on a barrier in order-- to synchronise on it. Returns the new phase, following the synchronisation.syncBarrierWith::(Unique->(Unique->Integer)->String->[RecordedIndivEventUnique])->(Int->STM())->EnrolledPhasedBarrierphase->CHPphasesyncBarrierWithrecEstoreN(Enrolled(Barrier(e,tv,fph)))=buildOnEventPoison(wrapIndivrecE)e(EventActionsincPhase(return()))(liftIO$atomically$readTVartv)whereincPhase::Map.MapUniqueInt->STM()incPhasem=doreadTVartv>>=writeTVartv.fphmaybe(return())storeN$Map.lookup(Event.getEventUniquee)m-- | A phased barrier that is capable of being poisoned and throwing poison.-- You will need to enroll on it to do anything useful with it.-- For the phases you can use any type that satisfies 'Enum', 'Bounded' and 'Eq'.-- The phase increments every time the barrier completes. Incrementing consists-- of: @if p == maxBound then minBound else succ p@. Examples of things that-- make sense for phases:---- * The () type (see the 'Barrier' type). This effectively has a single repeating-- phase, and acts like a non-phased barrier.---- * A bounded integer type. This increments the count every time the barrier completes.-- But don't forget that the count will wrap round when it reaches the end.-- You cannot use 'Integer' for a phase because it is unbounded. If you really-- want to have an infinitely increasing count, you can wrap 'Integer' in a newtype and-- provide a 'Bounded' instance for it (with minBound and maxBound set to -1,-- if you start on 0).---- * A boolean. This implements a simple black-white barrier, where the state-- flips on each iteration.---- * A custom data type that has only constructors. For example, @data MyPhases-- = Discover | Plan | Move@. Haskell supports deriving 'Enum', 'Bounded' and-- 'Eq' automatically on such types.newtypePhasedBarrierphase=Barrier(Event.Event,TVarphase,phase->phase)instanceEnrollablePhasedBarrierphasewhereenrollb@(Barrier(e,_,_))f=doliftSTM(Event.enrollEvente)>>=checkPoisonx<-f$EnrolledbliftSTM(Event.resignEvente)>>=checkPoison>>=(\es->dotr<-liftPoison$liftTraceaskwhen(not$nulles)$liftSTM$recordEventLast(nubes)tr)returnxresign(Enrolled(Barrier(e,_,_)))m=doliftSTM(Event.resignEvente)>>=checkPoison>>=(\es->dotr<-liftPoison$liftTraceaskwhen(not$nulles)$liftSTM$recordEventLast(nubes)tr)x<-mliftSTM(Event.enrollEvente)>>=checkPoisonreturnxinstancePoisonable(EnrolledPhasedBarrierphase)wherepoison(Enrolled(Barrier(e,_,_)))=liftSTM$Event.poisonEventecheckForPoison(Enrolled(Barrier(e,_,_)))=liftCHP$liftSTM(Event.checkEventForPoisone)>>=checkPoison