/****************************************************************************
* Writing out a non-empty list. *
****************************************************************************/
static void PRINT_writeCons(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType fx, int prec, OP_TermContext tc)
{
DF_TermPtr args = DF_consArgs(tmPtr);
DF_TermPtr arg;
OP_FixityType consfix = (OP_FixityType)AM_cstFixity(PERV_CONS_INDEX);
int consprec = AM_cstPrecedence(PERV_CONS_INDEX);
Boolean pparen = PRINT_parenNeeded(consfix, consprec, tc, fx,prec);
if (pparen) PRINT_writeLParen(outStream);
PRINT_writeTerm(outStream, args, consfix, consprec, OP_LEFT_TERM);
PRINT_writeConsSymbol(outStream);
do {
args++;
tmPtr = DF_termDeref(args);
if (DF_termTag(tmPtr) != DF_TM_TAG_CONS) break;
args = DF_consArgs(tmPtr);
PRINT_writeTerm(outStream, args, consfix, consprec, OP_LEFT_TERM);
PRINT_writeConsSymbol(outStream);
} while(1);
PRINT_writeTerm(outStream, tmPtr, consfix, consprec, OP_RIGHT_TERM);
if (pparen) PRINT_writeRParen(outStream);
}
/* (weak) head normalize cons or implicit suspension over cons */
static DF_TermPtr HN_hnormCons(DF_TermPtr consPtr, Boolean whnf)
{
DF_TermPtr argvec = DF_consArgs(consPtr),
rtPtr; //term pointer to be returned
if (HN_isEmptyEnv()){
AM_argVec = argvec;
AM_numArgs = DF_CONS_ARITY;
rtPtr = consPtr;
} else {
Boolean changed = HNL_makeConsArgvec(argvec, ol, nl, envlist);
if (changed){ //new argvec is built because of pushing susp
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushCons(AM_argVec);
} else rtPtr = consPtr;
HN_setEmptyEnv();
}
HNL_setRegsCons(rtPtr);
return rtPtr;
}
/* Fully normalize or weak head normalize cons or implicit suspension over
cons. The difference from HN_hnormCons is that the arguments of the cons
are fully normalized.
*/
static DF_TermPtr HN_lnormCons(DF_TermPtr consPtr, Boolean whnf)
{
DF_TermPtr argvec = DF_consArgs(consPtr),
rtPtr; //term pointer to be returned
if (HN_isEmptyEnv()){
HN_lnormArgvecEmpEnv(argvec, DF_CONS_ARITY);
AM_argVec = argvec;
AM_numArgs = DF_CONS_ARITY;
rtPtr = consPtr;
} else {
DF_TermPtr newArgvec = (DF_TermPtr)AM_hreg; //new argument vector
HN_lnormArgvec(argvec, DF_CONS_ARITY, ol, nl, envlist);
AM_argVec = newArgvec;
AM_numArgs = DF_CONS_ARITY;
rtPtr = (DF_TermPtr)AM_hreg;
HNL_pushCons(AM_argVec);
HN_setEmptyEnv();
}
HNL_setRegsCons(rtPtr);
return rtPtr;
}
