factrhs.c

NASA 开发使用的一个专家系统

#if DEFMODULE_CONSTRUCT
      if (FindImportExportConflict("deftemplate",((struct defmodule *) GetCurrentModule()),ValueToString(templateName)))
        {
         ImportExportConflictMessage("implied deftemplate",ValueToString(templateName),NULL,NULL);
         *error = CLIPS_TRUE;
         return(NULL);
        }
#endif

      theDeftemplate = CreateImpliedDeftemplate((SYMBOL_HN *) templateName,CLIPS_TRUE);
     }
#else
    { 
     NoSuchTemplateError(ValueToString(templateName));
     *error = CLIPS_TRUE;
     return(NULL);
    }
#endif
     
   /*=========================================*/
   /* If an explicit deftemplate exists, then */
   /* parse the fact as a deftemplate fact.   */
   /*=========================================*/
      
   if (theDeftemplate->implied == CLIPS_FALSE)
     {   
      firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate);
      firstOne->nextArg = ParseAssertTemplate(readSource,tempToken,
                                              error,endType,
                                              constantsOnly,theDeftemplate);
      if (*error)
        {
         ReturnExpression(firstOne);
         firstOne = NULL;
        }

      return(firstOne);
     }
   
   /*========================================*/
   /* Parse the fact as an ordered RHS fact. */
   /*========================================*/

   firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate);
   
#if (! RUN_TIME) && (! BLOAD_ONLY) 
   SavePPBuffer(" ");
#endif

   while ((nextOne = GetAssertArgument(readSource,tempToken,
                                        error,endType,constantsOnly,&printError)) != NULL)
     {
      if (argHead == NULL) argHead = nextOne;
      else lastOne->nextArg = nextOne;
      lastOne = nextOne;
#if (! RUN_TIME) && (! BLOAD_ONLY) 
      SavePPBuffer(" ");
#endif
     }

   /*===========================================================*/
   /* If an error occurred, set the error flag and return NULL. */
   /*===========================================================*/
   
   if (*error)
     {
      if (printError) SyntaxErrorMessage("RHS patterns");
      ReturnExpression(firstOne);
      ReturnExpression(argHead);
      return(NULL);
     }

   /*=====================================*/
   /* Fix the pretty print representation */
   /* of the RHS ordered fact.            */
   /*=====================================*/

#if (! RUN_TIME) && (! BLOAD_ONLY)   
   PPBackup();
   PPBackup();
   SavePPBuffer(tempToken->printForm);
#endif

   /*==========================================================*/
   /* Ordered fact assertions are processed by stuffing all of */
   /* the fact's proposition (except the relation name) into a */
   /* single multifield slot.                                  */
   /*==========================================================*/
                                  
   firstOne->nextArg = GenConstant(FACT_STORE_MULTIFIELD,AddBitMap("\0",1));
   firstOne->nextArg->argList = argHead;
      
   /*==============================*/
   /* Return the RHS ordered fact. */
   /*==============================*/
   
   return(firstOne);
  }

