prcdrpsr.c

clips源代码

   if (top->argList->type == DEFGLOBAL_PTR) return(top);
#endif

   if (top->argList->nextArg != NULL)
     { theConstraint = ExpressionToConstraintRecord(theEnv,top->argList->nextArg); }

   AddBindName(theEnv,variableName,theConstraint);

   return(top);
  }

/********************************************/
/* ReturnParse: Parses the return function. */
/********************************************/
static struct expr *ReturnParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   int error_flag = FALSE;
   struct token theToken;

   if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
     ExpressionData(theEnv)->ReturnContext = TRUE;
   if (ExpressionData(theEnv)->ReturnContext == FALSE)
     {
      PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n");
      ReturnExpression(theEnv,top);
      return(NULL);
     }
   ExpressionData(theEnv)->ReturnContext = FALSE;

   SavePPBuffer(theEnv," ");

   top->argList = ArgumentParse(theEnv,infile,&error_flag);
   if (error_flag)
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }
   else if (top->argList == NULL)
     {
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,")");
     }
   else
     {
      SavePPBuffer(theEnv," ");
      GetToken(theEnv,infile,&theToken);
      if (theToken.type != RPAREN)
        {
         SyntaxErrorMessage(theEnv,"return function");
         ReturnExpression(theEnv,top);
         return(NULL);
        }
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,")");
     }
   return(top);
  }

/**********************************************/
/* BreakParse:                                */
/**********************************************/
static struct expr *BreakParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token theToken;

   if (ExpressionData(theEnv)->svContexts->brk == FALSE)
     {
      PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n");
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   SavePPBuffer(theEnv," ");
   GetToken(theEnv,infile,&theToken);
   if (theToken.type != RPAREN)
     {
      SyntaxErrorMessage(theEnv,"break function");
      ReturnExpression(theEnv,top);
      return(NULL);
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,")");
   return(top);
  }

/**********************************************/
/* SwitchParse:                               */
/**********************************************/
static struct expr *SwitchParse(
  void *theEnv,
  struct expr *top,
  char *infile)
  {
   struct token theToken;
   EXPRESSION *theExp,*chk;
   int default_count = 0;

   /*============================*/
   /* Process the switch value   */
   /*============================*/
   IncrementIndentDepth(theEnv,3);
   SavePPBuffer(theEnv," ");
   top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL);
   if (theExp == NULL)
     goto SwitchParseError;

   /*========================*/
   /* Parse case statements. */
   /*========================*/
   GetToken(theEnv,infile,&theToken);
   while (theToken.type != RPAREN)
     {
      PPBackup(theEnv);
      PPCRAndIndent(theEnv);
      SavePPBuffer(theEnv,theToken.printForm);
      if (theToken.type != LPAREN)
        goto SwitchParseErrorAndMessage;
      GetToken(theEnv,infile,&theToken);
      SavePPBuffer(theEnv," ");
      if ((theToken.type == SYMBOL) &&
          (strcmp(ValueToString(theToken.value),"case") == 0))
        {
         if (default_count != 0)
           goto SwitchParseErrorAndMessage;
         theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL);
         SavePPBuffer(theEnv," ");
         if (theExp->nextArg == NULL)
           goto SwitchParseError;
         for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg)
           {
            if ((chk->type == theExp->nextArg->type) &&
                (chk->value == theExp->nextArg->value) &&
                IdenticalExpression(chk->argList,theExp->nextArg->argList))
              {
               PrintErrorID(theEnv,"PRCDRPSR",3,TRUE);
               EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n");
               goto SwitchParseError;
              }
           }
         GetToken(theEnv,infile,&theToken);
         if ((theToken.type != SYMBOL) ? TRUE :
             (strcmp(ValueToString(theToken.value),"then") != 0))
           goto SwitchParseErrorAndMessage;
        }
      else if ((theToken.type == SYMBOL) &&
               (strcmp(ValueToString(theToken.value),"default") == 0))
        {
         if (default_count)
           goto SwitchParseErrorAndMessage;
         theExp->nextArg = GenConstant(theEnv,RVOID,NULL);
         default_count = 1;
        }
      else
        goto SwitchParseErrorAndMessage;
      theExp = theExp->nextArg;
      if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
        ExpressionData(theEnv)->ReturnContext = TRUE;
      if (ExpressionData(theEnv)->svContexts->brk == TRUE)
        ExpressionData(theEnv)->BreakContext = TRUE;
      IncrementIndentDepth(theEnv,3);
      PPCRAndIndent(theEnv);
      theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);
      DecrementIndentDepth(theEnv,3);
      ExpressionData(theEnv)->ReturnContext = FALSE;
      ExpressionData(theEnv)->BreakContext = FALSE;
      if (theExp->nextArg == NULL)
        goto SwitchParseError;
      theExp = theExp->nextArg;
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,theToken.printForm);
      GetToken(theEnv,infile,&theToken);
     }
   DecrementIndentDepth(theEnv,3);
   return(top);

