static DF_TermPtr HN_hnormDispatchOcc(DF_TermPtr tmPtr, Boolean whnf)
{
restart_hnormOcc:
switch (DF_termTag(tmPtr)){
case DF_TM_TAG_VAR:
{
if (!HN_isEmptyEnv()) HN_setEmptyEnv();
HNL_setRegsFlex(tmPtr);
return tmPtr;
}
case DF_TM_TAG_CONST:
case DF_TM_TAG_INT:
case DF_TM_TAG_FLOAT:
case DF_TM_TAG_NIL:
case DF_TM_TAG_STR:
case DF_TM_TAG_STREAM:
{
if (!HN_isEmptyEnv()) HN_setEmptyEnv();
HNL_setRegsRig(tmPtr);
return tmPtr;
}
case DF_TM_TAG_BVAR: { return HN_hnormBVOcc(tmPtr, whnf); }
case DF_TM_TAG_CONS: { return HN_hnormConsOcc(tmPtr, whnf); }
case DF_TM_TAG_LAM: { return HN_hnormLamOcc(tmPtr, whnf); }
case DF_TM_TAG_APP: {
if (AM_vbbreg == tmPtr) EM_THROW(EM_FAIL);
return HN_hnormAppOcc(tmPtr, whnf); }
case DF_TM_TAG_SUSP: { return HN_hnormSuspOcc(tmPtr, whnf); }
case DF_TM_TAG_REF: {tmPtr=DF_termDeref(tmPtr); goto restart_hnormOcc;}
}
//Impossible to reach this point.
return NULL;
}
/****************************************************************************
* 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);
}
static DF_TermPtr HN_lnormDispatch(DF_TermPtr tmPtr, Boolean whnf)
{
restart_lnorm:
switch (DF_termTag(tmPtr)){
case DF_TM_TAG_VAR:
{
if (!HN_isEmptyEnv()) HN_setEmptyEnv();
HNL_setRegsFlex(tmPtr);
return tmPtr;
}
case DF_TM_TAG_CONST:
case DF_TM_TAG_INT:
case DF_TM_TAG_FLOAT:
case DF_TM_TAG_NIL:
case DF_TM_TAG_STR:
case DF_TM_TAG_STREAM:
{
if (!HN_isEmptyEnv()) HN_setEmptyEnv();
HNL_setRegsRig(tmPtr);
return tmPtr;
}
case DF_TM_TAG_BVAR: { return HN_lnormBV(tmPtr, whnf); }
case DF_TM_TAG_CONS: { return HN_lnormCons(tmPtr, whnf); }
case DF_TM_TAG_LAM: { return HN_lnormLam(tmPtr, whnf); }
case DF_TM_TAG_APP: { return HN_lnormApp(tmPtr, whnf); }
case DF_TM_TAG_SUSP: { return HN_lnormSusp(tmPtr, whnf); }
case DF_TM_TAG_REF: { tmPtr = DF_termDeref(tmPtr); goto restart_lnorm;}
}
//Impossible to reach this point.
return NULL;
}
/*****************************************************************************
* The main routine for writing out a term; this is called by the interface *
* routines to do the real job of printing. *
*****************************************************************************/
static void PRINT_writeTerm(WordPtr outStream, DF_TermPtr tmPtr,
OP_FixityType infx, int inprec, OP_TermContext tc)
{
tmPtr = DF_termDeref(tmPtr);
switch (DF_termTag(tmPtr)) {
case DF_TM_TAG_INT: PRINT_writeInt(outStream, tmPtr); break;
case DF_TM_TAG_FLOAT: PRINT_writeFloat(outStream, tmPtr); break;
case DF_TM_TAG_STR: PRINT_writeString(outStream, tmPtr); break;
case DF_TM_TAG_STREAM: PRINT_writeStream(outStream, tmPtr); break;
case DF_TM_TAG_CONST: PRINT_writeConst(outStream, tmPtr); break;
case DF_TM_TAG_VAR: PRINT_writeFVar(outStream, tmPtr); break;
case DF_TM_TAG_BVAR: PRINT_writeBVar(outStream, tmPtr); break;
case DF_TM_TAG_NIL: PRINT_writeNil(outStream); break;
case DF_TM_TAG_CONS:
PRINT_writeCons(outStream, tmPtr, infx, inprec, tc); break;
case DF_TM_TAG_LAM:
PRINT_writeAbst(outStream, tmPtr, infx, inprec, tc); break;
case DF_TM_TAG_APP:
PRINT_writeApp(outStream, tmPtr, infx, inprec, tc); break;
} /* switch */
}
/* Getting the fixity and precedence for the head of an application.
Assume the pointer to the term head is already dereferenced. */
static void PRINT_getHeadInfo(DF_TermPtr hdPtr, OP_FixityType *fx, int* prec)
{
int cstInd;
switch (DF_termTag(hdPtr)) {
case DF_TM_TAG_CONST:
cstInd = DF_constTabIndex(hdPtr);
if (AM_cstName(cstInd)) {
*fx = (OP_FixityType)AM_cstFixity(cstInd);
*prec = AM_cstPrecedence(cstInd);
} else {
*fx = OP_NONE;
*prec = 0;
}
break;
case DF_TM_TAG_VAR:
*fx = OP_NONE;
*prec = OP_MINPREC;
break;
case DF_TM_TAG_BVAR:
*fx = OP_NONE;
*prec = OP_MINPREC;
break;
}
}
