Exemple #1
0
/***********************************************************************************
  NAME         : GenericDispatch
  DESCRIPTION  : Executes the most specific applicable method
  INPUTS       : 1) The generic function
                 2) The method to start after in the search for an applicable
                    method (ignored if arg #3 is not NULL).
                 3) A specific method to call (NULL if want highest precedence
                    method to be called)
                 4) The generic function argument expressions
                 5) The caller's result value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of evaluating the generic function arguments
                 Any side-effects of evaluating query functions on method parameter
                   restrictions when determining the core (see warning #1)
                 Any side-effects of actual execution of methods (see warning #2)
                 Caller's buffer set to the result of the generic function call

                 In case of errors, the result is false, otherwise it is the
                   result returned by the most specific method (which can choose
                   to ignore or return the values of more general methods)
  NOTES        : WARNING #1: Query functions on method parameter restrictions
                    should not have side-effects, for they might be evaluated even
                    for methods that aren't applicable to the generic function call.
                 WARNING #2: Side-effects of method execution should not always rely
                    on only being executed once per generic function call.  Every
                    time a method calls (shadow-call) the same next-most-specific
                    method is executed.  Thus, it is possible for a method to be
                    executed multiple times per generic function call.
 ***********************************************************************************/
void GenericDispatch(
  void *theEnv,
  DEFGENERIC *gfunc,
  DEFMETHOD *prevmeth,
  DEFMETHOD *meth,
  EXPRESSION *params,
  DATA_OBJECT *result)
  {
   DEFGENERIC *previousGeneric;
   DEFMETHOD *previousMethod;
   int oldce;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif
   struct CLIPSBlock gcBlock;
   
   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   EvaluationData(theEnv)->EvaluationError = false;
   if (EvaluationData(theEnv)->HaltExecution)
     return;

   CLIPSBlockStart(theEnv,&gcBlock);
   
   oldce = ExecutingConstruct(theEnv);
   SetExecutingConstruct(theEnv,true);
   previousGeneric = DefgenericData(theEnv)->CurrentGeneric;
   previousMethod = DefgenericData(theEnv)->CurrentMethod;
   DefgenericData(theEnv)->CurrentGeneric = gfunc;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;
   gfunc->busy++;
   PushProcParameters(theEnv,params,CountArguments(params),
                      EnvGetDefgenericName(theEnv,(void *) gfunc),
                      "generic function",UnboundMethodErr);
   if (EvaluationData(theEnv)->EvaluationError)
     {
      gfunc->busy--;
      DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
      DefgenericData(theEnv)->CurrentMethod = previousMethod;
      EvaluationData(theEnv)->CurrentEvaluationDepth--;
      
      CLIPSBlockEnd(theEnv,&gcBlock,result);
      CallPeriodicTasks(theEnv);
     
      SetExecutingConstruct(theEnv,oldce);
      return;
     }
   if (meth != NULL)
     {
      if (IsMethodApplicable(theEnv,meth))
        {
         meth->busy++;
         DefgenericData(theEnv)->CurrentMethod = meth;
        }
      else
        {
         PrintErrorID(theEnv,"GENRCEXE",4,false);
         EnvSetEvaluationError(theEnv,true);
         DefgenericData(theEnv)->CurrentMethod = NULL;
         EnvPrintRouter(theEnv,WERROR,"Generic function ");
         EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
         EnvPrintRouter(theEnv,WERROR," method #");
         PrintLongInteger(theEnv,WERROR,(long long) meth->index);
         EnvPrintRouter(theEnv,WERROR," is not applicable to the given arguments.\n");
        }
     }
   else
     DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth);
   if (DefgenericData(theEnv)->CurrentMethod != NULL)
     {
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,BEGIN_TRACE);
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,BEGIN_TRACE);
#endif
      if (DefgenericData(theEnv)->CurrentMethod->system)
        {
         EXPRESSION fcall;

         fcall.type = FCALL;
         fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value;
         fcall.nextArg = NULL;
         fcall.argList = GetProcParamExpressions(theEnv);
         EvaluateExpression(theEnv,&fcall,result);
        }
      else
        {
#if PROFILING_FUNCTIONS
         StartProfile(theEnv,&profileFrame,
                      &DefgenericData(theEnv)->CurrentMethod->usrData,
                      ProfileFunctionData(theEnv)->ProfileConstructs);
#endif

         EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule,
                             DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount,
                             result,UnboundMethodErr);

