evaluatn.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.30  10/19/06            */
   /*                                                     */
   /*                  EVALUATION MODULE                  */
   /*******************************************************/

/*************************************************************/
/* Purpose: Provides routines for evaluating expressions.    */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*      6.24: Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*            Added EvaluateAndStoreInDataObject function.   */
/*                                                           */
/*      6.30: Added support for passing context information  */ 
/*            to user defined functions.                     */
/*                                                           */
/*************************************************************/

#define _EVALUATN_SOURCE_

#include <stdio.h>
#define _STDIO_INCLUDED_
#include <stdlib.h>
#include <string.h>
#include <ctype.h>

#include "setup.h"

#include "commline.h"
#include "constant.h"
#include "envrnmnt.h"
#include "memalloc.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 "proflfun.h"
#include "sysdep.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 */
/***************************************/

   static void                    PropagateReturnAtom(void *,int,void *);

/**************************************************/
/* InitializeEvaluationData: Allocates environment */
/*    data for expression evaluation.             */
/**************************************************/
globle void InitializeEvaluationData(
  void *theEnv)
  {
   AllocateEnvironmentData(theEnv,EVALUATION_DATA,sizeof(struct evaluationData),NULL);
  }

/**************************************************************/
/* EvaluateExpression: Evaluates an expression. Returns FALSE */
/*   if no errors occurred during evaluation, otherwise TRUE. */
/**************************************************************/
globle int EvaluateExpression(
  void *theEnv,
  struct expr *problem,
  DATA_OBJECT_PTR returnValue)
  {
   struct expr *oldArgument;
   void *oldContext;
   struct FunctionDefinition *fptr;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif

   if (problem == NULL)
     {
      returnValue->type = SYMBOL;
      returnValue->value = EnvFalseSymbol(theEnv);
      return(EvaluationData(theEnv)->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:
        {
         fptr = (struct FunctionDefinition *) problem->value;
         oldContext = SetEnvironmentFunctionContext(theEnv,fptr->context);

#if PROFILING_FUNCTIONS   
         StartProfile(theEnv,&profileFrame,
                      &fptr->usrData,
                      ProfileFunctionData(theEnv)->ProfileUserFunctions);
#endif

         oldArgument = EvaluationData(theEnv)->CurrentExpression;
         EvaluationData(theEnv)->CurrentExpression = problem;

         switch(fptr->returnValueType)
           {
            case 'v' :
              if (fptr->environmentAware)
                { (* (void (*)(void *)) fptr->functionPointer)(theEnv); }
              else
                { (* (void (*)(void)) fptr->functionPointer)(); }
              returnValue->type = RVOID;
              returnValue->value = EnvFalseSymbol(theEnv);
              break;
            case 'b' :
              returnValue->type = SYMBOL;
              if (fptr->environmentAware)
                {
                 if ((* (int (*)(void *)) fptr->functionPointer)(theEnv))
                   returnValue->value = EnvTrueSymbol(theEnv);
                 else
                   returnValue->value = EnvFalseSymbol(theEnv);
                }
              else
                {
                 if ((* (int (*)(void)) fptr->functionPointer)())
                   returnValue->value = EnvTrueSymbol(theEnv);
                 else
                   returnValue->value = EnvFalseSymbol(theEnv);
                }
              break;
            case 'a' :
              returnValue->type = EXTERNAL_ADDRESS;
              if (fptr->environmentAware)
                {
                 returnValue->value =
                                (* (void *(*)(void *)) fptr->functionPointer)(theEnv);
                }
              else
                {
                 returnValue->value =
                                (* (void *(*)(void)) fptr->functionPointer)();
                }
              break;
            case 'g' :
              returnValue->type = INTEGER;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                   EnvAddLong(theEnv,(* (long long (*)(void *)) fptr->functionPointer)(theEnv));
                }
              else
                {
                 returnValue->value = (void *)
                   EnvAddLong(theEnv,(* (long long (*)(void)) fptr->functionPointer)());
                }
              break;
            case 'i' :
              returnValue->type = INTEGER;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                   EnvAddLong(theEnv,(long long) (* (int (*)(void *)) fptr->functionPointer)(theEnv));
                }
              else
                {
                 returnValue->value = (void *)
                   EnvAddLong(theEnv,(long long) (* (int (*)(void)) fptr->functionPointer)());
                }
              break;
            case 'l' :
              returnValue->type = INTEGER;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                    EnvAddLong(theEnv,(long long) (* (long int (*)(void *)) fptr->functionPointer)(theEnv));
                }
              else
                {
                 returnValue->value = (void *)
                    EnvAddLong(theEnv,(long long) (* (long int (*)(void)) fptr->functionPointer)());
                }
              break;
            case 'f' :
              returnValue->type = FLOAT;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                    EnvAddDouble(theEnv,(double) (* (float (*)(void *)) fptr->functionPointer)(theEnv));
                }
              else
                {
                 returnValue->value = (void *)
                    EnvAddDouble(theEnv,(double) (* (float (*)(void)) fptr->functionPointer)());
                }
              break;
            case 'd' :
              returnValue->type = FLOAT;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                    EnvAddDouble(theEnv,(* (double (*)(void *)) fptr->functionPointer)(theEnv));
                }
              else
                {
                 returnValue->value = (void *)
                    EnvAddDouble(theEnv,(* (double (*)(void)) fptr->functionPointer)());
                }
              break;
            case 's' :
              returnValue->type = STRING;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                   (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv);
                }
              else
                {
                 returnValue->value = (void *)
                   (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)();
                }
              break;
            case 'w' :
              returnValue->type = SYMBOL;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                   (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv);
                }
              else
                {
                 returnValue->value = (void *)
                   (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)();
                }
              break;
