text:    /*******************************************************/
     /*      "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,
    EXEC_STATUS)
    {
  #if ! RUN_TIME
     EnvDefineFunction2(theEnv,execStatus,"fact-existp",  'b', PTIEF FactExistpFunction,  "FactExistpFunction", "11z");
     EnvDefineFunction2(theEnv,execStatus,"fact-relation",'w', PTIEF FactRelationFunction,"FactRelationFunction", "11z");
     EnvDefineFunction2(theEnv,execStatus,"fact-slot-value",'u', PTIEF FactSlotValueFunction,"FactSlotValueFunction", "22*zw");
     EnvDefineFunction2(theEnv,execStatus,"fact-slot-names",'u', PTIEF FactSlotNamesFunction,"FactSlotNamesFunction", "11z");
     EnvDefineFunction2(theEnv,execStatus,"get-fact-list",'m',PTIEF GetFactListFunction,"GetFactListFunction","01w");
     EnvDefineFunction2(theEnv,execStatus,"ppfact",'v',PTIEF PPFactFunction,"PPFactFunction","13*z");
  #else
  #if MAC_MCW || WIN_MCW || MAC_XCD
  #pragma unused(theEnv,execStatus)
  #endif
  #endif
    }
  
  /**********************************************/
  /* FactRelationFunction: H/L access routine   */
  /*   for the fact-relation function.          */
  /**********************************************/
  globle void *FactRelationFunction(
    void *theEnv,
    EXEC_STATUS)
    {
     struct fact *theFact;
  
     if (EnvArgCountCheck(theEnv,execStatus,"fact-relation",EXACTLY,1) == -1) return(EnvFalseSymbol(theEnv,execStatus));
  
     theFact = GetFactAddressOrIndexArgument(theEnv,execStatus,"fact-relation",1,FALSE);
  
     if (theFact == NULL) return(EnvFalseSymbol(theEnv,execStatus));
  
     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 WIN_BTC
  #pragma argsused
  #endif
  globle void *EnvFactDeftemplate(
    void *theEnv,
    EXEC_STATUS,
    void *vTheFact)
    {
  #if MAC_MCW || WIN_MCW || MAC_XCD
  #pragma unused(theEnv,execStatus)
  #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,
    EXEC_STATUS)
    {
     struct fact *theFact;
  
     if (EnvArgCountCheck(theEnv,execStatus,"fact-existp",EXACTLY,1) == -1) return(-1L);
  
     theFact = GetFactAddressOrIndexArgument(theEnv,execStatus,"fact-existp",1,FALSE);
  
     return(EnvFactExistp(theEnv,execStatus,theFact));
    }
  
  /***********************************/
  /* EnvFactExistp: C access routine */
  /*   for the fact-existp function. */
  /***********************************/
  #if WIN_BTC
  #pragma argsused
  #endif
  globle int EnvFactExistp(
    void *theEnv,
    EXEC_STATUS,
    void *vTheFact)
    {
  #if MAC_MCW || WIN_MCW || MAC_XCD
  #pragma unused(theEnv,execStatus)
  #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,
    EXEC_STATUS,
    DATA_OBJECT *returnValue)
    {
     struct fact *theFact;
     DATA_OBJECT theValue;
  
     /*=============================================*/
     /* Set up the default return value for errors. */
     /*=============================================*/
  
     returnValue->type = SYMBOL;
     returnValue->value = EnvFalseSymbol(theEnv,execStatus);
  
     /*============================================*/
     /* Check for the correct number of arguments. */
     /*============================================*/
  
     if (EnvArgCountCheck(theEnv,execStatus,"fact-slot-value",EXACTLY,2) == -1) return;
  
     /*================================*/
     /* Get the reference to the fact. */
     /*================================*/
  
     theFact = GetFactAddressOrIndexArgument(theEnv,execStatus,"fact-slot-value",1,TRUE);
     if (theFact == NULL) return;
  
     /*===========================*/
     /* Get the name of the slot. */
     /*===========================*/
  
     if (EnvArgTypeCheck(theEnv,execStatus,"fact-slot-value",2,SYMBOL,&theValue) == FALSE)
       { return; }
  
     /*=======================*/
     /* Get the slot's value. */
     /*=======================*/
  
     FactSlotValue(theEnv,execStatus,theFact,DOToString(theValue),returnValue);
    }
  
  /***************************************/
  /* FactSlotValue: C access routine for */
  /*   the fact-slot-value function.     */
  /***************************************/
  globle void FactSlotValue(
    void *theEnv,
    EXEC_STATUS,
    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,execStatus,TRUE);
           InvalidDeftemplateSlotMessage(theEnv,execStatus,theSlotName,
                                         ValueToString(theFact->whichDeftemplate->header.name),FALSE);
           return;
          }
       }
  
     else if (FindSlot(theFact->whichDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,theSlotName),&position) == NULL)
       {
        SetEvaluationError(theEnv,execStatus,TRUE);
        InvalidDeftemplateSlotMessage(theEnv,execStatus,theSlotName,
                                      ValueToString(theFact->whichDeftemplate->header.name),FALSE);
        return;
       }
  
     /*==========================*/
     /* Return the slot's value. */
     /*==========================*/
  
     if (theFact->whichDeftemplate->implied)
       { EnvGetFactSlot(theEnv,execStatus,theFact,NULL,returnValue); }
     else
       { EnvGetFactSlot(theEnv,execStatus,theFact,theSlotName,returnValue); }
    }
  
  /***********************************************/
  /* FactSlotNamesFunction: H/L access routine   */
  /*   for the fact-slot-names function.         */
  /***********************************************/
  globle void FactSlotNamesFunction(
    void *theEnv,
    EXEC_STATUS,
    DATA_OBJECT *returnValue)
    {
     struct fact *theFact;
  
     /*=============================================*/
     /* Set up the default return value for errors. */
     /*=============================================*/
  
     returnValue->type = SYMBOL;
     returnValue->value = EnvFalseSymbol(theEnv,execStatus);
  
     /*============================================*/
     /* Check for the correct number of arguments. */
     /*============================================*/
  
     if (EnvArgCountCheck(theEnv,execStatus,"fact-slot-names",EXACTLY,1) == -1) return;
  
     /*================================*/
     /* Get the reference to the fact. */
     /*================================*/
  
     theFact = GetFactAddressOrIndexArgument(theEnv,execStatus,"fact-slot-names",1,TRUE);
     if (theFact == NULL) return;
  
     /*=====================*/
     /* Get the slot names. */
     /*=====================*/
  
     EnvFactSlotNames(theEnv,execStatus,theFact,returnValue);
    }
  
  /***************************************/
  /* EnvFactSlotNames: C access routine  */
  /*   for the fact-slot-names function. */
  /***************************************/
  globle void EnvFactSlotNames(
    void *theEnv,
    EXEC_STATUS,
    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)
       {
        SetpType(returnValue,MULTIFIELD);
        SetpDOBegin(returnValue,1);
        SetpDOEnd(returnValue,1);
        theList = (struct multifield *) EnvCreateMultifield(theEnv,execStatus,(int) 1);
        SetMFType(theList,1,SYMBOL);
        SetMFValue(theList,1,EnvAddSymbol(theEnv,execStatus,"implied"));
        SetpValue(returnValue,(void *) theList);
        return;
       }
  
     /*=================================*/
     /* Count the number of slot names. */
     /*=================================*/
  
     for (count = 0, theSlot = theFact->whichDeftemplate->slotList;
          theSlot != NULL;
          count++, theSlot = theSlot->next)
       { /* Do Nothing */ }
  
     /*=============================================================*/
     /* Create a multifield value in which to store the slot names. */
     /*=============================================================*/
  
     SetpType(returnValue,MULTIFIELD);
     SetpDOBegin(returnValue,1);
     SetpDOEnd(returnValue,(long) count);
     theList = (struct multifield *) EnvCreateMultifield(theEnv,execStatus,count);
     SetpValue(returnValue,(void *) theList);
  
     /*===============================================*/
     /* Store the slot names in the multifield value. */
     /*===============================================*/
  
     for (count = 1, theSlot = theFact->whichDeftemplate->slotList;
          theSlot != NULL;
          count++, theSlot = theSlot->next)
       {
        SetMFType(theList,count,SYMBOL);
        SetMFValue(theList,count,theSlot->slotName);
       }
    }
  
  /*********************************************/
  /* GetFactListFunction: H/L access routine   */
  /*   for the get-fact-list function.         */
  /*********************************************/
  globle void GetFactListFunction(
    void *theEnv,
    EXEC_STATUS,
    DATA_OBJECT_PTR returnValue)
    {
     struct defmodule *theModule;
     DATA_OBJECT result;
     int numArgs;
  
     /*===========================================*/
     /* Determine if a module name was specified. */
     /*===========================================*/
  
     if ((numArgs = EnvArgCountCheck(theEnv,execStatus,"get-fact-list",NO_MORE_THAN,1)) == -1)
       {
        EnvSetMultifieldErrorValue(theEnv,execStatus,returnValue);
        return;
       }
  
     if (numArgs == 1)
       {
        EnvRtnUnknown(theEnv,execStatus,1,&result);
  
        if (GetType(result) != SYMBOL)
          {
           EnvSetMultifieldErrorValue(theEnv,execStatus,returnValue);
           ExpectedTypeError1(theEnv,execStatus,"get-fact-list",1,"defmodule name");
           return;
          }
  
        if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,DOToString(result))) == NULL)
          {
           if (strcmp("*",DOToString(result)) != 0)
             {
              EnvSetMultifieldErrorValue(theEnv,execStatus,returnValue);
              ExpectedTypeError1(theEnv,execStatus,"get-fact-list",1,"defmodule name");
              return;
             }
  
           theModule = NULL;
          }
       }
     else
       { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus)); }
  
     /*=====================*/
     /* Get the constructs. */
     /*=====================*/
  
     EnvGetFactList(theEnv,execStatus,returnValue,theModule);
    }
  
  /*************************************/
  /* EnvGetFactList: C access routine  */
  /*   for the get-fact-list function. */
  /*************************************/
  globle void EnvGetFactList(
    void *theEnv,
    EXEC_STATUS,
    DATA_OBJECT_PTR returnValue,
    void *vTheModule)
    {
     struct fact *theFact;
     unsigned long count;
     struct multifield *theList;
     struct defmodule *theModule = (struct defmodule *) vTheModule;
  
     /*==========================*/
     /* Save the current module. */
     /*==========================*/
  
     SaveCurrentModule(theEnv,execStatus);
  
     /*============================================*/
     /* Count the number of facts to be retrieved. */
     /*============================================*/
  
     if (theModule == NULL)
       {
        for (theFact = (struct fact *) EnvGetNextFact(theEnv,execStatus,NULL), count = 0;
             theFact != NULL;
             theFact = (struct fact *) EnvGetNextFact(theEnv,execStatus,theFact), count++)
          { /* Do Nothing */ }
       }
     else
       {
        EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
        UpdateDeftemplateScope(theEnv,execStatus);
        for (theFact = (struct fact *) GetNextFactInScope(theEnv,execStatus,NULL), count = 0;
             theFact != NULL;
             theFact = (struct fact *) GetNextFactInScope(theEnv,execStatus,theFact), count++)
          { /* Do Nothing */ }
       }
  
     /*===========================================================*/
     /* Create the multifield value to store the construct names. */
     /*===========================================================*/
  
     SetpType(returnValue,MULTIFIELD);
     SetpDOBegin(returnValue,1);
     SetpDOEnd(returnValue,(long) count);
     theList = (struct multifield *) EnvCreateMultifield(theEnv,execStatus,count);
     SetpValue(returnValue,(void *) theList);
  
     /*==================================================*/
     /* Store the fact pointers in the multifield value. */
     /*==================================================*/
  
     if (theModule == NULL)
       {
        for (theFact = (struct fact *) EnvGetNextFact(theEnv,execStatus,NULL), count = 1;
             theFact != NULL;
             theFact = (struct fact *) EnvGetNextFact(theEnv,execStatus,theFact), count++)
          {
           SetMFType(theList,count,FACT_ADDRESS);
           SetMFValue(theList,count,(void *) theFact);
          }
       }
     else
       {
        for (theFact = (struct fact *) GetNextFactInScope(theEnv,execStatus,NULL), count = 1;
             theFact != NULL;
             theFact = (struct fact *) GetNextFactInScope(theEnv,execStatus,theFact), count++)
          {
           SetMFType(theList,count,FACT_ADDRESS);
           SetMFValue(theList,count,(void *) theFact);
          }
       }
  
     /*=============================*/
     /* Restore the current module. */
     /*=============================*/
  
     RestoreCurrentModule(theEnv,execStatus);
     UpdateDeftemplateScope(theEnv,execStatus);
    }
    
  /**************************************/
  /* PPFactFunction: H/L access routine */
  /*   for the ppfact function.         */
  /**************************************/
  globle void PPFactFunction(
    void *theEnv,
    EXEC_STATUS)
    {
     struct fact *theFact;
     int numberOfArguments;
  #if WIN_BTC
     char *logicalName;             /* Avoids warning */
  #else
     char *logicalName = NULL;      /* Avoids warning */
  #endif
     int ignoreDefaults = FALSE;
     DATA_OBJECT theArg;
  
     if ((numberOfArguments = EnvArgRangeCheck(theEnv,execStatus,"ppfact",1,3)) == -1) return;
  
     theFact = GetFactAddressOrIndexArgument(theEnv,execStatus,"ppfact",1,TRUE);
     if (theFact == NULL) return;
  
     /*===============================================================*/
     /* Determine the logical name to which the fact will be printed. */
     /*===============================================================*/
  
     if (numberOfArguments == 1)
       { logicalName = "stdout"; }
     else
       {
        logicalName = GetLogicalName(theEnv,execStatus,2,"stdout");
        if (logicalName == NULL)
          {
           IllegalLogicalNameMessage(theEnv,execStatus,"ppfact");
           SetHaltExecution(theEnv,execStatus,TRUE);
           SetEvaluationError(theEnv,execStatus,TRUE);
           return;
          }
       }
       
     /*=========================================*/
     /* Should slot values be printed if they   */
     /* are the same as the default slot value. */
     /*=========================================*/
     
     if (numberOfArguments == 3)
       {
        EnvRtnUnknown(theEnv,execStatus,3,&theArg);
  
        if ((theArg.value == EnvFalseSymbol(theEnv,execStatus)) && (theArg.type == SYMBOL))
          { ignoreDefaults = FALSE; }
        else
          { ignoreDefaults = TRUE; }
       }
     
     /*============================================================*/
     /* Determine if any router recognizes the output destination. */
     /*============================================================*/
  
     if (strcmp(logicalName,"nil") == 0)
       { return; }
     else if (QueryRouters(theEnv,execStatus,logicalName) == FALSE)
       {
        UnrecognizedRouterMessage(theEnv,execStatus,logicalName);
        return;
       }
  
     EnvPPFact(theEnv,execStatus,theFact,logicalName,ignoreDefaults);
    }
  
  /*******************************/
  /* EnvPPFact: C access routine */
  /*   for the ppfact function.  */
  /*******************************/
  #if WIN_BTC
  #pragma argsused
  #endif
  globle void EnvPPFact(
    void *theEnv,
    EXEC_STATUS,
    void *vTheFact,
    char *logicalName,
    int ignoreDefaults)
    {
  #if MAC_MCW || WIN_MCW || MAC_XCD
  #pragma unused(theEnv,execStatus)
  #endif
     struct fact *theFact = (struct fact *) vTheFact;
  
     if (theFact == NULL) return;
  
     if (theFact->garbage) return;
  
     PrintFact(theEnv,execStatus,logicalName,theFact,TRUE,ignoreDefaults);
     
     EnvPrintRouter(theEnv,execStatus,logicalName,"\n");
    }
    
  /**************************************************************/
  /* GetFactAddressOrIndexArgument: Retrieves an argument for a */
  /*   function which should be a reference to a valid fact.    */
  /**************************************************************/
  globle struct fact *GetFactAddressOrIndexArgument(
    void *theEnv,
    EXEC_STATUS,
    char *theFunction,
    int position,
    int noFactError)
    {
     DATA_OBJECT item;
     long long factIndex;
     struct fact *theFact;
     char tempBuffer[20];
  
     EnvRtnUnknown(theEnv,execStatus,position,&item);
  
     if (GetType(item) == FACT_ADDRESS)
       {
        if (((struct fact *) GetValue(item))->garbage) return(NULL);
        else return (((struct fact *) GetValue(item)));
       }
     else if (GetType(item) == INTEGER)
       {
        factIndex = ValueToLong(item.value);
        if (factIndex < 0)
          {
           ExpectedTypeError1(theEnv,execStatus,theFunction,position,"fact-address or fact-index");
           return(NULL);
          }
  
        theFact = FindIndexedFact(theEnv,execStatus,factIndex);
        if ((theFact == NULL) && noFactError)
          {
           gensprintf(tempBuffer,"f-%lld",factIndex);
           CantFindItemErrorMessage(theEnv,execStatus,"fact",tempBuffer);
           return(NULL);
          }
  
        return(theFact);
       }
  
     ExpectedTypeError1(theEnv,execStatus,theFunction,position,"fact-address or fact-index");
     return(NULL);
    }
  
  #endif /* DEFTEMPLATE_CONSTRUCT */
  
  
  