factfun.c

clips源代码

   /*******************************************************/
   /*      "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
#endif
globle 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
#endif
globle 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)