/***************************************************************
NAME : CheckHandlerArgCount
DESCRIPTION : Verifies that the current argument
list satisfies the current
handler's parameter count restriction
INPUTS : None
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : EvaluationError set on errors
NOTES : Uses ProcParamArraySize and CurrentCore globals
***************************************************************/
globle int CheckHandlerArgCount(
void *theEnv,
EXEC_STATUS)
{
HANDLER *hnd;
hnd = MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd;
if ((hnd->maxParams == -1) ? (ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize < hnd->minParams) :
(ProceduralPrimitiveData(theEnv,execStatus)->ProcParamArraySize != hnd->minParams))
{
SetEvaluationError(theEnv,execStatus,TRUE);
PrintErrorID(theEnv,execStatus,"MSGFUN",2,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"Message-handler ");
EnvPrintRouter(theEnv,execStatus,WERROR,ValueToString(hnd->name));
EnvPrintRouter(theEnv,execStatus,WERROR," ");
EnvPrintRouter(theEnv,execStatus,WERROR,MessageHandlerData(theEnv,execStatus)->hndquals[hnd->type]);
EnvPrintRouter(theEnv,execStatus,WERROR," in class ");
EnvPrintRouter(theEnv,execStatus,WERROR,EnvGetDefclassName(theEnv,execStatus,(void *) hnd->cls));
EnvPrintRouter(theEnv,execStatus,WERROR," expected ");
if (hnd->maxParams == -1)
EnvPrintRouter(theEnv,execStatus,WERROR,"at least ");
else
EnvPrintRouter(theEnv,execStatus,WERROR,"exactly ");
PrintLongInteger(theEnv,execStatus,WERROR,(long long) (hnd->minParams-1));
EnvPrintRouter(theEnv,execStatus,WERROR," argument(s).\n");
return(FALSE);
}
return(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(
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 : CheckCurrentMessage
DESCRIPTION : Makes sure that a message is available
and active for an internal message function
INPUTS : 1) The name of the function checking the message
2) A flag indicating whether the object must be
a class instance or not (it could be a
primitive type)
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : EvaluationError set on errors
NOTES : None
*****************************************************************/
globle int CheckCurrentMessage(
void *theEnv,
EXEC_STATUS,
char *func,
int ins_reqd)
{
register DATA_OBJECT *activeMsgArg;
if (!MessageHandlerData(theEnv,execStatus)->CurrentCore || (MessageHandlerData(theEnv,execStatus)->CurrentCore->hnd->actions != ProceduralPrimitiveData(theEnv,execStatus)->CurrentProcActions))
{
PrintErrorID(theEnv,execStatus,"MSGFUN",4,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,func);
EnvPrintRouter(theEnv,execStatus,WERROR," may only be called from within message-handlers.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(FALSE);
}
activeMsgArg = GetNthMessageArgument(theEnv,execStatus,0);
if ((ins_reqd == TRUE) ? (activeMsgArg->type != INSTANCE_ADDRESS) : FALSE)
{
PrintErrorID(theEnv,execStatus,"MSGFUN",5,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,func);
EnvPrintRouter(theEnv,execStatus,WERROR," operates only on instances.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(FALSE);
}
if ((activeMsgArg->type == INSTANCE_ADDRESS) ?
(((INSTANCE_TYPE *) activeMsgArg->value)->garbage == 1) : FALSE)
{
StaleInstanceAddress(theEnv,execStatus,func,0);
SetEvaluationError(theEnv,execStatus,TRUE);
return(FALSE);
}
return(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;
}
