exprnpsr.c

一套美国国家宇航局人工智能中心NASA的专家系统工具源代码

     { return(CLIPS_FALSE); }

   /*======================================*/
   /* Get the maximum number of arguments. */
   /*======================================*/

   theChar[0] = restrictions[i++];
   if (isdigit(theChar[0]))
     { number2 = atoi(theChar); }
   else if (theChar[0] == '*')
     { number2 = 10000; }
   else
     { return(CLIPS_FALSE); }

   /*============================================*/
   /* Check for the correct number of arguments. */
   /*============================================*/

   if (number1 == number2)
     {
      if (argCount != number1)
        {
         ExpectedCountError(functionName,EXACTLY,number1);
         return(CLIPS_TRUE);
        }
     }
   else if (argCount < number1)
     {
      ExpectedCountError(functionName,AT_LEAST,number1);
      return(CLIPS_TRUE);
     }
   else if (argCount > number2)
     {
      ExpectedCountError(functionName,NO_MORE_THAN,number2);
      return(CLIPS_TRUE);
     }

   /*=======================================*/
   /* Check for the default argument types. */
   /*=======================================*/

   defaultRestriction = restrictions[i];
   if (defaultRestriction == '\0')
     { defaultRestriction = 'u'; }
   else if (defaultRestriction == '*')
     { 
      defaultRestriction = 'u';
      i++;
     }
   else
     { i++; }

   /*======================*/
   /* Check each argument. */
   /*======================*/

   for (argPtr = theExpression->argList;
        argPtr != NULL;
        argPtr = argPtr->nextArg)
     {
      argRestriction = restrictions[i];
      if (argRestriction == '\0')
        { argRestriction = defaultRestriction; }
      else
        { i++; }
        
      if (argRestriction != '*')
        { theRestriction = (int) argRestriction; }
      else
        { theRestriction = (int) defaultRestriction; }

      if (CheckArgumentAgainstRestriction(argPtr,theRestriction))
        { 
         ExpectedTypeError1(functionName,j,GetArgumentTypeName(theRestriction)); 
         return(CLIPS_TRUE);
        }

      j++;
     }

   return(CLIPS_FALSE);
  }
  
/*******************************************************/
/* CollectArguments: Parses and groups together all of */
/*   the arguments for a function call expression.     */
/*******************************************************/
globle struct expr *CollectArguments(top,logicalName)
  struct expr *top;
  char *logicalName;
  {
   int errorFlag;
   struct expr *lastOne, *nextOne;

   /*========================================*/
   /* Default parsing routine for functions. */
   /*========================================*/

   lastOne = NULL;

   while (CLIPS_TRUE)
     {
      SavePPBuffer(" ");

      errorFlag = CLIPS_FALSE;
      nextOne = ArgumentParse(logicalName,&errorFlag);

      if (errorFlag == CLIPS_TRUE)
        {
         ReturnExpression(top);
         return(NULL);
        }

      if (nextOne == NULL)
        {
         PPBackup();
         PPBackup();
         SavePPBuffer(")");
         return(top);
        }

      if (lastOne == NULL)
        { top->argList = nextOne; }
      else
        { lastOne->nextArg = nextOne; }

      lastOne = nextOne;
     }
  }

