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); }