{-# LANGUAGE CPP, GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies #-}#if __GLASGOW_HASKELL__ >= 709{-# LANGUAGE Safe #-}#elif __GLASGOW_HASKELL__ >= 701{-# LANGUAGE Trustworthy #-}#endif-- | Utilities for clients of Hoopl, not used internally.moduleCompiler.Hoopl.XUtil(-- * Utilities for clientsfirstXfer,distributeXfer,distributeFact,distributeFactBwd,successorFacts,joinFacts,joinOutFacts-- deprecated,joinMaps,analyzeAndRewriteFwdBody,analyzeAndRewriteBwdBody,analyzeAndRewriteFwdOx,analyzeAndRewriteBwdOx)whereimportqualifiedData.MapasMimportData.MaybeimportCompiler.Hoopl.CollectionsimportCompiler.Hoopl.CheckpointimportCompiler.Hoopl.DataflowimportCompiler.Hoopl.BlockimportCompiler.Hoopl.GraphimportCompiler.Hoopl.Label------------------------------------------------------------------------------- | Forward dataflow analysis and rewriting for the special case of a Body.-- A set of entry points must be supplied; blocks not reachable from-- the set are thrown away.analyzeAndRewriteFwdBody::forallmnfentries.(CheckpointMonadm,NonLocaln,LabelsPtrentries)=>FwdPassmnf->entries->Bodyn->FactBasef->m(Bodyn,FactBasef)-- | Backward dataflow analysis and rewriting for the special case of a Body.-- A set of entry points must be supplied; blocks not reachable from-- the set are thrown away.analyzeAndRewriteBwdBody::forallmnfentries.(CheckpointMonadm,NonLocaln,LabelsPtrentries)=>BwdPassmnf->entries->Bodyn->FactBasef->m(Bodyn,FactBasef)analyzeAndRewriteFwdBodypassen=mapBodyFacts(analyzeAndRewriteFwdpass(JustCen))analyzeAndRewriteBwdBodypassen=mapBodyFacts(analyzeAndRewriteBwdpass(JustCen))mapBodyFacts::(Monadm)=>(GraphnCC->FactCf->m(GraphnCC,FactCf,MaybeOCf))->(Bodyn->FactBasef->m(Bodyn,FactBasef))-- ^ Internal utility; should not escapemapBodyFactsanalbf=anal(GManyNothingObNothingO)f>>=bodyFactswhere-- the type constraint is needed for the pattern match;-- if it were not, we would use do-notation here.bodyFacts::Monadm=>(GraphnCC,FactCf,MaybeOCf)->m(Bodyn,FactCf)bodyFacts(GManyNothingObodyNothingO,fb,NothingO)=return(body,fb){-
Can't write:
do (GMany NothingO body NothingO, fb, NothingO) <- anal (....) f
return (body, fb)
because we need an explicit type signature in order to do the GADT
pattern matches on NothingO
-}-- | Forward dataflow analysis and rewriting for the special case of a -- graph open at the entry. This special case relieves the client-- from having to specify a type signature for 'NothingO', which beginners-- might find confusing and experts might find annoying.analyzeAndRewriteFwdOx::forallmnfx.(CheckpointMonadm,NonLocaln)=>FwdPassmnf->GraphnOx->f->m(GraphnOx,FactBasef,MaybeOxf)-- | Backward dataflow analysis and rewriting for the special case of a -- graph open at the entry. This special case relieves the client-- from having to specify a type signature for 'NothingO', which beginners-- might find confusing and experts might find annoying.analyzeAndRewriteBwdOx::forallmnfx.(CheckpointMonadm,NonLocaln)=>BwdPassmnf->GraphnOx->Factxf->m(GraphnOx,FactBasef,f)-- | A value that can be used for the entry point of a graph open at the entry.noEntries::MaybeCOLabelnoEntries=NothingCanalyzeAndRewriteFwdOxpassgf=analyzeAndRewriteFwdpassnoEntriesgfanalyzeAndRewriteBwdOxpassgfb=analyzeAndRewriteBwdpassnoEntriesgfb>>=stripwherestrip::forallmabc.Monadm=>(a,b,MaybeOOc)->m(a,b,c)strip(a,b,JustOc)=return(a,b,c)-- | A utility function so that a transfer function for a first-- node can be given just a fact; we handle the lookup. This-- function is planned to be made obsolete by changes in the dataflow-- interface.firstXfer::NonLocaln=>(nCO->f->f)->(nCO->FactBasef->f)firstXferxfernfb=xfern$fromJust$lookupFact(entryLabeln)fb-- | This utility function handles a common case in which a transfer function-- produces a single fact out of a last node, which is then distributed-- over the outgoing edges.distributeXfer::NonLocaln=>DataflowLatticef->(nOC->f->f)->(nOC->f->FactBasef)distributeXferlatticexfernf=mkFactBaselattice[(l,xfernf)|l<-successorsn]-- | This utility function handles a common case in which a transfer function-- for a last node takes the incoming fact unchanged and simply distributes-- that fact over the outgoing edges.distributeFact::NonLocaln=>nOC->f->FactBasefdistributeFactnf=mapFromList[(l,f)|l<-successorsn]-- because the same fact goes out on every edge,-- there's no need for 'mkFactBase' here.-- | This utility function handles a common case in which a backward transfer-- function takes the incoming fact unchanged and tags it with the node's label.distributeFactBwd::NonLocaln=>nCO->f->FactBasefdistributeFactBwdnf=mapSingleton(entryLabeln)f-- | List of (unlabelled) facts from the successors of a last nodesuccessorFacts::NonLocaln=>nOC->FactBasef->[f]successorFactsnfb=[f|id<-successorsn,letJustf=lookupFactidfb]-- | Join a list of facts.joinFacts::DataflowLatticef->Label->[f]->fjoinFactslatinBlock=foldrextend(fact_botlat)whereextendnewold=snd$fact_joinlatinBlock(OldFactold)(NewFactnew){-# DEPRECATED joinOutFacts
"should be replaced by 'joinFacts lat l (successorFacts n f)'; as is, it uses the wrong Label" #-}joinOutFacts::(NonLocalnode)=>DataflowLatticef->nodeOC->FactBasef->fjoinOutFactslatnf=foldrjoin(fact_botlat)factswherejoin(lbl,new)old=snd$fact_joinlatlbl(OldFactold)(NewFactnew)facts=[(s,fromJustfact)|s<-successorsn,letfact=lookupFactsf,isJustfact]-- | It's common to represent dataflow facts as a map from variables-- to some fact about the locations. For these maps, the join-- operation on the map can be expressed in terms of the join on each-- element of the codomain:joinMaps::Ordk=>JoinFunv->JoinFun(M.Mapkv)joinMapseltJoinl(OldFactold)(NewFactnew)=M.foldrWithKeyadd(NoChange,old)newwhereaddknew_v(ch,joinmap)=caseM.lookupkjoinmapofNothing->(SomeChange,M.insertknew_vjoinmap)Justold_v->caseeltJoinl(OldFactold_v)(NewFactnew_v)of(SomeChange,v')->(SomeChange,M.insertkv'joinmap)(NoChange,_)->(ch,joinmap)