prdctfun.c

NASA 开发使用的一个专家系统

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.05  04/09/97            */
   /*                                                     */
   /*              PREDICATE FUNCTIONS MODULE             */
   /*******************************************************/

/*************************************************************/
/* Purpose: Contains the code for several predicate          */
/*   functions including not, and, or, eq, neq, <=, >=, <,   */
/*   >, =, <>, symbolp, stringp, lexemep, numberp, integerp, */
/*   floatp, oddp, evenp, multifieldp, sequencep, and        */
/*   pointerp.                                               */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/

#define _PRDCTFUN_SOURCE_

#include <stdio.h>
#define _CLIPS_STDIO_

#include "setup.h"

#include "exprnpsr.h"
#include "argacces.h"
#include "multifld.h"
#include "router.h"

#include "prdctfun.h"

#if ! RUN_TIME
/**************************************************/
/* PredicateFunctionDefinitions: Defines standard */
/*   math and predicate functions.                */
/**************************************************/
globle VOID PredicateFunctionDefinitions()
  {
   DefineFunction2("not", 'b', NotFunction, "NotFunction", "11");
   DefineFunction2("and", 'b', AndFunction, "AndFunction", "2*");
   DefineFunction2("or", 'b', OrFunction, "OrFunction", "2*");

   DefineFunction2("eq", 'b', EqFunction, "EqFunction", "2*");
   DefineFunction2("neq", 'b', NeqFunction, "NeqFunction", "2*");

   DefineFunction2("<=", 'b', LessThanOrEqualFunction, "LessThanOrEqualFunction", "2*n");
   DefineFunction2(">=", 'b', GreaterThanOrEqualFunction, "GreaterThanOrEqualFunction", "2*n");
   DefineFunction2("<", 'b', LessThanFunction, "LessThanFunction", "2*n");
   DefineFunction2(">", 'b', GreaterThanFunction, "GreaterThanFunction", "2*n");
   DefineFunction2("=", 'b', NumericEqualFunction, "NumericEqualFunction", "2*n");
   DefineFunction2("<>", 'b', NumericNotEqualFunction, "NumericNotEqualFunction", "2*n");
   DefineFunction2("!=", 'b', NumericNotEqualFunction, "NumericNotEqualFunction", "2*n");

   DefineFunction2("symbolp", 'b', SymbolpFunction, "SymbolpFunction", "11");
   DefineFunction2("wordp", 'b', SymbolpFunction, "SymbolpFunction", "11");
   DefineFunction2("stringp", 'b', StringpFunction, "StringpFunction", "11");
   DefineFunction2("lexemep", 'b', LexemepFunction, "LexemepFunction", "11");
   DefineFunction2("numberp", 'b', NumberpFunction, "NumberpFunction", "11");
   DefineFunction2("integerp", 'b', IntegerpFunction, "IntegerpFunction", "11");
   DefineFunction2("floatp", 'b', FloatpFunction, "FloatpFunction", "11");
   DefineFunction2("oddp", 'b', OddpFunction, "OddpFunction", "11i");
   DefineFunction2("evenp", 'b', EvenpFunction, "EvenpFunction", "11i");
   DefineFunction2("multifieldp",'b', MultifieldpFunction, "MultifieldpFunction", "11");
   DefineFunction2("sequencep",'b', MultifieldpFunction, "MultifieldpFunction", "11");
   DefineFunction2("pointerp", 'b', PointerpFunction, "PointerpFunction", "11");
  }
#endif

