factrhs.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.05  04/09/97            */
   /*                                                     */
   /*            FACT RHS PATTERN PARSER MODULE           */
   /*******************************************************/

/*************************************************************/
/* Purpose: Provides a number of routines for parsing fact   */
/*   patterns typically found on the RHS of a rule (such as  */
/*   the assert command). Also contains some functions for   */
/*   parsing RHS slot values (used by functions such as      */
/*   assert, modify, and duplicate).                         */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Chris Culbert                                        */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/

#define _FACTRHS_SOURCE_

#include <stdio.h>
#define _CLIPS_STDIO_
#include <string.h>

#include "setup.h"

#if DEFTEMPLATE_CONSTRUCT

#include "constant.h"
#include "prntutil.h"
#include "extnfunc.h"
#include "pattern.h"
#include "modulutl.h"
#include "modulpsr.h"
#include "cstrcpsr.h"

#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
#include "bload.h"
#endif

#include "tmpltpsr.h"
#include "tmpltrhs.h"
#include "tmpltutl.h"
#include "exprnpsr.h"
#include "strngrtr.h"
#include "router.h"

#include "factrhs.h"

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

#if RUN_TIME || BLOAD_ONLY || BLOAD || BLOAD_AND_BSAVE
#if ANSI_COMPILER
   static VOID                       NoSuchTemplateError(char *);
#else
   static VOID                       NoSuchTemplateError();
#endif
#endif

#if (! RUN_TIME)

/**********************************************************************/
/* BuildRHSAssert: Parses zero or more RHS fact patterns (the format  */
/*   which is used by the assert command and the deffacts construct). */
/*   Each of the RHS patterns is attached to an assert command and if */
/*   there is more than one assert command, then a progn command is   */
/*   wrapped around all of the assert commands.                       */
/**********************************************************************/
globle struct expr *BuildRHSAssert(logicalName,theToken,error,atLeastOne,
                                   readFirstParen,whereParsed)
  char *logicalName;
  struct token *theToken;
  int *error;
  int readFirstParen;
  int atLeastOne;
  char *whereParsed;
  {
   struct expr *lastOne, *nextOne, *assertList, *stub;
   *error = CLIPS_FALSE;

   /*===============================================================*/
   /* If the first parenthesis of the RHS fact pattern has not been */
   /* read yet, then get the next token. If a right parenthesis is  */
   /* encountered then exit (however, set the error return value if */
   /* at least one fact was expected).                              */
   /*===============================================================*/
   
   if (readFirstParen == CLIPS_FALSE)
     {
      if (theToken->type == RPAREN)
        {
         if (atLeastOne) 
           {
            *error = CLIPS_TRUE;
            SyntaxErrorMessage(whereParsed);
           }
         return(NULL);
        }
     }
     
   /*================================================*/
   /* Parse the facts until no more are encountered. */
   /*================================================*/
   
   lastOne = assertList = NULL;
   while ((nextOne = GetRHSPattern(logicalName,theToken,
                                   error,CLIPS_FALSE,readFirstParen,
                                   CLIPS_TRUE,RPAREN)) != NULL)
     {      
      PPCRAndIndent();

      stub = GenConstant(FCALL,(VOID *) FindFunction("assert"));
      stub->argList = nextOne;
      nextOne = stub;

      if (lastOne == NULL)
        { assertList = nextOne; }
      else
        { lastOne->nextArg = nextOne; }
      lastOne = nextOne;
      
      readFirstParen = CLIPS_TRUE;
     }
   
   /*======================================================*/
   /* If an error was detected while parsing, then return. */
   /*======================================================*/
   
   if (*error)
     {
      ReturnExpression(assertList);
      return(NULL);
     }

   /*======================================*/
   /* Fix the pretty print representation. */
   /*======================================*/
   
   if (theToken->type == RPAREN)
     {
      PPBackup();
      PPBackup();
      SavePPBuffer(")");
     }

   /*==============================================================*/
   /* If no facts are being asserted then return NULL. In addition */
   /* if at least one fact was required, then signal an error.     */
   /*==============================================================*/
   
   if (assertList == NULL)
     {
      if (atLeastOne) 
        {
         *error = CLIPS_TRUE;
         SyntaxErrorMessage(whereParsed);
        }
        
      return(NULL);
     }

   /*===============================================*/
   /* If more than one fact is being asserted, then */
   /* wrap the assert commands within a progn call. */
   /*===============================================*/
   
   if (assertList->nextArg != NULL)
     {
      stub = GenConstant(FCALL,(VOID *) FindFunction("progn"));
      stub->argList = assertList;
      assertList = stub;
     }

   /*==========================================================*/
   /* Return the expression for asserting the specified facts. */
   /*==========================================================*/
   
   return(assertList);
  }

