/**************************************************************************
NAME : CallSpecificMethod
DESCRIPTION : Allows a specific method to be called without regards to
higher precedence methods which might also be applicable
However, shadowed methods can still be called.
INPUTS : A data object buffer to hold the method evaluation result
RETURNS : Nothing useful
SIDE EFFECTS : Side-effects of method applicability tests and the
evaluation of methods
NOTES : H/L Syntax: (call-specific-method
<generic-function> <method-index> <args>)
**************************************************************************/
void CallSpecificMethod(
UDFContext *context,
CLIPSValue *returnValue)
{
CLIPSValue theArg;
DEFGENERIC *gfunc;
int mi;
Environment *theEnv = UDFContextEnvironment(context);
mCVSetBoolean(returnValue,false);
if (! UDFFirstArgument(context,SYMBOL_TYPE,&theArg)) return;
gfunc = CheckGenericExists(theEnv,"call-specific-method",mCVToString(&theArg));
if (gfunc == NULL) return;
if (! UDFNextArgument(context,INTEGER_TYPE,&theArg)) return;
mi = CheckMethodExists(theEnv,"call-specific-method",gfunc,(long) mCVToInteger(&theArg));
if (mi == -1)
return;
gfunc->methods[mi].busy++;
GenericDispatch(theEnv,gfunc,NULL,&gfunc->methods[mi],
GetFirstArgument()->nextArg->nextArg,returnValue);
gfunc->methods[mi].busy--;
}
/******************************************************
NAME : CheckTwoClasses
DESCRIPTION : Checks for exactly two class arguments
for a H/L function
INPUTS : 1) The function name
2) Caller's buffer for first class
3) Caller's buffer for second class
RETURNS : True if both found, false otherwise
SIDE EFFECTS : Caller's buffers set
NOTES : Assumes exactly 2 arguments
******************************************************/
static bool CheckTwoClasses(
UDFContext *context,
const char *func,
Defclass **c1,
Defclass **c2)
{
UDFValue theArg;
Environment *theEnv = context->environment;
if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
{ return false; }
*c1 = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents);
if (*c1 == NULL)
{
ClassExistError(theEnv,func,theArg.lexemeValue->contents);
return false;
}
if (! UDFNextArgument(context,SYMBOL_BIT,&theArg))
{ return false; }
*c2 = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents);
if (*c2 == NULL)
{
ClassExistError(theEnv,func,theArg.lexemeValue->contents);
return false;
}
return true;
}
/**************************************************************************
NAME : CallSpecificMethod
DESCRIPTION : Allows a specific method to be called without regards to
higher precedence methods which might also be applicable
However, shadowed methods can still be called.
INPUTS : A data object buffer to hold the method evaluation result
RETURNS : Nothing useful
SIDE EFFECTS : Side-effects of method applicability tests and the
evaluation of methods
NOTES : H/L Syntax: (call-specific-method
<generic-function> <method-index> <args>)
**************************************************************************/
void CallSpecificMethod(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
UDFValue theArg;
Defgeneric *gfunc;
int mi;
returnValue->lexemeValue = FalseSymbol(theEnv);
if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
gfunc = CheckGenericExists(theEnv,"call-specific-method",theArg.lexemeValue->contents);
if (gfunc == NULL) return;
if (! UDFNextArgument(context,INTEGER_BIT,&theArg)) return;
mi = CheckMethodExists(theEnv,"call-specific-method",gfunc,(unsigned short) theArg.integerValue->contents);
if (mi == METHOD_NOT_FOUND)
return;
gfunc->methods[mi].busy++;
GenericDispatch(theEnv,gfunc,NULL,&gfunc->methods[mi],
GetFirstArgument()->nextArg->nextArg,returnValue);
gfunc->methods[mi].busy--;
}
/*********************************************************************
NAME : SlotExistPCommand
DESCRIPTION : Determines if a slot is present in a class
INPUTS : None
RETURNS : True if the slot exists, false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (slot-existp <class> <slot> [inherit])
*********************************************************************/
void SlotExistPCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *cls;
SlotDescriptor *sd;
bool inheritFlag = false;
UDFValue theArg;
sd = CheckSlotExists(context,"slot-existp",&cls,false,true);
if (sd == NULL)
{
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
if (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,SYMBOL_BIT,&theArg))
{ return; }
if (strcmp(theArg.lexemeValue->contents,"inherit") != 0)
{
UDFInvalidArgumentMessage(context,"keyword \"inherit\"");
SetEvaluationError(theEnv,true);
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
inheritFlag = true;
}
returnValue->lexemeValue = CreateBoolean(theEnv,((sd->cls == cls) ? true : inheritFlag));
}
const char *GetLogicalName(
UDFContext *context,
const char *defaultLogicalName)
{
Environment *theEnv = context->environment;
const char *logicalName;
UDFValue theArg;
if (! UDFNextArgument(context,ANY_TYPE_BITS,&theArg))
{ return NULL; }
if (CVIsType(&theArg,LEXEME_BITS) ||
CVIsType(&theArg,INSTANCE_NAME_BIT))
{
logicalName = theArg.lexemeValue->contents;
if ((strcmp(logicalName,"t") == 0) || (strcmp(logicalName,"T") == 0))
{ logicalName = defaultLogicalName; }
}
else if (CVIsType(&theArg,FLOAT_BIT))
{
logicalName = CreateSymbol(theEnv,FloatToString(theEnv,theArg.floatValue->contents))->contents;
}
else if (CVIsType(&theArg,INTEGER_BIT))
{
logicalName = CreateSymbol(theEnv,LongIntegerToString(theEnv,theArg.integerValue->contents))->contents;
}
else
{ logicalName = NULL; }
return(logicalName);
}
bool UDFFirstArgument(
UDFContext *context,
unsigned expectedType,
CLIPSValue *returnValue)
{
context->lastArg = EvaluationData(context->environment)->CurrentExpression->argList;
context->lastPosition = 1;
return UDFNextArgument(context,expectedType,returnValue);
}
/************************************************************************************
NAME : MessageHandlerExistPCommand
DESCRIPTION : Determines if a message-handler is present in a class
INPUTS : None
RETURNS : True if the message header is present, false otherwise
SIDE EFFECTS : None
NOTES : H/L Syntax : (message-handler-existp <class> <hnd> [<type>])
************************************************************************************/
void MessageHandlerExistPCommand(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
Defclass *cls;
CLIPSLexeme *mname;
UDFValue theArg;
unsigned mtype = MPRIMARY;
if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
{ return; }
cls = LookupDefclassByMdlOrScope(theEnv,theArg.lexemeValue->contents);
if (cls == NULL)
{
ClassExistError(theEnv,"message-handler-existp",theArg.lexemeValue->contents);
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
if (! UDFNextArgument(context,SYMBOL_BIT,&theArg))
{ return; }
mname = theArg.lexemeValue;
if (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,SYMBOL_BIT,&theArg))
{ return; }
mtype = HandlerType(theEnv,"message-handler-existp",true,theArg.lexemeValue->contents);
if (mtype == MERROR)
{
SetEvaluationError(theEnv,true);
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
}
if (FindHandlerByAddress(cls,mname,mtype) != NULL)
{ returnValue->lexemeValue = TrueSymbol(theEnv); }
else
{ returnValue->lexemeValue = FalseSymbol(theEnv); }
}
const char *GetFileName(
UDFContext *context)
{
UDFValue theArg;
if (! UDFNextArgument(context,LEXEME_BITS,&theArg))
{ return NULL; }
return theArg.lexemeValue->contents;
}
void DivisionFunction(
UDFContext *context,
CLIPSValue *returnValue)
{
CLIPSFloat ftotal = 1.0;
CLIPSFloat theNumber;
CLIPSValue theArg;
Environment *theEnv = UDFContextEnvironment(context);
/*===================================================*/
/* Get the first argument. This number which will be */
/* the starting product from which all subsequent */
/* arguments will divide. If the auto float dividend */
/* feature is enable, then this number is converted */
/* to a float if it is an integer. */
/*===================================================*/
if (! UDFFirstArgument(context,NUMBER_TYPES,&theArg))
{ return; }
ftotal = mCVToFloat(&theArg);
/*====================================================*/
/* Loop through each of the arguments dividing it */
/* into a running product. If a floating point number */
/* is encountered, then do all subsequent operations */
/* using floating point values. Each argument is */
/* checked to prevent a divide by zero error. */
/*====================================================*/
while (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,NUMBER_TYPES,&theArg))
{ return; }
theNumber = mCVToFloat(&theArg);
if (theNumber == 0.0)
{
DivideByZeroErrorMessage(theEnv,"/");
EnvSetEvaluationError(theEnv,true);
mCVSetFloat(returnValue,1.0);
return;
}
ftotal /= theNumber;
}
/*======================================================*/
/* If a floating point number was in the argument list, */
/* then return a float, otherwise return an integer. */
/*======================================================*/
mCVSetFloat(returnValue,ftotal);
}
void DivFunction(
UDFContext *context,
CLIPSValue *returnValue)
{
CLIPSInteger total = 1LL;
DATA_OBJECT theArg;
CLIPSInteger theNumber;
void *theEnv = UDFContextEnvironment(context);
/*===================================================*/
/* Get the first argument. This number which will be */
/* the starting product from which all subsequent */
/* arguments will divide. */
/*===================================================*/
if (! UDFFirstArgument(context,NUMBER_TYPES,&theArg))
{ return; }
total = mCVToInteger(&theArg);
/*=====================================================*/
/* Loop through each of the arguments dividing it into */
/* a running product. Floats are converted to integers */
/* and each argument is checked to prevent a divide by */
/* zero error. */
/*=====================================================*/
while (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,NUMBER_TYPES,&theArg))
{ return; }
theNumber = mCVToInteger(&theArg);
if (theNumber == 0LL)
{
DivideByZeroErrorMessage(theEnv,"div");
EnvSetEvaluationError(theEnv,true);
mCVSetInteger(returnValue,1L);
return;
}
total /= theNumber;
}
/*======================================================*/
/* The result of the div function is always an integer. */
/*======================================================*/
mCVSetInteger(returnValue,total);
}
void AdditionFunction(
UDFContext *context,
CLIPSValue *returnValue)
{
CLIPSFloat ftotal = 0.0;
CLIPSInteger ltotal = 0LL;
bool useFloatTotal = false;
CLIPSValue theArg;
/*=================================================*/
/* Loop through each of the arguments adding it to */
/* a running total. If a floating point number is */
/* encountered, then do all subsequent operations */
/* using floating point values. */
/*=================================================*/
while (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,NUMBER_TYPES,&theArg))
{ return; }
if (useFloatTotal)
{ ftotal += mCVToFloat(&theArg); }
else
{
if (mCVIsType(&theArg,INTEGER_TYPE))
{ ltotal += mCVToInteger(&theArg); }
else
{
ftotal = ((CLIPSFloat) ltotal) + mCVToFloat(&theArg);
useFloatTotal = true;
}
}
}
/*======================================================*/
/* If a floating point number was in the argument list, */
/* then return a float, otherwise return an integer. */
/*======================================================*/
if (useFloatTotal)
{ mCVSetFloat(returnValue,ftotal); }
else
{ mCVSetInteger(returnValue,ltotal); }
}
void MaxFunction(
UDFContext *context,
CLIPSValue *returnValue)
{
CLIPSValue nextPossible;
/*============================================*/
/* Check that the first argument is a number. */
/*============================================*/
if (! UDFFirstArgument(context,NUMBER_TYPES,returnValue))
{ return; }
/*===========================================================*/
/* Loop through the remaining arguments, first checking each */
/* argument to see that it is a number, and then determining */
/* if the argument is greater than the previous arguments */
/* and is thus the maximum value. */
/*===========================================================*/
while (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,NUMBER_TYPES,&nextPossible))
{ return; }
/*=============================================*/
/* If either argument is a float, convert both */
/* to floats. Otherwise compare two integers. */
/*=============================================*/
if (mCVIsType(returnValue,FLOAT_TYPE) || mCVIsType(&nextPossible,FLOAT_TYPE))
{
if (mCVToFloat(returnValue) < mCVToFloat(&nextPossible))
{ CVSetCLIPSValue(returnValue,&nextPossible); }
}
else
{
if (mCVToInteger(returnValue) < mCVToInteger(&nextPossible))
{ CVSetCLIPSValue(returnValue,&nextPossible); }
}
}
}
bool UDFNthArgument(
UDFContext *context,
int argumentPosition,
unsigned expectedType,
DATA_OBJECT_PTR returnValue)
{
void *theEnv = UDFContextEnvironment(context);
if (argumentPosition < context->lastPosition)
{
context->lastArg = EvaluationData(theEnv)->CurrentExpression->argList;
context->lastPosition = 1;
}
for ( ; (context->lastArg != NULL) && (context->lastPosition < argumentPosition) ;
context->lastArg = context->lastArg->nextArg)
{ context->lastPosition++; }
return UDFNextArgument(context,expectedType,returnValue);
}
void SubtractionFunction(
UDFContext *context,
CLIPSValue *returnValue)
{
CLIPSFloat ftotal = 0.0;
CLIPSInteger ltotal = 0LL;
bool useFloatTotal = false;
CLIPSValue theArg;
/*=================================================*/
/* Get the first argument. This number which will */
/* be the starting total from which all subsequent */
/* arguments will subtracted. */
/*=================================================*/
if (! UDFFirstArgument(context,NUMBER_TYPES,&theArg))
{ return; }
if (mCVIsType(&theArg,INTEGER_TYPE))
{ ltotal = mCVToInteger(&theArg); }
else
{
ftotal = mCVToFloat(&theArg);
useFloatTotal = true;
}
/*===================================================*/
/* Loop through each of the arguments subtracting it */
/* from a running total. If a floating point number */
/* is encountered, then do all subsequent operations */
/* using floating point values. */
/*===================================================*/
while (UDFHasNextArgument(context))
{
if (! UDFNextArgument(context,NUMBER_TYPES,&theArg))
{ return; }
if (useFloatTotal)
{ ftotal -= mCVToFloat(&theArg); }
else
{
if (mCVIsType(&theArg,INTEGER_TYPE))
{ ltotal -= mCVToInteger(&theArg); }
else
{
ftotal = ((CLIPSFloat) ltotal) - mCVToFloat(&theArg);
useFloatTotal = true;
}
}
}
/*======================================================*/
/* If a floating point number was in the argument list, */
/* then return a float, otherwise return an integer. */
/*======================================================*/
if (useFloatTotal)
{ mCVSetFloat(returnValue,ftotal); }
else
{ mCVSetInteger(returnValue,ltotal); }
}
