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