#endif

/***************************************************************/
/* GetRHSPattern: Parses a single RHS fact pattern. The return */
/*   value is the fact just parsed (or NULL if the delimiter   */
/*   for no more facts is the first token parsed). If an error */
/*   occurs, then the error flag passed as an argument is set. */
/***************************************************************/
globle struct expr *GetRHSPattern(readSource,tempToken,error,
                                  constantsOnly,readFirstParen,
                                  checkFirstParen,endType)
  char *readSource;
  struct token *tempToken;
  int *error, constantsOnly, readFirstParen;
  int checkFirstParen, endType;
  {
   struct expr *lastOne = NULL;
   struct expr *nextOne, *firstOne, *argHead = NULL;
   int printError, count;
   struct deftemplate *theDeftemplate;
   struct symbolHashNode *templateName;
   
   /*=================================================*/
   /* Get the opening parenthesis of the RHS pattern. */
   /*=================================================*/

   *error = CLIPS_FALSE;
   
   if (readFirstParen) GetToken(readSource,tempToken);
      
   if (checkFirstParen)
     {
      if (tempToken->type == endType) return(NULL);
   
      if (tempToken->type != LPAREN)
        {
         SyntaxErrorMessage("RHS patterns");
         *error = CLIPS_TRUE;
         return(NULL);
        }
     }

   /*======================================================*/
   /* The first field of an asserted fact must be a symbol */
   /* (but not = or : which have special significance).    */
   /*======================================================*/
        
   GetToken(readSource,tempToken);
   if (tempToken->type != SYMBOL)
     {
      SyntaxErrorMessage("first field of a RHS pattern");
      *error = CLIPS_TRUE;
      return(NULL);
     }
   else if ((strcmp(ValueToString(tempToken->value),"=") == 0) ||
            (strcmp(ValueToString(tempToken->value),":") == 0))
     {
      SyntaxErrorMessage("first field of a RHS pattern");
      *error = CLIPS_TRUE;
      return(NULL);
     }
     
   /*=========================================================*/
   /* Check to see if the relation name is a reserved symbol. */
   /*=========================================================*/
   
   templateName = (struct symbolHashNode *) tempToken->value;
   
   if (ReservedPatternSymbol(ValueToString(templateName),NULL))
     {
      ReservedPatternSymbolErrorMsg(ValueToString(templateName),"a relation name");
      *error = CLIPS_TRUE;
      return(NULL);
     }

   /*============================================================*/
   /* A module separator in the name is illegal in this context. */
   /*============================================================*/
   
   if (FindModuleSeparator(ValueToString(templateName)))
     {
      IllegalModuleSpecifierMessage();
      
      *error = CLIPS_TRUE;
      return(NULL);
     }
        
   /*=============================================================*/
   /* Determine if there is an associated deftemplate. If so, let */
   /* the deftemplate parsing functions parse the RHS pattern and */
   /* then return the fact pattern that was parsed.               */                          
   /*=============================================================*/
   
   theDeftemplate = (struct deftemplate *) 
                    FindImportedConstruct("deftemplate",NULL,ValueToString(templateName),
                                          &count,CLIPS_TRUE,NULL);
                                             
   if (count > 1) 
     {
      AmbiguousReferenceErrorMessage("deftemplate",ValueToString(templateName));
      *error = CLIPS_TRUE;
      return(NULL);
     }
     
   /*======================================================*/
   /* If no deftemplate exists with the specified relation */
   /* name, then create an implied deftemplate.            */
   /*======================================================*/

   if (theDeftemplate == NULL)
#if (! BLOAD_ONLY) && (! RUN_TIME)   
     { 
#if BLOAD || BLOAD_AND_BSAVE
      if (Bloaded()) 
        {
         NoSuchTemplateError(ValueToString(templateName));
         *error = CLIPS_TRUE;
         return(NULL); 
        }
#endif