/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.21  06/15/03            */   /*                                                     */   /*            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 _STDIO_INCLUDED_#include <string.h>#include "setup.h"#if DEFTEMPLATE_CONSTRUCT#include "constant.h"#include "envrnmnt.h"#include "extnfunc.h"#include "modulutl.h"#include "modulpsr.h"#include "pattern.h"#include "prntutil.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   static void                       NoSuchTemplateError(void *,char *);#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(  void *theEnv,  char *logicalName,  struct token *theToken,  int *error,  int atLeastOne,  int readFirstParen,  char *whereParsed)  {   struct expr *lastOne, *nextOne, *assertList, *stub;   *error = 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 == FALSE)     {      if (theToken->type == RPAREN)        {         if (atLeastOne)           {            *error = TRUE;            SyntaxErrorMessage(theEnv,whereParsed);           }         return(NULL);        }     }   /*================================================*/   /* Parse the facts until no more are encountered. */   /*================================================*/   lastOne = assertList = NULL;   while ((nextOne = GetRHSPattern(theEnv,logicalName,theToken,                                   error,FALSE,readFirstParen,                                   TRUE,RPAREN)) != NULL)     {      PPCRAndIndent(theEnv);      stub = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"assert"));      stub->argList = nextOne;      nextOne = stub;      if (lastOne == NULL)        { assertList = nextOne; }      else        { lastOne->nextArg = nextOne; }      lastOne = nextOne;      readFirstParen = TRUE;     }   /*======================================================*/   /* If an error was detected while parsing, then return. */   /*======================================================*/   if (*error)     {      ReturnExpression(theEnv,assertList);      return(NULL);     }   /*======================================*/   /* Fix the pretty print representation. */   /*======================================*/   if (theToken->type == RPAREN)     {      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,")");     }   /*==============================================================*/   /* 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 = TRUE;         SyntaxErrorMessage(theEnv,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(theEnv,FCALL,(void *) FindFunction(theEnv,"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(  void *theEnv,  char *readSource,  struct token *tempToken,  int *error,  int constantsOnly,  int readFirstParen,  int checkFirstParen,  int 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 = FALSE;   if (readFirstParen) GetToken(theEnv,readSource,tempToken);   if (checkFirstParen)     {      if (tempToken->type == endType) return(NULL);      if (tempToken->type != LPAREN)        {         SyntaxErrorMessage(theEnv,"RHS patterns");         *error = TRUE;         return(NULL);        }     }   /*======================================================*/   /* The first field of an asserted fact must be a symbol */   /* (but not = or : which have special significance).    */   /*======================================================*/   GetToken(theEnv,readSource,tempToken);   if (tempToken->type != SYMBOL)     {      SyntaxErrorMessage(theEnv,"first field of a RHS pattern");      *error = TRUE;      return(NULL);     }   else if ((strcmp(ValueToString(tempToken->value),"=") == 0) ||            (strcmp(ValueToString(tempToken->value),":") == 0))     {      SyntaxErrorMessage(theEnv,"first field of a RHS pattern");      *error = TRUE;      return(NULL);     }   /*=========================================================*/   /* Check to see if the relation name is a reserved symbol. */   /*=========================================================*/   templateName = (struct symbolHashNode *) tempToken->value;   if (ReservedPatternSymbol(theEnv,ValueToString(templateName),NULL))     {      ReservedPatternSymbolErrorMsg(theEnv,ValueToString(templateName),"a relation name");      *error = TRUE;      return(NULL);     }   /*============================================================*/   /* A module separator in the name is illegal in this context. */   /*============================================================*/   if (FindModuleSeparator(ValueToString(templateName)))     {      IllegalModuleSpecifierMessage(theEnv);      *error = 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(theEnv,"deftemplate",NULL,ValueToString(templateName),                                          &count,TRUE,NULL);   if (count > 1)     {      AmbiguousReferenceErrorMessage(theEnv,"deftemplate",ValueToString(templateName));      *error = 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(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))        {         NoSuchTemplateError(theEnv,ValueToString(templateName));         *error = TRUE;         return(NULL);        }#endif#if DEFMODULE_CONSTRUCT      if (FindImportExportConflict(theEnv,"deftemplate",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(templateName)))        {         ImportExportConflictMessage(theEnv,"implied deftemplate",ValueToString(templateName),NULL,NULL);         *error = TRUE;         return(NULL);        }#endif      if (! ConstructData(theEnv)->CheckSyntaxMode)