/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.24  06/05/06            */   /*                                                     */   /*               FACT FUNCTIONS MODULE                 */   /*******************************************************//*************************************************************//* Purpose:                                                  *//*                                                           *//*                                                           *//* (fact-existp <fact-address-or-index>)                     *//*    Returns TRUE if the fact exists, otherwise FALSE is    *//*    returned.                                              *//*                                                           *//* (fact-relation <fact-address-or-index>)                   *//*    Returns the deftemplate name of the fact. Returns      *//*    False if the specified fact doesn't exist.             *//*                                                           *//* (fact-slot-value <fact-address-or-index> <slot-name>)     *//*    Returns the contents of a slot (use the slot name      *//*    implied for the implied multifield slot of an ordered  *//*    fact). Returns the value FALSE if the slot name is     *//*    invalid or the fact doesn't exist.                     *//*                                                           *//* (fact-slot-names <fact-address-or-index>)                 *//*    Returns the slot names associated with a fact in a     *//*    multifield value. Returns FALSE if the fact doesn't    *//*    exist.                                                 *//*                                                           *//* (get-fact-list [<module-name>])                           *//*    Returns the list of facts visible to the specified     *//*    module or to the current module if none is specified.  *//*    If * is specified then all facts are returned.         *//*                                                           *//* Principal Programmer(s):                                  *//*      Gary D. Riley                                        *//*                                                           *//* Contributing Programmer(s):                               *//*                                                           *//* Revision History:                                         *//*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  *//*                                                           *//*            Corrected compilation errors for files         *//*            generated by constructs-to-c. DR0861           *//*                                                           *//*      6.24: Added ppfact function.                         *//*                                                           *//*************************************************************/#include <stdio.h>#define _STDIO_INCLUDED_#include <string.h>#include "setup.h"#if DEFTEMPLATE_CONSTRUCT#define _FACTFUN_SOURCE_#include "extnfunc.h"#include "envrnmnt.h"#include "argacces.h"#include "prntutil.h"#include "tmpltutl.h"#include "router.h"#include "sysdep.h"#include "factfun.h"/****************************************************//* FactFunctionDefinitions: Defines fact functions. *//****************************************************/globle void FactFunctionDefinitions(  void *theEnv)  {#if ! RUN_TIME   EnvDefineFunction2(theEnv,"fact-existp",  'b', PTIEF FactExistpFunction,  "FactExistpFunction", "11z");   EnvDefineFunction2(theEnv,"fact-relation",'w', PTIEF FactRelationFunction,"FactRelationFunction", "11z");   EnvDefineFunction2(theEnv,"fact-slot-value",'u', PTIEF FactSlotValueFunction,"FactSlotValueFunction", "22*zw");   EnvDefineFunction2(theEnv,"fact-slot-names",'u', PTIEF FactSlotNamesFunction,"FactSlotNamesFunction", "11z");   EnvDefineFunction2(theEnv,"get-fact-list",'m',PTIEF GetFactListFunction,"GetFactListFunction","01w");   EnvDefineFunction2(theEnv,"ppfact",'v',PTIEF PPFactFunction,"PPFactFunction","13*z");#else#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif#endif  }/**********************************************//* FactRelationFunction: H/L access routine   *//*   for the fact-relation function.          *//**********************************************/globle void *FactRelationFunction(  void *theEnv)  {   struct fact *theFact;   if (EnvArgCountCheck(theEnv,"fact-relation",EXACTLY,1) == -1) return(EnvFalseSymbol(theEnv));   theFact = GetFactAddressOrIndexArgument(theEnv,"fact-relation",1,FALSE);   if (theFact == NULL) return(EnvFalseSymbol(theEnv));   return(FactRelation(theFact));  }/**************************************//* FactRelation: C access routine for *//*   the fact-relation function.      *//**************************************/globle void *FactRelation(  void *vTheFact)  {   struct fact *theFact = (struct fact *) vTheFact;   return((void *) theFact->whichDeftemplate->header.name);  }  /****************************************//* EnvFactDeftemplate: C access routine *//*   to retrieve a fact's deftemplate.  *//****************************************/#if IBM_TBC#pragma argsused#endifgloble void *EnvFactDeftemplate(  void *theEnv,  void *vTheFact)  {#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif   struct fact *theFact = (struct fact *) vTheFact;   return((void *) theFact->whichDeftemplate);  }/********************************************//* FactExistpFunction: H/L access routine   *//*   for the fact-existp function.          *//********************************************/globle int FactExistpFunction(  void *theEnv)  {   struct fact *theFact;   if (EnvArgCountCheck(theEnv,"fact-existp",EXACTLY,1) == -1) return(-1L);   theFact = GetFactAddressOrIndexArgument(theEnv,"fact-existp",1,FALSE);   return(EnvFactExistp(theEnv,theFact));  }/***********************************//* EnvFactExistp: C access routine *//*   for the fact-existp function. *//***********************************/#if IBM_TBC#pragma argsused#endifgloble int EnvFactExistp(  void *theEnv,  void *vTheFact)  {#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif   struct fact *theFact = (struct fact *) vTheFact;   if (theFact == NULL) return(FALSE);   if (theFact->garbage) return(FALSE);   return(TRUE);  }/***********************************************//* FactSlotValueFunction: H/L access routine   *//*   for the fact-slot-value function.         *//***********************************************/globle void FactSlotValueFunction(  void *theEnv,  DATA_OBJECT *returnValue)  {   struct fact *theFact;   DATA_OBJECT theValue;   /*=============================================*/   /* Set up the default return value for errors. */   /*=============================================*/   returnValue->type = SYMBOL;   returnValue->value = EnvFalseSymbol(theEnv);   /*============================================*/   /* Check for the correct number of arguments. */   /*============================================*/   if (EnvArgCountCheck(theEnv,"fact-slot-value",EXACTLY,2) == -1) return;   /*================================*/   /* Get the reference to the fact. */   /*================================*/   theFact = GetFactAddressOrIndexArgument(theEnv,"fact-slot-value",1,TRUE);   if (theFact == NULL) return;   /*===========================*/   /* Get the name of the slot. */   /*===========================*/   if (EnvArgTypeCheck(theEnv,"fact-slot-value",2,SYMBOL,&theValue) == FALSE)     { return; }   /*=======================*/   /* Get the slot's value. */   /*=======================*/   FactSlotValue(theEnv,theFact,DOToString(theValue),returnValue);  }/***************************************//* FactSlotValue: C access routine for *//*   the fact-slot-value function.     *//***************************************/globle void FactSlotValue(  void *theEnv,  void *vTheFact,  char *theSlotName,  DATA_OBJECT *returnValue)  {   struct fact *theFact = (struct fact *) vTheFact;   short position;   /*==================================================*/   /* Make sure the slot exists (the symbol implied is */   /* used for the implied slot of an ordered fact).   */   /*==================================================*/   if (theFact->whichDeftemplate->implied)     {      if (strcmp(theSlotName,"implied") != 0)        {         SetEvaluationError(theEnv,TRUE);         InvalidDeftemplateSlotMessage(theEnv,theSlotName,                                       ValueToString(theFact->whichDeftemplate->header.name),FALSE);         return;        }     }   else if (FindSlot(theFact->whichDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,theSlotName),&position) == NULL)     {      SetEvaluationError(theEnv,TRUE);      InvalidDeftemplateSlotMessage(theEnv,theSlotName,                                    ValueToString(theFact->whichDeftemplate->header.name),FALSE);      return;     }   /*==========================*/   /* Return the slot's value. */   /*==========================*/   if (theFact->whichDeftemplate->implied)     { EnvGetFactSlot(theEnv,theFact,NULL,returnValue); }   else     { EnvGetFactSlot(theEnv,theFact,theSlotName,returnValue); }  }/***********************************************//* FactSlotNamesFunction: H/L access routine   *//*   for the fact-slot-names function.         *//***********************************************/globle void FactSlotNamesFunction(  void *theEnv,  DATA_OBJECT *returnValue)  {   struct fact *theFact;   /*=============================================*/   /* Set up the default return value for errors. */   /*=============================================*/   returnValue->type = SYMBOL;   returnValue->value = EnvFalseSymbol(theEnv);   /*============================================*/   /* Check for the correct number of arguments. */   /*============================================*/   if (EnvArgCountCheck(theEnv,"fact-slot-names",EXACTLY,1) == -1) return;   /*================================*/   /* Get the reference to the fact. */   /*================================*/   theFact = GetFactAddressOrIndexArgument(theEnv,"fact-slot-names",1,TRUE);   if (theFact == NULL) return;   /*=====================*/   /* Get the slot names. */   /*=====================*/   EnvFactSlotNames(theEnv,theFact,returnValue);  }/***************************************//* EnvFactSlotNames: C access routine  *//*   for the fact-slot-names function. *//***************************************/globle void EnvFactSlotNames(  void *theEnv,  void *vTheFact,  DATA_OBJECT *returnValue)  {   struct fact *theFact = (struct fact *) vTheFact;   struct multifield *theList;   struct templateSlot *theSlot;   unsigned long count;   /*===============================================*/   /* If we're dealing with an implied deftemplate, */   /* then the only slot names is "implied."        */   /*===============================================*/   if (theFact->whichDeftemplate->implied)