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 lhsParseNode *GetSingleLHSSlot(
void *theEnv,
char *readSource,
struct token *tempToken,
struct templateSlot *slotPtr,
int *error,
short position)
{
struct lhsParseNode *nextSlot;
SYMBOL_HN *slotName;
/*================================================*/
/* Get the slot name and read in the first token. */
/*================================================*/
slotName = (SYMBOL_HN *) tempToken->value;
SavePPBuffer(theEnv,(char*)" ");
GetToken(theEnv,readSource,tempToken);
/*====================================*/
/* Get value for a single field slot. */
/*====================================*/
if (slotPtr->multislot == FALSE)
{
/*=======================*/
/* Get the single value. */
/*=======================*/
nextSlot = RestrictionParse(theEnv,readSource,tempToken,FALSE,
slotPtr->slotName,(short) (position - 1),
slotPtr->constraints,0);
if (nextSlot == NULL)
{
*error = TRUE;
return(NULL);
}
/*======================================*/
/* Multi field wildcards and variables */
/* not allowed in a single field slot. */
/*======================================*/
if ((nextSlot->type == MF_VARIABLE) ||
(nextSlot->type == MULTIFIELD))
{
SingleFieldSlotCardinalityError(theEnv,slotPtr->slotName->contents);
*error = TRUE;
ReturnLHSParseNodes(theEnv,nextSlot);
return(NULL);
}
}
/*===================================*/
/* Get values for a multifield slot. */
/*===================================*/
else
{
nextSlot = RestrictionParse(theEnv,readSource,tempToken,TRUE,slotName,(short) (position - 1),
slotPtr->constraints,1);
if (nextSlot == NULL)
{
*error = TRUE;
return(NULL);
}
}
/*========================================================*/
/* The slot definition must end with a right parenthesis. */
/*========================================================*/
if (tempToken->type != RPAREN)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)" ");
SavePPBuffer(theEnv,tempToken->printForm);
SyntaxErrorMessage(theEnv,(char*)"deftemplate patterns");
*error = TRUE;
ReturnLHSParseNodes(theEnv,nextSlot);
return(NULL);
}
/*===============================================*/
/* Fix the pretty print output if the multifield */
/* slot contained no restrictions. */
/*===============================================*/
if ((nextSlot->bottom == NULL) && slotPtr->multislot)
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)")");
}
/*=================================*/
/* Add the slot values to the slot */
/* structure and return it. */
/*=================================*/
return(nextSlot);
}
static struct expr *ParseAssertSlotValues(
char *inputSource,
struct token *tempToken,
struct templateSlot *slotPtr,
int *error,
int constantsOnly)
{
struct expr *nextSlot;
struct expr *newField, *valueList, *lastValue;
int printError;
/*=============================*/
/* Handle a single field slot. */
/*=============================*/
if (slotPtr->multislot == FALSE)
{
/*=====================*/
/* Get the slot value. */
/*=====================*/
SavePPBuffer(" ");
newField = GetAssertArgument(inputSource,tempToken,
error,RPAREN,constantsOnly,&printError);
if (*error)
{
if (printError) SyntaxErrorMessage("deftemplate pattern");
return(NULL);
}
/*=================================================*/
/* A single field slot value must contain a value. */
/* Only a multifield slot can be empty. */
/*=================================================*/
if (newField == NULL)
{
*error = TRUE;
SingleFieldSlotCardinalityError(slotPtr->slotName->contents);
return(NULL);
}
/*==============================================*/
/* A function returning a multifield value can */
/* not be called to get the value for the slot. */
/*==============================================*/
if ((newField->type == FCALL) ? (ExpressionFunctionType(newField) == 'm') :
(newField->type == MF_VARIABLE))
{
*error = TRUE;
SingleFieldSlotCardinalityError(slotPtr->slotName->contents);
ReturnExpression(newField);
return(NULL);
}
/*============================*/
/* Move on to the next token. */
/*============================*/
GetToken(inputSource,tempToken);
}
/*========================================*/
/* Handle a multifield slot. Build a list */
/* of the values stored in the slot. */
/*========================================*/
else
{
SavePPBuffer(" ");
valueList = GetAssertArgument(inputSource,tempToken,
error,RPAREN,constantsOnly,&printError);
if (*error)
{
if (printError) SyntaxErrorMessage("deftemplate pattern");
return(NULL);
}
if (valueList == NULL)
{
PPBackup();
PPBackup();
SavePPBuffer(")");
}
lastValue = valueList;
while (lastValue != NULL) /* (tempToken->type != RPAREN) */
{
if (tempToken->type == RPAREN)
{ SavePPBuffer(" "); }
else
{
/* PPBackup(); */
SavePPBuffer(" ");
/* SavePPBuffer(tempToken->printForm); */
}
newField = GetAssertArgument(inputSource,tempToken,error,RPAREN,constantsOnly,&printError);
if (*error)
{
if (printError) SyntaxErrorMessage("deftemplate pattern");
ReturnExpression(valueList);
return(NULL);
}
if (newField == NULL)
{
PPBackup();
PPBackup();
SavePPBuffer(")");
}
lastValue->nextArg = newField;
lastValue = newField;
}
newField = valueList;
}
/*==========================================================*/
/* Slot definition must be closed with a right parenthesis. */
/*==========================================================*/
if (tempToken->type != RPAREN)
{
SingleFieldSlotCardinalityError(slotPtr->slotName->contents);
*error = TRUE;
ReturnExpression(newField);
return(NULL);
}
/*=========================================================*/
/* Build and return a structure describing the slot value. */
/*=========================================================*/
nextSlot = GenConstant(SYMBOL,slotPtr->slotName);
nextSlot->argList = newField;
return(nextSlot);
}
