globle void FactSlotValue(
void *theEnv,
void *vTheFact,
const char *theSlotName,
DATA_OBJECT *returnValue)
{
struct fact *theFact = (struct fact *) vTheFact;
short position;
/*==================================================*/
/* Make sure the slot exists (the symbol implied is */
/* used for the implied slot of an ordered fact). */
/*==================================================*/
if (theFact->whichDeftemplate->implied)
{
if (strcmp(theSlotName,"implied") != 0)
{
EnvSetEvaluationError(theEnv,TRUE);
InvalidDeftemplateSlotMessage(theEnv,theSlotName,
ValueToString(theFact->whichDeftemplate->header.name),FALSE);
return;
}
}
else if (FindSlot(theFact->whichDeftemplate,(SYMBOL_HN *) EnvAddSymbol(theEnv,theSlotName),&position) == NULL)
{
EnvSetEvaluationError(theEnv,TRUE);
InvalidDeftemplateSlotMessage(theEnv,theSlotName,
ValueToString(theFact->whichDeftemplate->header.name),FALSE);
return;
}
/*==========================*/
/* Return the slot's value. */
/*==========================*/
if (theFact->whichDeftemplate->implied)
{ EnvGetFactSlot(theEnv,theFact,NULL,returnValue); }
else
{ EnvGetFactSlot(theEnv,theFact,theSlotName,returnValue); }
}
static struct lhsParseNode *GetLHSSlots(
void *theEnv,
char *readSource,
struct token *tempToken,
struct deftemplate *theDeftemplate,
int *error)
{
struct lhsParseNode *firstSlot = NULL, *nextSlot, *lastSlot = NULL;
struct templateSlot *slotPtr;
short position;
/*=======================================================*/
/* Continue parsing slot definitions until the pattern's */
/* closing right parenthesis is encountered. */
/*=======================================================*/
while (tempToken->type != RPAREN)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)" ");
SavePPBuffer(theEnv,tempToken->printForm);
/*=================================================*/
/* Slot definitions begin with a left parenthesis. */
/*=================================================*/
if (tempToken->type != LPAREN)
{
*error = TRUE;
SyntaxErrorMessage(theEnv,(char*)"deftemplate patterns");
ReturnLHSParseNodes(theEnv,firstSlot);
return(NULL);
}
/*====================*/
/* Get the slot name. */
/*====================*/
GetToken(theEnv,readSource,tempToken);
if (tempToken->type != SYMBOL)
{
*error = TRUE;
SyntaxErrorMessage(theEnv,(char*)"deftemplate patterns");
ReturnLHSParseNodes(theEnv,firstSlot);
return(NULL);
}
/*==========================================================*/
/* Determine if the slot name is valid for the deftemplate. */
/*==========================================================*/
if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempToken->value,&position)) == NULL)
{
*error = TRUE;
InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempToken->value),
ValueToString(theDeftemplate->header.name),TRUE);
ReturnLHSParseNodes(theEnv,firstSlot);
return(NULL);
}
/*============================================*/
/* Determine if the slot is multiply defined. */
/*============================================*/
if (MultiplyDefinedLHSSlots(theEnv,firstSlot,(SYMBOL_HN *) tempToken->value) == TRUE)
{
*error = TRUE;
ReturnLHSParseNodes(theEnv,firstSlot);
return(NULL);
}
/*==============================================================*/
/* Get the pattern matching values used in the slot definition. */
/*==============================================================*/
nextSlot = GetSingleLHSSlot(theEnv,readSource,tempToken,slotPtr,error,(short) (position+1));
if (*error)
{
ReturnLHSParseNodes(theEnv,firstSlot);
ReturnLHSParseNodes(theEnv,nextSlot);
return(NULL);
}
/*=====================================*/
/* Add the slot definition to the list */
/* of slot definitions already parsed. */
/*=====================================*/
if (lastSlot == NULL)
{ firstSlot = nextSlot; }
else
{ lastSlot->right = nextSlot; }
while (nextSlot->right != NULL) nextSlot = nextSlot->right;
lastSlot = nextSlot;
/*==============================*/
/* Begin parsing the next slot. */
/*==============================*/
GetToken(theEnv,readSource,tempToken);
}
/*===========================================================*/
/* Return all the slot definitions found in the lhs pattern. */
/*===========================================================*/
return(firstSlot);
}
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 BOOLEAN UpdateModifyDuplicate(
void *theEnv,
struct expr *top,
char *name,
void *vTheLHS)
{
struct expr *functionArgs, *tempArg;
SYMBOL_HN *templateName;
struct deftemplate *theDeftemplate;
struct templateSlot *slotPtr;
short position;
/*========================================*/
/* Determine the fact-address or index to */
/* be retracted by the modify command. */
/*========================================*/
functionArgs = top->argList;
if (functionArgs->type == SF_VARIABLE)
{
templateName = FindTemplateForFactAddress((SYMBOL_HN *) functionArgs->value,
(struct lhsParseNode *) vTheLHS);
if (templateName == NULL) return(TRUE);
}
else
{ return(TRUE); }
/*========================================*/
/* Make sure that the fact being modified */
/* has a corresponding deftemplate. */
/*========================================*/
theDeftemplate = (struct deftemplate *)
LookupConstruct(theEnv,DeftemplateData(theEnv)->DeftemplateConstruct,
ValueToString(templateName),
FALSE);
if (theDeftemplate == NULL) return(TRUE);
if (theDeftemplate->implied) return(TRUE);
/*=============================================================*/
/* Make sure all the slot names are valid for the deftemplate. */
/*=============================================================*/
tempArg = functionArgs->nextArg;
while (tempArg != NULL)
{
/*======================*/
/* Does the slot exist? */
/*======================*/
if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempArg->value,&position)) == NULL)
{
InvalidDeftemplateSlotMessage(theEnv,ValueToString(tempArg->value),
ValueToString(theDeftemplate->header.name));
return(FALSE);
}
/*=========================================================*/
/* Is a multifield value being put in a single field slot? */
/*=========================================================*/
if (slotPtr->multislot == FALSE)
{
if (tempArg->argList == NULL)
{
SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents);
return(FALSE);
}
else if (tempArg->argList->nextArg != NULL)
{
SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents);
return(FALSE);
}
else if ((tempArg->argList->type == MF_VARIABLE) ||
((tempArg->argList->type == FCALL) ?
(((struct FunctionDefinition *) tempArg->argList->value)->returnValueType == 'm') :
FALSE))
{
SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents);
return(FALSE);
}
}
/*======================================*/
/* Are the slot restrictions satisfied? */
/*======================================*/
if (CheckRHSSlotTypes(theEnv,tempArg->argList,slotPtr,name) == 0)
return(FALSE);
/*=============================================*/
/* Replace the slot with the integer position. */
/*=============================================*/
tempArg->type = INTEGER;
tempArg->value = (void *) EnvAddLong(theEnv,(long) (FindSlotPosition(theDeftemplate,(SYMBOL_HN *) tempArg->value) - 1));
tempArg = tempArg->nextArg;
}
return(TRUE);
}
static struct templateSlot *ParseSlotLabel(
char *inputSource,
struct token *tempToken,
struct deftemplate *theDeftemplate,
int *error,
int endType)
{
struct templateSlot *slotPtr;
int position;
/*========================*/
/* Initialize error flag. */
/*========================*/
*error = FALSE;
/*============================================*/
/* If token is a right parenthesis, then fact */
/* template definition is complete. */
/*============================================*/
GetToken(inputSource,tempToken);
if (tempToken->type == endType)
{ return(NULL); }
/*=======================================*/
/* Put a space between the template name */
/* and the first slot definition. */
/*=======================================*/
PPBackup();
SavePPBuffer(" ");
SavePPBuffer(tempToken->printForm);
/*=======================================================*/
/* Slot definition begins with opening left parenthesis. */
/*=======================================================*/
if (tempToken->type != LPAREN)
{
SyntaxErrorMessage("deftemplate pattern");
*error = TRUE;
return(NULL);
}
/*=============================*/
/* Slot name must be a symbol. */
/*=============================*/
GetToken(inputSource,tempToken);
if (tempToken->type != SYMBOL)
{
SyntaxErrorMessage("deftemplate pattern");
*error = TRUE;
return(NULL);
}
/*======================================================*/
/* Check that the slot name is valid for this template. */
/*======================================================*/
if ((slotPtr = FindSlot(theDeftemplate,(SYMBOL_HN *) tempToken->value,&position)) == NULL)
{
InvalidDeftemplateSlotMessage(ValueToString(tempToken->value),
ValueToString(theDeftemplate->header.name));
*error = TRUE;
return(NULL);
}
/*====================================*/
/* Return a pointer to the slot name. */
/*====================================*/
return(slotPtr);
}