#if PROFILING_FUNCTIONS
         EndProfile(theEnv,&profileFrame);
#endif
        }
      DefgenericData(theEnv)->CurrentMethod->busy--;
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,END_TRACE);
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,END_TRACE);
#endif
     }
   else if (! EvaluationData(theEnv)->EvaluationError)
     {
      PrintErrorID(theEnv,"GENRCEXE",1,false);
      EnvPrintRouter(theEnv,WERROR,"No applicable methods for ");
      EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
      EnvPrintRouter(theEnv,WERROR,".\n");
      EnvSetEvaluationError(theEnv,true);
     }
   gfunc->busy--;
   ProcedureFunctionData(theEnv)->ReturnFlag = false;
   PopProcParameters(theEnv);
   DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
   DefgenericData(theEnv)->CurrentMethod = previousMethod;
   EvaluationData(theEnv)->CurrentEvaluationDepth--;

   CLIPSBlockEnd(theEnv,&gcBlock,result);
   CallPeriodicTasks(theEnv);
   
   SetExecutingConstruct(theEnv,oldce);
  }
Exemple #2
0
/***********************************************************************************
  NAME         : GenericDispatch
  DESCRIPTION  : Executes the most specific applicable method
  INPUTS       : 1) The generic function
                 2) The method to start after in the search for an applicable
                    method (ignored if arg #3 is not NULL).
                 3) A specific method to call (NULL if want highest precedence
                    method to be called)
                 4) The generic function argument expressions
                 5) The caller's result value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of evaluating the generic function arguments
                 Any side-effects of evaluating query functions on method parameter
                   restrictions when determining the core (see warning #1)
                 Any side-effects of actual execution of methods (see warning #2)
                 Caller's buffer set to the result of the generic function call

                 In case of errors, the result is false, otherwise it is the
                   result returned by the most specific method (which can choose
                   to ignore or return the values of more general methods)
  NOTES        : WARNING #1: Query functions on method parameter restrictions
                    should not have side-effects, for they might be evaluated even
                    for methods that aren't applicable to the generic function call.
                 WARNING #2: Side-effects of method execution should not always rely
                    on only being executed once per generic function call.  Every
                    time a method calls (shadow-call) the same next-most-specific
                    method is executed.  Thus, it is possible for a method to be
                    executed multiple times per generic function call.
 ***********************************************************************************/
