>-- | Obtains hylomorphisms representing functions in the original program.>-- >-- The hylomorphisms are returned in the second component of the output. >-- If a hylomorphism cannot be derived for some (possibly) mutually recursive >-- function definitions, then they are returned in the first component of the >-- output together with the error obtained when attempting derivation.>deriveHylos::[Def]->VarGenState([([Def],FusionError)],[([Def],HyloT)])>deriveHylosdfs=removeInputVardfs>>=>handleRegularFunctions.getCycles>>=\cdfs->>mapM(\cdf->runErrorT$fmap((,)cdf)$deriveHylocdf)cdfs>>=\ehs->>return(concat(zipWith(\df->either((:[]).((,)df))(const[]))cdfsehs)>,concat(map(either(const[])(:[]))ehs))

getCalls collects the information about each recursive call that can be rewritten as
a call to a recursive function which fixes one of the arguments.
The returned pair (def,l) contains the rewritten definition (with fresh vars for some
recursive calls), and l is a list containing data for each of the new definitions
to be introduced.
Each item in the list is a tuple (u,def,i,vrs,t) where
u is the name for the new definition,
def is the definition to be rewritten with a fixed argument,
i is the index of the fixed argument,
vrs are the bounded variables appearing in the term in the ith argument,
and t is that term.

>getCalls::[[Def]]->[CallDescription]->[Variable]->Def->VarGenState(Def,[CallDescription])>getCallspscallsds(Defvaluevt)=runStateT(do(t',ds')<-getCalls'[]t;return$(Defvaluevt',ds'))calls>>=return.fst>wheregetCalls'::[Variable]->Term->StateT[CallDescription](StateVarGen)(Term,[CallDescription])>getCalls'bs(Ttuplebts)=do(ts',ns)<-mapGetCalls'bsts>return(Ttuplebts',ns)>getCalls'bs(Tlambbvt)=do(t',ns)<-getCalls'(bs++varsbv)t;return(Tlambbvt',ns)>getCalls'bs(Tcaset0psts)=do(t0',n0)<-getCalls'bst0>res<-sequence$zipWith(getCalls'.(bs++).vars)psts>let(ts',ns)=unzipres>return(Tcaset0'psts',n0++concatns)>getCalls'bs(Tappt0t1)=do(t0',n0)<-getCalls'bst0>(t1',n1)<-getCalls'bst1>return(tappt0't1',n0++n1)>getCalls'bs(Tletvt0t1)=do(t0',n0)<-getCalls'(v:bs)t0>(t1',n1)<-getCalls'(v:bs)t1>return(Tletvt0't1',n0++n1)>getCalls'bs(Tcappcts)=do(ts',ns)<-mapGetCalls'bsts>return(Tcappcts',ns)>getCalls'bstt@(Tfappvts)=>do(ts',ns)<-mapGetCalls'bsts>letrr=return(Tfappvts',ns)>checkNoPattern(idxs,d@(Defvalue_t))=>case[i|(i,t)<-zip[0..]ts',any(flipelem(varst))ds,callIsOkToSpecializeit]of>i:_|elemiidxs->mrid-- recursive calls appear in constant positions>_->rr>where(vargs,t')=extractVarst>callIsOkToSpecializei(Tfappv'ts)=>elemv'ds>&&(lengthts<lengthvargs'>||lengthts==lengthvargs'>-- variable is used at most once>&&countLinear(getVar(vargs!!i))t'<2)>wherelengthvargs'=maybe(error"lengthvars'")>(length.fst.extractVars.getDefTerm)$find((v'==).getDefName)$concatps>callIsOkToSpecialize_(Tvar_)=True>callIsOkToSpecialize__=False>getVar(Bvarv)=v>getVar_=error"getCalls': getVar">mrid=dolet(ant,pos)=splitAtits'>tsargs=map(\t->if(not$isVart)||(not$null$intersect(varst)bs)thenJusttelseNothing)$>case(headpos)of{Tfapp_ts->ts;_->[]}>calls<-get>casefind(\(_,d',i',tsargs',t')->i'==i>&&getDefNamed'==getDefNamed>&&and(zipWith(\tt'->isJustt==isJustt')tsargstsargs')>&&t'==headpos)>callsof>Nothing->dou<-lift$getFreshVar(varPrefixv)>letc=(u,d,i,tsargs,headpos)>put(c:calls)>return(Tfappu(catMaybestsargs++ant++tailpos),c:ns)>Just(u,_,_,_,_)->return(Tfappu(catMaybestsargs++ant++tailpos),ns)>ifelemvbsthenrr>elsemayberrcheckNoPattern(lookupDefv(mapconstantArgsps)ps)>getCalls'_t=return(t,[])>isVar(Tvar_)=True>isVar_=False>constantArgs::[Def]->[Int]>constantArgsdfs=findConstantArgumentsdfs>mapGetCalls'bsts=dores<-mapM(getCalls'bs)ts>let(ts',ns)=unzipres>return(ts',concatns)>lookupDef::Variable->[[Int]]->[[Def]]->Maybe([Int],Def)>lookupDefvargidxsps=find((v==).getDefName.snd)$[(idxs,df)|(idxs,dfs)<-zipargidxsps,df<-dfs]