/************************************/
/* EqFunction: CLIPS access routine */
/*   for the eq function.           */
/************************************/
globle BOOLEAN EqFunction()
  {
   DATA_OBJECT item, nextItem;
   int numArgs, i;
   struct expr *theExpression;

   /*====================================*/
   /* Determine the number of arguments. */
   /*====================================*/
   
   numArgs = RtnArgCount();
   if (numArgs == 0) return(CLIPS_FALSE); 

   /*==============================================*/
   /* Get the value of the first argument against  */
   /* which subsequent arguments will be compared. */
   /*==============================================*/
   
   theExpression = GetFirstArgument();
   EvaluateExpression(theExpression,&item);
   
   /*=====================================*/
   /* Compare all arguments to the first. */
   /* If any are the same, return FALSE.  */
   /*=====================================*/
   
   theExpression = GetNextArgument(theExpression);
   for (i = 2 ; i <= numArgs ; i++)
     {
      EvaluateExpression(theExpression,&nextItem);
      
      if (GetType(nextItem) != GetType(item))
        { return(CLIPS_FALSE); }

      if (GetType(nextItem) == MULTIFIELD)
        {
         if (MultifieldDOsEqual(&nextItem,&item) == CLIPS_FALSE)
           { return(CLIPS_FALSE); }
        }
      else if (nextItem.value != item.value)
        { return(CLIPS_FALSE); }
        
      theExpression = GetNextArgument(theExpression);
     }

   /*=====================================*/
   /* All of the arguments were different */
   /* from the first. Return TRUE.        */
   /*=====================================*/
   
   return(CLIPS_TRUE);
  }

/*************************************/
/* NeqFunction: CLIPS access routine */
/*   for the neq function.           */
/*************************************/
globle BOOLEAN NeqFunction()
  {
   DATA_OBJECT item, nextItem;
   int numArgs, i;
   struct expr *theExpression;

   /*====================================*/
   /* Determine the number of arguments. */
   /*====================================*/
   
   numArgs = RtnArgCount();
   if (numArgs == 0) return(CLIPS_FALSE);
   
   /*==============================================*/
   /* Get the value of the first argument against  */
   /* which subsequent arguments will be compared. */
   /*==============================================*/
   
   theExpression = GetFirstArgument();
   EvaluateExpression(theExpression,&item);
   
   /*=====================================*/
   /* Compare all arguments to the first. */
   /* If any are different, return FALSE. */
   /*=====================================*/
   
   for (i = 2, theExpression = GetNextArgument(theExpression);
        i <= numArgs;
        i++, theExpression = GetNextArgument(theExpression))
     {
      EvaluateExpression(theExpression,&nextItem);
      if (GetType(nextItem) != GetType(item))
        { continue; }
      else if (nextItem.type == MULTIFIELD)
        {
         if (MultifieldDOsEqual(&nextItem,&item) == CLIPS_TRUE)
           { return(CLIPS_FALSE); }
        }
      else if (nextItem.value == item.value)
        { return(CLIPS_FALSE); }
     }

   /*=====================================*/
   /* All of the arguments were identical */
   /* to the first. Return TRUE.          */
   /*=====================================*/
   
   return(CLIPS_TRUE);
  }

/*****************************************/
/* StringpFunction: CLIPS access routine */
/*   for the stringp function.           */
/*****************************************/
globle BOOLEAN StringpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("stringp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if (GetType(item) == STRING)
     { return(CLIPS_TRUE); }
   else
     { return(CLIPS_FALSE); }
  }

/*****************************************/
/* SymbolpFunction: CLIPS access routine */
/*   for the symbolp function.           */
/*****************************************/
globle BOOLEAN SymbolpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("symbolp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if (GetType(item) == SYMBOL)
     { return(CLIPS_TRUE); }
   else
     { return(CLIPS_FALSE); }
  }

/*****************************************/
/* LexemepFunction: CLIPS access routine */
/*   for the lexemep function.           */
/*****************************************/
globle BOOLEAN LexemepFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("lexemep",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if ((GetType(item) == SYMBOL) || (GetType(item) == STRING))
     { return(CLIPS_TRUE); }
   else
     { return(CLIPS_FALSE); }
  }

/*****************************************/
/* NumberpFunction: CLIPS access routine */
/*   for the numberp function.           */
/*****************************************/
globle BOOLEAN NumberpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("numberp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if ((GetType(item) == FLOAT) || (GetType(item) == INTEGER))
     { return(CLIPS_TRUE); }
   else
     { return(CLIPS_FALSE); }
  }

/****************************************/
/* FloatpFunction: CLIPS access routine */
/*   for the floatp function.           */
/****************************************/
globle BOOLEAN FloatpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("floatp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if (GetType(item) == FLOAT)
     { return(CLIPS_TRUE); }
   else
     { return(CLIPS_FALSE); }
  }