/********************************************/
/* ArgumentParse: Parses an argument within */
/*   a function call expression.            */
/********************************************/
globle struct expr *ArgumentParse(logicalName,errorFlag)
  char *logicalName;
  int *errorFlag;
  {
   struct expr *top;
   struct token theToken;

   /*===============*/
   /* Grab a token. */
   /*===============*/
   
   GetToken(logicalName,&theToken);

   /*============================*/
   /* ')' counts as no argument. */
   /*============================*/

   if (theToken.type == RPAREN)
     { return(NULL); }

   /*================================*/
   /* Parse constants and variables. */
   /*================================*/

   if ((theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE) ||
       (theToken.type == SYMBOL) || (theToken.type == STRING) ||
#if DEFGLOBAL_CONSTRUCT
       (theToken.type == GBL_VARIABLE) ||
       (theToken.type == MF_GBL_VARIABLE) ||
#endif
#if OBJECT_SYSTEM
       (theToken.type == INSTANCE_NAME) ||
#endif
       (theToken.type == FLOAT) || (theToken.type == INTEGER))
     { return(GenConstant(theToken.type,theToken.value)); }

   /*======================*/
   /* Parse function call. */
   /*======================*/

   if (theToken.type != LPAREN)
     {   
      PrintErrorID("EXPRNPSR",2,CLIPS_TRUE);
      PrintCLIPS(WERROR,"Expected a constant, variable, or expression.\n");
      *errorFlag = CLIPS_TRUE;
      return(NULL);
     }

   top = Function1Parse(logicalName);
   if (top == NULL) *errorFlag = CLIPS_TRUE;
   return(top);
  }

/************************************************************/
/* ParseAtomOrExpression: Parses an expression which may be */
/*   a function call, atomic value (string, symbol, etc.),  */
/*   or variable (local or global).                         */
/************************************************************/
globle struct expr *ParseAtomOrExpression(logicalName,useToken)
  char *logicalName;
  struct token *useToken;
  {
   struct token theToken, *thisToken;
   struct expr *rv;
   
   if (useToken == NULL)
     {
      thisToken = &theToken;
      GetToken(logicalName,thisToken);
     }
   else thisToken = useToken;

   if ((thisToken->type == SYMBOL) || (thisToken->type == STRING) ||
       (thisToken->type == INTEGER) || (thisToken->type == FLOAT) ||
#if OBJECT_SYSTEM
       (thisToken->type == INSTANCE_NAME) ||
#endif
#if DEFGLOBAL_CONSTRUCT
       (thisToken->type == GBL_VARIABLE) ||
       (thisToken->type == MF_GBL_VARIABLE) ||
#endif
       (thisToken->type == SF_VARIABLE) || (thisToken->type == MF_VARIABLE))
     { rv = GenConstant(thisToken->type,thisToken->value); }
   else if (thisToken->type == LPAREN)
     {
      rv = Function1Parse(logicalName);
      if (rv == NULL) return(NULL);
     }
   else
     {
      PrintErrorID("EXPRNPSR",2,CLIPS_TRUE);
      PrintCLIPS(WERROR,"Expected a constant, variable, or expression.\n");
      return(NULL);
     }

   return(rv);
  }

/*********************************************/
/* GroupActions: Groups together a series of */
/*   actions within a progn expression. Used */
/*   for example to parse the RHS of a rule. */
/*********************************************/
globle struct expr *GroupActions(logicalName,theToken,readFirstToken,endWord)
  char *logicalName;
  struct token *theToken;
  int readFirstToken;
  char *endWord;
  {
   struct expr *top, *nextOne, *lastOne = NULL;
   
   /*=============================*/
   /* Create the enclosing progn. */
   /*=============================*/
   
   top = GenConstant(FCALL,FindFunction("progn"));

   /*========================================================*/
   /* Continue until all appropriate commands are processed. */
   /*========================================================*/

   while (CLIPS_TRUE)
     {
      /*================================================*/
      /* Skip reading in the token if this is the first */
      /* pass and the initial token was already read    */
      /* before calling this function.                  */
      /*================================================*/
      
      if (readFirstToken)
        { GetToken(logicalName,theToken); }
      else
        { readFirstToken = CLIPS_TRUE; }

      /*=================================================*/
      /* Look to see if a symbol has terminated the list */
      /* of actions (such as "else" in an if function).  */
      /*=================================================*/
      
      if ((theToken->type == SYMBOL) && (endWord != NULL))
        {
         if (strcmp(ValueToString(theToken->value),endWord) == 0) 
           { return(top); }
        }

      /*========================================*/
      /* Process a constant or global variable. */
      /*========================================*/
      
      if ((theToken->type == SYMBOL) || (theToken->type == STRING) ||
          (theToken->type == INTEGER) || (theToken->type == FLOAT) ||
#if DEFGLOBAL_CONSTRUCT
          (theToken->type == GBL_VARIABLE) ||
          (theToken->type == MF_GBL_VARIABLE) ||
#endif
#if OBJECT_SYSTEM
          (theToken->type == INSTANCE_NAME) ||
#endif
          (theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE))
        { nextOne = GenConstant(theToken->type,theToken->value); }
        
      /*=============================*/
      /* Otherwise parse a function. */
      /*=============================*/
      
      else if (theToken->type == LPAREN)
        { nextOne = Function1Parse(logicalName); }
        
      /*======================================*/
      /* Otherwise replace sequence expansion */
      /* variables and return the expression. */
      /*======================================*/
      
      else
        {
         if (ReplaceSequenceExpansionOps(top,NULL,
                                         FindFunction("(expansion-call)"),
                                         FindFunction("expand$")))
           {
            ReturnExpression(top);
            return(NULL);
           }
         return(top);
        }

      /*===========================*/
      /* Add the new action to the */
      /* list of progn arguments.  */
      /*===========================*/
      
      if (nextOne == NULL)
        {
         theToken->type = UNKNOWN_VALUE;
         ReturnExpression(top);
         return(NULL);
        }

      if (lastOne == NULL)
        { top->argList = nextOne; }
      else
        { lastOne->nextArg = nextOne; }

      lastOne = nextOne;

      PPCRAndIndent();
     }
  }
  
