-- 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 that re-exports all the parts of the library related to tracing.---- The idea of tracing is to record the concurrent events (i.e. channel communications-- and barrier synchronisations) that occur during a run of the program. You-- can think of it as automatically turning on a lot of debug logging.---- Typically, at the top-level of your program you should have:---- > main :: IO ()-- > main = runCHP myMainProcess---- To turn on the tracing mechanism of your choice (for example, CSP-style tracing)-- to automatically print out the trace after completion of your program, just-- use the appropriate helper function:---- > main :: IO ()-- > main = runCHP_CSPTraceAndPrint myMainProcess---- It could hardly be easier. If you want more fine-grained control and examination-- of the trace, you can use the helper functions of the form 'runCHP_CSPTrace'-- that give back a data structure representing the trace, which you can then-- manipulate.---- The Doc used by the traces is from the 'Text.PrettyPrint.HughesPJ'-- module that currently comes with GHC (I think).---- For more details on the theory behind the tracing, the logic behind its-- implementation, and example traces, see the paper \"Representation and Implementation-- of CSP and VCR Traces\", N.C.C. Brown and M.L. Smith, CPA 2008. An online version can-- be found at: <http://twistedsquare.com/Traces.pdf>moduleControl.Concurrent.CHP.Traces(moduleControl.Concurrent.CHP.Traces.CSP,moduleControl.Concurrent.CHP.Traces.Structural,moduleControl.Concurrent.CHP.Traces.TraceOff,moduleControl.Concurrent.CHP.Traces.VCR,RecordedEvent,ChannelLabels,RecordedEventType(..),RecordedIndivEvent(..),recordedIndivEventLabel,recordedIndivEventSeq,Trace(..),vcrToCSP,structuralToCSP,structuralToVCR)whereimportControl.Arrow--import Control.Monad.Cont--import Control.Monad.StateimportqualifiedData.FoldableasFimportData.ListimportqualifiedData.MapasMapimportData.MonoidimportqualifiedData.SetasSetimportControl.Concurrent.CHP.BaseimportControl.Concurrent.CHP.EventimportControl.Concurrent.CHP.ProcessIdimportControl.Concurrent.CHP.Traces.BaseimportControl.Concurrent.CHP.Traces.CSPimportControl.Concurrent.CHP.Traces.StructuralimportControl.Concurrent.CHP.Traces.TraceOffimportControl.Concurrent.CHP.Traces.VCR-- | Takes a VCR trace and forms all the possible CSP traces (without-- duplicates) that could have arisen from the same execution.---- This is done by taking all permutations of each set in the VCR trace (which-- is a list of sets) and concatenating them with the results of the same process-- on the rest of the trace. Thus the maximum size of the returned set of CSP traces-- is the product of the sizes of all the non-empty sets in the VCR trace.---- This function was added in version 1.5.0.vcrToCSP::Equ=>VCRTraceu->[CSPTraceu]vcrToCSP(VCRTrace(ls,sets))=[CSPTrace(ls,es)|es<-nub$processsets]whereprocess::[Set.Seta]->[[a]]process[]=[[]]process(s:ss)|Set.nulls=processss|otherwise=[a++b|a<-chp_permutations(Set.toLists),b<-processss]--type SeqId = Integer--type CM eventId = ContT (EventMap eventId) (State (Seq.Seq (Set.Set (RecordedEvent eventId))))typeEventMapeventId=Map.Map(RecordedIndivEventeventId)(Set.SetProcessId)combine::Ordu=>[EventMapu]->EventMapucombine=foldl(Map.unionWithSet.union)Map.emptyparticipants::Ordu=>EventHierarchy(RecordedIndivEventu)->Map.Map(RecordedIndivEventu)Int{-participants (SingleEvent e)
= Map.singleton (recordedIndivEventLabel e, recordedIndivEventSeq e) 1
participants (StructuralSequence _ ss)
= combine $ map participants ss
participants (StructuralParallel ps)
= combine $ map participants ps
-}participants=F.foldr(\e->Map.insertWith(+)e1)Map.emptysingle::RecordedIndivEventu->ProcessId->EventMapusinglekv=Map.singletonk(Set.singletonv)dataContu=Cont(EventMapu)([RecordedIndivEventu]->Contu)|ContDoneinstanceMonoid(Contu)wheremempty=ContDonemappendContDoner=rmappend(Contmf)r=Contm(\e->fe`mappend`r)makeCont::Ordu=>EventHierarchy(RecordedIndivEventu)->ProcessId->ContumakeCont(SingleEvente)pid=cwherec=Cont(singleepid)waitwaite'|e`elem`e'=ContDone|otherwise=cmakeCont(StructuralSequence0_)_=ContDonemakeCont(StructuralSequencenes)pid=mconcat(map(uncurrymakeCont)$zipespidsPlusOne)`mappend`makeCont(StructuralSequence(n-1)es)(lastpidsPlusOne)wherepidsPlusOne=take(1+lengthes)$iterateincPidpidincPid(ProcessIdps)=ProcessId$initps++[ParSeqp(succs)]whereParSeqps=lastpsmakeCont(StructuralParalleles)pid=mergePar(map(uncurrymakeCont)$zipes(parPidspid))whereparPids(ProcessIdps)=[ProcessId$ps++[ParSeqi0]|i<-[0..]]mergePar::Ordu=>[Contu]->ContumergeParcs=case[m|Contm_f<-cs]of[]->ContDonems->Cont(combinems)(\e->mergePar[fe|Cont_mf<-cs])-- | Takes a structural trace and forms all the possible VCR traces (without-- duplicates) that could have arisen from the same execution.---- This is done -- roughly speaking -- by replaying the structural trace in all-- possible execution orderings and pulling out the VCR trace for each ordering.---- This function was added in version 1.5.0.structuralToVCR::Ordu=>StructuralTraceu->[VCRTraceu]structuralToVCR(StructuralTrace(ls,Nothing))=[VCRTrace(ls,[])]structuralToVCR(StructuralTrace(ls,Juststr))=nubByeq[VCRTrace(ls,map(Set.mapsnd)$reverse$toVCR$reversetr)|tr<-flattenStructuralstr]whereeq(VCRTrace(_,a))(VCRTrace(_,b))=a==btoVCR::Ordu=>[(RecordedEventu,Set.SetProcessId)]->[(Set.Set(Set.SetProcessId,RecordedEventu))]toVCR[]=[]toVCR((e,pids):rest)=prependVCR(toVCRrest)pids[(pids,e)]-- | Takes a structural trace and forms all the possible CSP traces (without-- duplicates) that could have arisen from the same execution.---- This is done -- roughly speaking -- by replaying the structural trace in all-- possible execution orderings and pulling out the CSP trace for each ordering.---- It should be the case for all structural traces @t@ that do not use conjunction ('every' and-- '(\<&\>)'):-- -- > structuralToCSP t =~= (concatMap vcrToCSP . structuralToVCR) t-- > where a =~= b = or [a' == b' | a' <- permutations a, b' <- permutations b]---- This function was added in version 1.5.0.structuralToCSP::Ordu=>StructuralTraceu->[CSPTraceu]structuralToCSP(StructuralTrace(ls,Nothing))=[CSPTrace(ls,[])]structuralToCSP(StructuralTrace(ls,Juststr))=[CSPTrace(ls,mapfsttr)|tr<-flattenStructuralstr]flattenStructural::forallu.Ordu=>EventHierarchy(RecordedIndivEventu)->[[(RecordedEventu,Set.SetProcessId)]]flattenStructuraltr=process$makeConttrrootProcessIdwhereps=participantstrprocess::Contu->[[(RecordedEventu,Set.SetProcessId)]]processContDone=[[]]process(Contmf)=concat[map((e,pids):)$process(fie)|(e,(ie,pids))<-Map.toAscListeventsWithAllParticipants]whereindivEventsWithAllParticipants::Map.Map(RecordedIndivEventu)(Set.SetProcessId)indivEventsWithAllParticipants=Map.mapfst$Map.filter(\(s,n)->Set.sizes==n)(Map.intersectionWith(,)mps)eventsWithAllParticipants::Map.Map(RecordedEventu)([RecordedIndivEventu],Set.SetProcessId)eventsWithAllParticipants=Map.mapsnd$Map.filterWithKeyfixEvents$Map.mapKeysWithmergeValstoWhole$Map.map((,)False.first(:[]))$Map.mapWithKey(,)$indivEventsWithAllParticipantswheremergeVals::(Bool,([RecordedIndivEventu],Set.SetProcessId))->(Bool,([RecordedIndivEventu],Set.SetProcessId))->(Bool,([RecordedIndivEventu],Set.SetProcessId))mergeVals(_,(es,pids))(_,(es',pids'))=(True,(es++es',Set.unionpidspids'))fixEvents::RecordedEventa->(Bool,b)->BoolfixEvents(ChannelComm_,_)(b,_)=b-- Channel comms need to have both sidesfixEvents__=TruetoWhole::RecordedIndivEventa->RecordedEventatoWhole(ChannelWritex_s)=(ChannelComms,x)toWhole(ChannelReadx_s)=(ChannelComms,x)toWhole(BarrierSyncIndivx_s)=(BarrierSyncs,x)toWhole(ClockSyncIndivx_t)=(ClockSynct,x)