evaluatn.c

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

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

/*************************************************************/
/* Purpose: Provides routines for evaluating expressions.    */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/

#define _EVALUATN_SOURCE_

#include <stdio.h>
#define _CLIPS_STDIO_
#include <string.h>
#include <ctype.h>

#include "setup.h"
#include "constant.h"
#include "clipsmem.h"
#include "router.h"
#include "extnfunc.h"
#include "prcdrfun.h"
#include "multifld.h"
#include "factmngr.h"
#include "prntutil.h"
#include "exprnpsr.h"
#include "utility.h"
#include "commline.h"

#if DEFFUNCTION_CONSTRUCT
#include "dffnxfun.h"
#endif

#if DEFGENERIC_CONSTRUCT
#include "genrccom.h"
#endif

#if OBJECT_SYSTEM
#include "object.h"
#endif

#include "evaluatn.h"

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

#if ANSI_COMPILER
   static VOID                    PropagateReturnAtom(int,VOID *);
#else
   static VOID                    PropagateReturnAtom();
#endif

/****************************************/
/* GLOBAL INTERNAL VARIABLE DEFINITIONS */
/****************************************/

   globle struct expr          *CurrentExpression = NULL;
   globle int                   EvaluationError = CLIPS_FALSE;
   globle int                   HaltExecution = CLIPS_FALSE;
   globle int                   CurrentEvaluationDepth = 0;
   globle struct entityRecord  *PrimitivesArray[70];

/*******************************************************************/
/* EvaluateExpression: Evaluates a CLIPS expression. Returns FALSE */
/*   if no errors occurred during evaluation, otherwise TRUE.      */
/*******************************************************************/
globle int EvaluateExpression(problem,returnValue)
  struct expr *problem;
  DATA_OBJECT_PTR returnValue;
  {
   struct expr *oldArgument;
   struct FunctionDefinition *fptr;
        
   if (problem == NULL)
     {
      returnValue->type = SYMBOL;
      returnValue->value = CLIPSFalseSymbol;
      return(EvaluationError);
     }

   switch (problem->type)
     {
      case STRING:
      case SYMBOL:
      case FLOAT:
      case INTEGER:
#if OBJECT_SYSTEM
      case INSTANCE_NAME:
      case INSTANCE_ADDRESS:
#endif
      case EXTERNAL_ADDRESS:
        returnValue->type = problem->type;
        returnValue->value = problem->value;
        break;

      case FCALL:
        {
         oldArgument = CurrentExpression;
         CurrentExpression = problem;
         fptr = (struct FunctionDefinition *) problem->value;
         switch(fptr->returnValueType)
           {
            case 'v' :
              (* (VOID (*)(VOID_ARG)) fptr->functionPointer)();
              returnValue->type = RVOID;
              returnValue->value = CLIPSFalseSymbol;
              break;
            case 'b' :
              returnValue->type = SYMBOL;
              if ((* (int (*)(VOID_ARG)) fptr->functionPointer)())
                returnValue->value = CLIPSTrueSymbol;
              else
                returnValue->value = CLIPSFalseSymbol;
              break;
            case 'a' :
              returnValue->type = EXTERNAL_ADDRESS;
              returnValue->value =
                             (* (VOID *(*)(VOID_ARG)) fptr->functionPointer)();
              break;
            case 'i' :
              returnValue->type = INTEGER;
              returnValue->value = (VOID *)
                AddLong((long) (* (int (*)(VOID_ARG)) fptr->functionPointer)());
              break;
            case 'l' :
              returnValue->type = INTEGER;
              returnValue->value = (VOID *)
                 AddLong((* (long int (*)(VOID_ARG)) fptr->functionPointer)());
              break;
            case 'f' :
              returnValue->type = FLOAT;
              returnValue->value = (VOID *)
                 AddDouble((double) (* (float (*)(VOID_ARG)) fptr->functionPointer)());
              break;
            case 'd' :
              returnValue->type = FLOAT;
              returnValue->value = (VOID *)
                 AddDouble((* (double (*)(VOID_ARG)) fptr->functionPointer)());
              break;
            case 's' :
              returnValue->type = STRING;
              returnValue->value = (VOID *)
                (* (SYMBOL_HN *(*)(VOID_ARG)) fptr->functionPointer)();
              break;
            case 'w' :
              returnValue->type = SYMBOL;
              returnValue->value = (VOID *)
                (* (SYMBOL_HN *(*)(VOID_ARG)) fptr->functionPointer)();
              break;
#if OBJECT_SYSTEM
            case 'x' :
              returnValue->type = INSTANCE_ADDRESS;
              returnValue->value =
                             (* (VOID *(*)(VOID_ARG)) fptr->functionPointer)();
              break;
            case 'o' :
              returnValue->type = INSTANCE_NAME;
              returnValue->value = (VOID *)
                (* (SYMBOL_HN *(*)(VOID_ARG)) fptr->functionPointer)();
              break;
#endif
            case 'c' :
              {
               char cbuff[2];

               cbuff[0] = (* (char (*)(VOID_ARG)) fptr->functionPointer)();
               cbuff[1] = EOS;
               returnValue->type = SYMBOL;
               returnValue->value = (VOID *) AddSymbol(cbuff);
               break;
              }
              
            case 'j' :
            case 'k' :
            case 'm' :
            case 'n' :
            case 'u' :
#if ANSI_COMPILER
              (* (VOID (*)(DATA_OBJECT_PTR)) fptr->functionPointer)(returnValue);
#else
              (* (VOID (*)()) fptr->functionPointer)(returnValue);
#endif
              break;

            default :
               CLIPSSystemError("EVALUATN",2);
               ExitCLIPS(5);
               break;
            }

        CurrentExpression = oldArgument;
        break;
        }

     case MULTIFIELD:
        returnValue->type = MULTIFIELD;
        returnValue->value = ((DATA_OBJECT_PTR) (problem->value))->value;
        returnValue->begin = ((DATA_OBJECT_PTR) (problem->value))->begin;
        returnValue->end = ((DATA_OBJECT_PTR) (problem->value))->end;
        break;

     case MF_VARIABLE:
     case SF_VARIABLE:
        if (GetBoundVariable(returnValue,(SYMBOL_HN *) problem->value) == CLIPS_FALSE)
          {   
           PrintErrorID("EVALUATN",1,CLIPS_FALSE);
           PrintCLIPS(WERROR,"Variable ");
           PrintCLIPS(WERROR,ValueToString(problem->value));
           PrintCLIPS(WERROR," is unbound\n");
           returnValue->type = SYMBOL;
           returnValue->value = CLIPSFalseSymbol;
           SetEvaluationError(CLIPS_TRUE);
          }
        break;
        
      default:
        if (PrimitivesArray[problem->type] == NULL)
          {
           CLIPSSystemError("EVALUATN",3);
           ExitCLIPS(5);
          }
          
        if (PrimitivesArray[problem->type]->copyToEvaluate)
          {
           returnValue->type = problem->type;
           returnValue->value = problem->value;
           break;
          }
          
        if (PrimitivesArray[problem->type]->evaluateFunction == NULL)
          {
           CLIPSSystemError("EVALUATN",4);
           ExitCLIPS(5);
          }
          
        oldArgument = CurrentExpression;
        CurrentExpression = problem;
        (*PrimitivesArray[problem->type]->evaluateFunction)(problem->value,returnValue);
        CurrentExpression = oldArgument;
        break;
     }
     
   PropagateReturnValue(returnValue);
   return(EvaluationError);
  }

