void get_argument(void* env, int argposition, Values& values) {
DATA_OBJECT arg;
if (EnvArgTypeCheck(env, (char *)"clipsmm get_argument",
argposition, MULTIFIELD, &arg) == 0) return;
values.clear();
int end = EnvGetDOEnd(env, arg);
void *mfp = EnvGetValue(env, arg);
for (int i = EnvGetDOBegin(env, arg); i <= end; ++i) {
switch (GetMFType(mfp, i)) {
case SYMBOL:
case STRING:
case INSTANCE_NAME:
values.push_back(Value(ValueToString(GetMFValue(mfp, i))));
break;
case FLOAT:
values.push_back(Value(ValueToDouble(GetMFValue(mfp, i))));
break;
case INTEGER:
values.push_back(Value(ValueToInteger(GetMFValue(mfp, i))));
break;
default:
continue;
break;
}
}
}
std::vector<std::string> data_object_to_strings( dataObject& clipsdo ) {
void* mfptr;
long int end, i;
std::string s;
std::vector<std::string> strings;
switch ( GetType(clipsdo) ) {
case SYMBOL:
case INSTANCE_NAME:
case STRING:
strings.push_back( DOToString( clipsdo ) );
break;
case MULTIFIELD:
end = GetDOEnd( clipsdo );
mfptr = GetValue( clipsdo );
for ( i = GetDOBegin( clipsdo ); i <= end; i++ ) {
switch ( GetMFType( mfptr, i ) ) {
case SYMBOL:
case STRING:
case INSTANCE_NAME:
strings.push_back( ValueToString( GetMFValue( mfptr, i ) ) );
break;
default:
break;
}
}
default:
break;
}
return strings;
}
/***************************************************
NAME : EnvGetNextInstanceInClassAndSubclasses
DESCRIPTION : Finds next instance of class
(or first instance of class) and
all of its subclasses
INPUTS : 1) Class address (DIRECT POINTER!)
2) Instance address
(NULL to get first instance)
RETURNS : The next or first class instance
SIDE EFFECTS : None
NOTES : None
***************************************************/
globle void *EnvGetNextInstanceInClassAndSubclasses_PY(
void *theEnv,
void *cptr, /* this has changed */
void *iptr,
DATA_OBJECT *iterationInfo)
{
INSTANCE_TYPE *nextInstance;
DEFCLASS *theClass;
theClass = (DEFCLASS *)cptr;
if (iptr == NULL)
{
ClassSubclassAddresses(theEnv,theClass,iterationInfo,TRUE);
nextInstance = theClass->instanceList;
}
else if (((INSTANCE_TYPE *) iptr)->garbage == 1)
{ nextInstance = NULL; }
else
{ nextInstance = ((INSTANCE_TYPE *) iptr)->nxtClass; }
while ((nextInstance == NULL) &&
(GetpDOBegin(iterationInfo) <= GetpDOEnd(iterationInfo)))
{
theClass = (struct defclass *) GetMFValue(DOPToPointer(iterationInfo),
GetpDOBegin(iterationInfo));
SetpDOBegin(iterationInfo,GetpDOBegin(iterationInfo) + 1);
nextInstance = theClass->instanceList;
}
return(nextInstance);
}
globle struct expr *ConvertValueToExpression(
DATA_OBJECT *theValue)
{
long i;
struct expr *head = NULL, *last = NULL, *newItem;
if (GetpType(theValue) != MULTIFIELD)
{ return(GenConstant(GetpType(theValue),GetpValue(theValue))); }
for (i = GetpDOBegin(theValue); i <= GetpDOEnd(theValue); i++)
{
newItem = GenConstant(GetMFType(GetpValue(theValue),i),
GetMFValue(GetpValue(theValue),i));
if (last == NULL) head = newItem;
else last->nextArg = newItem;
last = newItem;
}
if (head == NULL)
return(GenConstant(FCALL,(void *) FindFunction("create$")));
return(head);
}
/*************************************************************
NAME : FormChain
DESCRIPTION : Builds a list of classes to be used in
fact queries - uses parse form.
INPUTS : 1) Name of calling function for error msgs
2) Data object - must be a symbol or a
multifield value containing all symbols
The symbols must be names of existing templates
RETURNS : The query chain, or NULL on errors
SIDE EFFECTS : Memory allocated for chain
Busy count incremented for all templates
NOTES : None
*************************************************************/
static QUERY_TEMPLATE *FormChain(
void *theEnv,
char *func,
DATA_OBJECT *val)
{
struct deftemplate *templatePtr;
QUERY_TEMPLATE *head,*bot,*tmp;
register long i,end; /* 6.04 Bug Fix */
char *templateName;
int count;
if (val->type == DEFTEMPLATE_PTR)
{
IncrementDeftemplateBusyCount(theEnv,(void *) val->value);
head = get_struct(theEnv,query_template);
head->templatePtr = (struct deftemplate *) val->value;
head->chain = NULL;
head->nxt = NULL;
return(head);
}
if (val->type == SYMBOL)
{
/* ===============================================
Allow instance-set query restrictions to have a
module specifier as part of the class name,
but search imported defclasses too if a
module specifier is not given
=============================================== */
templatePtr = (struct deftemplate *)
FindImportedConstruct(theEnv,"deftemplate",NULL,DOPToString(val),
&count,TRUE,NULL);
if (templatePtr == NULL)
{
CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",DOPToString(val),func);
return(NULL);
}
IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
head = get_struct(theEnv,query_template);
head->templatePtr = templatePtr;
head->chain = NULL;
head->nxt = NULL;
return(head);
}
if (val->type == MULTIFIELD)
{
head = bot = NULL;
end = GetpDOEnd(val);
for (i = GetpDOBegin(val) ; i <= end ; i++)
{
if (GetMFType(val->value,i) == SYMBOL)
{
templateName = ValueToString(GetMFValue(val->value,i));
templatePtr = (struct deftemplate *)
FindImportedConstruct(theEnv,"deftemplate",NULL,templateName,
&count,TRUE,NULL);
if (templatePtr == NULL)
{
CantFindItemInFunctionErrorMessage(theEnv,"deftemplate",templateName,func);
DeleteQueryTemplates(theEnv,head);
return(NULL);
}
}
else
{
DeleteQueryTemplates(theEnv,head);
return(NULL);
}
IncrementDeftemplateBusyCount(theEnv,(void *) templatePtr);
tmp = get_struct(theEnv,query_template);
tmp->templatePtr = templatePtr;
tmp->chain = NULL;
tmp->nxt = NULL;
if (head == NULL)
head = tmp;
else
bot->chain = tmp;
bot = tmp;
}
return(head);
}
return(NULL);
}
/***************************************************
NAME : GetObjectValueGeneral
DESCRIPTION : Access function for getting
pattern variable values within the
object pattern and join networks
INPUTS : 1) The result data object buffer
2) The instance to access
3) The list of multifield markers
for the pattern
4) Data for variable reference
RETURNS : Nothing useful
SIDE EFFECTS : Data object is filled with the
values of the pattern variable
NOTES : None
***************************************************/
static void GetObjectValueGeneral(
void *theEnv,
DATA_OBJECT *result,
INSTANCE_TYPE *theInstance,
struct multifieldMarker *theMarks,
struct ObjectMatchVar1 *matchVar)
{
long field, extent; /* 6.04 Bug Fix */
INSTANCE_SLOT **insSlot,*basisSlot;
if (matchVar->objectAddress)
{
result->type = INSTANCE_ADDRESS;
result->value = (void *) theInstance;
return;
}
if (matchVar->whichSlot == ISA_ID)
{
result->type = SYMBOL;
result->value = (void *) GetDefclassNamePointer((void *) theInstance->cls);
return;
}
if (matchVar->whichSlot == NAME_ID)
{
result->type = INSTANCE_NAME;
result->value = (void *) theInstance->name;
return;
}
insSlot =
&theInstance->slotAddresses
[theInstance->cls->slotNameMap[matchVar->whichSlot] - 1];
/* =========================================
We need to reference the basis slots if
the slot of this object has changed while
the RHS was executing
However, if the reference is being done
by the LHS of a rule (as a consequence of
an RHS action), give the pattern matcher
the real value of the slot
========================================= */
if ((theInstance->basisSlots != NULL) &&
(! EngineData(theEnv)->JoinOperationInProgress))
{
basisSlot = theInstance->basisSlots + (insSlot - theInstance->slotAddresses);
if (basisSlot->value != NULL)
insSlot = &basisSlot;
}
/* ==================================================
If we know we are accessing the entire slot,
the don't bother with searching multifield markers
or calculating offsets
================================================== */
if (matchVar->allFields)
{
result->type = (unsigned short) (*insSlot)->type;
result->value = (*insSlot)->value;
if (result->type == MULTIFIELD)
{
result->begin = 0;
SetpDOEnd(result,GetMFLength((*insSlot)->value));
}
return;
}
/* =============================================
Access a general field in a slot pattern with
two or more multifield variables
============================================= */
field = CalculateSlotField(theMarks,*insSlot,matchVar->whichField,&extent);
if (extent == -1)
{
if ((*insSlot)->desc->multiple)
{
result->type = GetMFType((*insSlot)->value,field);
result->value = GetMFValue((*insSlot)->value,field);
}
else
{
result->type = (unsigned short) (*insSlot)->type;
result->value = (*insSlot)->value;
}
}
else
{
result->type = MULTIFIELD;
result->value = (*insSlot)->value;
result->begin = field - 1;
result->end = field + extent - 2;
}
}
globle void *ImplodeMultifield(
void *theEnv,
DATA_OBJECT *value)
{
size_t strsize = 0;
long i, j;
const char *tmp_str;
char *ret_str;
void *rv;
struct multifield *theMultifield;
DATA_OBJECT tempDO;
/*===================================================*/
/* Determine the size of the string to be allocated. */
/*===================================================*/
theMultifield = (struct multifield *) GetpValue(value);
for (i = GetpDOBegin(value) ; i <= GetpDOEnd(value) ; i++)
{
if (GetMFType(theMultifield,i) == FLOAT)
{
tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
strsize += strlen(tmp_str) + 1;
}
else if (GetMFType(theMultifield,i) == INTEGER)
{
tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
strsize += strlen(tmp_str) + 1;
}
else if (GetMFType(theMultifield,i) == STRING)
{
strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3;
tmp_str = ValueToString(GetMFValue(theMultifield,i));
while(*tmp_str)
{
if (*tmp_str == '"')
{ strsize++; }
else if (*tmp_str == '\\') /* GDR 111599 #835 */
{ strsize++; } /* GDR 111599 #835 */
tmp_str++;
}
}
#if OBJECT_SYSTEM
else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
{ strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; }
else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
{ strsize += strlen(ValueToString(((INSTANCE_TYPE *)
GetMFValue(theMultifield,i))->name)) + 3; }
#endif
else
{
SetType(tempDO,GetMFType(theMultifield,i));
SetValue(tempDO,GetMFValue(theMultifield,i));
strsize += strlen(DataObjectToString(theEnv,&tempDO)) + 1;
}
}
/*=============================================*/
/* Allocate the string and copy all components */
/* of the MULTIFIELD variable to it. */
/*=============================================*/
if (strsize == 0) return(EnvAddSymbol(theEnv,""));
ret_str = (char *) gm2(theEnv,strsize);
for(j=0, i=GetpDOBegin(value); i <= GetpDOEnd(value) ; i++)
{
/*============================*/
/* Convert numbers to strings */
/*============================*/
if (GetMFType(theMultifield,i) == FLOAT)
{
tmp_str = FloatToString(theEnv,ValueToDouble(GetMFValue(theMultifield,i)));
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
}
else if (GetMFType(theMultifield,i) == INTEGER)
{
tmp_str = LongIntegerToString(theEnv,ValueToLong(GetMFValue(theMultifield,i)));
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
}
/*=======================================*/
/* Enclose strings in quotes and preceed */
/* imbedded quotes with a backslash */
/*=======================================*/
else if (GetMFType(theMultifield,i) == STRING)
{
tmp_str = ValueToString(GetMFValue(theMultifield,i));
*(ret_str+j) = '"';
j++;
while(*tmp_str)
{
if (*tmp_str == '"')
{
*(ret_str+j) = '\\';
j++;
}
else if (*tmp_str == '\\') /* GDR 111599 #835 */
{ /* GDR 111599 #835 */
*(ret_str+j) = '\\'; /* GDR 111599 #835 */
j++; /* GDR 111599 #835 */
} /* GDR 111599 #835 */
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
*(ret_str+j) = '"';
j++;
}
#if OBJECT_SYSTEM
else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
{
tmp_str = ValueToString(GetMFValue(theMultifield,i));
*(ret_str + j++) = '[';
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
*(ret_str + j++) = ']';
}
else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
{
tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name);
*(ret_str + j++) = '[';
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
*(ret_str + j++) = ']';
}
#endif
else
{
SetType(tempDO,GetMFType(theMultifield,i));
SetValue(tempDO,GetMFValue(theMultifield,i));
tmp_str = DataObjectToString(theEnv,&tempDO);
while(*tmp_str)
{
*(ret_str+j) = *tmp_str;
j++, tmp_str++;
}
}
*(ret_str+j) = ' ';
j++;
}
*(ret_str+j-1) = '\0';
/*====================*/
/* Return the string. */
/*====================*/
rv = EnvAddSymbol(theEnv,ret_str);
rm(theEnv,ret_str,strsize);
return(rv);
}
globle void SortFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
long argumentCount, i, j, k = 0;
DATA_OBJECT *theArguments, *theArguments2;
DATA_OBJECT theArg;
struct multifield *theMultifield, *tempMultifield;
char *functionName;
struct expr *functionReference;
int argumentSize = 0;
struct FunctionDefinition *fptr;
#if DEFFUNCTION_CONSTRUCT
DEFFUNCTION *dptr;
#endif
/*==================================*/
/* Set up the default return value. */
/*==================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
/*=============================================*/
/* The function expects at least one argument. */
/*=============================================*/
if ((argumentCount = EnvArgCountCheck(theEnv,"sort",AT_LEAST,1)) == -1)
{ return; }
/*=============================================*/
/* Verify that the comparison function exists. */
/*=============================================*/
if (EnvArgTypeCheck(theEnv,"sort",1,SYMBOL,&theArg) == FALSE)
{ return; }
functionName = DOToString(theArg);
functionReference = FunctionReferenceExpression(theEnv,functionName);
if (functionReference == NULL)
{
ExpectedTypeError1(theEnv,"sort",1,"function name, deffunction name, or defgeneric name");
return;
}
/*======================================*/
/* For an external function, verify the */
/* correct number of arguments. */
/*======================================*/
if (functionReference->type == FCALL)
{
fptr = (struct FunctionDefinition *) functionReference->value;
if ((GetMinimumArgs(fptr) > 2) ||
(GetMaximumArgs(fptr) == 0) ||
(GetMaximumArgs(fptr) == 1))
{
ExpectedTypeError1(theEnv,"sort",1,"function name expecting two arguments");
ReturnExpression(theEnv,functionReference);
return;
}
}
/*=======================================*/
/* For a deffunction, verify the correct */
/* number of arguments. */
/*=======================================*/
#if DEFFUNCTION_CONSTRUCT
if (functionReference->type == PCALL)
{
dptr = (DEFFUNCTION *) functionReference->value;
if ((dptr->minNumberOfParameters > 2) ||
(dptr->maxNumberOfParameters == 0) ||
(dptr->maxNumberOfParameters == 1))
{
ExpectedTypeError1(theEnv,"sort",1,"deffunction name expecting two arguments");
ReturnExpression(theEnv,functionReference);
return;
}
}
#endif
/*=====================================*/
/* If there are no items to be sorted, */
/* then return an empty multifield. */
/*=====================================*/
if (argumentCount == 1)
{
EnvSetMultifieldErrorValue(theEnv,returnValue);
ReturnExpression(theEnv,functionReference);
return;
}
/*=====================================*/
/* Retrieve the arguments to be sorted */
/* and determine how many there are. */
/*=====================================*/
theArguments = (DATA_OBJECT *) genalloc(theEnv,(argumentCount - 1) * sizeof(DATA_OBJECT));
for (i = 2; i <= argumentCount; i++)
{
EnvRtnUnknown(theEnv,i,&theArguments[i-2]);
if (GetType(theArguments[i-2]) == MULTIFIELD)
{ argumentSize += GetpDOLength(&theArguments[i-2]); }
else
{ argumentSize++; }
}
if (argumentSize == 0)
{
genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT)); /* Bug Fix */
EnvSetMultifieldErrorValue(theEnv,returnValue);
ReturnExpression(theEnv,functionReference);
return;
}
/*====================================*/
/* Pack all of the items to be sorted */
/* into a data object array. */
/*====================================*/
theArguments2 = (DATA_OBJECT *) genalloc(theEnv,argumentSize * sizeof(DATA_OBJECT));
for (i = 2; i <= argumentCount; i++)
{
if (GetType(theArguments[i-2]) == MULTIFIELD)
{
tempMultifield = (struct multifield *) GetValue(theArguments[i-2]);
for (j = GetDOBegin(theArguments[i-2]); j <= GetDOEnd(theArguments[i-2]); j++, k++)
{
SetType(theArguments2[k],GetMFType(tempMultifield,j));
SetValue(theArguments2[k],GetMFValue(tempMultifield,j));
}
}
else
{
SetType(theArguments2[k],GetType(theArguments[i-2]));
SetValue(theArguments2[k],GetValue(theArguments[i-2]));
k++;
}
}
genfree(theEnv,theArguments,(argumentCount - 1) * sizeof(DATA_OBJECT));
functionReference->nextArg = SortFunctionData(theEnv)->SortComparisonFunction;
SortFunctionData(theEnv)->SortComparisonFunction = functionReference;
for (i = 0; i < argumentSize; i++)
{ ValueInstall(theEnv,&theArguments2[i]); }
MergeSort(theEnv,(unsigned long) argumentSize,theArguments2,DefaultCompareSwapFunction);
for (i = 0; i < argumentSize; i++)
{ ValueDeinstall(theEnv,&theArguments2[i]); }
SortFunctionData(theEnv)->SortComparisonFunction = SortFunctionData(theEnv)->SortComparisonFunction->nextArg;
functionReference->nextArg = NULL;
ReturnExpression(theEnv,functionReference);
theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,(unsigned long) argumentSize);
for (i = 0; i < argumentSize; i++)
{
SetMFType(theMultifield,i+1,GetType(theArguments2[i]));
SetMFValue(theMultifield,i+1,GetValue(theArguments2[i]));
}
genfree(theEnv,theArguments2,argumentSize * sizeof(DATA_OBJECT));
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,argumentSize);
SetpValue(returnValue,(void *) theMultifield);
}
globle void StoreInMultifield(
void *theEnv,
DATA_OBJECT *returnValue,
EXPRESSION *expptr,
int garbageSegment)
{
DATA_OBJECT val_ptr;
DATA_OBJECT *val_arr;
struct multifield *theMultifield;
struct multifield *orig_ptr;
long start, end, i,j, k, argCount;
unsigned long seg_size;
argCount = CountArguments(expptr);
/*=========================================*/
/* If no arguments are given return a NULL */
/* multifield of length zero. */
/*=========================================*/
if (argCount == 0)
{
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,0);
if (garbageSegment) theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L);
else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
SetpValue(returnValue,(void *) theMultifield);
return;
}
else
{
/*========================================*/
/* Get a new segment with length equal to */
/* the total length of all the arguments. */
/*========================================*/
val_arr = (DATA_OBJECT *) gm3(theEnv,(long) sizeof(DATA_OBJECT) * argCount);
seg_size = 0;
for (i = 1; i <= argCount; i++, expptr = expptr->nextArg)
{
EvaluateExpression(theEnv,expptr,&val_ptr);
if (EvaluationData(theEnv)->EvaluationError)
{
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,0);
if (garbageSegment)
{ theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,0L); }
else theMultifield = (struct multifield *) CreateMultifield2(theEnv,0L);
SetpValue(returnValue,(void *) theMultifield);
rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
return;
}
SetpType(val_arr+i-1,GetType(val_ptr));
if (GetType(val_ptr) == MULTIFIELD)
{
SetpValue(val_arr+i-1,GetpValue(&val_ptr));
start = GetDOBegin(val_ptr);
end = GetDOEnd(val_ptr);
}
else if (GetType(val_ptr) == RVOID)
{
SetpValue(val_arr+i-1,GetValue(val_ptr));
start = 1;
end = 0;
}
else
{
SetpValue(val_arr+i-1,GetValue(val_ptr));
start = end = -1;
}
seg_size += (unsigned long) (end - start + 1);
SetpDOBegin(val_arr+i-1,start);
SetpDOEnd(val_arr+i-1,end);
}
if (garbageSegment)
{ theMultifield = (struct multifield *) EnvCreateMultifield(theEnv,seg_size); }
else theMultifield = (struct multifield *) CreateMultifield2(theEnv,seg_size);
/*========================================*/
/* Copy each argument into new segment. */
/*========================================*/
for (k = 0, j = 1; k < argCount; k++)
{
if (GetpType(val_arr+k) == MULTIFIELD)
{
start = GetpDOBegin(val_arr+k);
end = GetpDOEnd(val_arr+k);
orig_ptr = (struct multifield *) GetpValue(val_arr+k);
for (i = start; i < end + 1; i++, j++)
{
SetMFType(theMultifield,j,(GetMFType(orig_ptr,i)));
SetMFValue(theMultifield,j,(GetMFValue(orig_ptr,i)));
}
}
else if (GetpType(val_arr+k) != RVOID)
{
SetMFType(theMultifield,j,(short) (GetpType(val_arr+k)));
SetMFValue(theMultifield,j,(GetpValue(val_arr+k)));
j++;
}
}
/*=========================*/
/* Return the new segment. */
/*=========================*/
SetpType(returnValue,MULTIFIELD);
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,(long) seg_size);
SetpValue(returnValue,(void *) theMultifield);
rm3(theEnv,val_arr,(long) sizeof(DATA_OBJECT) * argCount);
return;
}
}
/***********************************************************************
NAME : ExpandFuncMultifield
DESCRIPTION : Recursively examines an expression and replaces
PROC_EXPAND_MULTIFIELD expressions with the expanded
evaluation expression of its argument
INPUTS : 1) A data object result buffer
2) The expression to modify
3) The address of the expression, in case it is
deleted entirely
4) The address of the H/L function expand$
RETURNS : Nothing useful
SIDE EFFECTS : Expressions allocated/deallocated as necessary
Evaluations performed
On errors, argument expression set to call a function
which causes an evaluation error when evaluated
a second time by actual caller.
NOTES : THIS ROUTINE MODIFIES EXPRESSIONS AT RUNTIME!! MAKE
SURE THAT THE EXPRESSION PASSED IS SAFE TO CHANGE!!
**********************************************************************/
static void ExpandFuncMultifield(
void *theEnv,
DATA_OBJECT *result,
EXPRESSION *theExp,
EXPRESSION **sto,
void *expmult)
{
EXPRESSION *newexp,*top,*bot;
register long i; /* 6.04 Bug Fix */
while (theExp != NULL)
{
if (theExp->value == expmult)
{
EvaluateExpression(theEnv,theExp->argList,result);
ReturnExpression(theEnv,theExp->argList);
if ((EvaluationData(theEnv)->EvaluationError) || (result->type != MULTIFIELD))
{
theExp->argList = NULL;
if ((EvaluationData(theEnv)->EvaluationError == FALSE) && (result->type != MULTIFIELD))
ExpectedTypeError2(theEnv,"expand$",1);
theExp->value = (void *) FindFunction(theEnv,"(set-evaluation-error)");
EvaluationData(theEnv)->EvaluationError = FALSE;
EvaluationData(theEnv)->HaltExecution = FALSE;
return;
}
top = bot = NULL;
for (i = GetpDOBegin(result) ; i <= GetpDOEnd(result) ; i++)
{
newexp = get_struct(theEnv,expr);
newexp->type = GetMFType(result->value,i);
newexp->value = GetMFValue(result->value,i);
newexp->argList = NULL;
newexp->nextArg = NULL;
if (top == NULL)
top = newexp;
else
bot->nextArg = newexp;
bot = newexp;
}
if (top == NULL)
{
*sto = theExp->nextArg;
rtn_struct(theEnv,expr,theExp);
theExp = *sto;
}
else
{
bot->nextArg = theExp->nextArg;
*sto = top;
rtn_struct(theEnv,expr,theExp);
sto = &bot->nextArg;
theExp = bot->nextArg;
}
}
else
{
if (theExp->argList != NULL)
ExpandFuncMultifield(theEnv,result,theExp->argList,&theExp->argList,expmult);
sto = &theExp->nextArg;
theExp = theExp->nextArg;
}
}
}
globle void FuncallFunction(
void *theEnv,
DATA_OBJECT *returnValue)
{
int argCount, i, j;
DATA_OBJECT theValue;
FUNCTION_REFERENCE theReference;
char *name;
struct multifield *theMultifield;
struct expr *lastAdd = NULL, *nextAdd, *multiAdd;
/*==================================*/
/* Set up the default return value. */
/*==================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
/*=================================================*/
/* The funcall function has at least one argument: */
/* the name of the function being called. */
/*=================================================*/
if ((argCount = EnvArgCountCheck(theEnv,"funcall",AT_LEAST,1)) == -1) return;
/*============================================*/
/* Get the name of the function to be called. */
/*============================================*/
if (EnvArgTypeCheck(theEnv,"funcall",1,SYMBOL_OR_STRING,&theValue) == FALSE)
{
return;
}
/*====================*/
/* Find the function. */
/*====================*/
name = DOToString(theValue);
if (! GetFunctionReference(theEnv,name,&theReference))
{
ExpectedTypeError1(theEnv,"funcall",1,"function, deffunction, or generic function name");
return;
}
ExpressionInstall(theEnv,&theReference);
/*======================================*/
/* Add the arguments to the expression. */
/*======================================*/
for (i = 2; i <= argCount; i++)
{
EnvRtnUnknown(theEnv,i,&theValue);
if (GetEvaluationError(theEnv))
{
ExpressionDeinstall(theEnv,&theReference);
return;
}
switch(GetType(theValue))
{
case MULTIFIELD:
nextAdd = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));
if (lastAdd == NULL)
{
theReference.argList = nextAdd;
}
else
{
lastAdd->nextArg = nextAdd;
}
lastAdd = nextAdd;
multiAdd = NULL;
theMultifield = (struct multifield *) GetValue(theValue);
for (j = GetDOBegin(theValue); j <= GetDOEnd(theValue); j++)
{
nextAdd = GenConstant(theEnv,GetMFType(theMultifield,j),GetMFValue(theMultifield,j));
if (multiAdd == NULL)
{
lastAdd->argList = nextAdd;
}
else
{
multiAdd->nextArg = nextAdd;
}
multiAdd = nextAdd;
}
ExpressionInstall(theEnv,lastAdd);
break;
default:
nextAdd = GenConstant(theEnv,GetType(theValue),GetValue(theValue));
if (lastAdd == NULL)
{
theReference.argList = nextAdd;
}
else
{
lastAdd->nextArg = nextAdd;
}
lastAdd = nextAdd;
ExpressionInstall(theEnv,lastAdd);
break;
}
}
/*===========================================================*/
/* Verify a deffunction has the correct number of arguments. */
/*===========================================================*/
#if DEFFUNCTION_CONSTRUCT
if (theReference.type == PCALL)
{
if (CheckDeffunctionCall(theEnv,theReference.value,CountArguments(theReference.argList)) == FALSE)
{
PrintErrorID(theEnv,"MISCFUN",4,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function funcall called with the wrong number of arguments for deffunction ");
EnvPrintRouter(theEnv,WERROR,EnvGetDeffunctionName(theEnv,theReference.value));
EnvPrintRouter(theEnv,WERROR,"\n");
ExpressionDeinstall(theEnv,&theReference);
ReturnExpression(theEnv,theReference.argList);
return;
}
}
#endif
/*======================*/
/* Call the expression. */
/*======================*/
EvaluateExpression(theEnv,&theReference,returnValue);
/*========================================*/
/* Return the expression data structures. */
/*========================================*/
ExpressionDeinstall(theEnv,&theReference);
ReturnExpression(theEnv,theReference.argList);
}
/*************************************************************
NAME : FormChain
DESCRIPTION : Builds a list of classes to be used in
instance queries - uses parse form.
INPUTS : 1) Name of calling function for error msgs
2) Data object - must be a symbol or a
multifield value containing all symbols
The symbols must be names of existing classes
RETURNS : The query chain, or NULL on errors
SIDE EFFECTS : Memory allocated for chain
Busy count incremented for all classes
NOTES : None
*************************************************************/
static QUERY_CLASS *FormChain(
void *theEnv,
EXEC_STATUS,
char *func,
DATA_OBJECT *val)
{
DEFCLASS *cls;
QUERY_CLASS *head,*bot,*tmp;
register long i,end; /* 6.04 Bug Fix */
char *className;
struct defmodule *currentModule;
currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus));
if (val->type == DEFCLASS_PTR)
{
IncrementDefclassBusyCount(theEnv,execStatus,(void *) val->value);
head = get_struct(theEnv,execStatus,query_class);
head->cls = (DEFCLASS *) val->value;
if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
head->theModule = currentModule;
else
head->theModule = head->cls->header.whichModule->theModule;
head->chain = NULL;
head->nxt = NULL;
return(head);
}
if (val->type == SYMBOL)
{
/* ===============================================
Allow instance-set query restrictions to have a
module specifier as part of the class name,
but search imported defclasses too if a
module specifier is not given
=============================================== */
cls = LookupDefclassByMdlOrScope(theEnv,execStatus,DOPToString(val));
if (cls == NULL)
{
ClassExistError(theEnv,execStatus,func,DOPToString(val));
return(NULL);
}
IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
head = get_struct(theEnv,execStatus,query_class);
head->cls = cls;
if (DefclassInScope(theEnv,execStatus,head->cls,currentModule))
head->theModule = currentModule;
else
head->theModule = head->cls->header.whichModule->theModule;
head->chain = NULL;
head->nxt = NULL;
return(head);
}
if (val->type == MULTIFIELD)
{
head = bot = NULL;
end = GetpDOEnd(val);
for (i = GetpDOBegin(val) ; i <= end ; i++)
{
if (GetMFType(val->value,i) == SYMBOL)
{
className = ValueToString(GetMFValue(val->value,i));
cls = LookupDefclassByMdlOrScope(theEnv,execStatus,className);
if (cls == NULL)
{
ClassExistError(theEnv,execStatus,func,className);
DeleteQueryClasses(theEnv,execStatus,head);
return(NULL);
}
}
else
{
DeleteQueryClasses(theEnv,execStatus,head);
return(NULL);
}
IncrementDefclassBusyCount(theEnv,execStatus,(void *) cls);
tmp = get_struct(theEnv,execStatus,query_class);
tmp->cls = cls;
if (DefclassInScope(theEnv,execStatus,tmp->cls,currentModule))
tmp->theModule = currentModule;
else
tmp->theModule = tmp->cls->header.whichModule->theModule;
tmp->chain = NULL;
tmp->nxt = NULL;
if (head == NULL)
head = tmp;
else
bot->chain = tmp;
bot = tmp;
}
return(head);
}
return(NULL);
}
void ClipsRuleMgr::getTemplateFields()
{
void *templatePtr;
DATA_OBJECT theValue;
void *theMultifield;
DATA_OBJECT theValueOfType;
void *theMultifieldOfType;
int cnt1 = 0;
int i = 1;
int fieldType;
void *fieldValue;
m_templateItor = m_templateNames.begin();
while(m_templateItor!=m_templateNames.end())
{
cout<<"Rule Engine IntializeStream::m_templateNames:" <<*m_templateItor<<endl;
templatePtr = EnvFindDeftemplate(m_theEnv,(*m_templateItor).c_str());
EnvDeftemplateSlotNames(m_theEnv, templatePtr, &theValue);
if (GetpType(&theValue) == MULTIFIELD)
{
cnt1 = GetpDOLength(&theValue);
//theMultifield = theValue.value;
theMultifield=GetValue(theValue);
vector<Field> fields;
for (i=1; i<=cnt1; i++)
{
fieldType = GetMFType(theMultifield,i);
if (fieldType == SYMBOL)
{
Field tmp;
fieldValue = (void*)ValueToString(GetMFValue(theMultifield,i));
tmp.name = string((char*)fieldValue);
tmp.type = 2;
EnvDeftemplateSlotTypes(m_theEnv,templatePtr,(char *)fieldValue, &theValueOfType);
if (GetpType(&theValueOfType) == MULTIFIELD)
{
GetpDOLength(&theValueOfType);
theMultifieldOfType = theValueOfType.value;
///default contraict to first one
fieldType = GetMFType(theMultifieldOfType,1);
if (fieldType == SYMBOL)
{
fieldValue = GetMFValue(theMultifieldOfType,1);
if (string(ValueToString(fieldValue)) == string("FLOAT"))
{
tmp.type = 0;
}
else if (string(ValueToString(fieldValue)) == string("INTEGER"))
{
tmp.type = 1;
}
else
{
tmp.type = 2;
}
}
else
{
cout<<"Rule Engine IntializeStream::EnvDeftemplateSlotTypes get unknown field type when get slot type:" <<fieldType<<endl;
}
}
fields.push_back(tmp);
}
else
{
cout<<"Rule Engine IntializeStream::get unknown field type when get slot name:" <<fieldType<<endl;
}
}
tableSchema.insert(pair<string, vector<Field> >(*m_templateItor, fields));
}
else
{
cout<<"Rule Engine IntializeStream:::EnvDeftemplateSlotNames return not multifiled" <<endl;
}
m_templateItor++;
}
//call streaming interface to set tableSchema here
}
Values data_object_to_values( dataObject& clipsdo ) {
Values values;
std::string s;
double d;
long int i;
void* p;
void* mfptr;
long int end;
switch ( GetType( clipsdo ) ) {
case RVOID:
return values;
case STRING:
s = DOToString( clipsdo );
values.push_back( Value( s, TYPE_STRING ) );
return values;
case INSTANCE_NAME:
s = DOToString( clipsdo );
values.push_back( Value( s, TYPE_INSTANCE_NAME ) );
return values;
case SYMBOL:
s = DOToString( clipsdo );
values.push_back( Value( s, TYPE_SYMBOL ) );
return values;
case FLOAT:
d = DOToDouble( clipsdo );
values.push_back( Value( d ) );
return values;
case INTEGER:
i = DOToLong( clipsdo );
values.push_back( Value( i ) );
return values;
case INSTANCE_ADDRESS:
p = DOToPointer( clipsdo );
values.push_back( Value( p, TYPE_INSTANCE_ADDRESS ) );
return values;
case EXTERNAL_ADDRESS:
p = (((struct externalAddressHashNode *) (clipsdo.value))->externalAddress);
values.push_back( Value( p, TYPE_EXTERNAL_ADDRESS ) );
return values;
case MULTIFIELD:
end = GetDOEnd( clipsdo );
mfptr = GetValue( clipsdo );
for ( int iter = GetDOBegin( clipsdo ); iter <= end; iter++ ) {
switch ( GetMFType( mfptr, iter ) ) {
case STRING:
s = ValueToString( GetMFValue( mfptr, iter ) );
values.push_back( Value( s, TYPE_STRING ) );
break;
case SYMBOL:
s = ValueToString( GetMFValue( mfptr, iter ) );
values.push_back( Value( s, TYPE_SYMBOL ) );
break;
case FLOAT:
d = ValueToDouble( GetMFValue( mfptr, iter ) );
values.push_back( Value( d ) );
break;
case INTEGER:
i = ValueToLong( GetMFValue( mfptr, iter ) );
values.push_back( Value( i ) );
break;
case EXTERNAL_ADDRESS:
p = ValueToExternalAddress( GetMFValue( mfptr, iter ) );
values.push_back( Value( p, TYPE_EXTERNAL_ADDRESS ) );
break;
default:
throw std::logic_error( "clipsmm::data_object_to_values: Unhandled multifield type" );
}
}
return values;
default:
//std::cout << std::endl << "Type: " << GetType(clipsdo) << std::endl;
throw std::logic_error( "clipsmm::data_object_to_values: Unhandled data object type" );
}
}
