/**************************************************************************** * 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; }