-- | This module is similar to "Language.Syntactic.Sharing.Reify", but operates-- on @`AST` (`HODomain` dom p)@ rather than a general 'AST'. The reason for-- having this module is that when using 'HODomain', it is important to do-- simultaneous sharing analysis and 'HOLambda' reification. Obviously we cannot-- do sharing analysis first (using-- 'Language.Syntactic.Sharing.Reify.reifyGraph' from-- "Language.Syntactic.Sharing.Reify"), since it needs to be able to look inside-- 'HOLambda'. On the other hand, if we did 'HOLambda' reification first (using-- 'reify'), we would destroy the sharing.---- This module is based on the paper /Type-Safe Observable Sharing in Haskell/-- (Andy Gill, 2009, <http://dx.doi.org/10.1145/1596638.1596653>).moduleLanguage.Syntactic.Sharing.ReifyHO(reifyGraphTop,reifyGraph)whereimportControl.Monad.WriterimportData.IntMapasMapimportData.IORefimportSystem.Mem.StableNameimportLanguage.SyntacticimportLanguage.Syntactic.Constructs.BindingimportLanguage.Syntactic.Constructs.Binding.HigherOrderimportLanguage.Syntactic.Sharing.GraphimportLanguage.Syntactic.Sharing.StableNameimportqualifiedLanguage.Syntactic.Sharing.Reify-- For Haddock-- | Shorthand used by 'reifyGraphM'---- Writes out a list of encountered nodes and returns the top expression.typeGraphMonaddomppVara=WriterT[(NodeId,ASTB(NodeDomain(FODomaindomppVar))p)]IO(AST(NodeDomain(FODomaindomppVar))a)reifyGraphM::foralldomppVara.(foralla.ASTF(HODomaindomppVar)a->Bool)->IORefVarId->IORefNodeId->IORef(History(AST(HODomaindomppVar)))->ASTF(HODomaindomppVar)a->GraphMonaddomppVar(Fulla)reifyGraphMcanSharevSuppnSupphistory=reifyNodewherereifyNode::ASTF(HODomaindomppVar)b->GraphMonaddomppVar(Fullb)reifyNodea|Dict<-exprDicta=casecanShareaofFalse->reifyRecaTrue|a`seq`True->dost<-liftIO$makeStableNameahist<-liftIO$readIORefhistorycaselookHistoryhist(StNamest)ofJustn->return$injC$Noden_->don<-freshnSuppliftIO$modifyIORefhistory$remember(StNamest)na'<-reifyRecatell[(n,ASTBa')]return$injC$NodenreifyRec::AST(HODomaindomppVar)b->GraphMonaddomppVarbreifyRec(f:$a)=liftM2(:$)(reifyRecf)(reifyNodea)reifyRec(Sym(C'(InjRa)))=return$Sym$C'$InjR$C'$InjRareifyRec(Sym(C'(InjL(HOLambdaf))))=dov<-freshvSuppbody<-reifyNode$f$injC$symTypepVar$C'(Variablev)return$injC(symTypepLam$SubConstr2(Lambdav)):$bodywherepVar=P::P(Variable:||pVar)pLam=P::P(CLambdapVar)-- | Convert a syntax tree to a sharing-preserving graphreifyGraphTop::(foralla.ASTF(HODomaindomppVar)a->Bool)->ASTF(HODomaindomppVar)a->IO(ASG(FODomaindomppVar)a,VarId)reifyGraphTopcanSharea=dovSupp<-newIORef0nSupp<-newIORef0history<-newIORefempty(a',ns)<-runWriterT$reifyGraphMcanSharevSuppnSupphistoryav<-readIORefvSuppn<-readIORefnSuppreturn(ASGa'nsn,v)-- | Reifying an n-ary syntactic function to a sharing-preserving graph---- This function is not referentially transparent (hence the 'IO'). However, it-- is well-behaved in the sense that the worst thing that could happen is that-- sharing is lost. It is not possible to get false sharing.reifyGraph::(Syntactica,Domaina~HODomaindomppVar)=>(foralla.ASTF(HODomaindomppVar)a->Bool)-- ^ A function that decides whether a given node can be shared->a->IO(ASG(FODomaindomppVar)(Internala),VarId)reifyGraphcanShare=reifyGraphTopcanShare.desugar