/********************************************************************/
/* GetAssertArgument: Parses a single RHS slot value and returns an */
/*   expression representing the value. When parsing a deftemplate  */
/*   slot, the slot name has already been parsed when this function */
/*   is called. NULL is returned if a slot or fact delimiter is     */
/*   encountered. In the event of a parse error, the error flag     */
/*   passed as an argument is set.                                  */
/********************************************************************/
globle struct expr *GetAssertArgument(logicalName,theToken,error,endType,
                                      constantsOnly,printError)
  char *logicalName;
  struct token *theToken;
  int *error;
  int endType, constantsOnly;
  int *printError;
  {
   struct expr *nextField;

   /*=================================================*/
   /* Read in the first token of the slot's value. If */
   /* the end delimiter is encountered, then return.  */
   /*=================================================*/
        
   *printError = CLIPS_TRUE;
   GetToken(logicalName,theToken);
   if (theToken->type == endType) return(NULL);

   /*=============================================================*/
   /* If an equal sign of left parenthesis was parsed, then parse */
   /* a function which is to be evaluated to determine the slot's */
   /* value. The equal sign corresponds to the return value       */
   /* constraint which can be used in LHS fact patterns. The      */
   /* equal sign is no longer necessary on either the LHS or RHS  */
   /* of a rule to indicate that a function is being evaluated to */
   /* determine its value either for assignment or pattern        */
   /* matching.                                                   */
   /*=============================================================*/
   
   if ((theToken->type == SYMBOL) ? 
       (strcmp(ValueToString(theToken->value),"=") == 0) : 
       (theToken->type == LPAREN))
     {
      if (constantsOnly)
        {
         *error = CLIPS_TRUE;
         return(NULL);
        }

#if ! RUN_TIME
      if (theToken->type == LPAREN) nextField = Function1Parse(logicalName);
      else nextField = Function0Parse(logicalName);
      if (nextField == NULL)
#endif
        {
         *printError = CLIPS_FALSE;
         *error = CLIPS_TRUE;
        }
#if ! RUN_TIME
      else
        {  
         theToken->type= RPAREN;
         theToken->value = (VOID *) AddSymbol(")");
         theToken->printForm = ")";
        }
#endif
        
      return(nextField);
     }
   
   /*==================================================*/
   /* Constants are always allowed as RHS slot values. */
   /*==================================================*/
   
   if ((theToken->type == SYMBOL) || (theToken->type == STRING) ||
#if OBJECT_SYSTEM
           (theToken->type == INSTANCE_NAME) ||
#endif
           (theToken->type == FLOAT) || (theToken->type == INTEGER))
     { return(GenConstant(theToken->type,theToken->value)); }
   
   /*========================================*/
   /* Variables are also allowed as RHS slot */
   /* values under some circumstances.       */
   /*========================================*/
   
   if ((theToken->type == SF_VARIABLE) ||
#if DEFGLOBAL_CONSTRUCT
            (theToken->type == GBL_VARIABLE) ||
            (theToken->type == MF_GBL_VARIABLE) ||
#endif
            (theToken->type == MF_VARIABLE))
     {
      if (constantsOnly)
        {
         *error = CLIPS_TRUE;
         return(NULL);
        }

      return(GenConstant(theToken->type,theToken->value));
     }

   /*==========================================================*/
   /* If none of the other cases have been satisfied, then the */
   /* token parsed is not appropriate for a RHS slot value.    */
   /*==========================================================*/
   
   *error = CLIPS_TRUE;
   return(NULL);
  }
  
/****************************************************/
/* StringToFact: Converts the string representation */
/*   of a fact to a fact data structure.            */
/****************************************************/
globle struct fact *StringToFact(str)
  char *str;
  {
   struct token theToken;
   struct fact *factPtr;
   int numberOfFields = 0, whichField;
   struct expr *assertArgs, *tempPtr;
   int error = CLIPS_FALSE;
   DATA_OBJECT theResult;

   /*=========================================*/
   /* Open a string router and parse the fact */
   /* using the router as an input source.    */
   /*=========================================*/
               
   OpenStringSource("assert_str",str,0);

   assertArgs = GetRHSPattern("assert_str",&theToken,
                              &error,CLIPS_FALSE,CLIPS_TRUE,
                              CLIPS_TRUE,RPAREN);

   CloseStringSource("assert_str");
   
   /*===========================================*/
   /* Check for errors or the use of variables. */
   /*===========================================*/
   
   if (error)
     {
      ReturnExpression(assertArgs);
      return(NULL);
     }

   if (ExpressionContainsVariables(assertArgs,CLIPS_FALSE))
     {
      LocalVariableErrorMessage("the assert-string function");
      SetEvaluationError(CLIPS_TRUE);
      ReturnExpression(assertArgs);
      return(NULL);
     }
          
   /*=======================================================*/
   /* Count the number of fields needed for the fact and    */
   /* create a fact data structure of the appropriate size. */
   /*=======================================================*/
   
   for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
     { numberOfFields++; }

   factPtr = (struct fact *) CreateFactBySize(numberOfFields);
   factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value;
   
   /*=============================================*/
   /* Copy the fields to the fact data structure. */
   /*=============================================*/
   
   whichField = 0;
   for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
     { 
      EvaluateExpression(tempPtr,&theResult);
      factPtr->theProposition.theFields[whichField].type = (short) theResult.type;
      factPtr->theProposition.theFields[whichField].value = theResult.value;
      whichField++;
     }

   ReturnExpression(assertArgs);

   /*==================*/
   /* Return the fact. */
   /*==================*/
   
   return(factPtr);
  }

#if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE

/*********************************************************/
/* NoSuchTemplateError: Prints out an error message      */
/* in a BLOAD_ONLY, RUN_TIME or bload active environment */
/* when an implied deftemplate cannot be created for     */
/* an assert                                             */
/*********************************************************/
static VOID NoSuchTemplateError(templateName)
  char *templateName;
  {
   PrintErrorID("FACTRHS",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Template ");
   PrintCLIPS(WERROR,templateName);
   PrintCLIPS(WERROR," does not exist for assert.\n");
  }

#endif /* RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE */
  
#endif /* DEFTEMPLATE_CONSTRUCT */