#endif /* (! RUN_TIME) */

/********************************************************/
/* SetSequenceOperatorRecognition: C access routine for */
/*   the set-sequence-operator-recognition function     */
/********************************************************/
globle BOOLEAN SetSequenceOperatorRecognition(value)
  int value;
  {
   int ov;

   ov = SequenceOpMode;
   SequenceOpMode = value;
   return(ov);
  }
  
/********************************************************/
/* SetSequenceOperatorRecognition: C access routine for */
/*   the Get-sequence-operator-recognition function     */
/********************************************************/
globle BOOLEAN GetSequenceOperatorRecognition()
  {
   return(SequenceOpMode);
  }
  
/*******************************************/
/* ParseConstantArguments: Parses a string */
/*    into a set of constant expressions.  */
/*******************************************/
globle EXPRESSION *ParseConstantArguments(argstr,error)
  char *argstr;
  int *error;
  {
   EXPRESSION *top = NULL,*bot = NULL,*tmp;
   char *router = "***CLIPSFNXARGS***";
   struct token tkn;

   *error = CLIPS_FALSE;
   
   if (argstr == NULL) return(NULL);
   
   /*=====================================*/
   /* Open the string as an input source. */
   /*=====================================*/
   
   if (OpenStringSource(router,argstr,0) == 0)
     {
      PrintErrorID("EXPRNPSR",6,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot read arguments for external call.\n");
      *error = CLIPS_TRUE;
      return(NULL);
     }

   /*======================*/
   /* Parse the constants. */
   /*======================*/
   
   GetToken(router,&tkn);
   while (tkn.type != STOP)
     {
      if ((tkn.type != SYMBOL) && (tkn.type != STRING) &&
          (tkn.type != FLOAT) && (tkn.type != INTEGER) &&
          (tkn.type != INSTANCE_NAME))
        {         
         PrintErrorID("EXPRNPSR",7,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Only constant arguments allowed for external CLIPS function call.\n");
         ReturnExpression(top);
         *error = CLIPS_TRUE;
         CloseStringSource(router);
         return(NULL);
        }
      tmp = GenConstant(tkn.type,tkn.value);
      if (top == NULL)
        top = tmp;
      else
        bot->nextArg = tmp;
      bot = tmp;
      GetToken(router,&tkn);
     }
   
   /*================================*/
   /* Close the string input source. */
   /*================================*/
   
   CloseStringSource(router);
      
   /*=======================*/
   /* Return the arguments. */
   /*=======================*/
   
   return(top);
  }