-- | This module is similar to "Language.Syntactic.Sharing.Reify", but operates-- on @`AST` (`HODomain` ctx dom)@ 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 /Type-Safe Observable Sharing in Haskell/ (Andy Gill,-- /Haskell Symposium/, 2009).moduleLanguage.Syntactic.Sharing.ReifyHO(reifyGraphTop,reifyGraph)whereimportControl.Monad.WriterimportData.IntMapasMapimportData.IORefimportData.TypeableimportSystem.Mem.StableNameimportData.ProxyimportLanguage.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.typeGraphMonadctxdoma=WriterT[(NodeId,SomeAST(Nodectx:+:Lambdactx:+:Variablectx:+:dom))]IO(AST(Nodectx:+:Lambdactx:+:Variablectx:+:dom)a)reifyGraphM::forallctxdoma.Typeablea=>(foralla.ASTF(HODomainctxdom)a->Maybe(SatWitctxa))->IORefVarId->IORefNodeId->IORef(History(AST(HODomainctxdom)))->ASTF(HODomainctxdom)a->GraphMonadctxdom(Fulla)reifyGraphMcanSharevSuppnSupphistory=reifyNodewherereifyNode::Typeableb=>ASTF(HODomainctxdom)b->GraphMonadctxdom(Fullb)reifyNodea=casecanShareaofNothing->reifyRecaJustSatWit|a`seq`True->dost<-liftIO$makeStableNameahist<-liftIO$readIORefhistorycaselookHistoryhist(StNamest)ofJustn->return$Sym$InjL$Noden_->don<-freshnSuppliftIO$modifyIORefhistory$remember(StNamest)na'<-reifyRecatell[(n,SomeASTa')]return$Sym$InjL$NodenreifyRec::AST(HODomainctxdom)b->GraphMonadctxdombreifyRec(f:$a)=liftM2(:$)(reifyRecf)(reifyNodea)reifyRec(Sym(InjRa))=return$Sym(InjR(InjRa))reifyRec(Sym(InjL(HOLambdaf)))=dov<-freshvSuppbody<-reifyNode$f$inj$(Variablev`withContext`ctx)return$inj(Lambdav`withContext`ctx):$bodywherectx=Proxy::Proxyctx-- | Convert a syntax tree to a sharing-preserving graphreifyGraphTop::Typeablea=>(foralla.ASTF(HODomainctxdom)a->Maybe(SatWitctxa))->ASTF(HODomainctxdom)a->IO(ASGctx(Lambdactx:+:Variablectx:+:dom)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(HODomainctxdom)=>(foralla.ASTF(HODomainctxdom)a->Maybe(SatWitctxa))-- ^ A function that decides whether a given node can be shared.-- 'Nothing' means \"don't share\"; 'Just' means \"share\". Nodes whose-- result type fulfills @(`Sat` ctx a)@ can be shared, which is why the-- function returns a 'SatWit'.->a->IO(ASGctx(Lambdactx:+:Variablectx:+:dom)(Internala),VarId)reifyGraphcanShare=reifyGraphTopcanShare.desugar