SwitchParseErrorAndMessage:
   SyntaxErrorMessage(theEnv,"switch function");
SwitchParseError:
   ReturnExpression(theEnv,top);
   DecrementIndentDepth(theEnv,3);
   return(NULL);
  }

/********************************************************/
/* SearchParsedBindNames:                               */
/********************************************************/
globle int SearchParsedBindNames(
  void *theEnv,
  SYMBOL_HN *name_sought)
  {
   struct BindInfo *var_ptr;
   int theIndex = 1;

   var_ptr = ProcedureParserData(theEnv)->ListOfParsedBindNames;
   while (var_ptr != NULL)
     {
      if (var_ptr->name == name_sought)
        { return(theIndex); }
      var_ptr = var_ptr->next;
      theIndex++;
     }

   return(0);
  }

/********************************************************/
/* FindBindConstraints:                               */
/********************************************************/
globle struct constraintRecord *FindBindConstraints(
  void *theEnv,
  SYMBOL_HN *nameSought)
  {
   struct BindInfo *theVariable;

   theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames;
   while (theVariable != NULL)
     {
      if (theVariable->name == nameSought)
        { return(theVariable->constraints); }
      theVariable = theVariable->next;
     }

   return(NULL);
  }

/********************************************************/
/* CountParsedBindNames: Counts the number of variables */
/*   names that have been bound using the bind function */
/*   in the current context (e.g. the RHS of a rule).   */
/********************************************************/
globle int CountParsedBindNames(
  void *theEnv)
  {
   struct BindInfo *theVariable;
   int theIndex = 0;

   theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames;
   while (theVariable != NULL)
     {
      theVariable = theVariable->next;
      theIndex++;
     }

   return(theIndex);
  }

/****************************************************************/
/* AddBindName: Adds a variable name used as the first argument */
/*   of the bind function to the list of variable names parsed  */
/*   within the current semantic context (e.g. RHS of a rule).  */
/****************************************************************/
static int AddBindName(
  void *theEnv,
  SYMBOL_HN *variableName,
  CONSTRAINT_RECORD *theConstraint)
  {
   CONSTRAINT_RECORD *tmpConstraint;
   struct BindInfo *currentBind, *lastBind;
   int theIndex = 1;

   /*=========================================================*/
   /* Look for the variable name in the list of bind variable */
   /* names already parsed. If it is found, then return the   */
   /* index to the variable and union the new constraint      */
   /* information with the old constraint information.        */
   /*=========================================================*/

   lastBind = NULL;
   currentBind = ProcedureParserData(theEnv)->ListOfParsedBindNames;
   while (currentBind != NULL)
     {
      if (currentBind->name == variableName)
        {
         if (theConstraint != NULL)
           {
            tmpConstraint = currentBind->constraints;
            currentBind->constraints = UnionConstraints(theEnv,theConstraint,currentBind->constraints);
            RemoveConstraint(theEnv,tmpConstraint);
            RemoveConstraint(theEnv,theConstraint);
           }

         return(theIndex);
        }
      lastBind = currentBind;
      currentBind = currentBind->next;
      theIndex++;
     }

   /*===============================================================*/
   /* If the variable name wasn't found, then add it to the list of */
   /* variable names and store the constraint information with it.  */
   /*===============================================================*/

   currentBind = get_struct(theEnv,BindInfo);
   currentBind->name = variableName;
   currentBind->constraints = theConstraint;
   currentBind->next = NULL;

   if (lastBind == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = currentBind;
   else lastBind->next = currentBind;

   return(theIndex);
  }

/********************************************************/
/* RemoveParsedBindName:                                     */
/********************************************************/
globle void RemoveParsedBindName(
  void *theEnv,
  struct symbolHashNode *bname)
  {
   struct BindInfo *prv,*tmp;

   prv = NULL;
   tmp = ProcedureParserData(theEnv)->ListOfParsedBindNames;
   while ((tmp != NULL) ? (tmp->name != bname) : FALSE)
     {
      prv = tmp;
      tmp = tmp->next;
     }
   if (tmp != NULL)
     {
      if (prv == NULL)
        ProcedureParserData(theEnv)->ListOfParsedBindNames = tmp->next;
      else
        prv->next = tmp->next;

      RemoveConstraint(theEnv,tmp->constraints);
      rtn_struct(theEnv,BindInfo,tmp);
     }
  }

#endif

#endif