/*************************************************************************************
NAME : ParseInitializeInstance
DESCRIPTION : Parses initialize-instance and make-instance function
calls into an EXPRESSION form that
can later be evaluated with EvaluateExpression()
INPUTS : 1) The address of the top node of the expression
containing the initialize-instance function call
2) The logical name of the input source
RETURNS : The address of the modified expression, or NULL
if there is an error
SIDE EFFECTS : The expression is enhanced to include all
aspects of the initialize-instance call
(slot-overrides etc.)
The "top" expression is deleted on errors.
NOTES : This function parses a initialize-instance call into
an expression of the following form :
(initialize-instance <instance-name> <slot-override>*)
where <slot-override> ::= (<slot-name> <expression>+)
goes to -->
initialize-instance
|
V
<instance or name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(make-instance <instance> of <class> <slot-override>*)
goes to -->
make-instance
|
V
<instance-name>-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(make-instance of <class> <slot-override>*)
goes to -->
make-instance
|
V
(gensym*)-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(modify-instance <instance> <slot-override>*)
goes to -->
modify-instance
|
V
<instance or name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(duplicate-instance <instance> [to <new-name>] <slot-override>*)
goes to -->
duplicate-instance
|
V
<instance or name>-><new-name>-><slot-name>-><dummy-node>...
OR |
(gensym*) V
<value-expression>...
*************************************************************************************/
globle EXPRESSION *ParseInitializeInstance(
EXPRESSION *top,
char *readSource)
{
int error,fcalltype,readclass;
if ((top->value == (void *) FindFunction("make-instance")) ||
(top->value == (void *) FindFunction("active-make-instance")))
fcalltype = MAKE_TYPE;
else if ((top->value == (void *) FindFunction("initialize-instance")) ||
(top->value == (void *) FindFunction("active-initialize-instance")))
fcalltype = INITIALIZE_TYPE;
else if ((top->value == (void *) FindFunction("modify-instance")) ||
(top->value == (void *) FindFunction("active-modify-instance")) ||
(top->value == (void *) FindFunction("message-modify-instance")) ||
(top->value == (void *) FindFunction("active-message-modify-instance")))
fcalltype = MODIFY_TYPE;
else
fcalltype = DUPLICATE_TYPE;
IncrementIndentDepth(3);
error = FALSE;
if (top->type == UNKNOWN_VALUE)
top->type = FCALL;
else
SavePPBuffer(" ");
top->argList = ArgumentParse(readSource,&error);
if (error)
goto ParseInitializeInstanceError;
else if (top->argList == NULL)
{
SyntaxErrorMessage("instance");
goto ParseInitializeInstanceError;
}
SavePPBuffer(" ");
if (fcalltype == MAKE_TYPE)
{
/* ======================================
Handle the case of anonymous instances
where the name was not specified
====================================== */
if ((top->argList->type != SYMBOL) ? FALSE :
(strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0))
{
top->argList->nextArg = ArgumentParse(readSource,&error);
if (error == TRUE)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage("instance class");
goto ParseInitializeInstanceError;
}
if ((top->argList->nextArg->type != SYMBOL) ? TRUE :
(strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0))
{
top->argList->type = FCALL;
top->argList->value = (void *) FindFunction("gensym*");
readclass = FALSE;
}
else
readclass = TRUE;
}
else
{
GetToken(readSource,&ObjectParseToken);
if ((GetType(ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(CLASS_RLN,DOToString(ObjectParseToken)) != 0))
{
SyntaxErrorMessage("make-instance");
goto ParseInitializeInstanceError;
}
SavePPBuffer(" ");
readclass = TRUE;
}
if (readclass)
{
top->argList->nextArg = ArgumentParse(readSource,&error);
if (error)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage("instance class");
goto ParseInitializeInstanceError;
}
}
/* ==============================================
If the class name is a constant, go ahead and
look it up now and replace it with the pointer
============================================== */
if (ReplaceClassNameWithReference(top->argList->nextArg) == FALSE)
goto ParseInitializeInstanceError;
PPCRAndIndent();
GetToken(readSource,&ObjectParseToken);
top->argList->nextArg->nextArg =
ParseSlotOverrides(readSource,&error);
}
else
{
PPCRAndIndent();
GetToken(readSource,&ObjectParseToken);
if (fcalltype == DUPLICATE_TYPE)
{
if ((ObjectParseToken.type != SYMBOL) ? FALSE :
(strcmp(DOToString(ObjectParseToken),DUPLICATE_NAME_REF) == 0))
{
PPBackup();
PPBackup();
SavePPBuffer(ObjectParseToken.print_rep);
SavePPBuffer(" ");
top->argList->nextArg = ArgumentParse(readSource,&error);
if (error)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage("instance name");
goto ParseInitializeInstanceError;
}
PPCRAndIndent();
GetToken(readSource,&ObjectParseToken);
}
else
top->argList->nextArg = GenConstant(FCALL,(void *) FindFunction("gensym*"));
top->argList->nextArg->nextArg = ParseSlotOverrides(readSource,&error);
}
else
top->argList->nextArg = ParseSlotOverrides(readSource,&error);
}
if (error)
goto ParseInitializeInstanceError;
if (GetType(ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage("slot-override");
goto ParseInitializeInstanceError;
}
DecrementIndentDepth(3);
return(top);
ParseInitializeInstanceError:
SetEvaluationError(TRUE);
ReturnExpression(top);
DecrementIndentDepth(3);
return(NULL);
}
globle intBool ProcessConnectedConstraints(
void *theEnv,
struct lhsParseNode *theNode,
struct lhsParseNode *multifieldHeader,
struct lhsParseNode *patternHead)
{
struct constraintRecord *orConstraints = NULL, *andConstraints;
struct constraintRecord *tmpConstraints, *rvConstraints;
struct lhsParseNode *orNode, *andNode;
struct expr *tmpExpr;
/*============================================*/
/* Loop through all of the or (|) constraints */
/* found in the connected constraint. */
/*============================================*/
for (orNode = theNode->bottom; orNode != NULL; orNode = orNode->bottom)
{
/*=================================================*/
/* Intersect all of the &'ed constraints together. */
/*=================================================*/
andConstraints = NULL;
for (andNode = orNode; andNode != NULL; andNode = andNode->right)
{
if (! andNode->negated)
{
if (andNode->type == RETURN_VALUE_CONSTRAINT)
{
if (andNode->expression->type == FCALL)
{
rvConstraints = FunctionCallToConstraintRecord(theEnv,andNode->expression->value);
tmpConstraints = andConstraints;
andConstraints = IntersectConstraints(theEnv,andConstraints,rvConstraints);
RemoveConstraint(theEnv,tmpConstraints);
RemoveConstraint(theEnv,rvConstraints);
}
}
else if (ConstantType(andNode->type))
{
tmpExpr = GenConstant(theEnv,andNode->type,andNode->value);
rvConstraints = ExpressionToConstraintRecord(theEnv,tmpExpr);
tmpConstraints = andConstraints;
andConstraints = IntersectConstraints(theEnv,andConstraints,rvConstraints);
RemoveConstraint(theEnv,tmpConstraints);
RemoveConstraint(theEnv,rvConstraints);
ReturnExpression(theEnv,tmpExpr);
}
else if (andNode->constraints != NULL)
{
tmpConstraints = andConstraints;
andConstraints = IntersectConstraints(theEnv,andConstraints,andNode->constraints);
RemoveConstraint(theEnv,tmpConstraints);
}
}
}
/*===========================================================*/
/* Intersect the &'ed constraints with the slot constraints. */
/*===========================================================*/
tmpConstraints = andConstraints;
andConstraints = IntersectConstraints(theEnv,andConstraints,theNode->constraints);
RemoveConstraint(theEnv,tmpConstraints);
/*===============================================================*/
/* Remove any negated constants from the list of allowed values. */
/*===============================================================*/
for (andNode = orNode; andNode != NULL; andNode = andNode->right)
{
if ((andNode->negated) && ConstantType(andNode->type))
{ RemoveConstantFromConstraint(theEnv,andNode->type,andNode->value,andConstraints); }
}
/*=======================================================*/
/* Union the &'ed constraints with the |'ed constraints. */
/*=======================================================*/
tmpConstraints = orConstraints;
orConstraints = UnionConstraints(theEnv,orConstraints,andConstraints);
RemoveConstraint(theEnv,tmpConstraints);
RemoveConstraint(theEnv,andConstraints);
}
/*===============================================*/
/* Replace the constraints for the slot with the */
/* constraints derived from the connected */
/* constraints (which should be a subset. */
/*===============================================*/
if (orConstraints != NULL)
{
if (theNode->derivedConstraints) RemoveConstraint(theEnv,theNode->constraints);
theNode->constraints = orConstraints;
theNode->derivedConstraints = TRUE;
}
/*==================================*/
/* Check for constraint violations. */
/*==================================*/
if (CheckForUnmatchableConstraints(theEnv,theNode,(int) patternHead->whichCE))
{ return(TRUE); }
/*=========================================*/
/* If the constraints are for a multifield */
/* slot, check for cardinality violations. */
/*=========================================*/
if ((multifieldHeader != NULL) && (theNode->right == NULL))
{
if (MultifieldCardinalityViolation(theEnv,multifieldHeader))
{
ConstraintViolationErrorMessage(theEnv,"The group of restrictions",
NULL,FALSE,
(int) patternHead->whichCE,
multifieldHeader->slot,
multifieldHeader->index,
CARDINALITY_VIOLATION,
multifieldHeader->constraints,TRUE);
return(TRUE);
}
}
/*=======================================*/
/* Return FALSE indicating no constraint */
/* violations were detected. */
/*=======================================*/
return(FALSE);
}
static void MarkDefclassItems(
struct constructHeader *theDefclass,
void *buf)
{
#if MAC_MPW || MAC_MCW || IBM_MCW
#pragma unused(buf)
#endif
DEFCLASS *cls = (DEFCLASS *) theDefclass;
register unsigned i;
EXPRESSION *tmpexp;
MarkConstructHeaderNeededItems(&cls->header,ClassCount++);
LinkCount += cls->directSuperclasses.classCount +
cls->directSubclasses.classCount +
cls->allSuperclasses.classCount;
#if DEFMODULE_CONSTRUCT
cls->scopeMap->neededBitMap = TRUE;
#endif
/* ===================================================
Mark items needed by slot default value expressions
=================================================== */
for (i = 0 ; i < cls->slotCount ; i++)
{
cls->slots[i].bsaveIndex = SlotCount++;
cls->slots[i].overrideMessage->neededSymbol = TRUE;
if (cls->slots[i].defaultValue != NULL)
{
if (cls->slots[i].dynamicDefault)
{
ExpressionCount +=
ExpressionSize((EXPRESSION *) cls->slots[i].defaultValue);
MarkNeededItems((EXPRESSION *) cls->slots[i].defaultValue);
}
else
{
/* =================================================
Static default values are stotred as data objects
and must be converted into expressions
================================================= */
tmpexp =
ConvertValueToExpression((DATA_OBJECT *) cls->slots[i].defaultValue);
ExpressionCount += ExpressionSize(tmpexp);
MarkNeededItems(tmpexp);
ReturnExpression(tmpexp);
}
}
}
/* ========================================
Count canonical slots needed by defclass
======================================== */
TemplateSlotCount += cls->instanceSlotCount;
if (cls->instanceSlotCount != 0)
SlotNameMapCount += cls->maxSlotNameID + 1;
/* ===============================================
Mark items needed by defmessage-handler actions
=============================================== */
for (i = 0 ; i < cls->handlerCount ; i++)
{
cls->handlers[i].name->neededSymbol = TRUE;
ExpressionCount += ExpressionSize(cls->handlers[i].actions);
MarkNeededItems(cls->handlers[i].actions);
}
HandlerCount += cls->handlerCount;
}
globle void FieldConversion(
void *theEnv,
EXEC_STATUS,
struct lhsParseNode *theField,
struct lhsParseNode *thePattern)
{
int testInPatternNetwork = TRUE;
struct lhsParseNode *patternPtr;
struct expr *headOfPNExpression, *headOfJNExpression, *headOfNandExpression;
struct expr *lastPNExpression, *lastJNExpression, *lastNandExpression;
struct expr *tempExpression;
struct expr *patternNetTest = NULL;
struct expr *joinNetTest = NULL;
struct expr *nandTest = NULL;
struct expr *constantSelector = NULL;
struct expr *constantValue = NULL;
int nandField;
/*==================================================*/
/* Consider a NULL pointer to be an internal error. */
/*==================================================*/
if (theField == NULL)
{
SystemError(theEnv,execStatus,"ANALYSIS",3);
EnvExitRouter(theEnv,execStatus,EXIT_FAILURE);
}
/*========================================================*/
/* Determine if constant testing must be performed in the */
/* join network. Only possible when a field contains an */
/* or ('|') and references are made to variables outside */
/* the pattern. */
/*========================================================*/
if (theField->bottom != NULL)
{
if (theField->bottom->bottom != NULL)
{ testInPatternNetwork = AllVariablesInPattern(theField->bottom,theField->pattern); }
}
/*=========================================================*/
/* Determine if any of the field tests require the network */
/* expression to be evaluted in the nand join. */
/*=========================================================*/
nandField = FieldIsNandTest(theField);
/*=============================================================*/
/* Extract pattern and join network expressions. Loop through */
/* the or'ed constraints of the field, extracting pattern and */
/* join network expressions and adding them to a running list. */
/*=============================================================*/
headOfPNExpression = lastPNExpression = NULL;
headOfJNExpression = lastJNExpression = NULL;
headOfNandExpression = lastNandExpression = NULL;
for (patternPtr = theField->bottom;
patternPtr != NULL;
patternPtr = patternPtr->bottom)
{
/*=============================================*/
/* Extract pattern and join network tests from */
/* the or'ed constraint being examined. */
/*=============================================*/
ExtractAnds(theEnv,execStatus,patternPtr,testInPatternNetwork,&patternNetTest,&joinNetTest,&nandTest,
&constantSelector,&constantValue,nandField);
/*=============================================================*/
/* Constant hashing is only used in the pattern network if the */
/* field doesn't contain an or'ed constraint. For example, the */
/* constaint "red | blue" can not use hashing. */
/*=============================================================*/
if (constantSelector != NULL)
{
if ((patternPtr == theField->bottom) &&
(patternPtr->bottom == NULL))
{
theField->constantSelector = constantSelector;
theField->constantValue = constantValue;
}
else
{
ReturnExpression(theEnv,execStatus,constantSelector);
ReturnExpression(theEnv,execStatus,constantValue);
ReturnExpression(theEnv,execStatus,theField->constantSelector);
ReturnExpression(theEnv,execStatus,theField->constantValue);
theField->constantSelector = NULL;
theField->constantValue = NULL;
}
}
/*=====================================================*/
/* Add the new pattern network expressions to the list */
/* of pattern network expressions being constructed. */
/*=====================================================*/
if (patternNetTest != NULL)
{
if (lastPNExpression == NULL)
{ headOfPNExpression = patternNetTest; }
else
{ lastPNExpression->nextArg = patternNetTest; }
lastPNExpression = patternNetTest;
}
/*==================================================*/
/* Add the new join network expressions to the list */
/* of join network expressions being constructed. */
/*==================================================*/
if (joinNetTest != NULL)
{
if (lastJNExpression == NULL)
{ headOfJNExpression = joinNetTest; }
else
{ lastJNExpression->nextArg = joinNetTest; }
lastJNExpression = joinNetTest;
}
/*=======================================================*/
/* Add the new nand join network expressions to the list */
/* of nand join network expressions being constructed. */
/*=======================================================*/
if (nandTest != NULL)
{
if (lastNandExpression == NULL)
{ headOfNandExpression = nandTest; }
else
{ lastNandExpression->nextArg = nandTest; }
lastNandExpression = nandTest;
}
}
/*==========================================================*/
/* If there was more than one expression generated from the */
/* or'ed field constraints for the pattern network, then */
/* enclose the expressions within an "or" function call. */
/*==========================================================*/
if ((headOfPNExpression != NULL) ? (headOfPNExpression->nextArg != NULL) : FALSE)
{
tempExpression = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_OR);
tempExpression->argList = headOfPNExpression;
headOfPNExpression = tempExpression;
}
/*==========================================================*/
/* If there was more than one expression generated from the */
/* or'ed field constraints for the join network, then */
/* enclose the expressions within an "or" function call. */
/*==========================================================*/
if ((headOfJNExpression != NULL) ? (headOfJNExpression->nextArg != NULL) : FALSE)
{
tempExpression = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_OR);
tempExpression->argList = headOfJNExpression;
headOfJNExpression = tempExpression;
}
/*==========================================================*/
/* If there was more than one expression generated from the */
/* or'ed field constraints for the nand join network, then */
/* enclose the expressions within an "or" function call. */
/*==========================================================*/
if ((headOfNandExpression != NULL) ? (headOfNandExpression->nextArg != NULL) : FALSE)
{
tempExpression = GenConstant(theEnv,execStatus,FCALL,ExpressionData(theEnv,execStatus)->PTR_OR);
tempExpression->argList = headOfNandExpression;
headOfNandExpression = tempExpression;
}
/*===============================================================*/
/* If the field constraint binds a variable that was previously */
/* bound somewhere in the LHS of the rule, then generate an */
/* expression to compare this binding occurrence of the variable */
/* to the previous binding occurrence. */
/*===============================================================*/
if (((theField->type == MF_VARIABLE) || (theField->type == SF_VARIABLE)) &&
(theField->referringNode != NULL))
{
/*================================================================*/
/* If the previous variable reference is within the same pattern, */
/* then the variable comparison can occur in the pattern network. */
/*================================================================*/
if (theField->referringNode->pattern == theField->pattern)
{
tempExpression = GenPNVariableComparison(theEnv,execStatus,theField,theField->referringNode);
headOfPNExpression = CombineExpressions(theEnv,execStatus,tempExpression,headOfPNExpression);
}
/*====================================*/
/* Otherwise, the variable comparison */
/* must occur in the join network. */
/*====================================*/
else if (theField->referringNode->pattern > 0)
{
tempExpression = GenJNVariableComparison(theEnv,execStatus,theField,theField->referringNode,nandField);
if (theField->beginNandDepth > theField->referringNode->beginNandDepth)
{
headOfNandExpression = CombineExpressions(theEnv,execStatus,tempExpression,headOfNandExpression);
/*==========================*/
/* Generate the hash index. */
/*==========================*/
if (theField->patternType->genGetJNValueFunction)
{
tempExpression = (*theField->patternType->genGetJNValueFunction)(theEnv,execStatus,theField,LHS);
thePattern->externalRightHash = AppendExpressions(tempExpression,thePattern->externalRightHash);
}
if (theField->referringNode->patternType->genGetJNValueFunction)
{
tempExpression = (*theField->referringNode->patternType->genGetJNValueFunction)(theEnv,execStatus,theField->referringNode,LHS);
thePattern->externalLeftHash = AppendExpressions(tempExpression,thePattern->externalLeftHash);
}
}
else
{
headOfJNExpression = CombineExpressions(theEnv,execStatus,tempExpression,headOfJNExpression);
/*==========================*/
/* Generate the hash index. */
/*==========================*/
if (theField->patternType->genGetPNValueFunction != NULL)
{
tempExpression = (*theField->patternType->genGetPNValueFunction)(theEnv,execStatus,theField);
thePattern->rightHash = AppendExpressions(tempExpression,thePattern->rightHash);
}
if (theField->referringNode->patternType->genGetJNValueFunction)
{
tempExpression = (*theField->referringNode->patternType->genGetJNValueFunction)(theEnv,execStatus,theField->referringNode,LHS);
thePattern->leftHash = AppendExpressions(tempExpression,thePattern->leftHash);
}
}
}
}
/*======================================================*/
/* Attach the pattern network expressions to the field. */
/*======================================================*/
theField->networkTest = headOfPNExpression;
/*=====================================================*/
/* Attach the join network expressions to the pattern. */
/*=====================================================*/
thePattern->networkTest = CombineExpressions(theEnv,execStatus,thePattern->networkTest,headOfJNExpression);
/*==========================================================*/
/* Attach the nand join network expressions to the pattern. */
/*==========================================================*/
thePattern->externalNetworkTest = CombineExpressions(theEnv,execStatus,thePattern->externalNetworkTest,headOfNandExpression); /* TBD */
}
globle int CheckSyntax(
void *theEnv,
char *theString,
DATA_OBJECT_PTR returnValue)
{
char *name;
struct token theToken;
struct expr *top;
short rv;
/*==============================*/
/* Set the default return value */
/* (TRUE for problems found). */
/*==============================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvTrueSymbol(theEnv));
/*===========================================*/
/* Create a string source router so that the */
/* string can be used as an input source. */
/*===========================================*/
if (OpenStringSource(theEnv,"check-syntax",theString,0) == 0)
{ return(TRUE); }
/*=================================*/
/* Only expressions and constructs */
/* can have their syntax checked. */
/*=================================*/
GetToken(theEnv,"check-syntax",&theToken);
if (theToken.type != LPAREN)
{
CloseStringSource(theEnv,"check-syntax");
SetpValue(returnValue,EnvAddSymbol(theEnv,"MISSING-LEFT-PARENTHESIS"));
return(TRUE);
}
/*========================================*/
/* The next token should be the construct */
/* type or function name. */
/*========================================*/
GetToken(theEnv,"check-syntax",&theToken);
if (theToken.type != SYMBOL)
{
CloseStringSource(theEnv,"check-syntax");
SetpValue(returnValue,EnvAddSymbol(theEnv,"EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS"));
return(TRUE);
}
name = ValueToString(theToken.value);
/*==============================================*/
/* Set up a router to capture the error output. */
/*==============================================*/
EnvAddRouter(theEnv,"error-capture",40,
FindErrorCapture, PrintErrorCapture,
NULL, NULL, NULL);
/*================================*/
/* Determine if it's a construct. */
/*================================*/
if (FindConstruct(theEnv,name))
{
ConstructData(theEnv)->CheckSyntaxMode = TRUE;
rv = (short) ParseConstruct(theEnv,name,"check-syntax");
GetToken(theEnv,"check-syntax",&theToken);
ConstructData(theEnv)->CheckSyntaxMode = FALSE;
if (rv)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
}
DestroyPPBuffer(theEnv);
CloseStringSource(theEnv,"check-syntax");
if ((rv != FALSE) || (ParseFunctionData(theEnv)->WarningString != NULL))
{
SetErrorCaptureValues(theEnv,returnValue);
DeactivateErrorCapture(theEnv);
return(TRUE);
}
if (theToken.type != STOP)
{
SetpValue(returnValue,EnvAddSymbol(theEnv,"EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
DeactivateErrorCapture(theEnv);
return(TRUE);
}
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
DeactivateErrorCapture(theEnv);
return(FALSE);
}
/*=======================*/
/* Parse the expression. */
/*=======================*/
top = Function2Parse(theEnv,"check-syntax",name);
GetToken(theEnv,"check-syntax",&theToken);
ClearParsedBindNames(theEnv);
CloseStringSource(theEnv,"check-syntax");
if (top == NULL)
{
SetErrorCaptureValues(theEnv,returnValue);
DeactivateErrorCapture(theEnv);
return(TRUE);
}
if (theToken.type != STOP)
{
SetpValue(returnValue,EnvAddSymbol(theEnv,"EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
DeactivateErrorCapture(theEnv);
ReturnExpression(theEnv,top);
return(TRUE);
}
DeactivateErrorCapture(theEnv);
ReturnExpression(theEnv,top);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
return(FALSE);
}
static void DeclarationParse(
void *theEnv,
EXEC_STATUS,
char *readSource,
char *ruleName,
int *error)
{
struct token theToken;
struct expr *packPtr;
int notDone = TRUE;
int salienceParsed = FALSE, autoFocusParsed = FALSE;
/*===========================*/
/* Next token must be a '('. */
/*===========================*/
SavePPBuffer(theEnv,execStatus," ");
GetToken(theEnv,execStatus,readSource,&theToken);
if (theToken.type != LPAREN)
{
SyntaxErrorMessage(theEnv,execStatus,"declare statement");
*error = TRUE;
return;
}
/*==========================================*/
/* Continue parsing until there are no more */
/* valid rule property declarations. */
/*==========================================*/
while (notDone)
{
/*=============================================*/
/* The name of a rule property must be symbol. */
/*=============================================*/
GetToken(theEnv,execStatus,readSource,&theToken);
if (theToken.type != SYMBOL)
{
SyntaxErrorMessage(theEnv,execStatus,"declare statement");
*error = TRUE;
}
/*==============================================*/
/* Parse a salience declaration if encountered. */
/*==============================================*/
else if (strcmp(ValueToString(theToken.value),"salience") == 0)
{
if (salienceParsed)
{
AlreadyParsedErrorMessage(theEnv,execStatus,"salience declaration",NULL);
*error = TRUE;
}
else
{
ParseSalience(theEnv,execStatus,readSource,ruleName,error);
salienceParsed = TRUE;
}
}
/*=================================================*/
/* Parse an auto-focus declaration if encountered. */
/* A global flag is used to indicate if the */
/* auto-focus feature for a rule was parsed. */
/*=================================================*/
else if (strcmp(ValueToString(theToken.value),"auto-focus") == 0)
{
if (autoFocusParsed)
{
AlreadyParsedErrorMessage(theEnv,execStatus,"auto-focus declaration",NULL);
*error = TRUE;
}
else
{
ParseAutoFocus(theEnv,execStatus,readSource,error);
autoFocusParsed = TRUE;
}
}
/*==========================================*/
/* Otherwise the symbol does not correspond */
/* to a valid rule property. */
/*==========================================*/
else
{
SyntaxErrorMessage(theEnv,execStatus,"declare statement");
*error = TRUE;
}
/*=====================================*/
/* Return if an error was encountered. */
/*=====================================*/
if (*error)
{
ReturnExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression);
PatternData(theEnv,execStatus)->SalienceExpression = NULL;
return;
}
/*=======================================*/
/* Both the salience and auto-focus rule */
/* properties are closed with a ')'. */
/*=======================================*/
GetToken(theEnv,execStatus,readSource,&theToken);
if (theToken.type != RPAREN)
{
PPBackup(theEnv,execStatus);
SavePPBuffer(theEnv,execStatus," ");
SavePPBuffer(theEnv,execStatus,theToken.printForm);
ReturnExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression);
PatternData(theEnv,execStatus)->SalienceExpression = NULL;
SyntaxErrorMessage(theEnv,execStatus,"declare statement");
*error = TRUE;
return;
}
/*=============================================*/
/* The declare statement is closed with a ')'. */
/*=============================================*/
GetToken(theEnv,execStatus,readSource,&theToken);
if (theToken.type == RPAREN) notDone = FALSE;
else if (theToken.type != LPAREN)
{
ReturnExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression);
PatternData(theEnv,execStatus)->SalienceExpression = NULL;
SyntaxErrorMessage(theEnv,execStatus,"declare statement");
*error = TRUE;
return;
}
else
{
PPBackup(theEnv,execStatus);
SavePPBuffer(theEnv,execStatus," (");
}
}
/*==========================================*/
/* Return the value of the salience through */
/* the global variable SalienceExpression. */
/*==========================================*/
packPtr = PackExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression);
ReturnExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression);
PatternData(theEnv,execStatus)->SalienceExpression = packPtr;
return;
}
/***************************************************************
NAME : ParseQueryRestrictions
DESCRIPTION : Parses the template restrictions for a query
INPUTS : 1) The top node of the query expression
2) The logical name of the input
3) Caller's token buffer
RETURNS : The fact-variable expressions
SIDE EFFECTS : Entire query expression deleted on errors
Nodes allocated for restrictions and fact
variable expressions
Template restrictions attached to query-expression
as arguments
NOTES : Expects top != NULL
***************************************************************/
static EXPRESSION *ParseQueryRestrictions(
void *theEnv,
EXPRESSION *top,
const char *readSource,
struct token *queryInputToken)
{
EXPRESSION *factQuerySetVars = NULL,*lastFactQuerySetVars = NULL,
*templateExp = NULL,*lastTemplateExp,
*tmp,*lastOne = NULL;
int error = FALSE;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != LPAREN)
{ goto ParseQueryRestrictionsError1; }
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != LPAREN)
{ goto ParseQueryRestrictionsError1; }
while (queryInputToken->type == LPAREN)
{
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != SF_VARIABLE)
{ goto ParseQueryRestrictionsError1; }
tmp = factQuerySetVars;
while (tmp != NULL)
{
if (tmp->value == queryInputToken->value)
{
PrintErrorID(theEnv,"FACTQPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Duplicate fact member variable name in function ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
EnvPrintRouter(theEnv,WERROR,".\n");
goto ParseQueryRestrictionsError2;
}
tmp = tmp->nextArg;
}
tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value);
if (factQuerySetVars == NULL)
{ factQuerySetVars = tmp; }
else
{ lastFactQuerySetVars->nextArg = tmp; }
lastFactQuerySetVars = tmp;
SavePPBuffer(theEnv," ");
templateExp = ArgumentParse(theEnv,readSource,&error);
if (error)
{ goto ParseQueryRestrictionsError2; }
if (templateExp == NULL)
{ goto ParseQueryRestrictionsError1; }
if (ReplaceTemplateNameWithReference(theEnv,templateExp) == FALSE)
{ goto ParseQueryRestrictionsError2; }
lastTemplateExp = templateExp;
SavePPBuffer(theEnv," ");
while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL)
{
if (ReplaceTemplateNameWithReference(theEnv,tmp) == FALSE)
goto ParseQueryRestrictionsError2;
lastTemplateExp->nextArg = tmp;
lastTemplateExp = tmp;
SavePPBuffer(theEnv," ");
}
if (error)
{ goto ParseQueryRestrictionsError2; }
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
tmp = GenConstant(theEnv,SYMBOL,(void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL);
lastTemplateExp->nextArg = tmp;
lastTemplateExp = tmp;
if (top->argList == NULL)
{ top->argList = templateExp; }
else
{ lastOne->nextArg = templateExp; }
lastOne = lastTemplateExp;
templateExp = NULL;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,queryInputToken);
}
if (queryInputToken->type != RPAREN)
{ goto ParseQueryRestrictionsError1; }
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
return(factQuerySetVars);
ParseQueryRestrictionsError1:
SyntaxErrorMessage(theEnv,"fact-set query function");
ParseQueryRestrictionsError2:
ReturnExpression(theEnv,templateExp);
ReturnExpression(theEnv,top);
ReturnExpression(theEnv,factQuerySetVars);
return(NULL);
}
static struct expr *LoopForCountParse(
void *theEnv,
struct expr *parse,
const char *infile)
{
struct token theToken;
SYMBOL_HN *loopVar = NULL;
EXPRESSION *tmpexp;
int read_first_paren;
struct BindInfo *oldBindList,*newBindList,*prev;
/*======================================*/
/* Process the loop counter expression. */
/*======================================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,infile,&theToken);
/* ==========================================
Simple form: loop-for-count <end> [do] ...
========================================== */
if (theToken.type != LPAREN)
{
parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));
parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
}
else
{
GetToken(theEnv,infile,&theToken);
if (theToken.type != SF_VARIABLE)
{
if (theToken.type != SYMBOL)
goto LoopForCountParseError;
parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));
parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value));
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
}
/* =============================================================
Complex form: loop-for-count (<var> [<start>] <end>) [do] ...
============================================================= */
else
{
loopVar = (SYMBOL_HN *) theToken.value;
SavePPBuffer(theEnv," ");
parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);
if (parse->argList == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i'))
goto LoopForCountParseError;
SavePPBuffer(theEnv," ");
GetToken(theEnv,infile,&theToken);
if (theToken.type == RPAREN)
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));
tmpexp->nextArg = parse->argList;
parse->argList = tmpexp;
}
else
{
parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
GetToken(theEnv,infile,&theToken);
if (theToken.type != RPAREN)
goto LoopForCountParseError;
}
SavePPBuffer(theEnv," ");
}
}
if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i'))
goto LoopForCountParseError;
/*====================================*/
/* Process the do keyword if present. */
/*====================================*/
GetToken(theEnv,infile,&theToken);
if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
{
read_first_paren = TRUE;
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,theToken.printForm);
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
}
else if (theToken.type == LPAREN)
{
read_first_paren = FALSE;
PPBackup(theEnv);
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
}
else
goto LoopForCountParseError;
/*=====================================*/
/* Process the loop-for-count actions. */
/*=====================================*/
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
ExpressionData(theEnv)->BreakContext = TRUE;
oldBindList = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
parse->argList->nextArg->nextArg =
GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);
if (parse->argList->nextArg->nextArg == NULL)
{
SetParsedBindNames(theEnv,oldBindList);
ReturnExpression(theEnv,parse);
return(NULL);
}
newBindList = GetParsedBindNames(theEnv);
prev = NULL;
while (newBindList != NULL)
{
if ((loopVar == NULL) ? FALSE :
(strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0))
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
PrintErrorID(theEnv,"PRCDRPSR",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n");
ReturnExpression(theEnv,parse);
return(NULL);
}
prev = newBindList;
newBindList = newBindList->next;
}
if (prev == NULL)
SetParsedBindNames(theEnv,oldBindList);
else
prev->next = oldBindList;
if (loopVar != NULL)
ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
/*================================================================*/
/* Check for the closing right parenthesis of the loop-for-count. */
/*================================================================*/
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"loop-for-count function");
ReturnExpression(theEnv,parse);
return(NULL);
}
DecrementIndentDepth(theEnv,3);
return(parse);
LoopForCountParseError:
SyntaxErrorMessage(theEnv,"loop-for-count function");
ReturnExpression(theEnv,parse);
return(NULL);
}
static struct expr *IfParse(
void *theEnv,
struct expr *top,
const char *infile)
{
struct token theToken;
/*============================*/
/* Process the if expression. */
/*============================*/
SavePPBuffer(theEnv," ");
top->argList = ParseAtomOrExpression(theEnv,infile,NULL);
if (top->argList == NULL)
{
ReturnExpression(theEnv,top);
return(NULL);
}
/*========================================*/
/* Keyword 'then' must follow expression. */
/*========================================*/
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
GetToken(theEnv,infile,&theToken);
if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"then") != 0))
{
SyntaxErrorMessage(theEnv,"if function");
ReturnExpression(theEnv,top);
return(NULL);
}
/*==============================*/
/* Process the if then actions. */
/*==============================*/
PPCRAndIndent(theEnv);
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
if (ExpressionData(theEnv)->svContexts->brk == TRUE)
ExpressionData(theEnv)->BreakContext = TRUE;
top->argList->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,"else",FALSE);
if (top->argList->nextArg == NULL)
{
ReturnExpression(theEnv,top);
return(NULL);
}
top->argList->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg);
/*===========================================*/
/* A ')' signals an if then without an else. */
/*===========================================*/
if (theToken.type == RPAREN)
{
DecrementIndentDepth(theEnv,3);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
return(top);
}
/*=============================================*/
/* Keyword 'else' must follow if then actions. */
/*=============================================*/
if ((theToken.type != SYMBOL) || (strcmp(ValueToString(theToken.value),"else") != 0))
{
SyntaxErrorMessage(theEnv,"if function");
ReturnExpression(theEnv,top);
return(NULL);
}
/*==============================*/
/* Process the if else actions. */
/*==============================*/
PPCRAndIndent(theEnv);
top->argList->nextArg->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);
if (top->argList->nextArg->nextArg == NULL)
{
ReturnExpression(theEnv,top);
return(NULL);
}
top->argList->nextArg->nextArg = RemoveUnneededProgn(theEnv,top->argList->nextArg->nextArg);
/*======================================================*/
/* Check for the closing right parenthesis of the if. */
/*======================================================*/
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"if function");
ReturnExpression(theEnv,top);
return(NULL);
}
/*===========================================*/
/* A ')' signals an if then without an else. */
/*===========================================*/
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
DecrementIndentDepth(theEnv,3);
return(top);
}
globle int ParseDeffacts(
void *theEnv,
const char *readSource)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *deffactsName;
struct expr *temp;
struct deffacts *newDeffacts;
int deffactsError;
struct token inputToken;
/*=========================*/
/* Parsing initialization. */
/*=========================*/
deffactsError = FALSE;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(deffacts ");
/*==========================================================*/
/* Deffacts can not be added when a binary image is loaded. */
/*==========================================================*/
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"deffacts");
return(TRUE);
}
#endif
/*============================*/
/* Parse the deffacts header. */
/*============================*/
deffactsName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deffacts",
EnvFindDeffactsInModule,EnvUndeffacts,"$",TRUE,
TRUE,TRUE,FALSE);
if (deffactsName == NULL) { return(TRUE); }
/*===============================================*/
/* Parse the list of facts in the deffacts body. */
/*===============================================*/
temp = BuildRHSAssert(theEnv,readSource,&inputToken,&deffactsError,FALSE,FALSE,"deffacts");
if (deffactsError == TRUE) { return(TRUE); }
if (ExpressionContainsVariables(temp,FALSE))
{
LocalVariableErrorMessage(theEnv,"a deffacts construct");
ReturnExpression(theEnv,temp);
return(TRUE);
}
SavePPBuffer(theEnv,"\n");
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deffacts to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,temp);
return(FALSE);
}
/*==========================*/
/* Create the new deffacts. */
/*==========================*/
ExpressionInstall(theEnv,temp);
newDeffacts = get_struct(theEnv,deffacts);
newDeffacts->header.name = deffactsName;
IncrementSymbolCount(deffactsName);
newDeffacts->assertList = PackExpression(theEnv,temp);
newDeffacts->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"deffacts")->moduleIndex);
newDeffacts->header.next = NULL;
newDeffacts->header.usrData = NULL;
ReturnExpression(theEnv,temp);
/*=======================================================*/
/* Save the pretty print representation of the deffacts. */
/*=======================================================*/
if (EnvGetConserveMemory(theEnv) == TRUE)
{ newDeffacts->header.ppForm = NULL; }
else
{ newDeffacts->header.ppForm = CopyPPBuffer(theEnv); }
/*=============================================*/
/* Add the deffacts to the appropriate module. */
/*=============================================*/
AddConstructToModule(&newDeffacts->header);
#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */
/*================================================================*/
/* Return FALSE to indicate the deffacts was successfully parsed. */
/*================================================================*/
return(FALSE);
}
static struct expr *WhileParse(
void *theEnv,
struct expr *parse,
const char *infile)
{
struct token theToken;
int read_first_paren;
/*===============================*/
/* Process the while expression. */
/*===============================*/
SavePPBuffer(theEnv," ");
parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);
if (parse->argList == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
/*====================================*/
/* Process the do keyword if present. */
/*====================================*/
GetToken(theEnv,infile,&theToken);
if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))
{
read_first_paren = TRUE;
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,theToken.printForm);
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
}
else if (theToken.type == LPAREN)
{
read_first_paren = FALSE;
PPBackup(theEnv);
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
}
else
{
SyntaxErrorMessage(theEnv,"while function");
ReturnExpression(theEnv,parse);
return(NULL);
}
/*============================*/
/* Process the while actions. */
/*============================*/
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
ExpressionData(theEnv)->BreakContext = TRUE;
parse->argList->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);
if (parse->argList->nextArg == NULL)
{
ReturnExpression(theEnv,parse);
return(NULL);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
/*=======================================================*/
/* Check for the closing right parenthesis of the while. */
/*=======================================================*/
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"while function");
ReturnExpression(theEnv,parse);
return(NULL);
}
DecrementIndentDepth(theEnv,3);
return(parse);
}
globle int ParseDefrule(
void *theEnv,
char *readSource)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,readSource)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *ruleName;
struct lhsParseNode *theLHS;
struct expr *actions;
struct token theToken;
struct defrule *topDisjunct, *tempPtr;
struct defruleModule *theModuleItem;
short error;
/*================================================*/
/* Flush the buffer which stores the pretty print */
/* representation for a rule. Add the already */
/* parsed keyword defrule to this buffer. */
/*================================================*/
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SavePPBuffer(theEnv,"(defrule ");
/*=========================================================*/
/* Rules cannot be loaded when a binary load is in effect. */
/*=========================================================*/
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defrule");
return(TRUE);
}
#endif
/*================================================*/
/* Parse the name and comment fields of the rule, */
/* deleting the rule if it already exists. */
/*================================================*/
#if DEBUGGING_FUNCTIONS
DefruleData(theEnv)->DeletedRuleDebugFlags = 0;
#endif
ruleName = GetConstructNameAndComment(theEnv,readSource,&theToken,"defrule",
EnvFindDefrule,EnvUndefrule,"*",FALSE,
TRUE,TRUE);
if (ruleName == NULL) return(TRUE);
/*============================*/
/* Parse the LHS of the rule. */
/*============================*/
theLHS = ParseRuleLHS(theEnv,readSource,&theToken,ValueToString(ruleName));
if (theLHS == NULL)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
return(TRUE);
}
/*============================*/
/* Parse the RHS of the rule. */
/*============================*/
ClearParsedBindNames(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseRuleRHS(theEnv,readSource);
if (actions == NULL)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
ReturnLHSParseNodes(theEnv,theLHS);
return(TRUE);
}
/*=======================*/
/* Process the rule LHS. */
/*=======================*/
topDisjunct = ProcessRuleLHS(theEnv,theLHS,actions,ruleName,&error);
ReturnExpression(theEnv,actions);
ClearParsedBindNames(theEnv);
ReturnLHSParseNodes(theEnv,theLHS);
if (error)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
return(TRUE);
}
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed defrule to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnPackedExpression(theEnv,PatternData(theEnv)->SalienceExpression);
PatternData(theEnv)->SalienceExpression = NULL;
return(FALSE);
}
PatternData(theEnv)->SalienceExpression = NULL;
/*======================================*/
/* Save the nice printout of the rules. */
/*======================================*/
SavePPBuffer(theEnv,"\n");
if (EnvGetConserveMemory(theEnv) == TRUE)
{ topDisjunct->header.ppForm = NULL; }
else
{ topDisjunct->header.ppForm = CopyPPBuffer(theEnv); }
/*=======================================*/
/* Store a pointer to the rule's module. */
/*=======================================*/
theModuleItem = (struct defruleModule *)
GetModuleItem(theEnv,NULL,FindModuleItem(theEnv,"defrule")->moduleIndex);
for (tempPtr = topDisjunct; tempPtr != NULL; tempPtr = tempPtr->disjunct)
{ tempPtr->header.whichModule = (struct defmoduleItemHeader *) theModuleItem; }
/*===============================================*/
/* Rule completely parsed. Add to list of rules. */
/*===============================================*/
AddToDefruleList(topDisjunct);
/*========================================================================*/
/* If a rule is redefined, then we want to restore its breakpoint status. */
/*========================================================================*/
#if DEBUGGING_FUNCTIONS
if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,0))
{ EnvSetBreak(theEnv,topDisjunct); }
if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,1) || EnvGetWatchItem(theEnv,"activations"))
{ EnvSetDefruleWatchActivations(theEnv,ON,(void *) topDisjunct); }
if (BitwiseTest(DefruleData(theEnv)->DeletedRuleDebugFlags,2) || EnvGetWatchItem(theEnv,"rules"))
{ EnvSetDefruleWatchFirings(theEnv,ON,(void *) topDisjunct); }
#endif
/*================================*/
/* Perform the incremental reset. */
/*================================*/
IncrementalReset(theEnv,topDisjunct);
/*=============================================*/
/* Return FALSE to indicate no errors occured. */
/*=============================================*/
#endif
return(FALSE);
}
static struct defrule *ProcessRuleLHS(
void *theEnv,
struct lhsParseNode *theLHS,
struct expr *actions,
SYMBOL_HN *ruleName,
short *error)
{
struct lhsParseNode *tempNode = NULL;
struct defrule *topDisjunct = NULL, *currentDisjunct, *lastDisjunct = NULL;
struct expr *newActions, *packPtr;
int logicalJoin;
int localVarCnt;
int complexity;
struct joinNode *lastJoin;
/*================================================*/
/* Initially set the parsing error flag to FALSE. */
/*================================================*/
*error = FALSE;
/*===========================================================*/
/* The top level of the construct representing the LHS of a */
/* rule is assumed to be an OR. If the implied OR is at the */
/* top level of the pattern construct, then remove it. */
/*===========================================================*/
if (theLHS->type == OR_CE) theLHS = theLHS->right;
/*=========================================*/
/* Loop through each disjunct of the rule. */
/*=========================================*/
localVarCnt = CountParsedBindNames(theEnv);
for (;
theLHS != NULL;
theLHS = theLHS->bottom)
{
/*===================================*/
/* Analyze the LHS of this disjunct. */
/*===================================*/
if (theLHS->type == AND_CE) tempNode = theLHS->right;
else if (theLHS->type == PATTERN_CE) tempNode = theLHS;
if (VariableAnalysis(theEnv,tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
/*=========================================*/
/* Perform entity dependent post analysis. */
/*=========================================*/
if (PostPatternAnalysis(theEnv,tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
/*========================================================*/
/* Print out developer information if it's being watched. */
/*========================================================*/
#if DEVELOPER && DEBUGGING_FUNCTIONS
/*
if (EnvGetWatchItem(theEnv,"rule-analysis"))
{
struct lhsParseNode *traceNode;
char buffer[20];
EnvPrintRouter(theEnv,WDISPLAY,"\n");
for (traceNode = tempNode; traceNode != NULL; traceNode = traceNode->bottom)
{
if (traceNode->userCE)
{
sprintf(buffer,"CE %2d: ",traceNode->whichCE);
EnvPrintRouter(theEnv,WDISPLAY,buffer);
PrintExpression(theEnv,WDISPLAY,traceNode->networkTest);
EnvPrintRouter(theEnv,WDISPLAY,"\n");
}
}
}
*/
#endif
/*========================================*/
/* Check to see that logical CEs are used */
/* appropriately in the LHS of the rule. */
/*========================================*/
if ((logicalJoin = LogicalAnalysis(theEnv,tempNode)) < 0)
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
/*======================================================*/
/* Check to see if there are any RHS constraint errors. */
/*======================================================*/
if (CheckRHSForConstraintErrors(theEnv,actions,tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
/*=================================================*/
/* Replace variable references in the RHS with the */
/* appropriate variable retrieval functions. */
/*=================================================*/
newActions = CopyExpression(theEnv,actions);
if (ReplaceProcVars(theEnv,"RHS of defrule",newActions,NULL,NULL,
ReplaceRHSVariable,(void *) tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
ReturnExpression(theEnv,newActions);
return(NULL);
}
/*==================================*/
/* We're finished for this disjunct */
/* if we're only checking syntax. */
/*==================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,newActions);
continue;
}
/*=================================*/
/* Install the disjunct's actions. */
/*=================================*/
ExpressionInstall(theEnv,newActions);
packPtr = PackExpression(theEnv,newActions);
ReturnExpression(theEnv,newActions);
/*===============================================================*/
/* Create the pattern and join data structures for the new rule. */
/*===============================================================*/
lastJoin = ConstructJoins(theEnv,logicalJoin,tempNode);
/*===================================================================*/
/* Determine the rule's complexity for use with conflict resolution. */
/*===================================================================*/
complexity = RuleComplexity(theEnv,tempNode);
/*=====================================================*/
/* Create the defrule data structure for this disjunct */
/* and put it in the list of disjuncts for this rule. */
/*=====================================================*/
currentDisjunct = CreateNewDisjunct(theEnv,ruleName,localVarCnt,packPtr,complexity,
(unsigned) logicalJoin,lastJoin);
/*============================================================*/
/* Place the disjunct in the list of disjuncts for this rule. */
/* If the disjunct is the first disjunct, then increment the */
/* reference counts for the dynamic salience (the expression */
/* for the dynamic salience is only stored with the first */
/* disjuncts and the other disjuncts refer back to the first */
/* disjunct for their dynamic salience value. */
/*============================================================*/
if (topDisjunct == NULL)
{
topDisjunct = currentDisjunct;
ExpressionInstall(theEnv,topDisjunct->dynamicSalience);
}
else lastDisjunct->disjunct = currentDisjunct;
/*===========================================*/
/* Move on to the next disjunct of the rule. */
/*===========================================*/
lastDisjunct = currentDisjunct;
}
return(topDisjunct);
}
/****************************************************************************
NAME : ParseSimpleInstance
DESCRIPTION : Parses instances from file for load-instances
into an EXPRESSION forms that
can later be evaluated with EvaluateExpression()
INPUTS : 1) The address of the top node of the expression
containing the make-instance function call
2) The logical name of the input source
RETURNS : The address of the modified expression, or NULL
if there is an error
SIDE EFFECTS : The expression is enhanced to include all
aspects of the make-instance call
(slot-overrides etc.)
The "top" expression is deleted on errors.
NOTES : The name, class, values etc. must be constants.
This function parses a make-instance call into
an expression of the following form :
(make-instance <instance> of <class> <slot-override>*)
where <slot-override> ::= (<slot-name> <expression>+)
goes to -->
make-instance
|
V
<instance-name>-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
****************************************************************************/
globle EXPRESSION *ParseSimpleInstance(
EXPRESSION *top,
char *readSource)
{
EXPRESSION *exp,*vals = NULL,*vbot,*tval;
int type;
GetToken(readSource,&ObjectParseToken);
if ((GetType(ObjectParseToken) != INSTANCE_NAME) &&
(GetType(ObjectParseToken) != SYMBOL))
goto MakeInstanceError;
if ((GetType(ObjectParseToken) == SYMBOL) &&
(strcmp(CLASS_RLN,DOToString(ObjectParseToken)) == 0))
{
top->argList = GenConstant(FCALL,
(VOID *) FindFunction("gensym*"));
}
else
{
top->argList = GenConstant(INSTANCE_NAME,
(VOID *) GetValue(ObjectParseToken));
GetToken(readSource,&ObjectParseToken);
if ((GetType(ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(CLASS_RLN,DOToString(ObjectParseToken)) != 0))
goto MakeInstanceError;
}
GetToken(readSource,&ObjectParseToken);
if (GetType(ObjectParseToken) != SYMBOL)
goto MakeInstanceError;
top->argList->nextArg =
GenConstant(SYMBOL,(void *) GetValue(ObjectParseToken));
exp = top->argList->nextArg;
if (ReplaceClassNameWithReference(exp) == FALSE)
goto MakeInstanceError;
GetToken(readSource,&ObjectParseToken);
while (GetType(ObjectParseToken) == LPAREN)
{
GetToken(readSource,&ObjectParseToken);
if (GetType(ObjectParseToken) != SYMBOL)
goto SlotOverrideError;
exp->nextArg = GenConstant(SYMBOL,(void *) GetValue(ObjectParseToken));
exp->nextArg->nextArg = GenConstant(SYMBOL,TrueSymbol);
exp = exp->nextArg->nextArg;
GetToken(readSource,&ObjectParseToken);
vbot = NULL;
while (GetType(ObjectParseToken) != RPAREN)
{
type = GetType(ObjectParseToken);
if (type == LPAREN)
{
GetToken(readSource,&ObjectParseToken);
if ((GetType(ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(ValueToString(ObjectParseToken.value),"create$") != 0))
goto SlotOverrideError;
GetToken(readSource,&ObjectParseToken);
if (GetType(ObjectParseToken) != RPAREN)
goto SlotOverrideError;
tval = GenConstant(FCALL,(void *) FindFunction("create$"));
}
else
{
if ((type != SYMBOL) && (type != STRING) &&
(type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME))
goto SlotOverrideError;
tval = GenConstant(type,(void *) GetValue(ObjectParseToken));
}
if (vals == NULL)
vals = tval;
else
vbot->nextArg = tval;
vbot = tval;
GetToken(readSource,&ObjectParseToken);
}
exp->argList = vals;
GetToken(readSource,&ObjectParseToken);
vals = NULL;
}
if (GetType(ObjectParseToken) != RPAREN)
goto SlotOverrideError;
return(top);
MakeInstanceError:
SyntaxErrorMessage("make-instance");
SetEvaluationError(TRUE);
ReturnExpression(top);
return(NULL);
SlotOverrideError:
SyntaxErrorMessage("slot-override");
SetEvaluationError(TRUE);
ReturnExpression(top);
ReturnExpression(vals);
return(NULL);
}
globle struct expr *BuildRHSAssert(
char *logicalName,
struct token *theToken,
int *error,
int atLeastOne,
int readFirstParen,
char *whereParsed)
{
struct expr *lastOne, *nextOne, *assertList, *stub;
*error = FALSE;
/*===============================================================*/
/* If the first parenthesis of the RHS fact pattern has not been */
/* read yet, then get the next token. If a right parenthesis is */
/* encountered then exit (however, set the error return value if */
/* at least one fact was expected). */
/*===============================================================*/
if (readFirstParen == FALSE)
{
if (theToken->type == RPAREN)
{
if (atLeastOne)
{
*error = TRUE;
SyntaxErrorMessage(whereParsed);
}
return(NULL);
}
}
/*================================================*/
/* Parse the facts until no more are encountered. */
/*================================================*/
lastOne = assertList = NULL;
while ((nextOne = GetRHSPattern(logicalName,theToken,
error,FALSE,readFirstParen,
TRUE,RPAREN)) != NULL)
{
PPCRAndIndent();
stub = GenConstant(FCALL,(void *) FindFunction("assert"));
stub->argList = nextOne;
nextOne = stub;
if (lastOne == NULL)
{ assertList = nextOne; }
else
{ lastOne->nextArg = nextOne; }
lastOne = nextOne;
readFirstParen = TRUE;
}
/*======================================================*/
/* If an error was detected while parsing, then return. */
/*======================================================*/
if (*error)
{
ReturnExpression(assertList);
return(NULL);
}
/*======================================*/
/* Fix the pretty print representation. */
/*======================================*/
if (theToken->type == RPAREN)
{
PPBackup();
PPBackup();
SavePPBuffer(")");
}
/*==============================================================*/
/* If no facts are being asserted then return NULL. In addition */
/* if at least one fact was required, then signal an error. */
/*==============================================================*/
if (assertList == NULL)
{
if (atLeastOne)
{
*error = TRUE;
SyntaxErrorMessage(whereParsed);
}
return(NULL);
}
/*===============================================*/
/* If more than one fact is being asserted, then */
/* wrap the assert commands within a progn call. */
/*===============================================*/
if (assertList->nextArg != NULL)
{
stub = GenConstant(FCALL,(void *) FindFunction("progn"));
stub->argList = assertList;
assertList = stub;
}
/*==========================================================*/
/* Return the expression for asserting the specified facts. */
/*==========================================================*/
return(assertList);
}
static struct expr *BindParse(
void *theEnv,
struct expr *top,
const char *infile)
{
struct token theToken;
SYMBOL_HN *variableName;
struct expr *texp;
CONSTRAINT_RECORD *theConstraint = NULL;
#if DEFGLOBAL_CONSTRUCT
struct defglobal *theGlobal;
int count;
#endif
SavePPBuffer(theEnv," ");
/*=============================================*/
/* Next token must be the name of the variable */
/* to be bound. */
/*=============================================*/
GetToken(theEnv,infile,&theToken);
if ((theToken.type != SF_VARIABLE) && (theToken.type != GBL_VARIABLE))
{
if ((theToken.type != MF_VARIABLE) || ExpressionData(theEnv)->SequenceOpMode)
{
SyntaxErrorMessage(theEnv,"bind function");
ReturnExpression(theEnv,top);
return(NULL);
}
}
/*==============================*/
/* Process the bind expression. */
/*==============================*/
top->argList = GenConstant(theEnv,SYMBOL,theToken.value);
variableName = (SYMBOL_HN *) theToken.value;
#if DEFGLOBAL_CONSTRUCT
if ((theToken.type == GBL_VARIABLE) ?
((theGlobal = (struct defglobal *)
FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(variableName),
&count,TRUE,FALSE)) != NULL) :
FALSE)
{
top->argList->type = DEFGLOBAL_PTR;
top->argList->value = (void *) theGlobal;
}
else if (theToken.type == GBL_VARIABLE)
{
GlobalReferenceErrorMessage(theEnv,ValueToString(variableName));
ReturnExpression(theEnv,top);
return(NULL);
}
#endif
texp = get_struct(theEnv,expr);
texp->argList = texp->nextArg = NULL;
if (CollectArguments(theEnv,texp,infile) == NULL)
{
ReturnExpression(theEnv,top);
return(NULL);
}
top->argList->nextArg = texp->argList;
rtn_struct(theEnv,expr,texp);
#if DEFGLOBAL_CONSTRUCT
if (top->argList->type == DEFGLOBAL_PTR) return(top);
#endif
if (top->argList->nextArg != NULL)
{ theConstraint = ExpressionToConstraintRecord(theEnv,top->argList->nextArg); }
AddBindName(theEnv,variableName,theConstraint);
return(top);
}
globle struct expr *ParseAssertTemplate(
void *theEnv,
EXEC_STATUS,
char *readSource,
struct token *theToken,
int *error,
int endType,
int constantsOnly,
struct deftemplate *theDeftemplate)
{
struct expr *firstSlot, *lastSlot, *nextSlot;
struct expr *firstArg, *tempSlot;
struct templateSlot *slotPtr;
firstSlot = NULL;
lastSlot = NULL;
/*==============================================*/
/* Parse each of the slot fields in the assert. */
/*==============================================*/
while ((slotPtr = ParseSlotLabel(theEnv,execStatus,readSource,theToken,theDeftemplate,error,endType)) != NULL)
{
/*========================================================*/
/* Check to see that the slot hasn't already been parsed. */
/*========================================================*/
for (tempSlot = firstSlot;
tempSlot != NULL;
tempSlot = tempSlot->nextArg)
{
if (tempSlot->value == (void *) slotPtr->slotName)
{
AlreadyParsedErrorMessage(theEnv,execStatus,"slot ",ValueToString(slotPtr->slotName));
*error = TRUE;
ReturnExpression(theEnv,execStatus,firstSlot);
return(NULL);
}
}
/*============================================*/
/* Parse the values to be stored in the slot. */
/*============================================*/
nextSlot = ParseAssertSlotValues(theEnv,execStatus,readSource,theToken,
slotPtr,error,constantsOnly);
if (*error)
{
ReturnExpression(theEnv,execStatus,firstSlot);
return(NULL);
}
/*============================================*/
/* Check to see if the values to be stored in */
/* the slot violate the slot's constraints. */
/*============================================*/
if (CheckRHSSlotTypes(theEnv,execStatus,nextSlot->argList,slotPtr,"assert") == 0)
{
*error = TRUE;
ReturnExpression(theEnv,execStatus,firstSlot);
ReturnExpression(theEnv,execStatus,nextSlot);
return(NULL);
}
/*===================================================*/
/* Add the slot to the list of slots already parsed. */
/*===================================================*/
if (lastSlot == NULL)
{ firstSlot = nextSlot; }
else
{ lastSlot->nextArg = nextSlot; }
lastSlot = nextSlot;
}
/*=================================================*/
/* Return if an error occured parsing a slot name. */
/*=================================================*/
if (*error)
{
ReturnExpression(theEnv,execStatus,firstSlot);
return(NULL);
}
/*=============================================================*/
/* Reorder the arguments to the order used by the deftemplate. */
/*=============================================================*/
firstArg = ReorderAssertSlotValues(theEnv,execStatus,theDeftemplate->slotList,firstSlot,error);
ReturnExpression(theEnv,execStatus,firstSlot);
/*==============================*/
/* Return the assert arguments. */
/*==============================*/
return(firstArg);
}
static struct expr *SwitchParse(
void *theEnv,
struct expr *top,
const char *infile)
{
struct token theToken;
EXPRESSION *theExp,*chk;
int default_count = 0;
/*============================*/
/* Process the switch value */
/*============================*/
IncrementIndentDepth(theEnv,3);
SavePPBuffer(theEnv," ");
top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL);
if (theExp == NULL)
goto SwitchParseError;
/*========================*/
/* Parse case statements. */
/*========================*/
GetToken(theEnv,infile,&theToken);
while (theToken.type != RPAREN)
{
PPBackup(theEnv);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
if (theToken.type != LPAREN)
goto SwitchParseErrorAndMessage;
GetToken(theEnv,infile,&theToken);
SavePPBuffer(theEnv," ");
if ((theToken.type == SYMBOL) &&
(strcmp(ValueToString(theToken.value),"case") == 0))
{
if (default_count != 0)
goto SwitchParseErrorAndMessage;
theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL);
SavePPBuffer(theEnv," ");
if (theExp->nextArg == NULL)
goto SwitchParseError;
for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg)
{
if ((chk->type == theExp->nextArg->type) &&
(chk->value == theExp->nextArg->value) &&
IdenticalExpression(chk->argList,theExp->nextArg->argList))
{
PrintErrorID(theEnv,"PRCDRPSR",3,TRUE);
EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n");
goto SwitchParseError;
}
}
GetToken(theEnv,infile,&theToken);
if ((theToken.type != SYMBOL) ? TRUE :
(strcmp(ValueToString(theToken.value),"then") != 0))
goto SwitchParseErrorAndMessage;
}
else if ((theToken.type == SYMBOL) &&
(strcmp(ValueToString(theToken.value),"default") == 0))
{
if (default_count)
goto SwitchParseErrorAndMessage;
theExp->nextArg = GenConstant(theEnv,RVOID,NULL);
default_count = 1;
}
else
goto SwitchParseErrorAndMessage;
theExp = theExp->nextArg;
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
if (ExpressionData(theEnv)->svContexts->brk == TRUE)
ExpressionData(theEnv)->BreakContext = TRUE;
IncrementIndentDepth(theEnv,3);
PPCRAndIndent(theEnv);
theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);
DecrementIndentDepth(theEnv,3);
ExpressionData(theEnv)->ReturnContext = FALSE;
ExpressionData(theEnv)->BreakContext = FALSE;
if (theExp->nextArg == NULL)
goto SwitchParseError;
theExp = theExp->nextArg;
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
GetToken(theEnv,infile,&theToken);
}
DecrementIndentDepth(theEnv,3);
return(top);
SwitchParseErrorAndMessage:
SyntaxErrorMessage(theEnv,"switch function");
SwitchParseError:
ReturnExpression(theEnv,top);
DecrementIndentDepth(theEnv,3);
return(NULL);
}
static void ParseSalience(
void *theEnv,
EXEC_STATUS,
char *readSource,
char *ruleName,
int *error)
{
int salience;
DATA_OBJECT salienceValue;
/*==============================*/
/* Get the salience expression. */
/*==============================*/
SavePPBuffer(theEnv,execStatus," ");
PatternData(theEnv,execStatus)->SalienceExpression = ParseAtomOrExpression(theEnv,execStatus,readSource,NULL);
if (PatternData(theEnv,execStatus)->SalienceExpression == NULL)
{
*error = TRUE;
return;
}
/*============================================================*/
/* Evaluate the expression and determine if it is an integer. */
/*============================================================*/
SetEvaluationError(theEnv,execStatus,FALSE);
if (EvaluateExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression,&salienceValue))
{
SalienceInformationError(theEnv,execStatus,"defrule",ruleName);
*error = TRUE;
return;
}
if (salienceValue.type != INTEGER)
{
SalienceNonIntegerError(theEnv,execStatus);
*error = TRUE;
return;
}
/*=======================================================*/
/* Salience number must be in the range -10000 to 10000. */
/*=======================================================*/
salience = (int) ValueToLong(salienceValue.value);
if ((salience > MAX_DEFRULE_SALIENCE) || (salience < MIN_DEFRULE_SALIENCE))
{
SalienceRangeError(theEnv,execStatus,MIN_DEFRULE_SALIENCE,MAX_DEFRULE_SALIENCE);
*error = TRUE;
return;
}
/*==========================================*/
/* If the expression is a constant integer, */
/* don't bother storing the expression. */
/*==========================================*/
if (PatternData(theEnv,execStatus)->SalienceExpression->type == INTEGER)
{
ReturnExpression(theEnv,execStatus,PatternData(theEnv,execStatus)->SalienceExpression);
PatternData(theEnv,execStatus)->SalienceExpression = NULL;
}
PatternData(theEnv,execStatus)->GlobalSalience = salience;
}
static void VariableReferenceErrorMessage(
void *theEnv,
struct symbolHashNode *theVariable,
struct lhsParseNode *theExpression,
int whichCE,
struct symbolHashNode *slotName,
int theField)
{
struct expr *temprv;
/*=============================*/
/* Print the error message ID. */
/*=============================*/
PrintErrorID(theEnv,"ANALYSIS",4,TRUE);
/*=================================*/
/* Print the name of the variable. */
/*=================================*/
EnvPrintRouter(theEnv,WERROR,"Variable ?");
EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable));
EnvPrintRouter(theEnv,WERROR," ");
/*=================================================*/
/* If the variable was found inside an expression, */
/* then print the expression. */
/*=================================================*/
if (theExpression != NULL)
{
whichCE = theExpression->whichCE;
temprv = LHSParseNodesToExpression(theEnv,theExpression);
ReturnExpression(theEnv,temprv->nextArg);
temprv->nextArg = NULL;
EnvPrintRouter(theEnv,WERROR,"found in the expression ");
PrintExpression(theEnv,WERROR,temprv);
EnvPrintRouter(theEnv,WERROR,"\n");
ReturnExpression(theEnv,temprv);
}
/*====================================================*/
/* Print the CE in which the variable was referenced. */
/*====================================================*/
EnvPrintRouter(theEnv,WERROR,"was referenced in CE #");
PrintLongInteger(theEnv,WERROR,(long int) whichCE);
/*=====================================*/
/* Identify the slot or field in which */
/* the variable was found. */
/*=====================================*/
if (slotName == NULL)
{
if (theField > 0)
{
EnvPrintRouter(theEnv,WERROR," field #");
PrintLongInteger(theEnv,WERROR,(long int) theField);
}
}
else
{
EnvPrintRouter(theEnv,WERROR," slot ");
EnvPrintRouter(theEnv,WERROR,ValueToString(slotName));
}
EnvPrintRouter(theEnv,WERROR," before being defined.\n");
}
/*************************************************************
NAME : ParseQueryActionExpression
DESCRIPTION : Parses the action-expression for a query
INPUTS : 1) The top node of the query expression
2) The logical name of the input
3) List of query parameters
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : Entire query-expression deleted on errors
Nodes allocated for new expression
Action shoved in front of template-restrictions
and in back of test-expression on query
argument list
NOTES : Expects top != NULL && top->argList != NULL
*************************************************************/
static int ParseQueryActionExpression(
void *theEnv,
EXPRESSION *top,
const char *readSource,
EXPRESSION *factQuerySetVars,
struct token *queryInputToken)
{
EXPRESSION *qaction,*tmpFactSetVars;
struct BindInfo *oldBindList,*newBindList,*prev;
oldBindList = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
ExpressionData(theEnv)->BreakContext = TRUE;
ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,queryInputToken->printForm);
ExpressionData(theEnv)->BreakContext = FALSE;
if (qaction == NULL)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
SyntaxErrorMessage(theEnv,"fact-set query function");
ReturnExpression(theEnv,top);
return(FALSE);
}
qaction->nextArg = top->argList->nextArg;
top->argList->nextArg = qaction;
newBindList = GetParsedBindNames(theEnv);
prev = NULL;
while (newBindList != NULL)
{
tmpFactSetVars = factQuerySetVars;
while (tmpFactSetVars != NULL)
{
if (tmpFactSetVars->value == (void *) newBindList->name)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
PrintErrorID(theEnv,"FACTQPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Cannot rebind fact-set member variable ");
EnvPrintRouter(theEnv,WERROR,ValueToString(tmpFactSetVars->value));
EnvPrintRouter(theEnv,WERROR," in function ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
EnvPrintRouter(theEnv,WERROR,".\n");
ReturnExpression(theEnv,top);
return(FALSE);
}
tmpFactSetVars = tmpFactSetVars->nextArg;
}
prev = newBindList;
newBindList = newBindList->next;
}
if (prev == NULL)
{ SetParsedBindNames(theEnv,oldBindList); }
else
{ prev->next = oldBindList; }
return(TRUE);
}
globle struct expr *ParseDefault(
void *theEnv,
char *readSource,
int multifield,
int dynamic,
int evalStatic,
int *noneSpecified,
int *deriveSpecified,
int *error)
{
struct expr *defaultList = NULL, *lastDefault = NULL;
struct expr *newItem, *tmpItem;
struct token theToken;
DATA_OBJECT theValue;
CONSTRAINT_RECORD *rv;
int specialVarCode;
*noneSpecified = FALSE;
*deriveSpecified = FALSE;
SavePPBuffer(theEnv,(char*)" ");
GetToken(theEnv,readSource,&theToken);
/*===================================================*/
/* Read the items contained in the default attribute */
/* until a closing right parenthesis is encountered. */
/*===================================================*/
while (theToken.type != RPAREN)
{
/*========================================*/
/* Get the next item in the default list. */
/*========================================*/
newItem = ParseAtomOrExpression(theEnv,readSource,&theToken);
if (newItem == NULL)
{
ReturnExpression(theEnv,defaultList);
*error = TRUE;
return(NULL);
}
/*===========================================================*/
/* Check for invalid variable usage. With the expection of */
/* ?NONE for the default attribute, local variables may not */
/* be used within the default or default-dynamic attributes. */
/*===========================================================*/
if ((newItem->type == SF_VARIABLE) || (newItem->type == MF_VARIABLE))
{
if (strcmp(ValueToString(newItem->value),"NONE") == 0)
{ specialVarCode = 0; }
else if (strcmp(ValueToString(newItem->value),"DERIVE") == 0)
{ specialVarCode = 1; }
else
{ specialVarCode = -1; }
if ((dynamic) ||
(newItem->type == MF_VARIABLE) ||
(specialVarCode == -1) ||
((specialVarCode != -1) && (defaultList != NULL)))
{
if (dynamic) SyntaxErrorMessage(theEnv,(char*)"default-dynamic attribute");
else SyntaxErrorMessage(theEnv,(char*)"default attribute");
ReturnExpression(theEnv,newItem);
ReturnExpression(theEnv,defaultList);
*error = TRUE;
return(NULL);
}
ReturnExpression(theEnv,newItem);
/*============================================*/
/* Check for the closing right parenthesis of */
/* the default or default dynamic attribute. */
/*============================================*/
GetToken(theEnv,readSource,&theToken);
if (theToken.type != RPAREN)
{
if (dynamic) SyntaxErrorMessage(theEnv,(char*)"default-dynamic attribute");
else SyntaxErrorMessage(theEnv,(char*)"default attribute");
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)" ");
SavePPBuffer(theEnv,theToken.printForm);
*error = TRUE;
}
if (specialVarCode == 0)
*noneSpecified = TRUE;
else
*deriveSpecified = TRUE;
return(NULL);
}
/*====================================================*/
/* Look to see if any variables have been used within */
/* expressions contained within the default list. */
/*====================================================*/
if (ExpressionContainsVariables(newItem,FALSE) == TRUE)
{
ReturnExpression(theEnv,defaultList);
ReturnExpression(theEnv,newItem);
*error = TRUE;
if (dynamic) SyntaxErrorMessage(theEnv,(char*)"default-dynamic attribute");
else SyntaxErrorMessage(theEnv,(char*)"default attribute");
return(NULL);
}
/*============================================*/
/* Add the default value to the default list. */
/*============================================*/
if (lastDefault == NULL)
{ defaultList = newItem; }
else
{ lastDefault->nextArg = newItem; }
lastDefault = newItem;
/*=======================================*/
/* Begin parsing the next default value. */
/*=======================================*/
SavePPBuffer(theEnv,(char*)" ");
GetToken(theEnv,readSource,&theToken);
}
/*=====================================*/
/* Fix up pretty print representation. */
/*=====================================*/
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,(char*)")");
/*=========================================*/
/* A single field slot's default attribute */
/* must contain a single value. */
/*=========================================*/
if (multifield == FALSE)
{
if (defaultList == NULL)
{ *error = TRUE; }
else if (defaultList->nextArg != NULL)
{ *error = TRUE; }
else
{
rv = ExpressionToConstraintRecord(theEnv,defaultList);
rv->multifieldsAllowed = FALSE;
if (UnmatchableConstraint(rv)) *error = TRUE;
RemoveConstraint(theEnv,rv);
}
if (*error)
{
PrintErrorID(theEnv,(char*)"DEFAULT",1,TRUE);
EnvPrintRouter(theEnv,WERROR,(char*)"The default value for a single field slot must be a single field value\n");
ReturnExpression(theEnv,defaultList);
return(NULL);
}
}
/*=======================================================*/
/* If the dynamic-default attribute is not being parsed, */
/* evaluate the expressions to make the default value. */
/*=======================================================*/
if (dynamic || (! evalStatic) || (defaultList == NULL)) return(defaultList);
tmpItem = defaultList;
newItem = defaultList;
defaultList = NULL;
while (newItem != NULL)
{
SetEvaluationError(theEnv,FALSE);
if (EvaluateExpression(theEnv,newItem,&theValue)) *error = TRUE;
if ((theValue.type == MULTIFIELD) &&
(multifield == FALSE) &&
(*error == FALSE))
{
PrintErrorID(theEnv,(char*)"DEFAULT",1,TRUE);
EnvPrintRouter(theEnv,WERROR,(char*)"The default value for a single field slot must be a single field value\n");
*error = TRUE;
}
if (*error)
{
ReturnExpression(theEnv,tmpItem);
ReturnExpression(theEnv,defaultList);
*error = TRUE;
return(NULL);
}
lastDefault = ConvertValueToExpression(theEnv,&theValue);
defaultList = AppendExpressions(defaultList,lastDefault);
newItem = newItem->nextArg;
}
ReturnExpression(theEnv,tmpItem);
/*==========================*/
/* Return the default list. */
/*==========================*/
return(defaultList);
}
/***********************************************************************
NAME : ParseDefmessageHandler
DESCRIPTION : Parses a message-handler for a class of objects
INPUTS : The logical name of the input source
RETURNS : FALSE if successful parse, TRUE otherwise
SIDE EFFECTS : Handler allocated and inserted into class
NOTES : H/L Syntax:
(defmessage-handler <class> <name> [<type>] [<comment>]
(<params>)
<action>*)
<params> ::= <var>* | <var>* $?<name>
***********************************************************************/
globle int ParseDefmessageHandler(
void *theEnv,
char *readSource)
{
DEFCLASS *cls;
SYMBOL_HN *cname,*mname,*wildcard;
unsigned mtype = MPRIMARY;
int min,max,error,lvars;
EXPRESSION *hndParams,*actions;
HANDLER *hnd;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SetIndentDepth(theEnv,3);
SavePPBuffer(theEnv,"(defmessage-handler ");
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv)) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"defmessage-handler");
return(TRUE);
}
#endif
cname = GetConstructNameAndComment(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,"defmessage-handler",
NULL,NULL,"~",TRUE,FALSE,TRUE);
if (cname == NULL)
return(TRUE);
cls = LookupDefclassByMdlOrScope(theEnv,ValueToString(cname));
if (cls == NULL)
{
PrintErrorID(theEnv,"MSGPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"A class must be defined before its message-handlers.\n");
return(TRUE);
}
if ((cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]) ||
(cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_ADDRESS]) ||
(cls == DefclassData(theEnv)->PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
{
PrintErrorID(theEnv,"MSGPSR",8,FALSE);
EnvPrintRouter(theEnv,WERROR,"Message-handlers cannot be attached to the class ");
EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
EnvPrintRouter(theEnv,WERROR,".\n");
return(TRUE);
}
if (HandlersExecuting(cls))
{
PrintErrorID(theEnv,"MSGPSR",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Cannot (re)define message-handlers during execution of \n");
EnvPrintRouter(theEnv,WERROR," other message-handlers for the same class.\n");
return(TRUE);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
return(TRUE);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv," ");
mname = (SYMBOL_HN *) GetValue(DefclassData(theEnv)->ObjectParseToken);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != LPAREN)
{
SavePPBuffer(theEnv," ");
if (GetType(DefclassData(theEnv)->ObjectParseToken) != STRING)
{
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
return(TRUE);
}
mtype = HandlerType(theEnv,"defmessage-handler",DOToString(DefclassData(theEnv)->ObjectParseToken));
if (mtype == MERROR)
return(TRUE);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) == STRING)
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
}
else
{
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
}
PPBackup(theEnv);
PPBackup(theEnv);
PPCRAndIndent(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
hnd = FindHandlerByAddress(cls,mname,mtype);
if (GetPrintWhileLoading(theEnv) && GetCompilationsWatch(theEnv))
{
EnvPrintRouter(theEnv,WDIALOG," Handler ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(mname));
EnvPrintRouter(theEnv,WDIALOG," ");
EnvPrintRouter(theEnv,WDIALOG,MessageHandlerData(theEnv)->hndquals[mtype]);
EnvPrintRouter(theEnv,WDIALOG,(char *) ((hnd == NULL) ? " defined.\n" : " redefined.\n"));
}
if ((hnd != NULL) ? hnd->system : FALSE)
{
PrintErrorID(theEnv,"MSGPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"System message-handlers may not be modified.\n");
return(TRUE);
}
hndParams = GenConstant(theEnv,SYMBOL,(void *) MessageHandlerData(theEnv)->SELF_SYMBOL);
hndParams = ParseProcParameters(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken,hndParams,
&wildcard,&min,&max,&error,IsParameterSlotReference);
if (error)
return(TRUE);
PPCRAndIndent(theEnv);
ExpressionData(theEnv)->ReturnContext = TRUE;
actions = ParseProcActions(theEnv,"message-handler",readSource,
&DefclassData(theEnv)->ObjectParseToken,hndParams,wildcard,
SlotReferenceVar,BindSlotReference,&lvars,
(void *) cls);
if (actions == NULL)
{
ReturnExpression(theEnv,hndParams);
return(TRUE);
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage(theEnv,"defmessage-handler");
ReturnExpression(theEnv,hndParams);
ReturnPackedExpression(theEnv,actions);
return(TRUE);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv,"\n");
/* ===================================================
If we're only checking syntax, don't add the
successfully parsed defmessage-handler to the KB.
=================================================== */
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,hndParams);
ReturnPackedExpression(theEnv,actions);
return(FALSE);
}
if (hnd != NULL)
{
ExpressionDeinstall(theEnv,hnd->actions);
ReturnPackedExpression(theEnv,hnd->actions);
if (hnd->ppForm != NULL)
rm(theEnv,(void *) hnd->ppForm,
(sizeof(char) * (strlen(hnd->ppForm)+1)));
}
else
{
hnd = InsertHandlerHeader(theEnv,cls,mname,(int) mtype);
IncrementSymbolCount(hnd->name);
}
ReturnExpression(theEnv,hndParams);
hnd->minParams = min;
hnd->maxParams = max;
hnd->localVarCount = lvars;
hnd->actions = actions;
ExpressionInstall(theEnv,hnd->actions);
#if DEBUGGING_FUNCTIONS
/* ===================================================
Old handler trace status is automatically preserved
=================================================== */
if (EnvGetConserveMemory(theEnv) == FALSE)
hnd->ppForm = CopyPPBuffer(theEnv);
else
#endif
hnd->ppForm = NULL;
return(FALSE);
}
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,SymbolData(theEnv)->FalseSymbol);
/*=============================================*/
/* 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)
{
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);
}
static intBool MultifieldCardinalityViolation(
void *theEnv,
struct lhsParseNode *theNode)
{
struct lhsParseNode *tmpNode;
struct expr *tmpMax;
long minFields = 0;
long maxFields = 0;
int posInfinity = FALSE;
CONSTRAINT_RECORD *newConstraint, *tempConstraint;
/*================================*/
/* A single field slot can't have */
/* a cardinality violation. */
/*================================*/
if (theNode->multifieldSlot == FALSE) return(FALSE);
/*=============================================*/
/* Determine the minimum and maximum number of */
/* fields the slot could contain based on the */
/* slot constraints found in the pattern. */
/*=============================================*/
for (tmpNode = theNode->bottom;
tmpNode != NULL;
tmpNode = tmpNode->right)
{
/*====================================================*/
/* A single field variable increases both the minimum */
/* and maximum number of fields by one. */
/*====================================================*/
if ((tmpNode->type == SF_VARIABLE) ||
(tmpNode->type == SF_WILDCARD))
{
minFields++;
maxFields++;
}
/*=================================================*/
/* Otherwise a multifield wildcard or variable has */
/* been encountered. If it is constrained then use */
/* minimum and maximum number of fields constraint */
/* associated with this LHS node. */
/*=================================================*/
else if (tmpNode->constraints != NULL)
{
/*=======================================*/
/* The lowest minimum of all the min/max */
/* pairs will be the first in the list. */
/*=======================================*/
if (tmpNode->constraints->minFields->value != SymbolData(theEnv)->NegativeInfinity)
{ minFields += ValueToLong(tmpNode->constraints->minFields->value); }
/*=========================================*/
/* The greatest maximum of all the min/max */
/* pairs will be the last in the list. */
/*=========================================*/
tmpMax = tmpNode->constraints->maxFields;
while (tmpMax->nextArg != NULL) tmpMax = tmpMax->nextArg;
if (tmpMax->value == SymbolData(theEnv)->PositiveInfinity)
{ posInfinity = TRUE; }
else
{ maxFields += ValueToLong(tmpMax->value); }
}
/*================================================*/
/* Otherwise an unconstrained multifield wildcard */
/* or variable increases the maximum number of */
/* fields to positive infinity. */
/*================================================*/
else
{ posInfinity = TRUE; }
}
/*==================================================================*/
/* Create a constraint record for the cardinality of the sum of the */
/* cardinalities of the restrictions inside the multifield slot. */
/*==================================================================*/
if (theNode->constraints == NULL) tempConstraint = GetConstraintRecord(theEnv);
else tempConstraint = CopyConstraintRecord(theEnv,theNode->constraints);
ReturnExpression(theEnv,tempConstraint->minFields);
ReturnExpression(theEnv,tempConstraint->maxFields);
tempConstraint->minFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) minFields));
if (posInfinity) tempConstraint->maxFields = GenConstant(theEnv,SYMBOL,SymbolData(theEnv)->PositiveInfinity);
else tempConstraint->maxFields = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,(long) maxFields));
/*================================================================*/
/* Determine the final cardinality for the multifield slot by */
/* intersecting the cardinality sum of the restrictions within */
/* the multifield slot with the original cardinality of the slot. */
/*================================================================*/
newConstraint = IntersectConstraints(theEnv,theNode->constraints,tempConstraint);
if (theNode->derivedConstraints) RemoveConstraint(theEnv,theNode->constraints);
RemoveConstraint(theEnv,tempConstraint);
theNode->constraints = newConstraint;
theNode->derivedConstraints = TRUE;
/*===================================================================*/
/* Determine if the final cardinality for the slot can be satisfied. */
/*===================================================================*/
if (EnvGetStaticConstraintChecking(theEnv) == FALSE) return(FALSE);
if (UnmatchableConstraint(newConstraint)) return(TRUE);
return(FALSE);
}
globle struct expr *GetRHSPattern(
char *readSource,
struct token *tempToken,
int *error,
int constantsOnly,
int readFirstParen,
int checkFirstParen,
int endType)
{
struct expr *lastOne = NULL;
struct expr *nextOne, *firstOne, *argHead = NULL;
int printError, count;
struct deftemplate *theDeftemplate;
struct symbolHashNode *templateName;
/*=================================================*/
/* Get the opening parenthesis of the RHS pattern. */
/*=================================================*/
*error = FALSE;
if (readFirstParen) GetToken(readSource,tempToken);
if (checkFirstParen)
{
if (tempToken->type == endType) return(NULL);
if (tempToken->type != LPAREN)
{
SyntaxErrorMessage("RHS patterns");
*error = TRUE;
return(NULL);
}
}
/*======================================================*/
/* The first field of an asserted fact must be a symbol */
/* (but not = or : which have special significance). */
/*======================================================*/
GetToken(readSource,tempToken);
if (tempToken->type != SYMBOL)
{
SyntaxErrorMessage("first field of a RHS pattern");
*error = TRUE;
return(NULL);
}
else if ((strcmp(ValueToString(tempToken->value),"=") == 0) ||
(strcmp(ValueToString(tempToken->value),":") == 0))
{
SyntaxErrorMessage("first field of a RHS pattern");
*error = TRUE;
return(NULL);
}
/*=========================================================*/
/* Check to see if the relation name is a reserved symbol. */
/*=========================================================*/
templateName = (struct symbolHashNode *) tempToken->value;
if (ReservedPatternSymbol(ValueToString(templateName),NULL))
{
ReservedPatternSymbolErrorMsg(ValueToString(templateName),"a relation name");
*error = TRUE;
return(NULL);
}
/*============================================================*/
/* A module separator in the name is illegal in this context. */
/*============================================================*/
if (FindModuleSeparator(ValueToString(templateName)))
{
IllegalModuleSpecifierMessage();
*error = TRUE;
return(NULL);
}
/*=============================================================*/
/* Determine if there is an associated deftemplate. If so, let */
/* the deftemplate parsing functions parse the RHS pattern and */
/* then return the fact pattern that was parsed. */
/*=============================================================*/
theDeftemplate = (struct deftemplate *)
FindImportedConstruct("deftemplate",NULL,ValueToString(templateName),
&count,TRUE,NULL);
if (count > 1)
{
AmbiguousReferenceErrorMessage("deftemplate",ValueToString(templateName));
*error = TRUE;
return(NULL);
}
/*======================================================*/
/* If no deftemplate exists with the specified relation */
/* name, then create an implied deftemplate. */
/*======================================================*/
if (theDeftemplate == NULL)
#if (! BLOAD_ONLY) && (! RUN_TIME)
{
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded()) && (! CheckSyntaxMode))
{
NoSuchTemplateError(ValueToString(templateName));
*error = TRUE;
return(NULL);
}
#endif
#if DEFMODULE_CONSTRUCT
if (FindImportExportConflict("deftemplate",((struct defmodule *) GetCurrentModule()),ValueToString(templateName)))
{
ImportExportConflictMessage("implied deftemplate",ValueToString(templateName),NULL,NULL);
*error = TRUE;
return(NULL);
}
#endif
if (! CheckSyntaxMode)
{ theDeftemplate = CreateImpliedDeftemplate((SYMBOL_HN *) templateName,TRUE); }
}
#else
{
NoSuchTemplateError(ValueToString(templateName));
*error = TRUE;
return(NULL);
}
#endif
/*=========================================*/
/* If an explicit deftemplate exists, then */
/* parse the fact as a deftemplate fact. */
/*=========================================*/
if ((theDeftemplate != NULL) && (theDeftemplate->implied == FALSE))
{
firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate);
#if FUZZY_DEFTEMPLATES
if (theDeftemplate->fuzzyTemplate != NULL)
firstOne->nextArg = ParseAssertFuzzyFact(readSource,tempToken,
error,endType,
constantsOnly,theDeftemplate,
TRUE);
else
#endif
firstOne->nextArg = ParseAssertTemplate(readSource,tempToken,
error,endType,
constantsOnly,theDeftemplate);
if (*error)
{
ReturnExpression(firstOne);
firstOne = NULL;
}
#if CERTAINTY_FACTORS
else
{
/* if certaintly factors allowed then the next item after a fact
specifier COULD be a certainty factor spec --- CF x.xxx
*/
SavePPBuffer(" ");
GetToken(readSource,tempToken);
if ((tempToken->type == SYMBOL) &&
((strcmp(ValueToString(tempToken->value),"CF") == 0) ||
(strcmp(ValueToString(tempToken->value),"cf") == 0))
)
{
struct expr *CFexpr;
/* expecting a certainty factor (float) expression */
/* tokenToFloatExpression expect 1st token already read */
SavePPBuffer(" ");
GetToken(readSource,tempToken);
CFexpr = tokenToFloatExpression(readSource,tempToken,error,constantsOnly);
if (*error)
{
ReturnExpression(firstOne);
return( NULL );
}
if (CFexpr->type == FLOAT) /* if constant -- check range */
{
double cfval = ValueToDouble(CFexpr->value);
if (cfval > 1.0 || cfval < 0.0)
{
*error = TRUE;
ReturnExpression(CFexpr);
cfRangeError();
ReturnExpression(firstOne);
return( NULL );
}
}
/* store the CF expression in the argList of the DEFTEMPLATE_PTR expr */
firstOne->argList = CFexpr;
}
else
{
/* Do an 'UnGetToken' function here to undo the lookahead for a CF.
Also need to PPBackup over the space added before reading the
potential CF expression -- UnGetToken does one PPBackup over the
token which was added to the PP Buffer
*/
UnGetToken(tempToken);
PPBackup();
}
}
#endif
return(firstOne);
}
/*========================================*/
/* Parse the fact as an ordered RHS fact. */
/*========================================*/
firstOne = GenConstant(DEFTEMPLATE_PTR,theDeftemplate);
#if FUZZY_DEFTEMPLATES
/*=============================================*/
/* Fuzzy facts parsed differently */
/*=============================================*/
if (theDeftemplate->fuzzyTemplate != NULL)
{
firstOne->nextArg = ParseAssertFuzzyFact(readSource,tempToken,
error,endType,
constantsOnly,theDeftemplate,
TRUE);
if (*error)
{
ReturnExpression(firstOne);
return(NULL);
}
}
else
{ /* --- matches } below with FUZZY_DEFTEMPLATES */
#endif /* FUZZY_DEFTEMPLATES */
#if (! RUN_TIME) && (! BLOAD_ONLY)
SavePPBuffer(" ");
#endif
while ((nextOne = GetAssertArgument(readSource,tempToken,
error,endType,constantsOnly,&printError)) != NULL)
{
if (argHead == NULL) argHead = nextOne;
else lastOne->nextArg = nextOne;
lastOne = nextOne;
#if (! RUN_TIME) && (! BLOAD_ONLY)
SavePPBuffer(" ");
#endif
}
/*===========================================================*/
/* If an error occurred, set the error flag and return NULL. */
/*===========================================================*/
if (*error)
{
if (printError) SyntaxErrorMessage("RHS patterns");
ReturnExpression(firstOne);
ReturnExpression(argHead);
return(NULL);
}
/*=====================================*/
/* Fix the pretty print representation */
/* of the RHS ordered fact. */
/*=====================================*/
#if (! RUN_TIME) && (! BLOAD_ONLY)
PPBackup();
PPBackup();
SavePPBuffer(tempToken->printForm);
#endif
/*==========================================================*/
/* Ordered fact assertions are processed by stuffing all of */
/* the fact's proposition (except the relation name) into a */
/* single multifield slot. */
/*==========================================================*/
firstOne->nextArg = GenConstant(FACT_STORE_MULTIFIELD,AddBitMap("\0",1));
firstOne->nextArg->argList = argHead;
#if FUZZY_DEFTEMPLATES
} /* --- matches else { above with FUZZY_DEFTEMPLATES */
#endif
#if CERTAINTY_FACTORS
/* if certaintly factors allowed then the next item after a fact
specifier could be a certainty factor spec --- CF x.xxx
*/
#if (! RUN_TIME) && (! BLOAD_ONLY)
SavePPBuffer(" ");
#endif
GetToken(readSource,tempToken);
if ((tempToken->type == SYMBOL) &&
((strcmp(ValueToString(tempToken->value),"CF") == 0) ||
(strcmp(ValueToString(tempToken->value),"cf") == 0))
)
{
struct expr *CFexpr;
/* expecting a certainty factor (float) expression */
/* tokenToFloatExpression expect 1st token already read */
#if (! RUN_TIME) && (! BLOAD_ONLY)
SavePPBuffer(" ");
#endif
GetToken(readSource,tempToken);
CFexpr = tokenToFloatExpression(readSource,tempToken,error,constantsOnly);
if (*error)
{
ReturnExpression(firstOne);
return( NULL );
}
if (CFexpr->type == FLOAT) /* if constant -- check range */
{
double cfval = ValueToDouble(CFexpr->value);
if (cfval > 1.0 || cfval < 0.0)
{
*error = TRUE;
ReturnExpression(CFexpr);
cfRangeError();
ReturnExpression(firstOne);
return( NULL );
}
}
/* store the CF expression in the argList of the DEFTEMPLATE_PTR expr */
firstOne->argList = CFexpr;
}
else
{
/* Do an 'UnGetToken' function here to undo the lookahead for a CF.
Also need to PPBackup over the space added before reading the
potential CF expression -- UnGetToken does one PPBackup over the
token which was added to the PP Buffer
*/
UnGetToken(tempToken);
#if (! RUN_TIME) && (! BLOAD_ONLY)
PPBackup();
#endif
}
#endif /* CERTAINTY_FACTORS */
/*==============================*/
/* Return the RHS ordered fact. */
/*==============================*/
return(firstOne);
}
globle void ConstraintReferenceErrorMessage(
void *theEnv,
struct symbolHashNode *theVariable,
struct lhsParseNode *theExpression,
int whichArgument,
int whichCE,
struct symbolHashNode *slotName,
int theField)
{
struct expr *temprv;
PrintErrorID(theEnv,"RULECSTR",2,TRUE);
/*==========================*/
/* Print the variable name. */
/*==========================*/
EnvPrintRouter(theEnv,WERROR,"Previous variable bindings of ?");
EnvPrintRouter(theEnv,WERROR,ValueToString(theVariable));
EnvPrintRouter(theEnv,WERROR," caused the type restrictions");
/*============================*/
/* Print the argument number. */
/*============================*/
EnvPrintRouter(theEnv,WERROR,"\nfor argument #");
PrintLongInteger(theEnv,WERROR,(long int) whichArgument);
/*=======================*/
/* Print the expression. */
/*=======================*/
EnvPrintRouter(theEnv,WERROR," of the expression ");
temprv = LHSParseNodesToExpression(theEnv,theExpression);
ReturnExpression(theEnv,temprv->nextArg);
temprv->nextArg = NULL;
PrintExpression(theEnv,WERROR,temprv);
EnvPrintRouter(theEnv,WERROR,"\n");
ReturnExpression(theEnv,temprv);
/*========================================*/
/* Print out the index of the conditional */
/* element and the slot name or field */
/* index where the violation occured. */
/*========================================*/
EnvPrintRouter(theEnv,WERROR,"found in CE #");
PrintLongInteger(theEnv,WERROR,(long int) whichCE);
if (slotName == NULL)
{
if (theField > 0)
{
EnvPrintRouter(theEnv,WERROR," field #");
PrintLongInteger(theEnv,WERROR,(long int) theField);
}
}
else
{
EnvPrintRouter(theEnv,WERROR," slot ");
EnvPrintRouter(theEnv,WERROR,ValueToString(slotName));
}
EnvPrintRouter(theEnv,WERROR," to be violated.\n");
}
globle struct fact *StringToFact(
char *str)
{
struct token theToken;
struct fact *factPtr;
int numberOfFields = 0, whichField;
struct expr *assertArgs, *tempPtr;
int error = FALSE;
DATA_OBJECT theResult;
/*=========================================*/
/* Open a string router and parse the fact */
/* using the router as an input source. */
/*=========================================*/
OpenStringSource("assert_str",str,0);
assertArgs = GetRHSPattern("assert_str",&theToken,
&error,FALSE,TRUE,
TRUE,RPAREN);
CloseStringSource("assert_str");
#if CERTAINTY_FACTORS
/* GetRHSPattern called above may have left a token
in the lookahead Token (theUnToken) -- see GetRHSPattern and
Scanner.c -- clear it since we are closing the string source
and it should not be read when next token requested
NOTE: this may not be needed now that am not unGetting STOP tokens?
*/
ClearTheUnToken();
#endif
/*===========================================*/
/* Check for errors or the use of variables. */
/*===========================================*/
if (error)
{
ReturnExpression(assertArgs);
return(NULL);
}
if (ExpressionContainsVariables(assertArgs,FALSE))
{
LocalVariableErrorMessage("the assert-string function");
SetEvaluationError(TRUE);
ReturnExpression(assertArgs);
return(NULL);
}
/*=======================================================*/
/* Count the number of fields needed for the fact and */
/* create a fact data structure of the appropriate size. */
/*=======================================================*/
for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
{ numberOfFields++; }
factPtr = (struct fact *) CreateFactBySize(numberOfFields);
factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value;
#if CERTAINTY_FACTORS
/* get the CF from the argList of the DEFTEMPLATE_PTR expr struct currently
pointed at be assertArgs
*/
if (assertArgs->argList == NULL)
factPtr->factCF = 1.0;
else
{
EvaluateExpression(assertArgs->argList,&theResult);
if (theResult.type != FLOAT && theResult.type != INTEGER)
{
cfNonNumberError();
factPtr->factCF = 1.0;
}
else
factPtr->factCF = (theResult.type == FLOAT) ?
ValueToDouble(theResult.value) :
(double)ValueToLong(theResult.value);
}
#endif
/*=============================================*/
/* Copy the fields to the fact data structure. */
/*=============================================*/
ExpressionInstall(assertArgs); /* DR0836 */
whichField = 0;
for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
{
#if FUZZY_DEFTEMPLATES /* 03-07-96 */
/* NOTE: a fuzzy fact should have been parsed to give a single constant arg
of type FUZZY_VALUE
*/
#endif
EvaluateExpression(tempPtr,&theResult);
factPtr->theProposition.theFields[whichField].type = (short) theResult.type;
factPtr->theProposition.theFields[whichField].value = theResult.value;
whichField++;
}
ExpressionDeinstall(assertArgs); /* DR0836 */
ReturnExpression(assertArgs);
/*==================*/
/* Return the fact. */
/*==================*/
return(factPtr);
}
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);
}
static struct defrule *ProcessRuleLHS(
void *theEnv,
struct lhsParseNode *theLHS,
struct expr *actions,
SYMBOL_HN *ruleName,
int *error)
{
struct lhsParseNode *tempNode = NULL;
struct defrule *topDisjunct = NULL, *currentDisjunct, *lastDisjunct = NULL;
struct expr *newActions, *packPtr;
int logicalJoin;
int localVarCnt;
int complexity;
struct joinNode *lastJoin;
intBool emptyLHS;
/*================================================*/
/* Initially set the parsing error flag to FALSE. */
/*================================================*/
*error = FALSE;
/*===========================================================*/
/* The top level of the construct representing the LHS of a */
/* rule is assumed to be an OR. If the implied OR is at the */
/* top level of the pattern construct, then remove it. */
/*===========================================================*/
if (theLHS == NULL)
{ emptyLHS = TRUE; }
else
{
emptyLHS = FALSE;
if (theLHS->type == OR_CE) theLHS = theLHS->right;
}
/*=========================================*/
/* Loop through each disjunct of the rule. */
/*=========================================*/
localVarCnt = CountParsedBindNames(theEnv);
while ((theLHS != NULL) || (emptyLHS == TRUE))
{
#if FUZZY_DEFTEMPLATES
unsigned int LHSRuleType; /* LHSRuleType is set to FUZZY_LHS or CRISP_LHS */
unsigned int numFuzzySlots;
int patternNum;
#endif
/*===================================*/
/* Analyze the LHS of this disjunct. */
/*===================================*/
if (emptyLHS)
{ tempNode = NULL; }
else
{
if (theLHS->type == AND_CE) tempNode = theLHS->right;
else if (theLHS->type == PATTERN_CE) tempNode = theLHS;
}
if (VariableAnalysis(theEnv,tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
/*=========================================*/
/* Perform entity dependent post analysis. */
/*=========================================*/
if (PostPatternAnalysis(theEnv,tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
#if FUZZY_DEFTEMPLATES
/* calculate the number of fuzzy value slots in patterns with
the rule disjunct and also determine LHS type of the
rule -- if number of fuzzy slots in non-NOT patterns >0
then FUZZY LHS [if pattern is (not (xxx (fuzzySlot ...) ...))
then they don't count when considering the LHS type]
*/
if (emptyLHS)
{ tempNode = NULL; }
else
{
if (theLHS->type == AND_CE) tempNode = theLHS->right;
else if (theLHS->type == PATTERN_CE) tempNode = theLHS;
}
{
int numFuzzySlotsInNonNotPatterns = 0;
numFuzzySlots = FuzzySlotAnalysis(theEnv,tempNode, &numFuzzySlotsInNonNotPatterns);
if (numFuzzySlotsInNonNotPatterns > 0)
LHSRuleType = FUZZY_LHS;
else
LHSRuleType = CRISP_LHS;
}
#endif
/*========================================================*/
/* Print out developer information if it's being watched. */
/*========================================================*/
#if DEVELOPER && DEBUGGING_FUNCTIONS
if (EnvGetWatchItem(theEnv,"rule-analysis"))
{ DumpRuleAnalysis(theEnv,tempNode); }
#endif
/*======================================================*/
/* Check to see if there are any RHS constraint errors. */
/*======================================================*/
if (CheckRHSForConstraintErrors(theEnv,actions,tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
return(NULL);
}
/*=================================================*/
/* Replace variable references in the RHS with the */
/* appropriate variable retrieval functions. */
/*=================================================*/
newActions = CopyExpression(theEnv,actions);
if (ReplaceProcVars(theEnv,"RHS of defrule",newActions,NULL,NULL,
ReplaceRHSVariable,(void *) tempNode))
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
ReturnExpression(theEnv,newActions);
return(NULL);
}
/*===================================================*/
/* Remove any test CEs from the LHS and attach their */
/* expression to the closest preceeding non-negated */
/* join at the same not/and depth. */
/*===================================================*/
AttachTestCEsToPatternCEs(theEnv,tempNode);
/*========================================*/
/* Check to see that logical CEs are used */
/* appropriately in the LHS of the rule. */
/*========================================*/
if ((logicalJoin = LogicalAnalysis(theEnv,tempNode)) < 0)
{
*error = TRUE;
ReturnDefrule(theEnv,topDisjunct);
ReturnExpression(theEnv,newActions);
return(NULL);
}
/*==================================*/
/* We're finished for this disjunct */
/* if we're only checking syntax. */
/*==================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnExpression(theEnv,newActions);
if (emptyLHS)
{ emptyLHS = FALSE; }
else
{ theLHS = theLHS->bottom; }
continue;
}
/*=================================*/
/* Install the disjunct's actions. */
/*=================================*/
ExpressionInstall(theEnv,newActions);
packPtr = PackExpression(theEnv,newActions);
ReturnExpression(theEnv,newActions);
/*===============================================================*/
/* Create the pattern and join data structures for the new rule. */
/*===============================================================*/
lastJoin = ConstructJoins(theEnv,logicalJoin,tempNode,1,NULL,TRUE,TRUE);
/*===================================================================*/
/* Determine the rule's complexity for use with conflict resolution. */
/*===================================================================*/
complexity = RuleComplexity(theEnv,tempNode);
/*=====================================================*/
/* Create the defrule data structure for this disjunct */
/* and put it in the list of disjuncts for this rule. */
/*=====================================================*/
#if FUZZY_DEFTEMPLATES
/* if not a FUZZY LHS then no need to allocate space to store ptrs to
fuzzy slots of the patterns on the LHS since there won't be any
-- numFuzzySlots will be 0.
*/
currentDisjunct = CreateNewDisjunct(theEnv,ruleName,localVarCnt,packPtr,complexity,
logicalJoin,lastJoin,numFuzzySlots);
/* set the type of LHS of Rule disjunct and also
save fuzzy slot locator info for any fuzzy patterns
*/
currentDisjunct->lhsRuleType = LHSRuleType;
if (numFuzzySlots > 0)
{
struct lhsParseNode *lhsPNPtr, *lhsSlotPtr;
int i;
/* get ptr to a pattern CE */
if (theLHS->type == AND_CE) lhsPNPtr = theLHS->right;
else if (theLHS->type == PATTERN_CE) lhsPNPtr = theLHS;
else lhsPNPtr = NULL;
patternNum = 0; /* indexed from 0 */
i = 0;
while (lhsPNPtr != NULL)
{
if (lhsPNPtr->type == PATTERN_CE)
{
lhsSlotPtr = lhsPNPtr->right;
while (lhsSlotPtr != NULL)
{
/*==========================================================*/
/* If fuzzy template slot then save ptr to fuzzy value */
/* */
/* NOTE: when the pattern was added to the pattern net, the */
/* pattern node for the template name was removed (see */
/* PlaceFactPattern) and the pattern node of the FUZZY_VALUE*/
/* was changed a networkTest link in the SF_VARIABLE or */
/* SF_WILDCARD node as an SCALL_PN_FUZZY_VALUE expression. */
/* We need to search for that fuzzy value to put it in the */
/* rule (pattern_fv_arrayPtr points to an array of */
/* structures that holds the pattern number, slot number and*/
/* fuzzy value HN ptrs connected to the patterns of LHS). */
/*==========================================================*/
if (lhsSlotPtr->type == SF_WILDCARD ||
lhsSlotPtr->type == SF_VARIABLE)
{
FUZZY_VALUE_HN *fv_ptr;
struct fzSlotLocator * fzSL_ptr;
fv_ptr = findFuzzyValueInNetworktest(lhsSlotPtr->networkTest);
if (fv_ptr != NULL)
{
fzSL_ptr = currentDisjunct->pattern_fv_arrayPtr + i;
fzSL_ptr->patternNum = patternNum;
fzSL_ptr->slotNum = (lhsSlotPtr->slotNumber)-1;
fzSL_ptr->fvhnPtr = fv_ptr;
i++;
}
}
/*=====================================================*/
/* Move on to the next slot in the pattern. */
/*=====================================================*/
lhsSlotPtr = lhsSlotPtr->right;
}
}
/*=====================================================*/
/* Move on to the next pattern in the LHS of the rule. */
/*=====================================================*/
lhsPNPtr = lhsPNPtr->bottom;
patternNum++;
}
/* i should == numFuzzySlots OR something internal is screwed up --
OR this algorithm has a problem.
*/
if (i != numFuzzySlots)
{
EnvPrintRouter(theEnv,WERROR,"Internal ERROR *** Fuzzy structures -- routine ProcessRuleLHS\n");
EnvExitRouter(theEnv,EXIT_FAILURE);
}
}
#else
currentDisjunct = CreateNewDisjunct(theEnv,ruleName,localVarCnt,packPtr,complexity,
(unsigned) logicalJoin,lastJoin);
#endif
/*============================================================*/
/* Place the disjunct in the list of disjuncts for this rule. */
/* If the disjunct is the first disjunct, then increment the */
/* reference counts for the dynamic salience (the expression */
/* for the dynamic salience is only stored with the first */
/* disjuncts and the other disjuncts refer back to the first */
/* disjunct for their dynamic salience value. */
/*============================================================*/
if (topDisjunct == NULL)
{
topDisjunct = currentDisjunct;
ExpressionInstall(theEnv,topDisjunct->dynamicSalience);
#if CERTAINTY_FACTORS
ExpressionInstall(theEnv,topDisjunct->dynamicCF);
#endif
}
else lastDisjunct->disjunct = currentDisjunct;
/*===========================================*/
/* Move on to the next disjunct of the rule. */
/*===========================================*/
lastDisjunct = currentDisjunct;
if (emptyLHS)
{ emptyLHS = FALSE; }
else
{ theLHS = theLHS->bottom; }
}
return(topDisjunct);
}