/******************************************/
/* InstallPrimitive: Installs a primitive */
/*   data type in the primitives array.   */
/******************************************/
globle VOID InstallPrimitive(thePrimitive,whichPosition)
  struct entityRecord *thePrimitive;
  int whichPosition;
  {
   if (PrimitivesArray[whichPosition] != NULL)
     {
      CLIPSSystemError("EVALUATN",5);
      ExitCLIPS(7);
     }
     
   PrimitivesArray[whichPosition] = thePrimitive;
  }
  
/******************************************************/
/* SetEvaluationError: Sets the EvaluationError flag. */
/******************************************************/
globle VOID SetEvaluationError(value)
  int value;
  {
   EvaluationError = value;
   if (value == CLIPS_TRUE) HaltExecution = CLIPS_TRUE;
  }

/*********************************************************/
/* GetEvaluationError: Returns the EvaluationError flag. */
/*********************************************************/
globle int GetEvaluationError()
  {
   return(EvaluationError);
  }

/**************************************************/
/* SetHaltExecution: Sets the HaltExecution flag. */
/**************************************************/
globle VOID SetHaltExecution(value)
  int value;
  { HaltExecution = value; }

/*****************************************************/
/* GetHaltExecution: Returns the HaltExecution flag. */
/*****************************************************/
globle int GetHaltExecution()
  {
   return(HaltExecution);
  }

/******************************************************/
/* ReturnValues: Returns a linked list of DATA_OBJECT */
/*   structures to the pool of free memory.           */
/******************************************************/
globle VOID ReturnValues(garbagePtr)
  DATA_OBJECT_PTR garbagePtr;
  {
   DATA_OBJECT_PTR nextPtr;

   while (garbagePtr != NULL)
     {
      nextPtr = garbagePtr->next;
      ValueDeinstall(garbagePtr);
      rtn_struct(dataObject,garbagePtr);
      garbagePtr = nextPtr;
     }
  }

/***************************************************/
/* PrintDataObject: Prints a DATA_OBJECT structure */
/*   to the specified logical name.                */
/***************************************************/
globle VOID PrintDataObject(fileid,argPtr)
  char *fileid;
  DATA_OBJECT_PTR argPtr;
  {
   switch(argPtr->type)
     {
      case RVOID:
      case SYMBOL:
      case STRING:
      case INTEGER:
      case FLOAT:
      case EXTERNAL_ADDRESS:
      case FACT_ADDRESS:
#if OBJECT_SYSTEM
      case INSTANCE_NAME:
      case INSTANCE_ADDRESS:
#endif
        PrintAtom(fileid,argPtr->type,argPtr->value);
        break;
      case MULTIFIELD:
        PrintMultifield(fileid,(struct multifield *) argPtr->value,
                        argPtr->begin,argPtr->end,CLIPS_TRUE);
        break;

      default:
        PrintCLIPS(fileid,"<UnknownPrintType");
        PrintLongInteger(fileid,(long int) argPtr->type);
        PrintCLIPS(fileid,">");
        SetHaltExecution(CLIPS_TRUE);
        SetEvaluationError(CLIPS_TRUE);
        break;
     }
  }

/*************************************************/
/* SetMultifieldErrorValue: Creates a multifield */
/*   value of length zero for error returns.     */
/*************************************************/
globle VOID SetMultifieldErrorValue(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   returnValue->type = MULTIFIELD;
   returnValue->value = CreateMultifield(0L);
   returnValue->begin = 1;
   returnValue->end = 0;
  }

/**************************************************/
/* ValueInstall: Increments the appropriate count */
/*   (in use) values for a DATA_OBJECT structure. */
/**************************************************/
globle VOID ValueInstall(vPtr)
  DATA_OBJECT *vPtr;
  {
   if (vPtr->type == MULTIFIELD) MultifieldInstall((struct multifield *) vPtr->value);
   else AtomInstall(vPtr->type,vPtr->value);
  }

/****************************************************/
/* ValueDeinstall: Decrements the appropriate count */