/* Main routine for writing out an application term */
static void PRINT_writeApp(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType infx, int inprec, OP_TermContext tc)
{
DF_TermPtr head = DF_termDeref(DF_appFunc(tmPtr));
DF_TermPtr args = DF_appArgs(tmPtr);
int arity = DF_appArity(tmPtr);
Boolean pparen = PRINT_parenNeeded(OP_APP_FIXITY, OP_APP_PREC, tc, infx,
inprec);
OP_FixityType fix;
int prec;
HN_hnorm(tmPtr);
PRINT_getHeadInfo(AM_head, &fix, &prec);
switch(fix){
case OP_PREFIX: case OP_PREFIXR:
if (arity == 1) {
pparen = FALSE;
PRINT_writePrefixTerm(outStream, head, fix, prec, tc, infx, inprec,
args);
} else {
if (pparen) PRINT_writeLParen(outStream);
PRINT_writePrefixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
OP_APP_FIXITY, OP_APP_PREC, args);
}
arity--; args++;
break;
case OP_INFIX: case OP_INFIXL: case OP_INFIXR:
if (arity == 2) {
pparen = FALSE;
PRINT_writeInfixTerm(outStream, head, fix, prec, tc, infx, inprec,
args);
} else {
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeInfixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
OP_APP_FIXITY, OP_APP_PREC, args);
}
arity -= 2; args += 2;
break;
case OP_POSTFIX: case OP_POSTFIXL:
if (arity == 1) {
pparen = FALSE;
PRINT_writePostfixTerm(outStream, head, fix, prec, tc, infx,
inprec, args);
} else {
if (pparen) PRINT_writeLParen(outStream);
PRINT_writePostfixTerm(outStream, head, fix, prec, OP_LEFT_TERM,
OP_APP_FIXITY, OP_APP_PREC, args);
}
arity--; args++;
break;
case OP_NONE:
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeTerm(outStream,head,OP_APP_FIXITY,OP_APP_PREC,OP_LEFT_TERM);
break;
} /*switch*/
/* print the arguments (if any) of the application */
while (arity > 0) {
PRINT_writeSpace(outStream, 1);
PRINT_writeTerm(outStream, args, OP_APP_FIXITY, OP_APP_PREC,
OP_RIGHT_TERM);
args++;
arity--;
}
if (pparen) PRINT_writeRParen(outStream);
}
/* 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;
}
