static void ReplaceLoopCountVars(
void *theEnv,
SYMBOL_HN *loopVar,
EXPRESSION *theExp,
int depth)
{
while (theExp != NULL)
{
if ((theExp->type != SF_VARIABLE) ? FALSE :
(strcmp(ValueToString(theExp->value),ValueToString(loopVar)) == 0))
{
theExp->type = FCALL;
theExp->value = (void *) FindFunction(theEnv,"(get-loop-count)");
theExp->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) depth));
}
else if (theExp->argList != NULL)
{
if ((theExp->type != FCALL) ? FALSE :
(theExp->value == (void *) FindFunction(theEnv,"loop-for-count")))
ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth+1);
else
ReplaceLoopCountVars(theEnv,loopVar,theExp->argList,depth);
}
theExp = theExp->nextArg;
}
}
static void ReplaceLoopCountVars(
SYMBOL_HN *loopVar,
EXPRESSION *exp,
int depth)
{
while (exp != NULL)
{
if ((exp->type != SF_VARIABLE) ? FALSE :
(strcmp(ValueToString(exp->value),ValueToString(loopVar)) == 0))
{
exp->type = FCALL;
exp->value = (void *) FindFunction("(get-loop-count)");
exp->argList = GenConstant(INTEGER,AddLong((long) depth));
}
else if (exp->argList != NULL)
{
if ((exp->type != FCALL) ? FALSE :
(exp->value == (void *) FindFunction("loop-for-count")))
ReplaceLoopCountVars(loopVar,exp->argList,depth+1);
else
ReplaceLoopCountVars(loopVar,exp->argList,depth);
}
exp = exp->nextArg;
}
}
static struct expr *LoopForCountParse(
void *theEnv,
struct expr *parse,
char *infile)
{
struct token theToken;
SYMBOL_HN *loopVar = NULL;
EXPRESSION *tmpexp;
int read_first_paren;
struct BindInfo *oldBindList,*newBindList,*prev;
/*======================================*/
/* Process the loop counter expression. */
/*======================================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,infile,&theToken);
/* ==========================================
Simple form: loop-for-count <end> [do] ...
========================================== */
if (theToken.type != LPAREN)
{
parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L));
parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
}
else
{
GetToken(theEnv,infile,&theToken);
if (theToken.type != SF_VARIABLE)
{
if (theToken.type != SYMBOL)
goto LoopForCountParseError;
parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L));
parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value));
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
}
/* =============================================================
Complex form: loop-for-count (<var> [<start>] <end>) [do] ...
============================================================= */
else
{
loopVar = (SYMBOL_HN *) theToken.value;
SavePPBuffer(theEnv," ");
parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);
if (parse->argList == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i'))
goto LoopForCountParseError;
SavePPBuffer(theEnv," ");
GetToken(theEnv,infile,&theToken);
if (theToken.type == RPAREN)
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1L));
tmpexp->nextArg = parse->argList;
parse->argList = tmpexp;
}
else
{
parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
GetToken(theEnv,infile,&theToken);
if (theToken.type != RPAREN)
goto LoopForCountParseError;
}
SavePPBuffer(theEnv," ");
}
}
if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i'))
goto LoopForCountParseError;
/*====================================*/
/* Process the do keyword if present. */
/*====================================*/
GetToken(theEnv,infile,&theToken);
if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
{
read_first_paren = TRUE;
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,theToken.printForm);
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
}
else if (theToken.type == LPAREN)
{
read_first_paren = FALSE;
PPBackup(theEnv);
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
}
else
goto LoopForCountParseError;
/*=====================================*/
/* Process the loop-for-count actions. */
/*=====================================*/
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
ExpressionData(theEnv)->BreakContext = TRUE;
oldBindList = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
parse->argList->nextArg->nextArg =
GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);
if (parse->argList->nextArg->nextArg == NULL)
{
SetParsedBindNames(theEnv,oldBindList);
ReturnExpression(theEnv,parse);
return(NULL);
}
newBindList = GetParsedBindNames(theEnv);
prev = NULL;
while (newBindList != NULL)
{
if ((loopVar == NULL) ? FALSE :
(strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0))
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
PrintErrorID(theEnv,"PRCDRPSR",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n");
ReturnExpression(theEnv,parse);
return(NULL);
}
prev = newBindList;
newBindList = newBindList->next;
}
if (prev == NULL)
SetParsedBindNames(theEnv,oldBindList);
else
prev->next = oldBindList;
if (loopVar != NULL)
ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
/*================================================================*/
/* Check for the closing right parenthesis of the loop-for-count. */
/*================================================================*/
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"loop-for-count function");
ReturnExpression(theEnv,parse);
return(NULL);
}
DecrementIndentDepth(theEnv,3);
return(parse);
LoopForCountParseError:
SyntaxErrorMessage(theEnv,"loop-for-count function");
ReturnExpression(theEnv,parse);
return(NULL);
}
