/**********************************************************************
NAME : WatchMethod
DESCRIPTION : Prints out a trace of the beginning or end
of the execution of a generic function
method
INPUTS : A string to indicate beginning or end of execution
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : Uses the globals CurrentGeneric, CurrentMethod,
ProcParamArraySize and ProcParamArray for
other trace info
**********************************************************************/
static void WatchMethod(
Environment *theEnv,
const char *tstring)
{
if (ConstructData(theEnv)->ClearReadyInProgress ||
ConstructData(theEnv)->ClearInProgress)
{ return; }
WriteString(theEnv,STDOUT,"MTH ");
WriteString(theEnv,STDOUT,tstring);
WriteString(theEnv,STDOUT," ");
if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != GetCurrentModule(theEnv))
{
WriteString(theEnv,STDOUT,DefgenericModule(DefgenericData(theEnv)->CurrentGeneric));
WriteString(theEnv,STDOUT,"::");
}
WriteString(theEnv,STDOUT,DefgenericData(theEnv)->CurrentGeneric->header.name->contents);
WriteString(theEnv,STDOUT,":#");
if (DefgenericData(theEnv)->CurrentMethod->system)
WriteString(theEnv,STDOUT,"SYS");
PrintUnsignedInteger(theEnv,STDOUT,DefgenericData(theEnv)->CurrentMethod->index);
WriteString(theEnv,STDOUT," ");
WriteString(theEnv,STDOUT," ED:");
WriteInteger(theEnv,STDOUT,EvaluationData(theEnv)->CurrentEvaluationDepth);
PrintProcParamArray(theEnv,STDOUT);
}
/****************************************************************
NAME : SingleDefgenericToCode
DESCRIPTION : Writes out a single defgeneric's
data to the file
INPUTS : 1) The output file
2) The compile image id
3) The maximum number of
elements in an array
4) The defgeneric
5) The module index
6) The partition holding the
generic methods
7) The relative index of the
generics methods in the partition
RETURNS : Nothing useful
SIDE EFFECTS : Defgeneric data written
NOTES : None
***************************************************************/
static void SingleDefgenericToCode(
void *theEnv,
FILE *theFile,
int imageID,
int maxIndices,
DEFGENERIC *theDefgeneric,
int moduleCount,
int methodArrayVersion,
int methodArrayCount)
{
/* ==================
Defgeneric Header
================== */
fprintf(theFile,"{");
ConstructHeaderToCode(theEnv,theFile,&theDefgeneric->header,imageID,maxIndices,moduleCount,
ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem),
ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem));
/* =========================
Defgeneric specific data
========================= */
fprintf(theFile,",0,0,");
if (theDefgeneric->methods == NULL)
fprintf(theFile,"NULL");
else
{
fprintf(theFile,"&%s%d_%d[%d]",MethodPrefix(),imageID,
methodArrayVersion,methodArrayCount);
}
fprintf(theFile,",%hd,0}",theDefgeneric->mcnt);
}
/***********************************************************
NAME : GetGenericCurrentArgument
DESCRIPTION : Returns the value of the generic function
argument being tested in the method
applicability determination process
INPUTS : A data-object buffer
RETURNS : Nothing useful
SIDE EFFECTS : Data-object set
NOTES : Useful for queries in wildcard restrictions
***********************************************************/
void GetGenericCurrentArgument(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
returnValue->value = DefgenericData(theEnv)->GenericCurrentArgument->value;
returnValue->begin = DefgenericData(theEnv)->GenericCurrentArgument->begin;
returnValue->range = DefgenericData(theEnv)->GenericCurrentArgument->range;
}
/*******************************************************
NAME : UnboundMethodErr
DESCRIPTION : Print out a synopis of the currently
executing method for unbound variable
errors
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Error synopsis printed to WERROR
NOTES : None
*******************************************************/
void UnboundMethodErr(
void *theEnv)
{
EnvPrintRouter(theEnv,WERROR,"generic function ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric));
EnvPrintRouter(theEnv,WERROR," method #");
PrintLongInteger(theEnv,WERROR,(long long) DefgenericData(theEnv)->CurrentMethod->index);
EnvPrintRouter(theEnv,WERROR,".\n");
}
/*******************************************************
NAME : UnboundMethodErr
DESCRIPTION : Print out a synopis of the currently
executing method for unbound variable
errors
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Error synopsis printed to STDERR
NOTES : None
*******************************************************/
void UnboundMethodErr(
Environment *theEnv,
const char *logName)
{
WriteString(theEnv,logName,"generic function '");
WriteString(theEnv,logName,DefgenericName(DefgenericData(theEnv)->CurrentGeneric));
WriteString(theEnv,logName,"' method #");
PrintUnsignedInteger(theEnv,logName,DefgenericData(theEnv)->CurrentMethod->index);
WriteString(theEnv,logName,".\n");
}
/***********************************************************
NAME : GetGenericCurrentArgument
DESCRIPTION : Returns the value of the generic function
argument being tested in the method
applicability determination process
INPUTS : A data-object buffer
RETURNS : Nothing useful
SIDE EFFECTS : Data-object set
NOTES : Useful for queries in wildcard restrictions
***********************************************************/
void GetGenericCurrentArgument(
UDFContext *context,
CLIPSValue *returnValue)
{
Environment *theEnv = UDFContextEnvironment(context);
returnValue->type = DefgenericData(theEnv)->GenericCurrentArgument->type;
returnValue->value = DefgenericData(theEnv)->GenericCurrentArgument->value;
returnValue->begin = DefgenericData(theEnv)->GenericCurrentArgument->begin;
returnValue->end = DefgenericData(theEnv)->GenericCurrentArgument->end;
}
/***************************************************
NAME : BsaveGenericsExpressions
DESCRIPTION : Writes out all expressions needed
by generic functions
INPUTS : The file pointer of the binary file
RETURNS : Nothing useful
SIDE EFFECTS : File updated
NOTES : None
***************************************************/
static void BsaveGenericsExpressions(
void *theEnv,
FILE *fp)
{
/* ================================================================
Important to save all expressions for methods before any
expressions for restrictions, since methods will be stored first
================================================================ */
DoForAllConstructs(theEnv,BsaveMethodExpressions,DefgenericData(theEnv)->DefgenericModuleIndex,
FALSE,(void *) fp);
DoForAllConstructs(theEnv,BsaveRestrictionExpressions,DefgenericData(theEnv)->DefgenericModuleIndex,
FALSE,(void *) fp);
}
/***************************************************
NAME : NextMethodP
DESCRIPTION : Determines if a shadowed generic
function method is available for
execution
INPUTS : None
RETURNS : true if there is a method available,
false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax: (next-methodp)
***************************************************/
bool NextMethodP(
void *theEnv)
{
register DEFMETHOD *meth;
if (DefgenericData(theEnv)->CurrentMethod == NULL)
return(false);
meth = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod);
if (meth != NULL)
{
meth->busy--;
return(true);
}
return(false);
}
/***************************************************
NAME : DetermineRestrictionClass
DESCRIPTION : Finds the class of an argument in
the ProcParamArray
INPUTS : The argument data object
RETURNS : The class address, NULL if error
SIDE EFFECTS : EvaluationError set on errors
NOTES : None
***************************************************/
static Defclass *DetermineRestrictionClass(
Environment *theEnv,
UDFValue *dobj)
{
Instance *ins;
Defclass *cls;
if (dobj->header->type == INSTANCE_NAME_TYPE)
{
ins = FindInstanceBySymbol(theEnv,dobj->lexemeValue);
cls = (ins != NULL) ? ins->cls : NULL;
}
else if (dobj->header->type == INSTANCE_ADDRESS_TYPE)
{
ins = dobj->instanceValue;
cls = (ins->garbage == 0) ? ins->cls : NULL;
}
else
return(DefclassData(theEnv)->PrimitiveClassMap[dobj->header->type]);
if (cls == NULL)
{
SetEvaluationError(theEnv,true);
PrintErrorID(theEnv,"GENRCEXE",3,false);
WriteString(theEnv,STDERR,"Unable to determine class of ");
WriteUDFValue(theEnv,STDERR,dobj);
WriteString(theEnv,STDERR," in generic function '");
WriteString(theEnv,STDERR,DefgenericName(DefgenericData(theEnv)->CurrentGeneric));
WriteString(theEnv,STDERR,"'.\n");
}
return(cls);
}
/***************************************************
NAME : DetermineRestrictionClass
DESCRIPTION : Finds the class of an argument in
the ProcParamArray
INPUTS : The argument data object
RETURNS : The class address, NULL if error
SIDE EFFECTS : EvaluationError set on errors
NOTES : None
***************************************************/
static DEFCLASS *DetermineRestrictionClass(
void *theEnv,
DATA_OBJECT *dobj)
{
INSTANCE_TYPE *ins;
DEFCLASS *cls;
if (dobj->type == INSTANCE_NAME)
{
ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) dobj->value);
cls = (ins != NULL) ? ins->cls : NULL;
}
else if (dobj->type == INSTANCE_ADDRESS)
{
ins = (INSTANCE_TYPE *) dobj->value;
cls = (ins->garbage == 0) ? ins->cls : NULL;
}
else
return(DefclassData(theEnv)->PrimitiveClassMap[dobj->type]);
if (cls == NULL)
{
EnvSetEvaluationError(theEnv,true);
PrintErrorID(theEnv,"GENRCEXE",3,false);
EnvPrintRouter(theEnv,WERROR,"Unable to determine class of ");
PrintDataObject(theEnv,WERROR,dobj);
EnvPrintRouter(theEnv,WERROR," in generic function ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) DefgenericData(theEnv)->CurrentGeneric));
EnvPrintRouter(theEnv,WERROR,".\n");
}
return(cls);
}
/***************************************************
NAME : NextMethodP
DESCRIPTION : Determines if a shadowed generic
function method is available for
execution
INPUTS : None
RETURNS : True if there is a method available,
false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax: (next-methodp)
***************************************************/
bool NextMethodP(
Environment *theEnv)
{
Defmethod *meth;
if (DefgenericData(theEnv)->CurrentMethod == NULL)
{ return false; }
meth = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod);
if (meth != NULL)
{
meth->busy--;
return true;
}
else
{ return false; }
}
/*************************************************************
NAME : PreviewGeneric
DESCRIPTION : Allows the user to see a printout of all the
applicable methods for a particular generic
function call
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : Any side-effects of evaluating the generic
function arguments
and evaluating query-functions to determine
the set of applicable methods
NOTES : H/L Syntax: (preview-generic <func> <args>)
*************************************************************/
globle void PreviewGeneric(
void *theEnv,
EXEC_STATUS)
{
DEFGENERIC *gfunc;
DEFGENERIC *previousGeneric;
int oldce;
DATA_OBJECT temp;
execStatus->EvaluationError = FALSE;
if (EnvArgTypeCheck(theEnv,execStatus,"preview-generic",1,SYMBOL,&temp) == FALSE)
return;
gfunc = LookupDefgenericByMdlOrScope(theEnv,execStatus,DOToString(temp));
if (gfunc == NULL)
{
PrintErrorID(theEnv,execStatus,"GENRCFUN",3,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"Unable to find generic function ");
EnvPrintRouter(theEnv,execStatus,WERROR,DOToString(temp));
EnvPrintRouter(theEnv,execStatus,WERROR," in function preview-generic.\n");
return;
}
oldce = ExecutingConstruct(theEnv,execStatus);
SetExecutingConstruct(theEnv,execStatus,TRUE);
previousGeneric = DefgenericData(theEnv,execStatus)->CurrentGeneric;
DefgenericData(theEnv,execStatus)->CurrentGeneric = gfunc;
execStatus->CurrentEvaluationDepth++;
PushProcParameters(theEnv,execStatus,GetFirstArgument()->nextArg,
CountArguments(GetFirstArgument()->nextArg),
EnvGetDefgenericName(theEnv,execStatus,(void *) gfunc),"generic function",
UnboundMethodErr);
if (execStatus->EvaluationError)
{
PopProcParameters(theEnv,execStatus);
DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric;
execStatus->CurrentEvaluationDepth--;
SetExecutingConstruct(theEnv,execStatus,oldce);
return;
}
gfunc->busy++;
DisplayGenericCore(theEnv,execStatus,gfunc);
gfunc->busy--;
PopProcParameters(theEnv,execStatus);
DefgenericData(theEnv,execStatus)->CurrentGeneric = previousGeneric;
execStatus->CurrentEvaluationDepth--;
SetExecutingConstruct(theEnv,execStatus,oldce);
}
/***********************************************************************
NAME : OverrideNextMethod
DESCRIPTION : Changes the arguments to shadowed methods, thus the set
of applicable methods to this call may change
INPUTS : A buffer to hold the result of the call
RETURNS : Nothing useful
SIDE EFFECTS : Any of evaluating method restrictions and bodies
NOTES : H/L Syntax: (override-next-method <args>)
***********************************************************************/
void OverrideNextMethod(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
returnValue->lexemeValue = FalseSymbol(theEnv);
if (EvaluationData(theEnv)->HaltExecution)
return;
if (DefgenericData(theEnv)->CurrentMethod == NULL)
{
PrintErrorID(theEnv,"GENRCEXE",2,false);
WriteString(theEnv,STDERR,"Shadowed methods not applicable in current context.\n");
SetEvaluationError(theEnv,true);
return;
}
GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL,
GetFirstArgument(),returnValue);
}
/***************************************************
NAME : FreeDefgenericModule
DESCRIPTION : Removes a deffunction module and
all associated deffunctions
INPUTS : The deffunction module
RETURNS : Nothing useful
SIDE EFFECTS : Module and deffunctions deleted
NOTES : None
***************************************************/
globle void FreeDefgenericModule(
void *theEnv,
void *theItem)
{
#if (! BLOAD_ONLY)
FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DefgenericData(theEnv)->DefgenericConstruct);
#endif
rtn_struct(theEnv,defgenericModule,theItem);
}
/**********************************************************************
NAME : WatchGeneric
DESCRIPTION : Prints out a trace of the beginning or end
of the execution of a generic function
INPUTS : A string to indicate beginning or end of execution
RETURNS : Nothing useful
SIDE EFFECTS : None
NOTES : Uses the globals CurrentGeneric, ProcParamArraySize and
ProcParamArray for other trace info
**********************************************************************/
static void WatchGeneric(
void *theEnv,
const char *tstring)
{
EnvPrintRouter(theEnv,WTRACE,"GNC ");
EnvPrintRouter(theEnv,WTRACE,tstring);
EnvPrintRouter(theEnv,WTRACE," ");
if (DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) EnvGetCurrentModule(theEnv)))
{
EnvPrintRouter(theEnv,WTRACE,EnvGetDefmoduleName(theEnv,(void *)
DefgenericData(theEnv)->CurrentGeneric->header.whichModule->theModule));
EnvPrintRouter(theEnv,WTRACE,"::");
}
EnvPrintRouter(theEnv,WTRACE,ValueToString((void *) DefgenericData(theEnv)->CurrentGeneric->header.name));
EnvPrintRouter(theEnv,WTRACE," ");
EnvPrintRouter(theEnv,WTRACE," ED:");
PrintLongInteger(theEnv,WTRACE,(long long) EvaluationData(theEnv)->CurrentEvaluationDepth);
PrintProcParamArray(theEnv,WTRACE);
}
/***********************************************************************
NAME : OverrideNextMethod
DESCRIPTION : Changes the arguments to shadowed methods, thus the set
of applicable methods to this call may change
INPUTS : A buffer to hold the result of the call
RETURNS : Nothing useful
SIDE EFFECTS : Any of evaluating method restrictions and bodies
NOTES : H/L Syntax: (override-next-method <args>)
***********************************************************************/
void OverrideNextMethod(
UDFContext *context,
CLIPSValue *returnValue)
{
Environment *theEnv = UDFContextEnvironment(context);
mCVSetBoolean(returnValue,false);
if (EvaluationData(theEnv)->HaltExecution)
return;
if (DefgenericData(theEnv)->CurrentMethod == NULL)
{
PrintErrorID(theEnv,"GENRCEXE",2,false);
EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n");
EnvSetEvaluationError(theEnv,true);
return;
}
GenericDispatch(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod,NULL,
GetFirstArgument(),returnValue);
}
/***************************************************
NAME : DefgenericModuleToCode
DESCRIPTION : Writes out the C values for a
defgeneric module item
INPUTS : 1) The output file
2) The module for the defgenerics
3) The compile image id
4) The maximum number of elements
in an array
RETURNS : Nothing useful
SIDE EFFECTS : Defgeneric module item written
NOTES : None
***************************************************/
static void DefgenericModuleToCode(
void *theEnv,
FILE *theFile,
struct defmodule *theModule,
int imageID,
int maxIndices)
{
fprintf(theFile,"{");
ConstructModuleToCode(theEnv,theFile,theModule,imageID,maxIndices,
DefgenericData(theEnv)->DefgenericModuleIndex,ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem));
fprintf(theFile,"}");
}
/****************************************************
NAME : DefgenericCModuleReference
DESCRIPTION : Prints out a reference to a
defgeneric module
INPUTS : 1) The output file
2) The id of the module item
3) The id of the image
4) The maximum number of elements
allowed in an array
RETURNS : Nothing useful
SIDE EFFECTS : Defgeneric module reference printed
NOTES : None
****************************************************/
globle void DefgenericCModuleReference(
void *theEnv,
FILE *theFile,
int count,
int imageID,
int maxIndices)
{
fprintf(theFile,"MIHS &%s%d_%d[%d]",
ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem),
imageID,
(count / maxIndices) + 1,
(count % maxIndices));
}
/***************************************************
NAME : PrintGenericFunctionReference
DESCRIPTION : Prints a reference to the run-time
generic array for the construct
compiler
INPUTS : 1) The file output destination
2) A pointer to the generic
3) The id of the run-time image
4) The maximum number of indices
in any array
RETURNS : Nothing useful
SIDE EFFECTS : Reference printed
NOTES : None
***************************************************/
globle void PrintGenericFunctionReference(
void *theEnv,
FILE *fp,
DEFGENERIC *gfunc,
int imageID,
int maxIndices)
{
if (gfunc == NULL)
fprintf(fp,"NULL");
else
fprintf(fp,"&%s%d_%d[%d]",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem),imageID,
(int) ((gfunc->header.bsaveID / maxIndices) + 1),
(int) (gfunc->header.bsaveID % maxIndices));
}
/***************************************************************************
NAME : BsaveGenericsFind
DESCRIPTION : For all generic functions and their
methods, this routine marks all
the needed symbols and system functions.
Also, it also counts the number of
expression structures needed.
Also, counts total number of generics, methods,
restrictions and types.
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : ExpressionCount (a global from BSAVE.C) is incremented
for every expression needed
Symbols and system function are marked in their structures
NOTES : Also sets bsaveIndex for each generic function (assumes
generic functions will be bsaved in order of binary list)
***************************************************************************/
static void BsaveGenericsFind(
void *theEnv)
{
SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->ModuleCount);
SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->GenericCount);
SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->MethodCount);
SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->RestrictionCount);
SaveBloadCount(theEnv,DefgenericBinaryData(theEnv)->TypeCount);
DefgenericBinaryData(theEnv)->GenericCount = 0L;
DefgenericBinaryData(theEnv)->MethodCount = 0L;
DefgenericBinaryData(theEnv)->RestrictionCount = 0L;
DefgenericBinaryData(theEnv)->TypeCount = 0L;
DefgenericBinaryData(theEnv)->ModuleCount =
DoForAllConstructs(theEnv,MarkDefgenericItems,DefgenericData(theEnv)->DefgenericModuleIndex,
FALSE,NULL);
}
static void UpdateGeneric(
void *theEnv,
void *buf,
long obji)
{
BSAVE_GENERIC *bgp;
DEFGENERIC *gp;
bgp = (BSAVE_GENERIC *) buf;
gp = (DEFGENERIC *) &DefgenericBinaryData(theEnv)->DefgenericArray[obji];
UpdateConstructHeader(theEnv,&bgp->header,&gp->header,
(int) sizeof(DEFGENERIC_MODULE),(void *) DefgenericBinaryData(theEnv)->ModuleArray,
(int) sizeof(DEFGENERIC),(void *) DefgenericBinaryData(theEnv)->DefgenericArray);
DefgenericBinaryData(theEnv)->DefgenericArray[obji].busy = 0;
#if DEBUGGING_FUNCTIONS
DefgenericBinaryData(theEnv)->DefgenericArray[obji].trace = DefgenericData(theEnv)->WatchGenerics;
#endif
DefgenericBinaryData(theEnv)->DefgenericArray[obji].methods = MethodPointer(bgp->methods);
DefgenericBinaryData(theEnv)->DefgenericArray[obji].mcnt = bgp->mcnt;
DefgenericBinaryData(theEnv)->DefgenericArray[obji].new_index = 0;
}
static void UpdateMethod(
void *theEnv,
void *buf,
long obji)
{
BSAVE_METHOD *bmth;
bmth = (BSAVE_METHOD *) buf;
DefgenericBinaryData(theEnv)->MethodArray[obji].index = bmth->index;
DefgenericBinaryData(theEnv)->MethodArray[obji].busy = 0;
#if DEBUGGING_FUNCTIONS
DefgenericBinaryData(theEnv)->MethodArray[obji].trace = DefgenericData(theEnv)->WatchMethods;
#endif
DefgenericBinaryData(theEnv)->MethodArray[obji].restrictionCount = bmth->restrictionCount;
DefgenericBinaryData(theEnv)->MethodArray[obji].minRestrictions = bmth->minRestrictions;
DefgenericBinaryData(theEnv)->MethodArray[obji].maxRestrictions = bmth->maxRestrictions;
DefgenericBinaryData(theEnv)->MethodArray[obji].localVarCount = bmth->localVarCount;
DefgenericBinaryData(theEnv)->MethodArray[obji].system = bmth->system;
DefgenericBinaryData(theEnv)->MethodArray[obji].restrictions = RestrictionPointer(bmth->restrictions);
DefgenericBinaryData(theEnv)->MethodArray[obji].actions = ExpressionPointer(bmth->actions);
DefgenericBinaryData(theEnv)->MethodArray[obji].ppForm = NULL;
DefgenericBinaryData(theEnv)->MethodArray[obji].usrData = NULL;
}
/****************************************************
NAME : CallNextMethod
DESCRIPTION : Executes the next available method
in the core for a generic function
INPUTS : Caller's buffer for the result
RETURNS : Nothing useful
SIDE EFFECTS : Side effects of execution of shadow
EvaluationError set if no method
is available to execute.
NOTES : H/L Syntax: (call-next-method)
****************************************************/
void CallNextMethod(
UDFContext *context,
CLIPSValue *returnValue)
{
DEFMETHOD *oldMethod;
Environment *theEnv = UDFContextEnvironment(context);
#if PROFILING_FUNCTIONS
struct profileFrameInfo profileFrame;
#endif
mCVSetBoolean(returnValue,false);
if (EvaluationData(theEnv)->HaltExecution)
return;
oldMethod = DefgenericData(theEnv)->CurrentMethod;
if (DefgenericData(theEnv)->CurrentMethod != NULL)
DefgenericData(theEnv)->CurrentMethod = FindApplicableMethod(theEnv,DefgenericData(theEnv)->CurrentGeneric,DefgenericData(theEnv)->CurrentMethod);
if (DefgenericData(theEnv)->CurrentMethod == NULL)
{
DefgenericData(theEnv)->CurrentMethod = oldMethod;
PrintErrorID(theEnv,"GENRCEXE",2,false);
EnvPrintRouter(theEnv,WERROR,"Shadowed methods not applicable in current context.\n");
EnvSetEvaluationError(theEnv,true);
return;
}
#if DEBUGGING_FUNCTIONS
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)->CurrentGeneric->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);
#endif
DefgenericData(theEnv)->CurrentMethod = oldMethod;
ProcedureFunctionData(theEnv)->ReturnFlag = false;
}
/***********************************************************************************
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);
}
/***********************************************************************************
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 : ReadyDefgenericsForCode
DESCRIPTION : Sets index of generic-functions
for use in compiled expressions
INPUTS : None
RETURNS : Nothing useful
SIDE EFFECTS : BsaveIndices set
NOTES : None
***************************************************/
static void ReadyDefgenericsForCode(
void *theEnv)
{
MarkConstructBsaveIDs(theEnv,DefgenericData(theEnv)->DefgenericModuleIndex);
}
/*******************************************************
NAME : DefgenericsToCode
DESCRIPTION : Writes out static array code for
generic functions, methods, etc.
INPUTS : 1) The base name of the construct set
2) The base id for this construct
3) The file pointer for the header file
4) The base id for the construct set
5) The max number of indices allowed
in an array
RETURNS : -1 if no generic functions, 0 on errors,
1 if generic functions written
SIDE EFFECTS : Code written to files
NOTES : None
*******************************************************/
static int DefgenericsToCode(
void *theEnv,
char *fileName,
char *pathName,
char *fileNameBuffer,
int fileID,
FILE *headerFP,
int imageID,
int maxIndices)
{
int fileCount = 1;
struct defmodule *theModule;
DEFGENERIC *theDefgeneric;
DEFMETHOD *theMethod;
RESTRICTION *theRestriction;
short i,j,k;
int moduleCount = 0;
int itemArrayCounts[SAVE_ITEMS];
int itemArrayVersions[SAVE_ITEMS];
FILE *itemFiles[SAVE_ITEMS];
int itemReopenFlags[SAVE_ITEMS];
struct CodeGeneratorFile itemCodeFiles[SAVE_ITEMS];
for (i = 0 ; i < SAVE_ITEMS ; i++)
{
itemArrayCounts[i] = 0;
itemArrayVersions[i] = 1;
itemFiles[i] = NULL;
itemReopenFlags[i] = FALSE;
itemCodeFiles[i].filePrefix = NULL;
itemCodeFiles[i].pathName = pathName;
itemCodeFiles[i].fileNameBuffer = fileNameBuffer;
}
/* ===========================================
Include the appropriate generic header file
=========================================== */
fprintf(headerFP,"#include \"genrcfun.h\"\n");
/* =============================================================
Loop through all the modules and all the defgenerics writing
their C code representation to the file as they are traversed
============================================================= */
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,NULL);
while (theModule != NULL)
{
EnvSetCurrentModule(theEnv,(void *) theModule);
itemFiles[MODULEI] =
OpenFileIfNeeded(theEnv,itemFiles[MODULEI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
itemArrayVersions[MODULEI],headerFP,
(char*)"DEFGENERIC_MODULE",ModulePrefix(DefgenericData(theEnv)->DefgenericCodeItem),
itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]);
if (itemFiles[MODULEI] == NULL)
goto GenericCodeError;
DefgenericModuleToCode(theEnv,itemFiles[MODULEI],theModule,imageID,maxIndices);
itemFiles[MODULEI] =
CloseFileIfNeeded(theEnv,itemFiles[MODULEI],&itemArrayCounts[MODULEI],
&itemArrayVersions[MODULEI],maxIndices,
&itemReopenFlags[MODULEI],&itemCodeFiles[MODULEI]);
theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,NULL);
while (theDefgeneric != NULL)
{
itemFiles[GENERICI] =
OpenFileIfNeeded(theEnv,itemFiles[GENERICI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
itemArrayVersions[GENERICI],headerFP,
(char*)"DEFGENERIC",ConstructPrefix(DefgenericData(theEnv)->DefgenericCodeItem),
itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]);
if (itemFiles[GENERICI] == NULL)
goto GenericCodeError;
SingleDefgenericToCode(theEnv,itemFiles[GENERICI],imageID,maxIndices,theDefgeneric,
moduleCount,itemArrayVersions[METHODI],
itemArrayCounts[METHODI]);
itemArrayCounts[GENERICI]++;
itemFiles[GENERICI] =
CloseFileIfNeeded(theEnv,itemFiles[GENERICI],&itemArrayCounts[GENERICI],
&itemArrayVersions[GENERICI],maxIndices,
&itemReopenFlags[GENERICI],&itemCodeFiles[GENERICI]);
if (theDefgeneric->mcnt > 0)
{
/* ===========================================
Make sure that all methods for a particular
generic function go into the same array
=========================================== */
itemFiles[METHODI] =
OpenFileIfNeeded(theEnv,itemFiles[METHODI],fileName,pathName,fileNameBuffer,fileID,imageID,&fileCount,
itemArrayVersions[METHODI],headerFP,
(char*)"DEFMETHOD",MethodPrefix(),
itemReopenFlags[METHODI],&itemCodeFiles[METHODI]);
if (itemFiles[METHODI] == NULL)
goto GenericCodeError;
for (i = 0 ; i < theDefgeneric->mcnt ; i++)
{
theMethod = &theDefgeneric->methods[i];
if (i > 0)
fprintf(itemFiles[METHODI],",\n");
MethodToCode(theEnv,itemFiles[METHODI],imageID,theMethod,
itemArrayVersions[RESTRICTIONI],itemArrayCounts[RESTRICTIONI]);
if (theMethod->restrictionCount > 0)
{
/* ========================================
Make sure that all restrictions for a
particular method go into the same array
======================================== */
itemFiles[RESTRICTIONI] =
OpenFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],fileName,pathName,fileNameBuffer,fileID,
imageID,&fileCount,
itemArrayVersions[RESTRICTIONI],headerFP,
(char*)"RESTRICTION",RestrictionPrefix(),
itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]);
if (itemFiles[RESTRICTIONI] == NULL)
goto GenericCodeError;
for (j = 0 ; j < theMethod->restrictionCount ; j++)
{
theRestriction = &theMethod->restrictions[j];
if (j > 0)
fprintf(itemFiles[RESTRICTIONI],",\n");
RestrictionToCode(theEnv,itemFiles[RESTRICTIONI],imageID,theRestriction,
itemArrayVersions[TYPEI],itemArrayCounts[TYPEI]);
if (theRestriction->tcnt > 0)
{
/* =========================================
Make sure that all types for a particular
restriction go into the same array
========================================= */
itemFiles[TYPEI] =
OpenFileIfNeeded(theEnv,itemFiles[TYPEI],fileName,pathName,fileNameBuffer,fileID,
imageID,&fileCount,
itemArrayVersions[TYPEI],headerFP,
(char*)"void *",TypePrefix(),
itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]);
if (itemFiles[TYPEI] == NULL)
goto GenericCodeError;
for (k = 0 ; k < theRestriction->tcnt ; k++)
{
if (k > 0)
fprintf(itemFiles[TYPEI],",\n");
TypeToCode(theEnv,itemFiles[TYPEI],imageID,
theRestriction->types[k],maxIndices);
}
itemArrayCounts[TYPEI] += (int) theRestriction->tcnt;
itemFiles[TYPEI] =
CloseFileIfNeeded(theEnv,itemFiles[TYPEI],&itemArrayCounts[TYPEI],
&itemArrayVersions[TYPEI],maxIndices,
&itemReopenFlags[TYPEI],&itemCodeFiles[TYPEI]);
}
}
itemArrayCounts[RESTRICTIONI] += theMethod->restrictionCount;
itemFiles[RESTRICTIONI] =
CloseFileIfNeeded(theEnv,itemFiles[RESTRICTIONI],&itemArrayCounts[RESTRICTIONI],
&itemArrayVersions[RESTRICTIONI],maxIndices,
&itemReopenFlags[RESTRICTIONI],&itemCodeFiles[RESTRICTIONI]);
}
}
itemArrayCounts[METHODI] += (int) theDefgeneric->mcnt;
itemFiles[METHODI] =
CloseFileIfNeeded(theEnv,itemFiles[METHODI],&itemArrayCounts[METHODI],
&itemArrayVersions[METHODI],maxIndices,
&itemReopenFlags[METHODI],&itemCodeFiles[METHODI]);
}
theDefgeneric = (DEFGENERIC *) EnvGetNextDefgeneric(theEnv,theDefgeneric);
}
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,theModule);
moduleCount++;
itemArrayCounts[MODULEI]++;
}
CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices);
return(1);
GenericCodeError:
CloseDefgenericFiles(theEnv,itemFiles,itemReopenFlags,itemCodeFiles,maxIndices);
return(0);
}
/***********************************************************************
NAME : IsMethodApplicable
DESCRIPTION : Tests to see if a method satsifies the arguments of a
generic function
A method is applicable if all its restrictions are
satisfied by the corresponding arguments
INPUTS : The method address
RETURNS : true if method is applicable, false otherwise
SIDE EFFECTS : Any query functions are evaluated
NOTES : Uses globals ProcParamArraySize and ProcParamArray
***********************************************************************/
bool IsMethodApplicable(
void *theEnv,
DEFMETHOD *meth)
{
DATA_OBJECT temp;
short i,j,k;
register RESTRICTION *rp;
#if OBJECT_SYSTEM
void *type;
#else
int type;
#endif
if ((ProceduralPrimitiveData(theEnv)->ProcParamArraySize < meth->minRestrictions) ||
((ProceduralPrimitiveData(theEnv)->ProcParamArraySize > meth->minRestrictions) && (meth->maxRestrictions != -1)))
return(false);
for (i = 0 , k = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
{
rp = &meth->restrictions[k];
if (rp->tcnt != 0)
{
#if OBJECT_SYSTEM
type = (void *) DetermineRestrictionClass(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]);
if (type == NULL)
return(false);
for (j = 0 ; j < rp->tcnt ; j++)
{
if (type == rp->types[j])
break;
if (HasSuperclass((DEFCLASS *) type,(DEFCLASS *) rp->types[j]))
break;
if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS])
{
if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS)
break;
}
else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME])
{
if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME)
break;
}
else if (rp->types[j] ==
(void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0])
{
if ((ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_NAME) ||
(ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type == INSTANCE_ADDRESS))
break;
}
}
#else
type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].type;
for (j = 0 ; j < rp->tcnt ; j++)
{
if (type == ValueToInteger(rp->types[j]))
break;
if (SubsumeType(type,ValueToInteger(rp->types[j])))
break;
}
#endif
if (j == rp->tcnt)
return(false);
}
if (rp->query != NULL)
{
DefgenericData(theEnv)->GenericCurrentArgument = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i];
EvaluateExpression(theEnv,rp->query,&temp);
if ((temp.type != SYMBOL) ? false :
(temp.value == EnvFalseSymbol(theEnv)))
return(false);
}
if (((int) k) != meth->restrictionCount-1)
k++;
}
return(true);
}
/***************************************************
NAME : ClearDefgenericsReady
DESCRIPTION : Determines if it is safe to
remove all defgenerics
Assumes *all* constructs will be
deleted - only checks to see if
any methods are currently
executing
INPUTS : None
RETURNS : TRUE if no methods are
executing, FALSE otherwise
SIDE EFFECTS : None
NOTES : Used by (clear) and (bload)
***************************************************/
globle intBool ClearDefgenericsReady(
void *theEnv)
{
return((DefgenericData(theEnv)->CurrentGeneric != NULL) ? FALSE : TRUE);
}
/***********************************************************************
NAME : IsMethodApplicable
DESCRIPTION : Tests to see if a method satsifies the arguments of a
generic function
A method is applicable if all its restrictions are
satisfied by the corresponding arguments
INPUTS : The method address
RETURNS : True if method is applicable, false otherwise
SIDE EFFECTS : Any query functions are evaluated
NOTES : Uses globals ProcParamArraySize and ProcParamArray
***********************************************************************/
bool IsMethodApplicable(
Environment *theEnv,
Defmethod *meth)
{
UDFValue temp;
unsigned int i,j,k;
RESTRICTION *rp;
#if OBJECT_SYSTEM
Defclass *type;
#else
int type;
#endif
if (((ProceduralPrimitiveData(theEnv)->ProcParamArraySize < meth->minRestrictions) && (meth->minRestrictions != RESTRICTIONS_UNBOUNDED)) ||
((ProceduralPrimitiveData(theEnv)->ProcParamArraySize > meth->minRestrictions) && (meth->maxRestrictions != RESTRICTIONS_UNBOUNDED))) // TBD minRestrictions || maxRestrictions
return false;
for (i = 0 , k = 0 ; i < ProceduralPrimitiveData(theEnv)->ProcParamArraySize ; i++)
{
rp = &meth->restrictions[k];
if (rp->tcnt != 0)
{
#if OBJECT_SYSTEM
type = DetermineRestrictionClass(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParamArray[i]);
if (type == NULL)
return false;
for (j = 0 ; j < rp->tcnt ; j++)
{
if (type == rp->types[j])
break;
if (HasSuperclass(type,(Defclass *) rp->types[j]))
break;
if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS_TYPE])
{
if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_ADDRESS_TYPE)
break;
}
else if (rp->types[j] == (void *) DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE])
{
if (ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_NAME_TYPE)
break;
}
else if (rp->types[j] ==
DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME_TYPE]->directSuperclasses.classArray[0])
{
if ((ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_NAME_TYPE) ||
(ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type == INSTANCE_ADDRESS_TYPE))
break;
}
}
#else
type = ProceduralPrimitiveData(theEnv)->ProcParamArray[i].header->type;
for (j = 0 ; j < rp->tcnt ; j++)
{
if (type == ((CLIPSInteger *) (rp->types[j]))->contents)
break;
if (SubsumeType(type,((CLIPSInteger *) (rp->types[j]))->contents))
break;
}
#endif
if (j == rp->tcnt)
return false;
}
if (rp->query != NULL)
{
DefgenericData(theEnv)->GenericCurrentArgument = &ProceduralPrimitiveData(theEnv)->ProcParamArray[i];
EvaluateExpression(theEnv,rp->query,&temp);
if (temp.value == FalseSymbol(theEnv))
return false;
}
if ((k + 1) != meth->restrictionCount)
k++;
}
return true;
}
