/***********************************************************************************
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);
}
/***********************************************************************************
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);
}
