prcdrpsr.c

clips源代码

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

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

/*********************************************************/
/* IfParse: purpose is to parse the if statement.  The  */
/*   parse of the statement is the return value.         */
/*   Syntax: (if <expression> then <action>+             */
/*               [ else <action>+ ] )                    */
/*********************************************************/
static struct expr *IfParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token theToken;

   /*============================*/
   /* Process the if expression. */
   /*============================*/

   SavePPBuffer(theEnv," ");

   top->argList = ParseAtomOrExpression(theEnv,infile,NULL);

   if (top->argList == NULL)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   /*========================================*/
   /* Keyword 'then' must follow expression. */
   /*========================================*/

   IncrementIndentDepth(theEnv,3);
   PPCRAndIndent(theEnv);

   GetToken(theEnv,infile,&theToken);
   if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0))
     {
      SyntaxErrorMessage(theEnv,"if function");
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   /*==============================*/
   /* Process the if then actions. */
   /*==============================*/

   PPCRAndIndent(theEnv);
   if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
     ExpressionData(theEnv)->ReturnContext = TRUE;
   if (ExpressionData(theEnv)->svContexts->brk == TRUE)
     ExpressionData(theEnv)->BreakContext = TRUE;
   top->argList->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,"else",FALSE);

   if (top->argList->nextArg == NULL)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   top->argList->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg);

   /*===========================================*/
   /* A ')' signals an if then without an else. */
   /*===========================================*/

   if (theToken.type == RPAREN)
     {
      DecrementIndentDepth(theEnv,3);
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,theToken.printForm);
      return(top);
     }

   /*=============================================*/
   /* Keyword 'else' must follow if then actions. */
   /*=============================================*/

   if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"else") != 0))
     {
      SyntaxErrorMessage(theEnv,"if function");
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   /*==============================*/
   /* Process the if else actions. */
   /*==============================*/

   PPCRAndIndent(theEnv);
   top->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);

   if (top->argList->nextArg->nextArg == NULL)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   top->argList->nextArg->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg->nextArg);

   /*======================================================*/
   /* Check for the closing right parenthesis of the if. */
   /*======================================================*/

   if (theToken.type != RPAREN)
     {
      SyntaxErrorMessage(theEnv,"if function");
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   /*===========================================*/
   /* A ')' signals an if then without an else. */
   /*===========================================*/

   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,")");
   DecrementIndentDepth(theEnv,3);
   return(top);
  }

/********************************************************/
/* PrognParse: purpose is to parse the progn statement. */
/*   The parse of the statement is the return value.    */
/*   Syntax:  (progn <expression>*)                     */
/********************************************************/
static struct expr *PrognParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token tkn;
   struct expr *tmp;

   ReturnExpression(theEnv,top);
   ExpressionData(theEnv)->BreakContext = ExpressionData(theEnv)->svContexts->brk;
   ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
   IncrementIndentDepth(theEnv,3);
   PPCRAndIndent(theEnv);
   tmp = GroupActions(theEnv,infile,&tkn,TRUE,NULL,FALSE);
   DecrementIndentDepth(theEnv,3);
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,tkn.printForm);
   return(tmp);
  }

/***********************************************************/
/* BindParse: purpose is to parse the bind statement. The */
/*   parse of the statement is the return value.           */
/*   Syntax:  (bind ?var <expression>)                     */
/***********************************************************/
static struct expr *BindParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token theToken;
   SYMBOL_HN *variableName;
   struct expr *texp;
   CONSTRAINT_RECORD *theConstraint = NULL;
#if DEFGLOBAL_CONSTRUCT
   struct defglobal *theGlobal;
   int count;
#endif

   SavePPBuffer(theEnv," ");

   /*=============================================*/
   /* Next token must be the name of the variable */
   /* to be bound.                                */
   /*=============================================*/

   GetToken(theEnv,infile,&theToken);
   if ((theToken.type != SF_VARIABLE) && (theToken.type != GBL_VARIABLE))
     {
      if ((theToken.type != MF_VARIABLE) || ExpressionData(theEnv)->SequenceOpMode)
        {
         SyntaxErrorMessage(theEnv,"bind function");
         ReturnExpression(theEnv,top);
         return(NULL);
        }
     }

   /*==============================*/
   /* Process the bind expression. */
   /*==============================*/

   top->argList = GenConstant(theEnv,SYMBOL,theToken.value);
   variableName = (SYMBOL_HN *) theToken.value;

#if DEFGLOBAL_CONSTRUCT
   if ((theToken.type == GBL_VARIABLE) ?
       ((theGlobal = (struct defglobal *)
                     FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(variableName),
                                           &count,TRUE,FALSE)) != NULL) :
       FALSE)
     {
      top->argList->type = DEFGLOBAL_PTR;
      top->argList->value = (void *) theGlobal;
     }
   else if (theToken.type == GBL_VARIABLE)
     {
      GlobalReferenceErrorMessage(theEnv,ValueToString(variableName));
      ReturnExpression(theEnv,top);
      return(NULL);
     }
#endif

   texp = get_struct(theEnv,expr);
   texp->argList = texp->nextArg = NULL;
   if (CollectArguments(theEnv,texp,infile) == NULL)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   top->argList->nextArg = texp->argList;
   rtn_struct(theEnv,expr,texp);

#if DEFGLOBAL_CONSTRUCT