/***********************************************************
NAME : EvaluateAndStoreInDataObject
DESCRIPTION : Evaluates slot-value expressions
and stores the result in a
Kernel data object
INPUTS : 1) Flag indicating if multifields are OK
2) The value-expression
3) The data object structure
4) Flag indicating if a multifield value
should be placed on the garbage list.
RETURNS : FALSE on errors, TRUE otherwise
SIDE EFFECTS : Segment allocated for storing
multifield values
NOTES : None
***********************************************************/
globle int EvaluateAndStoreInDataObject(
void *theEnv,
int mfp,
EXPRESSION *theExp,
DATA_OBJECT *val,
int garbageSegment)
{
val->type = MULTIFIELD;
val->begin = 0;
val->end = -1;
if (theExp == NULL)
{
if (garbageSegment) val->value = EnvCreateMultifield(theEnv,0L);
else val->value = CreateMultifield2(theEnv,0L);
return(TRUE);
}
if ((mfp == 0) && (theExp->nextArg == NULL))
EvaluateExpression(theEnv,theExp,val);
else
StoreInMultifield(theEnv,val,theExp,garbageSegment);
return(EvaluationData(theEnv)->EvaluationError ? FALSE : TRUE);
}
globle int FactStoreMultifield(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE);
return(TRUE);
}
globle int FactStoreMultifield(
void *theEnv,
void *theValue,
DATA_OBJECT *theResult)
{
#if MAC_MCW || WIN_MCW || MAC_XCD
#pragma unused(theValue)
#endif
StoreInMultifield(theEnv,theResult,GetFirstArgument(),FALSE);
return(TRUE);
}
bool FactStoreMultifield(
Environment *theEnv,
void *theValue,
UDFValue *theResult)
{
#if MAC_XCD
#pragma unused(theValue)
#endif
StoreInMultifield(theEnv,theResult,GetFirstArgument(),false);
return true;
}
globle BOOLEAN AssignFactSlotDefaults(
void *vTheFact)
{
struct fact *theFact = (struct fact *) vTheFact;
struct deftemplate *theDeftemplate;
struct templateSlot *slotPtr;
int i;
DATA_OBJECT theResult;
/*===============================================*/
/* Get the deftemplate associated with the fact. */
/*===============================================*/
theDeftemplate = theFact->whichDeftemplate;
/*================================================*/
/* The value for the implied multifield slot of */
/* an implied deftemplate is set to a multifield */
/* of length zero when the fact is created. */
/*================================================*/
if (theDeftemplate->implied) return(TRUE);
/*============================================*/
/* Loop through each slot of the deftemplate. */
/*============================================*/
for (i = 0, slotPtr = theDeftemplate->slotList;
i < (int) theDeftemplate->numberOfSlots;
i++, slotPtr = slotPtr->next)
{
/*===================================*/
/* If the slot's value has been set, */
/* then move on to the next slot. */
/*===================================*/
if (theFact->theProposition.theFields[i].type != RVOID) continue;
/*===============================================*/
/* If the (default ?NONE) attribute was declared */
/* for the slot, then return FALSE to indicate */
/* the default values for the fact couldn't be */
/* supplied since this attribute requires that a */
/* default value can't be used for the slot. */
/*===============================================*/
if (slotPtr->noDefault) return(FALSE);
/*==============================================*/
/* Otherwise if a static default was specified, */
/* use this as the default value. */
/*==============================================*/
else if (slotPtr->defaultPresent)
{
if (slotPtr->multislot)
{
StoreInMultifield(&theResult,slotPtr->defaultList,TRUE);
theFact->theProposition.theFields[i].value = DOToMultifield(&theResult);
}
else
{
theFact->theProposition.theFields[i].type = slotPtr->defaultList->type;
theFact->theProposition.theFields[i].value = slotPtr->defaultList->value;
}
}
/*================================================*/
/* Otherwise if a dynamic-default was specified, */
/* evaluate it and use this as the default value. */
/*================================================*/
else if (slotPtr->defaultDynamic)
{
EvaluateExpression(slotPtr->defaultList,&theResult);
if (EvaluationError) return(FALSE);
theFact->theProposition.theFields[i].type = (short) theResult.type;
if (theResult.type == MULTIFIELD)
{ theFact->theProposition.theFields[i].value = DOToMultifield(&theResult); }
else
{ theFact->theProposition.theFields[i].value = theResult.value; }
}
/*====================================*/
/* Otherwise derive the default value */
/* from the slot's constraints. */
/*====================================*/
else
{
DeriveDefaultFromConstraints(slotPtr->constraints,&theResult,
(int) slotPtr->multislot);
theFact->theProposition.theFields[i].type = (short) theResult.type;
if (theResult.type == MULTIFIELD)
{ theFact->theProposition.theFields[i].value = DOToMultifield(&theResult); }
else
{ theFact->theProposition.theFields[i].value = theResult.value; }
}
}
/*==========================================*/
/* Return TRUE to indicate that the default */
/* values have been successfully set. */
/*==========================================*/
return(TRUE);
}
static void DuplicateModifyCommand(
void *theEnv,
int retractIt,
DATA_OBJECT_PTR returnValue)
{
long int factNum;
struct fact *oldFact, *newFact, *theFact;
struct expr *testPtr;
DATA_OBJECT computeResult;
struct deftemplate *templatePtr;
struct templateSlot *slotPtr;
int i, position, found;
/*===================================================*/
/* Set the default return value to the symbol FALSE. */
/*===================================================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,SymbolData(theEnv)->FalseSymbol);
/*==================================================*/
/* Evaluate the first argument which is used to get */
/* a pointer to the fact to be modified/duplicated. */
/*==================================================*/
testPtr = GetFirstArgument();
EvaluateExpression(theEnv,testPtr,&computeResult);
/*==============================================================*/
/* If an integer is supplied, then treat it as a fact-index and */
/* search the fact-list for the fact with that fact-index. */
/*==============================================================*/
if (computeResult.type == INTEGER)
{
factNum = ValueToLong(computeResult.value);
if (factNum < 0)
{
if (retractIt) ExpectedTypeError2(theEnv,"modify",1);
else ExpectedTypeError2(theEnv,"duplicate",1);
SetEvaluationError(theEnv,TRUE);
return;
}
oldFact = (struct fact *) EnvGetNextFact(theEnv,NULL);
while (oldFact != NULL)
{
if (oldFact->factIndex == factNum)
{ break; }
else
{ oldFact = oldFact->nextFact; }
}
if (oldFact == NULL)
{
char tempBuffer[20];
sprintf(tempBuffer,"f-%ld",factNum);
CantFindItemErrorMessage(theEnv,"fact",tempBuffer);
return;
}
}
/*==========================================*/
/* Otherwise, if a pointer is supplied then */
/* no lookup is required. */
/*==========================================*/
else if (computeResult.type == FACT_ADDRESS)
{ oldFact = (struct fact *) computeResult.value; }
/*===========================================*/
/* Otherwise, the first argument is invalid. */
/*===========================================*/
else
{
if (retractIt) ExpectedTypeError2(theEnv,"modify",1);
else ExpectedTypeError2(theEnv,"duplicate",1);
SetEvaluationError(theEnv,TRUE);
return;
}
/*==================================*/
/* See if it is a deftemplate fact. */
/*==================================*/
templatePtr = oldFact->whichDeftemplate;
if (templatePtr->implied) return;
/*================================================================*/
/* Duplicate the values from the old fact (skipping multifields). */
/*================================================================*/
newFact = (struct fact *) CreateFactBySize(theEnv,oldFact->theProposition.multifieldLength);
newFact->whichDeftemplate = templatePtr;
for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++)
{
newFact->theProposition.theFields[i].type = oldFact->theProposition.theFields[i].type;
if (newFact->theProposition.theFields[i].type != MULTIFIELD)
{ newFact->theProposition.theFields[i].value = oldFact->theProposition.theFields[i].value; }
else
{ newFact->theProposition.theFields[i].value = NULL; }
}
/*========================*/
/* Start replacing slots. */
/*========================*/
testPtr = testPtr->nextArg;
while (testPtr != NULL)
{
/*============================================================*/
/* If the slot identifier is an integer, then the slot was */
/* previously identified and its position within the template */
/* was stored. Otherwise, the position of the slot within the */
/* deftemplate has to be determined by comparing the name of */
/* the slot against the list of slots for the deftemplate. */
/*============================================================*/
if (testPtr->type == INTEGER)
{ position = (int) ValueToLong(testPtr->value); }
else
{
found = FALSE;
position = 0;
slotPtr = templatePtr->slotList;
while (slotPtr != NULL)
{
if (slotPtr->slotName == (SYMBOL_HN *) testPtr->value)
{
found = TRUE;
slotPtr = NULL;
}
else
{
slotPtr = slotPtr->next;
position++;
}
}
if (! found)
{
InvalidDeftemplateSlotMessage(theEnv,ValueToString(testPtr->value),
ValueToString(templatePtr->header.name));
SetEvaluationError(theEnv,TRUE);
ReturnFact(theEnv,newFact);
return;
}
}
/*===================================================*/
/* If a single field slot is being replaced, then... */
/*===================================================*/
if (newFact->theProposition.theFields[position].type != MULTIFIELD)
{
/*======================================================*/
/* If the list of values to store in the slot is empty */
/* or contains more than one member than an error has */
/* occured because a single field slot can only contain */
/* a single value. */
/*======================================================*/
if ((testPtr->argList == NULL) ? TRUE : (testPtr->argList->nextArg != NULL))
{
MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr);
ReturnFact(theEnv,newFact);
return;
}
/*===================================================*/
/* Evaluate the expression to be stored in the slot. */
/*===================================================*/
EvaluateExpression(theEnv,testPtr->argList,&computeResult);
SetEvaluationError(theEnv,FALSE);
/*====================================================*/
/* If the expression evaluated to a multifield value, */
/* then an error occured since a multifield value can */
/* not be stored in a single field slot. */
/*====================================================*/
if (computeResult.type == MULTIFIELD)
{
ReturnFact(theEnv,newFact);
MultiIntoSingleFieldSlotError(theEnv,GetNthSlot(templatePtr,position),templatePtr);
return;
}
/*=============================*/
/* Store the value in the slot */
/*=============================*/
newFact->theProposition.theFields[position].type =
computeResult.type;
newFact->theProposition.theFields[position].value =
computeResult.value;
}
/*=================================*/
/* Else replace a multifield slot. */
/*=================================*/
else
{
/*======================================*/
/* Determine the new value of the slot. */
/*======================================*/
StoreInMultifield(theEnv,&computeResult,testPtr->argList,FALSE);
SetEvaluationError(theEnv,FALSE);
/*=============================*/
/* Store the value in the slot */
/*=============================*/
newFact->theProposition.theFields[position].type =
computeResult.type;
newFact->theProposition.theFields[position].value =
computeResult.value;
}
testPtr = testPtr->nextArg;
}
/*=====================================*/
/* Copy the multifield values from the */
/* old fact that were not replaced. */
/*=====================================*/
for (i = 0; i < (int) oldFact->theProposition.multifieldLength; i++)
{
if ((newFact->theProposition.theFields[i].type == MULTIFIELD) &&
(newFact->theProposition.theFields[i].value == NULL))
{
newFact->theProposition.theFields[i].value =
CopyMultifield(theEnv,(struct multifield *) oldFact->theProposition.theFields[i].value);
}
}
/*======================================*/
/* Perform the duplicate/modify action. */
/*======================================*/
if (retractIt) EnvRetract(theEnv,oldFact);
theFact = (struct fact *) EnvAssert(theEnv,newFact);
/*========================================*/
/* The asserted fact is the return value. */
/*========================================*/
if (theFact != NULL)
{
SetpDOBegin(returnValue,1);
SetpDOEnd(returnValue,theFact->theProposition.multifieldLength);
SetpType(returnValue,FACT_ADDRESS);
SetpValue(returnValue,(void *) theFact);
}
return;
}
globle void BindFunction(
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT *theBind, *lastBind;
int found = FALSE,
unbindVar = FALSE;
SYMBOL_HN *variableName = NULL;
#if DEFGLOBAL_CONSTRUCT
struct defglobal *theGlobal = NULL;
#endif
/*===============================================*/
/* Determine the name of the variable to be set. */
/*===============================================*/
#if DEFGLOBAL_CONSTRUCT
if (GetFirstArgument()->type == DEFGLOBAL_PTR)
{ theGlobal = (struct defglobal *) GetFirstArgument()->value; }
else
#endif
{
EvaluateExpression(GetFirstArgument(),returnValue);
variableName = (SYMBOL_HN *) DOPToPointer(returnValue);
}
/*===========================================*/
/* Determine the new value for the variable. */
/*===========================================*/
if (GetFirstArgument()->nextArg == NULL)
{ unbindVar = TRUE; }
else if (GetFirstArgument()->nextArg->nextArg == NULL)
{ EvaluateExpression(GetFirstArgument()->nextArg,returnValue); }
else
{ StoreInMultifield(returnValue,GetFirstArgument()->nextArg,TRUE); }
/*==================================*/
/* Bind a defglobal if appropriate. */
/*==================================*/
#if DEFGLOBAL_CONSTRUCT
if (theGlobal != NULL)
{
QSetDefglobalValue(theGlobal,returnValue,unbindVar);
return;
}
#endif
/*===============================================*/
/* Search for the variable in the list of binds. */
/*===============================================*/
theBind = BindList;
lastBind = NULL;
while ((theBind != NULL) && (found == FALSE))
{
if (theBind->supplementalInfo == (void *) variableName)
{ found = TRUE; }
else
{
lastBind = theBind;
theBind = theBind->next;
}
}
/*========================================================*/
/* If variable was not in the list of binds, then add it. */
/* Make sure that this operation preserves the bind list */
/* as a stack. */
/*========================================================*/
if (found == FALSE)
{
if (unbindVar == FALSE)
{
theBind = get_struct(dataObject);
theBind->supplementalInfo = (void *) variableName;
theBind->next = NULL;
if (lastBind == NULL)
{ BindList = theBind; }
else
{ lastBind->next = theBind; }
}
else
{
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
return;
}
}
else
{ ValueDeinstall(theBind); }
/*================================*/
/* Set the value of the variable. */
/*================================*/
if (unbindVar == FALSE)
{
theBind->type = returnValue->type;
theBind->value = returnValue->value;
theBind->begin = returnValue->begin;
theBind->end = returnValue->end;
ValueInstall(returnValue);
}
else
{
if (lastBind == NULL) BindList = theBind->next;
else lastBind->next = theBind->next;
rtn_struct(dataObject,theBind);
returnValue->type = SYMBOL;
returnValue->value = FalseSymbol;
}
}
globle void CreateFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
StoreInMultifield(theEnv,returnValue,GetFirstArgument(),TRUE);
}