/******************************************/
/* IntegerpFunction: CLIPS access routine */
/*   for the integerp function.           */
/******************************************/
globle BOOLEAN IntegerpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("integerp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if (GetType(item) != INTEGER) return(CLIPS_FALSE);

   return(CLIPS_TRUE);
  }

/*********************************************/
/* MultifieldpFunction: CLIPS access routine */
/*   for the multifieldp function.           */
/*********************************************/
globle BOOLEAN MultifieldpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("multifieldp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if (GetType(item) != MULTIFIELD) return(CLIPS_FALSE);

   return(CLIPS_TRUE);
  }

/******************************************/
/* PointerpFunction: CLIPS access routine */
/*   for the pointerp function.           */
/******************************************/
globle BOOLEAN PointerpFunction()
  {
   DATA_OBJECT item;

   if (ArgCountCheck("pointerp",EXACTLY,1) == -1) return(CLIPS_FALSE);

   RtnUnknown(1,&item);

   if (GetType(item) != EXTERNAL_ADDRESS) return(CLIPS_FALSE);

   return(CLIPS_TRUE);
  }

/*************************************/
/* NotFunction: CLIPS access routine */
/*   for the not function.           */
/*************************************/
globle BOOLEAN NotFunction()
  {
   EXPRESSION *theArgument;
   DATA_OBJECT result;

   theArgument = GetFirstArgument();
   if (theArgument == NULL) { return(CLIPS_FALSE); }

   if (EvaluateExpression(theArgument,&result)) return(CLIPS_FALSE);

   if ((result.value == CLIPSFalseSymbol) && (result.type == SYMBOL))
     { return(CLIPS_TRUE); }

   return(CLIPS_FALSE);
  }

/*************************************/
/* AndFunction: CLIPS access routine */
/*   for the and function.           */
/*************************************/
globle BOOLEAN AndFunction()
  {
   EXPRESSION *theArgument;
   DATA_OBJECT result;

   for (theArgument = GetFirstArgument();
        theArgument != NULL;
        theArgument = GetNextArgument(theArgument))
     {
      if (EvaluateExpression(theArgument,&result)) return(CLIPS_FALSE);
      if ((result.value == CLIPSFalseSymbol) && (result.type == SYMBOL))
        { return(CLIPS_FALSE); }
     }

   return(CLIPS_TRUE);
  }

/************************************/
/* OrFunction: CLIPS access routine */
/*   for the or function.           */
/************************************/
globle BOOLEAN OrFunction()
  {
   EXPRESSION *theArgument;
   DATA_OBJECT result;

   for (theArgument = GetFirstArgument();
        theArgument != NULL;
        theArgument = GetNextArgument(theArgument))
     {
      if (EvaluateExpression(theArgument,&result)) return(CLIPS_FALSE);

      if ((result.value != CLIPSFalseSymbol) || (result.type != SYMBOL))
        { return(CLIPS_TRUE); }
     }

   return(CLIPS_FALSE);
  }

/*****************************************/
/* LessThanOrEqualFunction: CLIPS access */
/*   routine for the <= function.        */
/*****************************************/
globle BOOLEAN LessThanOrEqualFunction()
  {
   EXPRESSION *theArgument;
   DATA_OBJECT rv1, rv2;
   int pos = 1;

   /*=========================*/
   /* Get the first argument. */
   /*=========================*/
   
   theArgument = GetFirstArgument();
   if (theArgument == NULL) { return(CLIPS_TRUE); }
   if (! GetNumericArgument(theArgument,"<=",&rv1,CLIPS_FALSE,pos)) return(CLIPS_FALSE);
   pos++;
   
   /*====================================================*/
   /* Compare each of the subsequent arguments to its    */
   /* predecessor. If any is greater, then return FALSE. */
   /*====================================================*/
   
   for (theArgument = GetNextArgument(theArgument);
        theArgument != NULL;
        theArgument = GetNextArgument(theArgument), pos++)
     {
      if (! GetNumericArgument(theArgument,"<=",&rv2,CLIPS_FALSE,pos)) return(CLIPS_FALSE);