static void PRINT_writeAbst(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType fx, int prec, OP_TermContext tc)
{
int numabs = 0;
Boolean pparen = PRINT_parenNeeded(OP_LAM_FIXITY,OP_LAM_PREC,tc,fx,prec);
PRINT_BVList tmpbvs;
int tmpbvc = PRINT_bvcounter;
if (pparen) PRINT_writeLParen(outStream);
while (DF_isLam(tmPtr)){
numabs += DF_lamNumAbs(tmPtr);
tmPtr = DF_termDeref(DF_lamBody(tmPtr));
}
PRINT_writeAbstBinders(outStream, numabs);
PRINT_writeTerm(outStream, tmPtr, OP_LAM_FIXITY,OP_LAM_PREC,OP_RIGHT_TERM);
if (pparen) PRINT_writeRParen(outStream);
while (numabs > 0) {
numabs--;
tmpbvs = PRINT_bvs;
PRINT_bvs = PRINT_bvs->next;
PRINT_cleanBV(tmpbvs);
}
PRINT_bvcounter = tmpbvc;
}
/* Fully normalize or weak head normalize application or implicit suspension
over application. The actions carried out here is the same as those in
HN_hnormApp except that HN_lnormDispatch is invoked as HN_hnormDispatch, and
in making argument vectors makeArgvecLnorm functions are used to fully
normalize the arguments.
*/
static DF_TermPtr HN_lnormApp(DF_TermPtr appPtr, Boolean whnf)
{
DF_TermPtr funPtr = DF_appFunc(appPtr), argvec = DF_appArgs(appPtr),
rtPtr; // term pointer to be returned
DF_TermPtr oldFunPtr = funPtr;
int arity = DF_appArity(appPtr);
Boolean emptyTopEnv = HN_isEmptyEnv();
int myol, mynl; //for book keeping the implicit suspension env
DF_EnvPtr myenvlist; //for book keeping the implicit suspension env
int myarity = arity; //book keeping the arity before contraction
if (!emptyTopEnv) { //book keeping the current environment
myol = ol; mynl = nl; myenvlist = envlist;
}
funPtr = HN_lnormDispatch(funPtr, TRUE); //whf of the function
while ((arity > 0) && (DF_isLam(funPtr))) {
//perform contraction on top-level redexes while you can
DF_TermPtr lamBody = DF_lamBody(funPtr); //abs body
int numAbsInFun = DF_lamNumAbs(funPtr);
int numContract = ((arity<=numAbsInFun) ? arity : numAbsInFun);
DF_EnvPtr newenv;
int newol = ol + numContract;
AM_embedError(newol);
if (emptyTopEnv) newenv = HN_addNPairEmpEnv(argvec, numContract);
else newenv = HN_addNPair(argvec, myol, mynl, myenvlist, numContract);
HN_setEnv(newol, nl, newenv);
if (arity == numAbsInFun){
funPtr = HN_lnormDispatch(lamBody, whnf);
arity = 0;
} else if (arity > numAbsInFun) {
funPtr = HN_lnormDispatch(lamBody, TRUE);
argvec=(DF_TermPtr)(((MemPtr)argvec)+numAbsInFun*DF_TM_ATOMIC_SIZE);
arity -= numAbsInFun;
} else { //arity < numabsInFun
DF_TermPtr newBody = (DF_TermPtr)AM_hreg;
HNL_pushLam(lamBody, (numAbsInFun-arity));
funPtr = HN_lnormDispatch(newBody, whnf);
arity = 0;
}
}// while ((arity >0) && (DF_IsLam(fun)))
//update or create application
if (arity == 0) { //app disappears
rtPtr = funPtr;
if (emptyTopEnv && HN_isEmptyEnv()) HNL_updateToRef(appPtr, funPtr);
} else { //app persists; Note: now HN_isEmptyEnv must be TRUE
Boolean changed;
if (emptyTopEnv) changed = HN_makeArgvecEmpEnvLnorm(argvec, arity);
else changed = HN_makeArgvecLnorm(argvec,arity,myol,mynl,myenvlist);
if ((!changed) && (arity == myarity) && (oldFunPtr == funPtr)) {
rtPtr = appPtr;
} else {// create new app and in place update the old if empty top env
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushApp(AM_head, AM_argVec, AM_numArgs);
if (emptyTopEnv) HNL_updateToRef(appPtr, rtPtr);
}
}
return rtPtr;
}