#if OBJECT_SYSTEM
            case 'x' :
              returnValue->type = INSTANCE_ADDRESS;
              if (fptr->environmentAware)
                {
                 returnValue->value =
                                (* (void *(*)(void *)) fptr->functionPointer)(theEnv);
                }
              else
                {
                 returnValue->value =
                                (* (void *(*)(void)) fptr->functionPointer)();
                }
              break;
            case 'o' :
              returnValue->type = INSTANCE_NAME;
              if (fptr->environmentAware)
                {
                 returnValue->value = (void *)
                   (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv);
                }
              else
                {
                 returnValue->value = (void *)
                   (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)();
                }
              break;
#endif
            case 'c' :
              {
               char cbuff[2];
               if (fptr->environmentAware)
                 {
                  cbuff[0] = (* (char (*)(void *)) fptr->functionPointer)(theEnv);
                 }
               else
                 {
                  cbuff[0] = (* (char (*)(void)) fptr->functionPointer)();
                 }
               cbuff[1] = EOS;
               returnValue->type = SYMBOL;
               returnValue->value = (void *) EnvAddSymbol(theEnv,cbuff);
               break;
              }

            case 'j' :
            case 'k' :
            case 'm' :
            case 'n' :
            case 'u' :
               if (fptr->environmentAware)
                 {
                  (* (void (*)(void *,DATA_OBJECT_PTR)) fptr->functionPointer)(theEnv,returnValue);
                 }
               else
                 {
                  (* (void (*)(DATA_OBJECT_PTR)) fptr->functionPointer)(returnValue);
                 }
              break;

            default :
               SystemError(theEnv,"EVALUATN",2);
               EnvExitRouter(theEnv,EXIT_FAILURE);
               break;
            }

#if PROFILING_FUNCTIONS 
        EndProfile(theEnv,&profileFrame);
#endif

        SetEnvironmentFunctionContext(theEnv,oldContext);
        EvaluationData(theEnv)->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(theEnv,returnValue,(SYMBOL_HN *) problem->value) == FALSE)
          {
           PrintErrorID(theEnv,"EVALUATN",1,FALSE);
           EnvPrintRouter(theEnv,WERROR,"Variable ");
           EnvPrintRouter(theEnv,WERROR,ValueToString(problem->value));
           EnvPrintRouter(theEnv,WERROR," is unbound\n");
           returnValue->type = SYMBOL;
           returnValue->value = EnvFalseSymbol(theEnv);
           SetEvaluationError(theEnv,TRUE);
          }
        break;

      default:
        if (EvaluationData(theEnv)->PrimitivesArray[problem->type] == NULL)
          {
           SystemError(theEnv,"EVALUATN",3);
           EnvExitRouter(theEnv,EXIT_FAILURE);
          }

        if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->copyToEvaluate)
          {
           returnValue->type = problem->type;
           returnValue->value = problem->value;
           break;
          }

        if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction == NULL)
          {
           SystemError(theEnv,"EVALUATN",4);
           EnvExitRouter(theEnv,EXIT_FAILURE);
          }