/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.24  06/05/06            */   /*                                                     */   /*                FACT COMMANDS MODULE                 */   /*******************************************************//*************************************************************//* Purpose: Provides the facts, assert, retract, save-facts, *//*   load-facts, set-fact-duplication, get-fact-duplication, *//*   assert-string, and fact-index commands and functions.   *//*                                                           *//* Principal Programmer(s):                                  *//*      Gary D. Riley                                        *//*                                                           *//* Contributing Programmer(s):                               *//*      Brian L. Donnell                                     *//*                                                           *//* Revision History:                                         *//*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  *//*                                                           *//*      6.24: Added environment parameter to GenClose.       *//*            Added environment parameter to GenOpen.        *//*                                                           *//*            Renamed BOOLEAN macro type to intBool.         *//*                                                           *//*************************************************************/#include <stdio.h>#define _STDIO_INCLUDED_#include <string.h>#include "setup.h"#if DEFTEMPLATE_CONSTRUCT#define _FACTCOM_SOURCE_#include "memalloc.h"#include "envrnmnt.h"#include "exprnpsr.h"#include "factmngr.h"#include "argacces.h"#include "match.h"#include "router.h"#include "scanner.h"#include "constant.h"#include "factrhs.h"#include "factmch.h"#include "extnfunc.h"#include "tmpltpsr.h"#include "tmpltutl.h"#include "facthsh.h"#include "modulutl.h"#include "strngrtr.h"#include "tmpltdef.h"#include "tmpltfun.h"#include "sysdep.h"#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY#include "bload.h"#endif#include "factcom.h"#define INVALID     -2L#define UNSPECIFIED -1L/***************************************//* LOCAL INTERNAL FUNCTION DEFINITIONS *//***************************************/#if (! RUN_TIME)   static struct expr            *AssertParse(void *,struct expr *,char *);#endif#if DEBUGGING_FUNCTIONS   static long long               GetFactsArgument(void *,int,int);#endif   static struct expr            *StandardLoadFact(void *,char *,struct token *);   static DATA_OBJECT_PTR         GetSaveFactsDeftemplateNames(void *,struct expr *,int,int *,int *);/***************************************//* FactCommandDefinitions: Initializes *//*   fact commands and functions.      *//***************************************/globle void FactCommandDefinitions(  void *theEnv)  {#if ! RUN_TIME#if DEBUGGING_FUNCTIONS   EnvDefineFunction2(theEnv,"facts", 'v', PTIEF FactsCommand,        "FactsCommand", "*4iu");#endif   EnvDefineFunction(theEnv,"assert", 'u', PTIEF AssertCommand,  "AssertCommand");   EnvDefineFunction2(theEnv,"retract", 'v', PTIEF RetractCommand, "RetractCommand","1*z");   EnvDefineFunction2(theEnv,"assert-string", 'u', PTIEF AssertStringFunction,   "AssertStringFunction", "11s");   EnvDefineFunction2(theEnv,"str-assert", 'u', PTIEF AssertStringFunction,   "AssertStringFunction", "11s");   EnvDefineFunction2(theEnv,"get-fact-duplication",'b',                   GetFactDuplicationCommand,"GetFactDuplicationCommand", "00");   EnvDefineFunction2(theEnv,"set-fact-duplication",'b',                   SetFactDuplicationCommand,"SetFactDuplicationCommand", "11");   EnvDefineFunction2(theEnv,"save-facts", 'b', PTIEF SaveFactsCommand, "SaveFactsCommand", "1*wk");   EnvDefineFunction2(theEnv,"load-facts", 'b', PTIEF LoadFactsCommand, "LoadFactsCommand", "11k");   EnvDefineFunction2(theEnv,"fact-index", 'g', PTIEF FactIndexFunction,"FactIndexFunction", "11y");   AddFunctionParser(theEnv,"assert",AssertParse);   FuncSeqOvlFlags(theEnv,"assert",FALSE,FALSE);#else#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif#endif  }/***************************************//* AssertCommand: H/L access routine   *//*   for the assert function.          *//***************************************/globle void AssertCommand(  void *theEnv,  DATA_OBJECT_PTR rv)  {   struct deftemplate *theDeftemplate;   struct field *theField;   DATA_OBJECT theValue;   struct expr *theExpression;   struct templateSlot *slotPtr;   struct fact *newFact;   int error = FALSE;   int i;   struct fact *theFact;      /*===================================================*/   /* Set the default return value to the symbol FALSE. */   /*===================================================*/   SetpType(rv,SYMBOL);   SetpValue(rv,EnvFalseSymbol(theEnv));   /*================================*/   /* Get the deftemplate associated */   /* with the fact being asserted.  */   /*================================*/   theExpression = GetFirstArgument();   theDeftemplate = (struct deftemplate *) theExpression->value;   /*=======================================*/   /* Create the fact and store the name of */   /* the deftemplate as the 1st field.     */   /*=======================================*/   if (theDeftemplate->implied == FALSE)     {      newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots);      slotPtr = theDeftemplate->slotList;     }   else     {      newFact = CreateFactBySize(theEnv,1);      if (theExpression->nextArg == NULL)        {         newFact->theProposition.theFields[0].type = MULTIFIELD;         newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L);        }      slotPtr = NULL;     }   newFact->whichDeftemplate = theDeftemplate;   /*===================================================*/   /* Evaluate the expression associated with each slot */   /* and store the result in the appropriate slot of   */   /* the newly created fact.                           */   /*===================================================*/   theField = newFact->theProposition.theFields;   for (theExpression = theExpression->nextArg, i = 0;        theExpression != NULL;        theExpression = theExpression->nextArg, i++)     {      /*===================================================*/      /* Evaluate the expression to be stored in the slot. */      /*===================================================*/      EvaluateExpression(theEnv,theExpression,&theValue);      /*============================================================*/      /* A multifield value can't be stored in a single field slot. */      /*============================================================*/      if ((slotPtr != NULL) ?          (slotPtr->multislot == FALSE) && (theValue.type == MULTIFIELD) :          FALSE)        {         MultiIntoSingleFieldSlotError(theEnv,slotPtr,theDeftemplate);         theValue.type = SYMBOL;         theValue.value = EnvFalseSymbol(theEnv);         error = TRUE;        }      /*==============================*/      /* Store the value in the slot. */      /*==============================*/      theField[i].type = theValue.type;      theField[i].value = theValue.value;      /*========================================*/      /* Get the information for the next slot. */      /*========================================*/      if (slotPtr != NULL) slotPtr = slotPtr->next;     }   /*============================================*/   /* If an error occured while generating the   */   /* fact's slot values, then abort the assert. */   /*============================================*/   if (error)     {      ReturnFact(theEnv,newFact);      return;     }   /*================================*/   /* Add the fact to the fact-list. */   /*================================*/   theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact);   /*========================================*/   /* The asserted fact is the return value. */   /*========================================*/   if (theFact != NULL)     {      SetpType(rv,FACT_ADDRESS);      SetpValue(rv,(void *) theFact);     }   return;  }/****************************************//* RetractCommand: H/L access routine   *//*   for the retract command.           *//****************************************/globle void RetractCommand(  void *theEnv)  {   long long factIndex;   struct fact *ptr;   struct expr *theArgument;   DATA_OBJECT theResult;   int argNumber;   /*================================*/   /* Iterate through each argument. */   /*================================*/   for (theArgument = GetFirstArgument(), argNumber = 1;        theArgument != NULL;        theArgument = GetNextArgument(theArgument), argNumber++)     {      /*========================*/      /* Evaluate the argument. */      /*========================*/      EvaluateExpression(theEnv,theArgument,&theResult);      /*===============================================*/      /* If the argument evaluates to an integer, then */      /* it's assumed to be the fact index of the fact */      /* to be retracted.                              */      /*===============================================*/      if (theResult.type == INTEGER)        {         /*==========================================*/         /* A fact index must be a positive integer. */         /*==========================================*/         factIndex = ValueToLong(theResult.value);         if (factIndex < 0)           {            ExpectedTypeError1(theEnv,"retract",argNumber,"fact-address, fact-index, or the symbol *");            return;           }         /*================================================*/         /* See if a fact with the specified index exists. */         /*================================================*/         ptr = FindIndexedFact(theEnv,factIndex);         /*=====================================*/         /* If the fact exists then retract it, */         /* otherwise print an error message.   */         /*=====================================*/         if (ptr != NULL)           { EnvRetract(theEnv,(void *) ptr); }         else           {            char tempBuffer[20];            gensprintf(tempBuffer,"f-%lld",factIndex);            CantFindItemErrorMessage(theEnv,"fact",tempBuffer);           }        }      /*===============================================*/      /* Otherwise if the argument evaluates to a fact */      /* address, we can directly retract it.          */      /*===============================================*/      else if (theResult.type == FACT_ADDRESS)        { EnvRetract(theEnv,theResult.value); }      /*============================================*/      /* Otherwise if the argument evaluates to the */      /* symbol *, then all facts are retracted.    */      /*============================================*/      else if ((theResult.type == SYMBOL) ?               (strcmp(ValueToString(theResult.value),"*") == 0) : FALSE)        {         RemoveAllFacts(theEnv);         return;        }      /*============================================*/      /* Otherwise the argument has evaluated to an */      /* illegal value for the retract command.     */      /*============================================*/      else        {         ExpectedTypeError1(theEnv,"retract",argNumber,"fact-address, fact-index, or the symbol *");         SetEvaluationError(theEnv,TRUE);        }     }  }/***************************************************//* SetFactDuplicationCommand: H/L access routine   *//*   for the set-fact-duplication command.         *//***************************************************/globle int SetFactDuplicationCommand(  void *theEnv)  {   int oldValue;   DATA_OBJECT theValue;   /*=====================================================*/   /* Get the old value of the fact duplication behavior. */   /*=====================================================*/   oldValue = EnvGetFactDuplication(theEnv);   /*============================================*/   /* Check for the correct number of arguments. */   /*============================================*/   if (EnvArgCountCheck(theEnv,"set-fact-duplication",EXACTLY,1) == -1)     { return(oldValue); }   /*========================*/   /* Evaluate the argument. */   /*========================*/   EnvRtnUnknown(theEnv,1,&theValue);   /*===============================================================*/   /* If the argument evaluated to FALSE, then the fact duplication */   /* behavior is disabled, otherwise it is enabled.                */   /*===============================================================*/   if ((theValue.value == EnvFalseSymbol(theEnv)) && (theValue.type == SYMBOL))     { EnvSetFactDuplication(theEnv,FALSE); }   else     { EnvSetFactDuplication(theEnv,TRUE); }   /*========================================================*/   /* Return the old value of the fact duplication behavior. */   /*========================================================*/   return(oldValue);  }/***************************************************//* GetFactDuplicationCommand: H/L access routine   *//*   for the get-fact-duplication command.         *//***************************************************/globle int GetFactDuplicationCommand(  void *theEnv)  {   int currentValue;   /*=========================================================*/   /* Get the current value of the fact duplication behavior. */   /*=========================================================*/   currentValue = EnvGetFactDuplication(theEnv);   /*============================================*/   /* Check for the correct number of arguments. */   /*============================================*/   if (EnvArgCountCheck(theEnv,"get-fact-duplication",EXACTLY,0) == -1)     { return(currentValue); }   /*============================================================*/   /* Return the current value of the fact duplication behavior. */   /*============================================================*/   return(currentValue);  }/*******************************************//* FactIndexFunction: H/L access routine   *//*   for the fact-index function.          *//*******************************************/globle long long FactIndexFunction(  void *theEnv)  {   DATA_OBJECT item;   /*============================================*/