void GenericDispatch(
  Environment *theEnv,
  Defgeneric *gfunc,
  Defmethod *prevmeth,
  Defmethod *meth,
  Expression *params,
  UDFValue *returnValue)
  {
   Defgeneric *previousGeneric;
   Defmethod *previousMethod;
   bool oldce;
#if PROFILING_FUNCTIONS
   struct profileFrameInfo profileFrame;
#endif
   GCBlock gcb;

   returnValue->value = FalseSymbol(theEnv);
   EvaluationData(theEnv)->EvaluationError = false;
   if (EvaluationData(theEnv)->HaltExecution)
     return;

   GCBlockStart(theEnv,&gcb);

   oldce = ExecutingConstruct(theEnv);
   SetExecutingConstruct(theEnv,true);
   previousGeneric = DefgenericData(theEnv)->CurrentGeneric;
   previousMethod = DefgenericData(theEnv)->CurrentMethod;
   DefgenericData(theEnv)->CurrentGeneric = gfunc;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;
   gfunc->busy++;
   PushProcParameters(theEnv,params,CountArguments(params),
                      DefgenericName(gfunc),
                      "generic function",UnboundMethodErr);
   if (EvaluationData(theEnv)->EvaluationError)
     {
      gfunc->busy--;
      DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
      DefgenericData(theEnv)->CurrentMethod = previousMethod;
      EvaluationData(theEnv)->CurrentEvaluationDepth--;

      GCBlockEndUDF(theEnv,&gcb,returnValue);
      CallPeriodicTasks(theEnv);

      SetExecutingConstruct(theEnv,oldce);
      return;
     }
   if (meth != NULL)
     {
      if (IsMethodApplicable(theEnv,meth))
        {
         meth->busy++;
         DefgenericData(theEnv)->CurrentMethod = meth;
        }
      else
        {
         PrintErrorID(theEnv,"GENRCEXE",4,false);
         SetEvaluationError(theEnv,true);
         DefgenericData(theEnv)->CurrentMethod = NULL;
         WriteString(theEnv,STDERR,"Generic function '");
         WriteString(theEnv,STDERR,DefgenericName(gfunc));
         WriteString(theEnv,STDERR,"' method #");
         PrintUnsignedInteger(theEnv,STDERR,meth->index);
         WriteString(theEnv,STDERR," is not applicable to the given arguments.\n");
        }
     }
   else
     DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,gfunc,prevmeth);
   if (DefgenericData(theEnv)->CurrentMethod != NULL)
     {
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,BEGIN_TRACE);
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,BEGIN_TRACE);
#endif
      if (DefgenericData(theEnv)->CurrentMethod->system)
        {
         Expression fcall;

         fcall.type = FCALL;
         fcall.value = DefgenericData(theEnv)->CurrentMethod->actions->value;
         fcall.nextArg = NULL;
         fcall.argList = GetProcParamExpressions(theEnv);
         EvaluateExpression(theEnv,&fcall,returnValue);
        }
      else
        {
#if PROFILING_FUNCTIONS
         StartProfile(theEnv,&profileFrame,
                      &DefgenericData(theEnv)->CurrentMethod->header.usrData,
                      ProfileFunctionData(theEnv)->ProfileConstructs);
#endif

         EvaluateProcActions(theEnv,DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule,
                             DefgenericData(theEnv)->CurrentMethod->actions,DefgenericData(theEnv)->CurrentMethod->localVarCount,
                             returnValue,UnboundMethodErr);

#if PROFILING_FUNCTIONS
         EndProfile(theEnv,&profileFrame);
#endif
        }
      DefgenericData(theEnv)->CurrentMethod->busy--;
#if DEBUGGING_FUNCTIONS
      if (DefgenericData(theEnv)->CurrentMethod->trace)
        WatchMethod(theEnv,END_TRACE);
      if (DefgenericData(theEnv)->CurrentGeneric->trace)
        WatchGeneric(theEnv,END_TRACE);
#endif
     }
   else if (! EvaluationData(theEnv)->EvaluationError)
     {
      PrintErrorID(theEnv,"GENRCEXE",1,false);
      WriteString(theEnv,STDERR,"No applicable methods for '");
      WriteString(theEnv,STDERR,DefgenericName(gfunc));
      WriteString(theEnv,STDERR,"'.\n");
      SetEvaluationError(theEnv,true);
     }
   gfunc->busy--;
   ProcedureFunctionData(theEnv)->ReturnFlag = false;
   PopProcParameters(theEnv);
   DefgenericData(theEnv)->CurrentGeneric = previousGeneric;
   DefgenericData(theEnv)->CurrentMethod = previousMethod;
   EvaluationData(theEnv)->CurrentEvaluationDepth--;

   GCBlockEndUDF(theEnv,&gcb,returnValue);
   CallPeriodicTasks(theEnv);

   SetExecutingConstruct(theEnv,oldce);
  }