/******************************************************************************
NAME : QueryDoForInstance
DESCRIPTION : Finds the first set of instances which satisfy the query and
executes a user-action with that set
INPUTS : None
RETURNS : Caller's result buffer
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
zero or more times (depending on instance restrictions
and how early the expression evaulates to TRUE - if at all).
Also the action expression is executed zero or once.
Caller's result buffer holds result of user-action
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForInstance(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"do-for-instance",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = GetFirstArgument()->nextArg;
if (TestForFirstInChain(qclasses,0) == TRUE)
EvaluateExpression(QueryCore->action,result);
AbortQuery = FALSE;
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
/*************************************************************
NAME : GetQueryInstance
DESCRIPTION : Internal function for referring to instance
array on instance-queries
INPUTS : None
RETURNS : The name of the specified instance-set member
SIDE EFFECTS : None
NOTES : H/L Syntax : ((query-instance) <index>)
*************************************************************/
globle SYMBOL_HN *GetQueryInstance()
{
register QUERY_CORE *core;
core = FindQueryCore(DOPToInteger(GetFirstArgument()));
return(GetFullInstanceName(core->solns[DOPToInteger(GetFirstArgument()->nextArg)]));
}
/***************************************************************************
NAME : GetQueryInstanceSlot
DESCRIPTION : Internal function for referring to slots of instances in
instance array on instance-queries
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set appropriately
NOTES : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
**************************************************************************/
globle void GetQueryInstanceSlot(
DATA_OBJECT *result)
{
INSTANCE_TYPE *ins;
INSTANCE_SLOT *sp;
DATA_OBJECT temp;
QUERY_CORE *core;
result->type = SYMBOL;
result->value = FalseSymbol;
core = FindQueryCore(DOPToInteger(GetFirstArgument()));
ins = core->solns[DOPToInteger(GetFirstArgument()->nextArg)];
EvaluateExpression(GetFirstArgument()->nextArg->nextArg,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1("get",1,"symbol");
SetEvaluationError(TRUE);
return;
}
sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(ValueToString(temp.value),"instance-set query");
return;
}
result->type = sp->type;
result->value = sp->value;
if (sp->type == MULTIFIELD)
{
result->begin = 0;
result->end = GetInstanceSlotLength(sp) - 1;
}
}
globle void PrintFactPNConstant2(
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN2Call *hack;
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(fact-pn-constant2 ");
PrintLongInteger(logicalName,(long) hack->whichSlot);
PrintRouter(logicalName," ");
PrintLongInteger(logicalName,(long) hack->offset);
if (hack->testForEquality) PrintRouter(logicalName," = ");
else PrintRouter(logicalName," != ");
PrintAtom(logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
/******************************************************************************
NAME : QueryDoForInstance
DESCRIPTION : Finds the first set of instances which satisfy the query and
executes a user-action with that set
INPUTS : None
RETURNS : Caller's result buffer
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
zero or more times (depending on instance restrictions
and how early the expression evaulates to TRUE - if at all).
Also the action expression is executed zero or once.
Caller's result buffer holds result of user-action
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForInstance(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qclasses = DetermineQueryClasses(theEnv,GetFirstArgument()->nextArg->nextArg,
"do-for-instance",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv);
InstanceQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
InstanceQueryData(theEnv)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
if (TestForFirstInChain(theEnv,qclasses,0) == TRUE)
EvaluateExpression(theEnv,InstanceQueryData(theEnv)->QueryCore->action,result);
InstanceQueryData(theEnv)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) InstanceQueryData(theEnv)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,query_core,InstanceQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryClasses(theEnv,qclasses);
}
/***************************************************************************
NAME : GetQueryInstanceSlot
DESCRIPTION : Internal function for referring to slots of instances in
instance array on instance-queries
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set appropriately
NOTES : H/L Syntax : ((query-instance-slot) <index> <slot-name>)
**************************************************************************/
globle void GetQueryInstanceSlot(
void *theEnv,
DATA_OBJECT *result)
{
INSTANCE_TYPE *ins;
INSTANCE_SLOT *sp;
DATA_OBJECT temp;
QUERY_CORE *core;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
ins = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1(theEnv,"get",1,"symbol");
EnvSetEvaluationError(theEnv,TRUE);
return;
}
sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(theEnv,ValueToString(temp.value),"instance-set query");
return;
}
result->type = (unsigned short) sp->type;
result->value = sp->value;
if (sp->type == MULTIFIELD)
{
result->begin = 0;
SetpDOEnd(result,GetInstanceSlotLength(sp));
}
}
/******************************************************************************
NAME : QueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. Also, the action is
executed for every instance set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForAllInstances(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = GetFirstArgument()->nextArg;
QueryCore->result = result;
ValueInstall(QueryCore->result);
TestEntireChain(qclasses,0);
ValueDeinstall(QueryCore->result);
PropagateReturnValue(QueryCore->result);
AbortQuery = FALSE;
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
/******************************************************************************
NAME : QueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. Also, the action is
executed for every fact set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryAction()
******************************************************************************/
void QueryDoForAllFacts(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
returnValue->lexemeValue = FalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (Fact **) gm2(theEnv,(sizeof(Fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
FactQueryData(theEnv)->QueryCore->result = returnValue;
RetainUDFV(theEnv,FactQueryData(theEnv)->QueryCore->result);
TestEntireChain(theEnv,qtemplates,0);
ReleaseUDFV(theEnv,FactQueryData(theEnv)->QueryCore->result);
FactQueryData(theEnv)->AbortQuery = false;
ProcedureFunctionData(theEnv)->BreakFlag = false;
rm(theEnv,FactQueryData(theEnv)->QueryCore->solns,(sizeof(Fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
globle void PrintFactPNConstant1(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN1Call *hack;
hack = (struct factConstantPN1Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(fact-pn-constant1 ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName," = ");
else EnvPrintRouter(theEnv,logicalName," != ");
PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
EnvPrintRouter(theEnv,logicalName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
/******************************************************************************
NAME : AnyFacts
DESCRIPTION : Determines if there any existing facts which satisfy
the query
INPUTS : None
RETURNS : True if the query is satisfied, false otherwise
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
zero or more times (depending on fact restrictions
and how early the expression evaluates to true - if at all).
NOTES : H/L Syntax : See FactParseQueryNoAction()
******************************************************************************/
void AnyFacts(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
bool testResult;
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg,
"any-factp",&rcnt);
if (qtemplates == NULL)
{
returnValue->lexemeValue = FalseSymbol(theEnv);
return;
}
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (Fact **) gm2(theEnv,(sizeof(Fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
testResult = TestForFirstInChain(theEnv,qtemplates,0);
FactQueryData(theEnv)->AbortQuery = false;
rm(theEnv,FactQueryData(theEnv)->QueryCore->solns,(sizeof(Fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
returnValue->lexemeValue = CreateBoolean(theEnv,testResult);
}
/******************************************************************************
NAME : QueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. Also, the action is
executed for every instance set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForAllInstances(
void *theEnv,
EXEC_STATUS,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
"do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv,execStatus);
InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
InstanceQueryData(theEnv,execStatus)->QueryCore->result = result;
ValueInstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
TestEntireChain(theEnv,execStatus,qclasses,0);
ValueDeinstall(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
PropagateReturnValue(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->result);
InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
PopQueryCore(theEnv,execStatus);
DeleteQueryClasses(theEnv,execStatus,qclasses);
}
static void PrintObjectCmpConstant(
void *theEnv,
const char *logicalName,
void *theValue)
{
#if DEVELOPER
struct ObjectCmpPNConstant *hack;
hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,"(obj-const ");
EnvPrintRouter(theEnv,logicalName,hack->pass ? "p " : "n ");
if (hack->general)
PrintExpression(theEnv,logicalName,GetFirstArgument());
else
{
EnvPrintRouter(theEnv,logicalName,hack->fromBeginning ? "B" : "E");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset);
EnvPrintRouter(theEnv,logicalName," ");
PrintExpression(theEnv,logicalName,GetFirstArgument());
}
EnvPrintRouter(theEnv,logicalName,")");
#else
#endif
}
globle void PrintFactPNConstant2(
void *theEnv,
char *logicalName,
void *theValue)
{
#if DEVELOPER
struct factConstantPN2Call *hack;
hack = (struct factConstantPN2Call *) ValueToBitMap(theValue);
EnvPrintRouter(theEnv,logicalName,(char*)"(fact-pn-constant2 ");
PrintLongInteger(theEnv,logicalName,(long long) hack->whichSlot);
EnvPrintRouter(theEnv,logicalName,(char*)" ");
PrintLongInteger(theEnv,logicalName,(long long) hack->offset);
if (hack->testForEquality) EnvPrintRouter(theEnv,logicalName,(char*)" = ");
else EnvPrintRouter(theEnv,logicalName,(char*)" != ");
PrintAtom(theEnv,logicalName,GetFirstArgument()->type,GetFirstArgument()->value);
EnvPrintRouter(theEnv,logicalName,(char*)")");
#else
#endif
}
/******************************************************************************
NAME : QueryDoForFact
DESCRIPTION : Finds the first set of facts which satisfy the query and
executes a user-action with that set
INPUTS : None
RETURNS : Caller's result buffer
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
zero or more times (depending on fact restrictions
and how early the expression evaulates to TRUE - if at all).
Also the action expression is executed zero or once.
Caller's result buffer holds result of user-action
NOTES : H/L Syntax : See ParseQueryAction()
******************************************************************************/
globle void QueryDoForFact(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"do-for-fact",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
if (TestForFirstInChain(theEnv,qtemplates,0) == TRUE)
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
FactQueryData(theEnv)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : QueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
executes a user-function for each set as it is found
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. Also, the action is
executed for every fact set.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryAction()
******************************************************************************/
globle void QueryDoForAllFacts(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
FactQueryData(theEnv)->QueryCore->result = result;
ValueInstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
TestEntireChain(theEnv,qtemplates,0);
ValueDeinstall(theEnv,FactQueryData(theEnv)->QueryCore->result);
PropagateReturnValue(theEnv,FactQueryData(theEnv)->QueryCore->result);
FactQueryData(theEnv)->AbortQuery = FALSE;
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
globle void PrintHandlerSlotPutFunction(
char *logicalName,
void *theValue)
{
#if DEVELOPER
HANDLER_SLOT_REFERENCE *theReference;
DEFCLASS *theDefclass;
SLOT_DESC *sd;
theReference = (HANDLER_SLOT_REFERENCE *) ValueToBitMap(theValue);
PrintRouter(logicalName,"(bind ?self:[");
theDefclass = ClassIDMap[theReference->classID];
PrintRouter(logicalName,ValueToString(theDefclass->header.name));
PrintRouter(logicalName,"]");
sd = theDefclass->instanceTemplate[theDefclass->slotNameMap[theReference->slotID]];
PrintRouter(logicalName,ValueToString(sd->slotName->name));
if (GetFirstArgument() != NULL)
{
PrintRouter(logicalName," ");
PrintExpression(logicalName,GetFirstArgument());
}
PrintRouter(logicalName,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(logicalName)
#pragma unused(theValue)
#endif
#endif
}
/*************************************************************
NAME : GetQueryInstance
DESCRIPTION : Internal function for referring to instance
array on instance-queries
INPUTS : None
RETURNS : The name of the specified instance-set member
SIDE EFFECTS : None
NOTES : H/L Syntax : ((query-instance) <index>)
*************************************************************/
globle void *GetQueryInstance(
void *theEnv)
{
register QUERY_CORE *core;
core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
return(GetFullInstanceName(theEnv,core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))]));
}
/********************************************************************
NAME : ExpandFuncCall
DESCRIPTION : This function is a wrap-around for a normal
function call. It preexamines the argument
expression list and expands any references to the
sequence operator. It builds a copy of the
function call expression with these new arguments
inserted and evaluates the function call.
INPUTS : A data object buffer
RETURNS : Nothing useful
SIDE EFFECTS : Expressions alloctaed/deallocated
Function called and arguments evaluated
EvaluationError set on errors
NOTES : None
*******************************************************************/
globle void ExpandFuncCall(
void *theEnv,
DATA_OBJECT *result)
{
EXPRESSION *newargexp,*fcallexp;
struct FunctionDefinition *func;
/* ======================================================================
Copy the original function call's argument expression list.
Look for expand$ function callsexpressions and replace those
with the equivalent expressions of the expansions of evaluations
of the arguments.
====================================================================== */
newargexp = CopyExpression(theEnv,GetFirstArgument()->argList);
ExpandFuncMultifield(theEnv,result,newargexp,&newargexp,
(void *) FindFunction(theEnv,"expand$"));
/* ===================================================================
Build the new function call expression with the expanded arguments.
Check the number of arguments, if necessary, and call the thing.
=================================================================== */
fcallexp = get_struct(theEnv,expr);
fcallexp->type = GetFirstArgument()->type;
fcallexp->value = GetFirstArgument()->value;
fcallexp->nextArg = NULL;
fcallexp->argList = newargexp;
if (fcallexp->type == FCALL)
{
func = (struct FunctionDefinition *) fcallexp->value;
if (CheckFunctionArgCount(theEnv,ValueToString(func->callFunctionName),
func->restrictions,CountArguments(newargexp)) == FALSE)
{
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
ReturnExpression(theEnv,fcallexp);
return;
}
}
#if DEFFUNCTION_CONSTRUCT
else if (fcallexp->type == PCALL)
{
if (CheckDeffunctionCall(theEnv,fcallexp->value,
CountArguments(fcallexp->argList)) == FALSE)
{
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
ReturnExpression(theEnv,fcallexp);
SetEvaluationError(theEnv,TRUE);
return;
}
}
#endif
EvaluateExpression(theEnv,fcallexp,result);
ReturnExpression(theEnv,fcallexp);
}
/***********************************************************
NAME : DynamicHandlerPutSlot
DESCRIPTION : Directly puts a slot's value
(uses dynamic binding to lookup slot)
INPUTS : Data obejct buffer for holding slot value
RETURNS : Nothing useful
SIDE EFFECTS : Slot modified - and caller's buffer set
to value (or symbol FALSE on errors)
NOTES : H/L Syntax: (put <slot> <value>*)
***********************************************************/
globle void DynamicHandlerPutSlot(
DATA_OBJECT *theResult)
{
INSTANCE_SLOT *sp;
INSTANCE_TYPE *ins;
DATA_OBJECT temp;
theResult->type = SYMBOL;
theResult->value = FalseSymbol;
if (CheckCurrentMessage("dynamic-put",TRUE) == FALSE)
return;
EvaluateExpression(GetFirstArgument(),&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1("dynamic-put",1,"symbol");
SetEvaluationError(TRUE);
return;
}
ins = GetActiveInstance();
sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(ValueToString(temp.value),"dynamic-put");
return;
}
if ((sp->desc->noWrite == 0) ? FALSE :
((sp->desc->initializeOnly == 0) || (!ins->initializeInProgress)))
{
SlotAccessViolationError(ValueToString(sp->desc->slotName->name),
TRUE,(void *) ins);
SetEvaluationError(TRUE);
return;
}
if ((sp->desc->publicVisibility == 0) &&
(CurrentCore->hnd->cls != sp->desc->cls))
{
SlotVisibilityViolationError(sp->desc,CurrentCore->hnd->cls);
SetEvaluationError(TRUE);
return;
}
if (GetFirstArgument()->nextArg)
{
if (EvaluateAndStoreInDataObject((int) sp->desc->multiple,
GetFirstArgument()->nextArg,&temp) == FALSE)
return;
}
else
{
SetpDOBegin(&temp,1);
SetpDOEnd(&temp,0);
SetpType(&temp,MULTIFIELD);
SetpValue(&temp,NoParamValue);
}
PutSlotValue(ins,sp,&temp,theResult,NULL);
}
/*************************************************************
NAME : GetQueryFact
DESCRIPTION : Internal function for referring to fact
array on fact-queries
INPUTS : None
RETURNS : The name of the specified fact-set member
SIDE EFFECTS : None
NOTES : H/L Syntax : ((query-fact) <index>)
*************************************************************/
void GetQueryFact(
Environment *theEnv,
UDFContext *context,
UDFValue *returnValue)
{
QUERY_CORE *core;
core = FindQueryCore(theEnv,GetFirstArgument()->integerValue->contents);
returnValue->factValue = core->solns[GetFirstArgument()->nextArg->integerValue->contents];
}
/*************************************************************
NAME : GetQueryFact
DESCRIPTION : Internal function for referring to fact
array on fact-queries
INPUTS : None
RETURNS : The name of the specified fact-set member
SIDE EFFECTS : None
NOTES : H/L Syntax : ((query-fact) <index>)
*************************************************************/
globle void GetQueryFact(
void *theEnv,
DATA_OBJECT *result)
{
register QUERY_CORE *core;
core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
result->type = FACT_ADDRESS;
result->value = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
}
/*************************************************************
NAME : GetQueryFact
DESCRIPTION : Internal function for referring to fact
array on fact-queries
INPUTS : None
RETURNS : The name of the specified fact-set member
SIDE EFFECTS : None
NOTES : H/L Syntax : ((query-fact) <index>)
*************************************************************/
globle void GetQueryFact(
void *theEnv,
DATA_OBJECT *result)
{
register QUERY_CORE *core;
core = FindQueryCore(theEnv,DOPToInteger(GetFirstArgument()));
result->type = FACT_ADDRESS;
result->value = core->solns[DOPToInteger(GetFirstArgument()->nextArg)];
/* return(GetFullInstanceName(theEnv,core->solns[DOPToInteger(GetFirstArgument()->nextArg)])); */
}
/***************************************************************************
NAME : GetQueryFactSlot
DESCRIPTION : Internal function for referring to slots of fact in
fact array on fact-queries
INPUTS : The caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : Caller's result buffer set appropriately
NOTES : H/L Syntax : ((query-fact-slot) <index> <slot-name>)
**************************************************************************/
globle void GetQueryFactSlot(
void *theEnv,
DATA_OBJECT *result)
{
struct fact *theFact;
DATA_OBJECT temp;
QUERY_CORE *core;
short position;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
core = FindQueryCore(theEnv,ValueToInteger(GetpValue(GetFirstArgument())));
theFact = core->solns[ValueToInteger(GetpValue(GetFirstArgument()->nextArg))];
EvaluateExpression(theEnv,GetFirstArgument()->nextArg->nextArg,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1(theEnv,"get",1,"symbol");
SetEvaluationError(theEnv,TRUE);
return;
}
/*==================================================*/
/* Make sure the slot exists (the symbol implied is */
/* used for the implied slot of an ordered fact). */
/*==================================================*/
if (theFact->whichDeftemplate->implied)
{
if (strcmp(ValueToString(temp.value),"implied") != 0)
{
SlotExistError(theEnv,ValueToString(temp.value),"fact-set query");
return;
}
position = 1;
}
else if (FindSlot((struct deftemplate *) theFact->whichDeftemplate,
(struct symbolHashNode *) temp.value,&position) == NULL)
{
SlotExistError(theEnv,ValueToString(temp.value),"fact-set query");
return;
}
result->type = theFact->theProposition.theFields[position-1].type;
result->value = theFact->theProposition.theFields[position-1].value;
if (result->type == MULTIFIELD)
{
SetpDOBegin(result,1);
SetpDOEnd(result,((struct multifield *) result->value)->multifieldLength);
}
}
/*****************************************************
NAME : ObjectCmpConstantFunction
DESCRIPTION : Used to compare object slot values
against a constant
INPUTS : 1) The constant test bitmap
2) Data object buffer to hold result
RETURNS : TRUE if test successful,
FALSE otherwise
SIDE EFFECTS : Buffer set to symbol TRUE if test
successful, FALSE otherwise
NOTES : Called directly by
EvaluatePatternExpression()
*****************************************************/
globle intBool ObjectCmpConstantFunction(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
struct ObjectCmpPNConstant *hack;
DATA_OBJECT theVar;
EXPRESSION *constantExp;
int rv;
SEGMENT *theSegment;
hack = (struct ObjectCmpPNConstant *) ValueToBitMap(theValue);
if (hack->general)
{
EvaluateExpression(theEnv,GetFirstArgument(),&theVar);
constantExp = GetFirstArgument()->nextArg;
}
else
{
constantExp = GetFirstArgument();
if (ObjectReteData(theEnv)->CurrentPatternObjectSlot->type == MULTIFIELD)
{
theSegment = (struct multifield *) ObjectReteData(theEnv)->CurrentPatternObjectSlot->value;
if (hack->fromBeginning)
{
theVar.type = theSegment->theFields[hack->offset].type;
theVar.value = theSegment->theFields[hack->offset].value;
}
else
{
theVar.type = theSegment->theFields[theSegment->multifieldLength -
(hack->offset + 1)].type;
theVar.value = theSegment->theFields[theSegment->multifieldLength -
(hack->offset + 1)].value;
}
}
else
{
theVar.type = (unsigned short) ObjectReteData(theEnv)->CurrentPatternObjectSlot->type;
theVar.value = ObjectReteData(theEnv)->CurrentPatternObjectSlot->value;
}
}
if (theVar.type != constantExp->type)
rv = hack->fail;
else if (theVar.value != constantExp->value)
rv = hack->fail;
else
rv = hack->pass;
theResult->type = SYMBOL;
theResult->value = rv ? EnvTrueSymbol(theEnv) : EnvFalseSymbol(theEnv);
return(rv);
}
/******************************************************************************
NAME : DelayedQueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllInstances() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllInstances(
void *theEnv,
EXEC_STATUS,
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
unsigned rcnt;
register unsigned i;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv,execStatus);
qclasses = DetermineQueryClasses(theEnv,execStatus,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore(theEnv,execStatus);
InstanceQueryData(theEnv,execStatus)->QueryCore = get_struct(theEnv,execStatus,query_core);
InstanceQueryData(theEnv,execStatus)->QueryCore->solns = (INSTANCE_TYPE **) gm2(theEnv,execStatus,(sizeof(INSTANCE_TYPE *) * rcnt));
InstanceQueryData(theEnv,execStatus)->QueryCore->query = GetFirstArgument();
InstanceQueryData(theEnv,execStatus)->QueryCore->action = NULL;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set = NULL;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_size = rcnt;
InstanceQueryData(theEnv,execStatus)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,execStatus,qclasses,0);
InstanceQueryData(theEnv,execStatus)->AbortQuery = FALSE;
InstanceQueryData(theEnv,execStatus)->QueryCore->action = GetFirstArgument()->nextArg;
while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
InstanceQueryData(theEnv,execStatus)->QueryCore->solns[i] = InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv,execStatus);
execStatus->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,execStatus,InstanceQueryData(theEnv,execStatus)->QueryCore->action,result);
execStatus->CurrentEvaluationDepth--;
if (ProcedureFunctionData(theEnv,execStatus)->ReturnFlag == TRUE)
{ PropagateReturnValue(theEnv,execStatus,result); }
PeriodicCleanup(theEnv,execStatus,FALSE,TRUE);
if (execStatus->HaltExecution || ProcedureFunctionData(theEnv,execStatus)->BreakFlag || ProcedureFunctionData(theEnv,execStatus)->ReturnFlag)
{
while (InstanceQueryData(theEnv,execStatus)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv,execStatus);
break;
}
}
ProcedureFunctionData(theEnv,execStatus)->BreakFlag = FALSE;
rm(theEnv,execStatus,(void *) InstanceQueryData(theEnv,execStatus)->QueryCore->solns,(sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(theEnv,execStatus,query_core,InstanceQueryData(theEnv,execStatus)->QueryCore);
PopQueryCore(theEnv,execStatus);
DeleteQueryClasses(theEnv,execStatus,qclasses);
}
/******************************************************************************
NAME : DelayedQueryDoForAllFacts
DESCRIPTION : Finds all sets of facts which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllFacts() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query template-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every fact set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See FactParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllFacts(
void *theEnv,
DATA_OBJECT *result)
{
QUERY_TEMPLATE *qtemplates;
unsigned rcnt;
register unsigned i;
result->type = SYMBOL;
result->value = EnvFalseSymbol(theEnv);
qtemplates = DetermineQueryTemplates(theEnv,GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-facts",&rcnt);
if (qtemplates == NULL)
return;
PushQueryCore(theEnv);
FactQueryData(theEnv)->QueryCore = get_struct(theEnv,query_core);
FactQueryData(theEnv)->QueryCore->solns = (struct fact **) gm2(theEnv,(sizeof(struct fact *) * rcnt));
FactQueryData(theEnv)->QueryCore->query = GetFirstArgument();
FactQueryData(theEnv)->QueryCore->action = NULL;
FactQueryData(theEnv)->QueryCore->soln_set = NULL;
FactQueryData(theEnv)->QueryCore->soln_size = rcnt;
FactQueryData(theEnv)->QueryCore->soln_cnt = 0;
TestEntireChain(theEnv,qtemplates,0);
FactQueryData(theEnv)->AbortQuery = FALSE;
FactQueryData(theEnv)->QueryCore->action = GetFirstArgument()->nextArg;
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
FactQueryData(theEnv)->QueryCore->solns[i] = FactQueryData(theEnv)->QueryCore->soln_set->soln[i];
PopQuerySoln(theEnv);
EvaluationData(theEnv)->CurrentEvaluationDepth++;
EvaluateExpression(theEnv,FactQueryData(theEnv)->QueryCore->action,result);
EvaluationData(theEnv)->CurrentEvaluationDepth--;
if (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE)
{ PropagateReturnValue(theEnv,result); }
PeriodicCleanup(theEnv,FALSE,TRUE);
if (EvaluationData(theEnv)->HaltExecution || ProcedureFunctionData(theEnv)->BreakFlag || ProcedureFunctionData(theEnv)->ReturnFlag)
{
while (FactQueryData(theEnv)->QueryCore->soln_set != NULL)
PopQuerySoln(theEnv);
break;
}
}
ProcedureFunctionData(theEnv)->BreakFlag = FALSE;
rm(theEnv,(void *) FactQueryData(theEnv)->QueryCore->solns,(sizeof(struct fact *) * rcnt));
rtn_struct(theEnv,query_core,FactQueryData(theEnv)->QueryCore);
PopQueryCore(theEnv);
DeleteQueryTemplates(theEnv,qtemplates);
}
/******************************************************************************
NAME : DelayedQueryDoForAllInstances
DESCRIPTION : Finds all sets of instances which satisfy the query and
and exceutes a user-action for each set
This function differs from QueryDoForAllInstances() in
that it forms the complete list of query satisfactions
BEFORE executing any actions.
INPUTS : Caller's result buffer
RETURNS : Nothing useful
SIDE EFFECTS : The query class-expressions are evaluated once,
and the query boolean-expression is evaluated
once for every instance set. The action is executed
for evry query satisfaction.
Caller's result buffer holds result of last action executed.
NOTES : H/L Syntax : See ParseQueryNoAction()
******************************************************************************/
globle void DelayedQueryDoForAllInstances(
DATA_OBJECT *result)
{
QUERY_CLASS *qclasses;
int rcnt;
register int i;
result->type = SYMBOL;
result->value = FalseSymbol;
qclasses = DetermineQueryClasses(GetFirstArgument()->nextArg->nextArg,
"delayed-do-for-all-instances",&rcnt);
if (qclasses == NULL)
return;
PushQueryCore();
QueryCore = get_struct(query_core);
QueryCore->solns = (INSTANCE_TYPE **) gm2((int) (sizeof(INSTANCE_TYPE *) * rcnt));
QueryCore->query = GetFirstArgument();
QueryCore->action = NULL;
QueryCore->soln_set = NULL;
QueryCore->soln_size = rcnt;
QueryCore->soln_cnt = 0;
TestEntireChain(qclasses,0);
AbortQuery = FALSE;
QueryCore->action = GetFirstArgument()->nextArg;
while (QueryCore->soln_set != NULL)
{
for (i = 0 ; i < rcnt ; i++)
QueryCore->solns[i] = QueryCore->soln_set->soln[i];
PopQuerySoln();
CurrentEvaluationDepth++;
EvaluateExpression(QueryCore->action,result);
CurrentEvaluationDepth--;
if (ReturnFlag == TRUE)
{ PropagateReturnValue(result); }
PeriodicCleanup(FALSE,TRUE);
if (HaltExecution || BreakFlag || ReturnFlag)
{
while (QueryCore->soln_set != NULL)
PopQuerySoln();
break;
}
}
BreakFlag = FALSE;
rm((void *) QueryCore->solns,(int) (sizeof(INSTANCE_TYPE *) * rcnt));
rtn_struct(query_core,QueryCore);
PopQueryCore();
DeleteQueryClasses(qclasses);
}
/**************************************************************************
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 : 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--;
}
globle intBool FactPNConstant1(
void *theEnv,
void *theValue,
DATA_OBJECT_PTR returnValue)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(returnValue)
#endif
struct factConstantPN1Call *hack;
struct field *fieldPtr;
struct expr *theConstant;
/*==========================================*/
/* Retrieve the arguments for the function. */
/*==========================================*/
hack = (struct factConstantPN1Call *) ValueToBitMap(theValue);
/*============================================*/
/* Extract the value from the specified slot. */
/*============================================*/
fieldPtr = &FactData(theEnv)->CurrentPatternFact->theProposition.theFields[hack->whichSlot];
/*====================================*/
/* Compare the value to the constant. */
/*====================================*/
theConstant = GetFirstArgument();
if (theConstant->type != fieldPtr->type) return(1 - hack->testForEquality);
if (theConstant->value != fieldPtr->value) return(1 - hack->testForEquality);
return(hack->testForEquality);
}
