/**************************************************************************
OkWatchCallback
Description: This function will reset the watch flags to the new
values and remove the watch window from the screen.
Arguments: w - widget that event was activated
client_data - NULL
call_data - Unused
Return: None
**************************************************************************/
void OkWatchCallback(
Widget w,
XtPointer client_data,
XtPointer call_data)
{
void *theEnv = GetCurrentEnvironment();
int i,n;
Boolean OnOff = False;
for(i = 0; i< MAX_WATCH; i++)
{
n = 0;
XtSetArg(TheArgs[n],XtNstate,&OnOff);n++;
XtGetValues(watch_widgets[i],TheArgs,n);
/*----------------------------------------------------------------*/
/* I have to do this because I am not sure if True and False in X */
/* are defined the same as CLIPS_TRUE and CLIPS_FALSE */
/*----------------------------------------------------------------*/
if((OnOff == True)&&(EnvGetWatchItem(theEnv,WatchName[i])!= CLIPS_TRUE))
{
EnvSetWatchItem(theEnv,WatchName[i], ON,NULL);
}
else if((OnOff == False) && (EnvGetWatchItem(theEnv,WatchName[i]) == CLIPS_TRUE))
{
EnvSetWatchItem(theEnv,WatchName[i], OFF,NULL);
}
}
XtPopdown(XtParent(XtParent(w)));
quit_get_event = True;
}
struct deftemplate *CreateImpliedDeftemplate(
void *theEnv,
SYMBOL_HN *deftemplateName,
bool setFlag)
{
struct deftemplate *newDeftemplate;
newDeftemplate = get_struct(theEnv,deftemplate);
newDeftemplate->header.name = deftemplateName;
newDeftemplate->header.ppForm = NULL;
newDeftemplate->header.usrData = NULL;
newDeftemplate->slotList = NULL;
newDeftemplate->implied = setFlag;
newDeftemplate->numberOfSlots = 0;
newDeftemplate->inScope = 1;
newDeftemplate->patternNetwork = NULL;
newDeftemplate->factList = NULL;
newDeftemplate->lastFact = NULL;
newDeftemplate->busyCount = 0;
newDeftemplate->watch = false;
newDeftemplate->header.next = NULL;
#if DEBUGGING_FUNCTIONS
if (EnvGetWatchItem(theEnv,"facts"))
{ EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); }
#endif
newDeftemplate->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex);
AddConstructToModule(&newDeftemplate->header);
InstallDeftemplate(theEnv,newDeftemplate);
return(newDeftemplate);
}
globle int GetWatchItemCommand(
void *theEnv)
{
DATA_OBJECT theValue;
char *argument;
int recognized;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"get-watch-item",EXACTLY,1) == -1)
{ return(FALSE); }
/*========================================*/
/* Determine which item is to be watched. */
/*========================================*/
if (EnvArgTypeCheck(theEnv,"get-watch-item",1,SYMBOL,&theValue) == FALSE)
{ return(FALSE); }
argument = DOToString(theValue);
ValidWatchItem(theEnv,argument,&recognized);
if (recognized == FALSE)
{
SetEvaluationError(theEnv,TRUE);
ExpectedTypeError1(theEnv,"get-watch-item",1,"watchable symbol");
return(FALSE);
}
/*===========================*/
/* Get the watch item value. */
/*===========================*/
if (EnvGetWatchItem(theEnv,argument) == 1)
{ return(TRUE); }
return(FALSE);
}
globle struct joinNode *ConstructJoins(
void *theEnv,
int logicalJoin,
struct lhsParseNode *theLHS,
int startDepth)
{
struct joinNode *lastJoin = NULL;
struct patternNodeHeader *lastPattern;
unsigned firstJoin = TRUE;
int tryToReuse = TRUE;
struct joinNode *listOfJoins = NULL;
struct joinNode *oldJoin;
int joinNumber = 1;
int isLogical, isExists;
struct joinNode *lastRightJoin;
int lastIteration = FALSE;
int rhsType;
struct expr *leftHash, *rightHash;
void *rhsStruct;
struct lhsParseNode *nextLHS;
struct expr *networkTest, *secondaryNetworkTest, *secondaryExternalTest;
int joinFromTheRight;
struct joinLink *theLinks;
intBool useLinks;
/*===================================================*/
/* Remove any test CEs from the LHS and attach their */
/* expression to the closest preceeding non-negated */
/* join at the same not/and depth. */
/*===================================================*/
if (startDepth == 1)
{ AttachTestCEsToPatternCEs(theEnv,theLHS); }
if (theLHS == NULL)
{
lastJoin = FindShareableJoin(DefruleData(theEnv)->RightPrimeJoins,NULL,TRUE,NULL,TRUE,
FALSE,FALSE,FALSE,NULL,NULL,NULL,NULL);
if (lastJoin == NULL)
{ lastJoin = CreateNewJoin(theEnv,NULL,NULL,NULL,NULL,FALSE,FALSE,FALSE,NULL,NULL); }
}
/*=====================================================*/
/* Process each pattern CE in the rule. At this point, */
/* there should be no and/or/not/test CEs in the LHS. */
/*=====================================================*/
while (theLHS != NULL)
{
/*======================================================*/
/* Find the beginning of the next group of patterns. If */
/* the current pattern is not the beginning of a "join */
/* from the right" group of patterns, then the next */
/* pattern is the next pattern. Otherwise skip over all */
/* the patterns that belong to the group of subjoins. */
/*======================================================*/
nextLHS = theLHS->bottom;
secondaryExternalTest = NULL;
if (theLHS->endNandDepth > startDepth)
{
while ((nextLHS != NULL) &&
(nextLHS->endNandDepth > startDepth))
{ nextLHS = nextLHS->bottom; }
/*====================================================*/
/* Variable nextLHS is now pointing to the end of the */
/* not/and group beginning with variable theLHS. If */
/* the end depth of the group is less than the depth */
/* of the current enclosing not/and group, then this */
/* is the last iteration for the enclosing group. */
/*====================================================*/
if (nextLHS != NULL)
{
if (nextLHS->endNandDepth < startDepth)
{ lastIteration = TRUE; }
}
if (nextLHS != NULL)
{ nextLHS = nextLHS->bottom; }
if ((nextLHS != NULL) && (nextLHS->type == TEST_CE))
{
secondaryExternalTest = nextLHS->networkTest;
nextLHS = nextLHS->bottom;
}
}
/*=======================================*/
/* Is this the last pattern to be added? */
/*=======================================*/
if (nextLHS == NULL)
{ lastIteration = TRUE; }
else if (theLHS->endNandDepth < startDepth)
{ lastIteration = TRUE; }
else if ((nextLHS->type == TEST_CE) &&
(theLHS->beginNandDepth > startDepth) &&
(nextLHS->endNandDepth < startDepth))
{ lastIteration = TRUE; }
/*===============================================*/
/* If the pattern is a join from the right, then */
/* construct the subgroup of patterns and use */
/* that as the RHS of the join to be added. */
/*===============================================*/
if (theLHS->beginNandDepth > startDepth)
{
joinFromTheRight = TRUE;
isExists = theLHS->existsNand;
lastRightJoin = ConstructJoins(theEnv,logicalJoin,theLHS,startDepth+1);
rhsStruct = lastRightJoin;
rhsType = 0;
lastPattern = NULL;
networkTest = theLHS->externalNetworkTest; /* TBD */
secondaryNetworkTest = secondaryExternalTest;
leftHash = theLHS->externalLeftHash;
rightHash = theLHS->externalRightHash;
}
/*=======================================================*/
/* Otherwise, add the pattern to the appropriate pattern */
/* network and use the pattern node containing the alpha */
/* memory as the RHS of the join to be added. */
/*=======================================================*/
else if (theLHS->right == NULL)
{
joinFromTheRight = FALSE;
rhsType = 0;
lastPattern = NULL;
rhsStruct = NULL;
lastRightJoin = NULL;
isExists = theLHS->exists;
networkTest = theLHS->networkTest;
secondaryNetworkTest = theLHS->secondaryNetworkTest;
leftHash = NULL;
rightHash = NULL;
}
else
{
joinFromTheRight = FALSE;
rhsType = theLHS->patternType->positionInArray;
lastPattern = (*theLHS->patternType->addPatternFunction)(theEnv,theLHS);
rhsStruct = lastPattern;
lastRightJoin = NULL;
isExists = theLHS->exists;
networkTest = theLHS->networkTest;
secondaryNetworkTest = theLHS->secondaryNetworkTest;
leftHash = theLHS->leftHash;
rightHash = theLHS->rightHash;
}
/*======================================================*/
/* Determine if the join being added is a logical join. */
/*======================================================*/
if ((startDepth == 1) && (joinNumber == logicalJoin)) isLogical = TRUE;
else isLogical = FALSE;
/*===============================================*/
/* Get the list of joins which could potentially */
/* be reused in place of the join being added. */
/*===============================================*/
useLinks = TRUE;
if (firstJoin == TRUE)
{
if (theLHS->right == NULL)
{ theLinks = DefruleData(theEnv)->RightPrimeJoins; }
else if (lastPattern != NULL)
{
listOfJoins = lastPattern->entryJoin;
theLinks = NULL;
useLinks = FALSE;
}
else
{ theLinks = lastRightJoin->nextLinks; }
}
else
{ theLinks = lastJoin->nextLinks; }
/*=======================================================*/
/* Determine if the next join to be added can be shared. */
/*=======================================================*/
if ((tryToReuse == TRUE) &&
((oldJoin = FindShareableJoin(theLinks,listOfJoins,useLinks,rhsStruct,firstJoin,
theLHS->negated,isExists,isLogical,
networkTest,secondaryNetworkTest,
leftHash,rightHash)) != NULL) )
{
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,(char*)"compilations") == TRUE) && GetPrintWhileLoading(theEnv))
{ EnvPrintRouter(theEnv,WDIALOG,(char*)"=j"); }
#endif
lastJoin = oldJoin;
}
else
{
tryToReuse = FALSE;
if (! joinFromTheRight)
{
lastJoin = CreateNewJoin(theEnv,networkTest,secondaryNetworkTest,lastJoin,
lastPattern,FALSE,(int) theLHS->negated, isExists,
leftHash,rightHash);
lastJoin->rhsType = rhsType;
}
else
{
lastJoin = CreateNewJoin(theEnv,networkTest,secondaryNetworkTest,lastJoin,
lastRightJoin,TRUE,(int) theLHS->negated, isExists,
leftHash,rightHash);
lastJoin->rhsType = rhsType;
}
}
/*============================================*/
/* If we've reached the end of the subgroup, */
/* then return the last join of the subgroup. */
/*============================================*/
if (lastIteration)
{ break; }
/*=======================================*/
/* Move on to the next join to be added. */
/*=======================================*/
theLHS = nextLHS;
joinNumber++;
firstJoin = FALSE;
}
/*=================================================*/
/* Add the final join which stores the activations */
/* of the rule. This join is never shared. */
/*=================================================*/
if (startDepth == 1)
{
lastJoin = CreateNewJoin(theEnv,NULL,NULL,lastJoin,NULL,
FALSE,FALSE,FALSE,NULL,NULL);
}
/*===================================================*/
/* If compilations are being watched, put a carriage */
/* return after all of the =j's and +j's */
/*===================================================*/
#if DEBUGGING_FUNCTIONS
if ((startDepth == 1) &&
(EnvGetWatchItem(theEnv,(char*)"compilations") == TRUE) &&
GetPrintWhileLoading(theEnv))
{ EnvPrintRouter(theEnv,WDIALOG,(char*)"\n"); }
#endif
/*=============================*/
/* Return the last join added. */
/*=============================*/
return(lastJoin);
}
static struct joinNode *CreateNewJoin(
void *theEnv,
struct expr *joinTest,
struct expr *secondaryJoinTest,
struct joinNode *lhsEntryStruct,
void *rhsEntryStruct,
int joinFromTheRight,
int negatedRHSPattern,
int existsRHSPattern,
struct expr *leftHash,
struct expr *rightHash)
{
struct joinNode *newJoin;
struct joinLink *theLink;
/*===============================================*/
/* If compilations are being watch, print +j to */
/* indicate that a new join has been created for */
/* this pattern of the rule (i.e. a join could */
/* not be shared with another rule. */
/*===============================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,(char*)"compilations") == TRUE) && GetPrintWhileLoading(theEnv))
{ EnvPrintRouter(theEnv,WDIALOG,(char*)"+j"); }
#endif
/*======================*/
/* Create the new join. */
/*======================*/
newJoin = get_struct(theEnv,joinNode);
/*======================================================*/
/* The first join of a rule does not have a beta memory */
/* unless the RHS pattern is an exists or not CE. */
/*======================================================*/
if ((lhsEntryStruct != NULL) || existsRHSPattern || negatedRHSPattern || joinFromTheRight)
{
if (leftHash == NULL)
{
newJoin->leftMemory = get_struct(theEnv,betaMemory);
newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
newJoin->leftMemory->beta[0] = NULL;
newJoin->leftMemory->last = NULL;
newJoin->leftMemory->size = 1;
newJoin->leftMemory->count = 0;
}
else
{
newJoin->leftMemory = get_struct(theEnv,betaMemory);
newJoin->leftMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
memset(newJoin->leftMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
newJoin->leftMemory->last = NULL;
newJoin->leftMemory->size = INITIAL_BETA_HASH_SIZE;
newJoin->leftMemory->count = 0;
}
/*===========================================================*/
/* If the first join of a rule connects to an exists or not */
/* CE, then we create an empty partial match for the usually */
/* empty left beta memory so that we can track the current */
/* current right memory partial match satisfying the CE. */
/*===========================================================*/
if ((lhsEntryStruct == NULL) && (existsRHSPattern || negatedRHSPattern || joinFromTheRight))
{
newJoin->leftMemory->beta[0] = CreateEmptyPartialMatch(theEnv);
newJoin->leftMemory->beta[0]->owner = newJoin;
newJoin->leftMemory->count = 1;
}
}
else
{ newJoin->leftMemory = NULL; }
if (joinFromTheRight)
{
if (leftHash == NULL)
{
newJoin->rightMemory = get_struct(theEnv,betaMemory);
newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
newJoin->rightMemory->beta[0] = NULL;
newJoin->rightMemory->last[0] = NULL;
newJoin->rightMemory->size = 1;
newJoin->rightMemory->count = 0;
}
else
{
newJoin->rightMemory = get_struct(theEnv,betaMemory);
newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
memset(newJoin->rightMemory->beta,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
memset(newJoin->rightMemory->last,0,sizeof(struct partialMatch *) * INITIAL_BETA_HASH_SIZE);
newJoin->rightMemory->size = INITIAL_BETA_HASH_SIZE;
newJoin->rightMemory->count = 0;
}
}
else if ((lhsEntryStruct == NULL) && (rhsEntryStruct == NULL))
{
newJoin->rightMemory = get_struct(theEnv,betaMemory);
newJoin->rightMemory->beta = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
newJoin->rightMemory->last = (struct partialMatch **) genalloc(theEnv,sizeof(struct partialMatch *));
newJoin->rightMemory->beta[0] = CreateEmptyPartialMatch(theEnv);
newJoin->rightMemory->beta[0]->owner = newJoin;
newJoin->rightMemory->beta[0]->rhsMemory = TRUE;
newJoin->rightMemory->last[0] = newJoin->rightMemory->beta[0];
newJoin->rightMemory->size = 1;
newJoin->rightMemory->count = 1;
}
else
{ newJoin->rightMemory = NULL; }
newJoin->nextLinks = NULL;
newJoin->joinFromTheRight = joinFromTheRight;
if (existsRHSPattern)
{ newJoin->patternIsNegated = FALSE; }
else
{ newJoin->patternIsNegated = negatedRHSPattern; }
newJoin->patternIsExists = existsRHSPattern;
newJoin->marked = FALSE;
newJoin->initialize = EnvGetIncrementalReset(theEnv);
newJoin->logicalJoin = FALSE;
newJoin->ruleToActivate = NULL;
newJoin->memoryAdds = 0;
newJoin->memoryDeletes = 0;
newJoin->memoryCompares = 0;
/*==============================================*/
/* Install the expressions used to determine */
/* if a partial match satisfies the constraints */
/* associated with this join. */
/*==============================================*/
newJoin->networkTest = AddHashedExpression(theEnv,joinTest);
newJoin->secondaryNetworkTest = AddHashedExpression(theEnv,secondaryJoinTest);
/*=====================================================*/
/* Install the expression used to hash the beta memory */
/* partial match to determine the location to search */
/* in the alpha memory. */
/*=====================================================*/
newJoin->leftHash = AddHashedExpression(theEnv,leftHash);
newJoin->rightHash = AddHashedExpression(theEnv,rightHash);
/*============================================================*/
/* Initialize the values associated with the LHS of the join. */
/*============================================================*/
newJoin->lastLevel = lhsEntryStruct;
if (lhsEntryStruct == NULL)
{
newJoin->firstJoin = TRUE;
newJoin->depth = 1;
}
else
{
newJoin->firstJoin = FALSE;
newJoin->depth = lhsEntryStruct->depth;
newJoin->depth++; /* To work around Sparcworks C compiler bug */
theLink = get_struct(theEnv,joinLink);
theLink->join = newJoin;
theLink->enterDirection = LHS;
theLink->next = lhsEntryStruct->nextLinks;
lhsEntryStruct->nextLinks = theLink;
}
/*=======================================================*/
/* Initialize the pointer values associated with the RHS */
/* of the join (both for the new join and the join or */
/* pattern which enters this join from the right. */
/*=======================================================*/
newJoin->rightSideEntryStructure = rhsEntryStruct;
if (rhsEntryStruct == NULL)
{
if (newJoin->firstJoin)
{
theLink = get_struct(theEnv,joinLink);
theLink->join = newJoin;
theLink->enterDirection = RHS;
theLink->next = DefruleData(theEnv)->RightPrimeJoins;
DefruleData(theEnv)->RightPrimeJoins = theLink;
}
newJoin->rightMatchNode = NULL;
return(newJoin);
}
/*===========================================================*/
/* If the first join of a rule is a not CE, then it needs to */
/* be "primed" under certain circumstances. This used to be */
/* handled by adding the (initial-fact) pattern to a rule */
/* with the not CE as its first pattern, but this alternate */
/* mechanism is now used so patterns don't have to be added. */
/*===========================================================*/
if (newJoin->firstJoin && (newJoin->patternIsNegated || newJoin->joinFromTheRight) && (! newJoin->patternIsExists))
{
theLink = get_struct(theEnv,joinLink);
theLink->join = newJoin;
theLink->enterDirection = LHS;
theLink->next = DefruleData(theEnv)->LeftPrimeJoins;
DefruleData(theEnv)->LeftPrimeJoins = theLink;
}
if (joinFromTheRight)
{
theLink = get_struct(theEnv,joinLink);
theLink->join = newJoin;
theLink->enterDirection = RHS;
theLink->next = ((struct joinNode *) rhsEntryStruct)->nextLinks;
((struct joinNode *) rhsEntryStruct)->nextLinks = theLink;
newJoin->rightMatchNode = NULL;
}
else
{
newJoin->rightMatchNode = ((struct patternNodeHeader *) rhsEntryStruct)->entryJoin;
((struct patternNodeHeader *) rhsEntryStruct)->entryJoin = newJoin;
}
/*================================*/
/* Return the newly created join. */
/*================================*/
return(newJoin);
}
static intBool GetVariableDefinition(
void *theEnv,
char *readSource,
int *defglobalError,
int tokenRead,
struct token *theToken)
{
SYMBOL_HN *variableName;
struct expr *assignPtr;
DATA_OBJECT assignValue;
/*========================================*/
/* Get next token, which should either be */
/* a closing parenthesis or a variable. */
/*========================================*/
if (! tokenRead) GetToken(theEnv,readSource,theToken);
if (theToken->type == RPAREN) return(FALSE);
if (theToken->type == SF_VARIABLE)
{
SyntaxErrorMessage(theEnv,"defglobal");
*defglobalError = TRUE;
return(FALSE);
}
else if (theToken->type != GBL_VARIABLE)
{
SyntaxErrorMessage(theEnv,"defglobal");
*defglobalError = TRUE;
return(FALSE);
}
variableName = (SYMBOL_HN *) theToken->value;
SavePPBuffer(theEnv," ");
/*================================*/
/* Print out compilation message. */
/*================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") == ON) && GetPrintWhileLoading(theEnv))
{
if (QFindDefglobal(theEnv,variableName) != NULL)
{
PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
EnvPrintRouter(theEnv,WDIALOG,"Redefining defglobal: ");
}
else EnvPrintRouter(theEnv,WDIALOG,"Defining defglobal: ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(variableName));
EnvPrintRouter(theEnv,WDIALOG,"\n");
}
else
#endif
{ if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,":"); }
/*==================================================================*/
/* Check for import/export conflicts from the construct definition. */
/*==================================================================*/
#if DEFMODULE_CONSTRUCT
if (FindImportExportConflict(theEnv,"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName)))
{
ImportExportConflictMessage(theEnv,"defglobal",ValueToString(variableName),NULL,NULL);
*defglobalError = TRUE;
return(FALSE);
}
#endif
/*==============================*/
/* The next token must be an =. */
/*==============================*/
GetToken(theEnv,readSource,theToken);
if (strcmp(theToken->printForm,"=") != 0)
{
SyntaxErrorMessage(theEnv,"defglobal");
*defglobalError = TRUE;
return(FALSE);
}
SavePPBuffer(theEnv," ");
/*======================================================*/
/* Parse the expression to be assigned to the variable. */
/*======================================================*/
assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL);
if (assignPtr == NULL)
{
*defglobalError = TRUE;
return(FALSE);
}
/*==========================*/
/* Evaluate the expression. */
/*==========================*/
if (! ConstructData(theEnv)->CheckSyntaxMode)
{
SetEvaluationError(theEnv,FALSE);
if (EvaluateExpression(theEnv,assignPtr,&assignValue))
{
ReturnExpression(theEnv,assignPtr);
*defglobalError = TRUE;
return(FALSE);
}
}
else
{ ReturnExpression(theEnv,assignPtr); }
SavePPBuffer(theEnv,")");
/*======================================*/
/* Add the variable to the global list. */
/*======================================*/
if (! ConstructData(theEnv)->CheckSyntaxMode)
{ AddDefglobal(theEnv,variableName,&assignValue,assignPtr); }
/*==================================================*/
/* Return TRUE to indicate that the global variable */
/* definition was successfully parsed. */
/*==================================================*/
return(TRUE);
}
globle int ParseDeftemplate(
void *theEnv,
char *readSource)
{
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(readSource)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *deftemplateName;
struct deftemplate *newDeftemplate;
struct templateSlot *slots;
struct token inputToken;
/*================================================*/
/* Initialize pretty print and error information. */
/*================================================*/
DeftemplateData(theEnv)->DeftemplateError = FALSE;
SetPPBufferStatus(theEnv,ON);
FlushPPBuffer(theEnv);
SavePPBuffer(theEnv,"(deftemplate ");
/*==============================================================*/
/* Deftemplates can not be added when a binary image is loaded. */
/*==============================================================*/
#if BLOAD || BLOAD_AND_BSAVE
if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
CannotLoadWithBloadMessage(theEnv,"deftemplate");
return(TRUE);
}
#endif
/*=======================================================*/
/* Parse the name and comment fields of the deftemplate. */
/*=======================================================*/
#if DEBUGGING_FUNCTIONS
DeftemplateData(theEnv)->DeletedTemplateDebugFlags = 0;
#endif
deftemplateName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"deftemplate",
EnvFindDeftemplate,EnvUndeftemplate,"%",
TRUE,TRUE,DEFMODULE_CONSTRUCT);
if (deftemplateName == NULL) return(TRUE);
if (ReservedPatternSymbol(theEnv,ValueToString(deftemplateName),"deftemplate"))
{
ReservedPatternSymbolErrorMsg(theEnv,ValueToString(deftemplateName),"a deftemplate name");
return(TRUE);
}
/*===========================================*/
/* Parse the slot fields of the deftemplate. */
/*===========================================*/
slots = SlotDeclarations(theEnv,readSource,&inputToken);
if (DeftemplateData(theEnv)->DeftemplateError == TRUE) return(TRUE);
/*==============================================*/
/* If we're only checking syntax, don't add the */
/* successfully parsed deftemplate to the KB. */
/*==============================================*/
if (ConstructData(theEnv)->CheckSyntaxMode)
{
ReturnSlots(theEnv,slots);
return(FALSE);
}
/*=====================================*/
/* Create a new deftemplate structure. */
/*=====================================*/
newDeftemplate = get_struct(theEnv,deftemplate);
newDeftemplate->header.name = deftemplateName;
newDeftemplate->header.next = NULL;
newDeftemplate->header.usrData = NULL;
newDeftemplate->slotList = slots;
newDeftemplate->implied = FALSE;
newDeftemplate->numberOfSlots = 0;
newDeftemplate->busyCount = 0;
newDeftemplate->watch = 0;
newDeftemplate->inScope = TRUE;
newDeftemplate->patternNetwork = NULL;
newDeftemplate->factList = NULL;
newDeftemplate->lastFact = NULL;
newDeftemplate->header.whichModule = (struct defmoduleItemHeader *)
GetModuleItem(theEnv,NULL,DeftemplateData(theEnv)->DeftemplateModuleIndex);
/*================================*/
/* Determine the number of slots. */
/*================================*/
while (slots != NULL)
{
newDeftemplate->numberOfSlots++;
slots = slots->next;
}
/*====================================*/
/* Store pretty print representation. */
/*====================================*/
if (EnvGetConserveMemory(theEnv) == TRUE)
{ newDeftemplate->header.ppForm = NULL; }
else
{ newDeftemplate->header.ppForm = CopyPPBuffer(theEnv); }
/*=======================================================================*/
/* If a template is redefined, then we want to restore its watch status. */
/*=======================================================================*/
#if DEBUGGING_FUNCTIONS
if ((BitwiseTest(DeftemplateData(theEnv)->DeletedTemplateDebugFlags,0)) || EnvGetWatchItem(theEnv,"facts"))
{ EnvSetDeftemplateWatch(theEnv,ON,(void *) newDeftemplate); }
#endif
/*==============================================*/
/* Add deftemplate to the list of deftemplates. */
/*==============================================*/
AddConstructToModule(&newDeftemplate->header);
InstallDeftemplate(theEnv,newDeftemplate);
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif
#endif
return(FALSE);
}
/*******************************************************************************
Name: WatchWindow
Description: Creates Watch menu
arguments:
Returns: None
*******************************************************************************/
void WatchWindow(
Widget w,
XtPointer client_data,
XtPointer call_data)
{
void *theEnv = GetCurrentEnvironment();
int n = 0,i;
Widget Okay,cancel,All,none;
static char *WidgetName[MAX_WATCH] = {"Compilations","Facts","Rules","Statistics","Activations",
"Focus","Globals","Deffunctions","Generic Functions","Methods",
"Instances","Slots","Messages-handlers","Messages"};
/* ====================================================== */
/* If the watch shell have already existed pop it up, */
/* else create it. */
/* ====================================================== */
if(watchShell != NULL)
{
for(i = 0; i < MAX_WATCH; i++)
{
n = 0;
if (EnvGetWatchItem(theEnv,WatchName[i]))
XtSetArg( TheArgs[n],XtNstate,True);
else
XtSetArg( TheArgs[n],XtNstate,False);
n++;
XtSetValues(watch_widgets[i],TheArgs,n);
}
XtPopup(watchShell,XtGrabExclusive);
return;
}
/* ========================================= */
/* Create the watch toggle menu */
/* ========================================= */
XtSetArg( TheArgs[n], XtNwidth,250);n++;
XtSetArg( TheArgs[n], XtNheight,400);n++;
watchShell = XtCreatePopupShell("Watch Menu",topLevelShellWidgetClass,XtParent(w),NULL,0);
n = 0;
watchForm = XtCreateManagedWidget( "watch_form", formWidgetClass,
watchShell, TheArgs,n);
n = 0;
XtSetArg(TheArgs[n],XtNwidth,150);n++;
XtSetArg(TheArgs[n],XtNhorizDistance,15);n++;
for(i = 0; i < 7;i++)
{
if (EnvGetWatchItem(theEnv,WatchName[i]))
XtSetArg( TheArgs[n],XtNstate,True);
else
XtSetArg( TheArgs[n],XtNstate,False);
n++;
watch_widgets[i] = XtCreateManagedWidget(WidgetName[i],
toggleWidgetClass,
watchForm,
TheArgs, n);
n = 2;
XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[i]);n++;
}
n = 1;
XtSetArg(TheArgs[n],XtNfromHoriz,watch_widgets[0]);n++;
for(; i < MAX_WATCH ; i++)
{
if (EnvGetWatchItem(theEnv,WatchName[i]))
XtSetArg( TheArgs[n],XtNstate,True);
else
XtSetArg( TheArgs[n],XtNstate,False);
n++;
watch_widgets[i] = XtCreateManagedWidget(WidgetName[i],
toggleWidgetClass,
watchForm,
TheArgs, n);
n = 1;
XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[i]);n++;
XtSetArg(TheArgs[n],XtNfromHoriz,watch_widgets[i - 7]);n++;
}
/* ======================= */
/* Create the "All" button */
/* ======================= */
n = 0;
XtSetArg(TheArgs[n],XtNcornerRoundPercent,40);n++;
XtSetArg(TheArgs[n],XtNshapeStyle,XmuShapeRoundedRectangle);n++;
XtSetArg(TheArgs[n],XtNwidth,150);n++;
XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[6]);n++;
XtSetArg(TheArgs[n],XtNvertDistance,31);n++;
XtSetArg(TheArgs[n],XtNlabel,"All");n++;
All = XtCreateManagedWidget("watchButton",
commandWidgetClass,
watchForm,
TheArgs, n);
XtAddCallback(All, XtNcallback, WatchAllCallback, NULL);
/* ============================= */
/* Create the "None" button */
/* ============================= */
n = 3;
XtSetArg(TheArgs[n],XtNfromHoriz,All);n++;
XtSetArg(TheArgs[n],XtNfromVert,watch_widgets[6]);n++;
XtSetArg(TheArgs[n],XtNvertDistance,31);n++;
XtSetArg(TheArgs[n],XtNhorizDistance,30);n++;
XtSetArg(TheArgs[n],XtNlabel,"None");n++;
none = XtCreateManagedWidget("watchButton",
commandWidgetClass,
watchForm,TheArgs,n);
XtAddCallback(none, XtNcallback, WatchNoneCallback, NULL);
/* ================================ */
/* Create the "Okay" button */
/* ================================ */
n = 3;
XtSetArg(TheArgs[n],XtNfromVert,All);n++;
XtSetArg(TheArgs[n],XtNvertDistance,15);n++;
XtSetArg(TheArgs[n],XtNlabel,"Okay");n++;
Okay = XtCreateManagedWidget("watchButton",
commandWidgetClass,
watchForm,
TheArgs, n);
XtAddCallback(Okay,XtNcallback,OkWatchCallback,(XtPointer)watchForm);
/* ================================ */
/* Create the "Cancel" button */
/* ================================ */
n = 3;
XtSetArg(TheArgs[n],XtNfromVert,none);n++;
XtSetArg(TheArgs[n],XtNvertDistance,15);n++;
XtSetArg(TheArgs[n],XtNfromHoriz,Okay);n++;
XtSetArg(TheArgs[n],XtNlabel,"Cancel");n++;
XtSetArg(TheArgs[n],XtNhorizDistance,30);n++;
cancel = XtCreateManagedWidget("watchButton",
commandWidgetClass,
watchForm,
TheArgs, n);
XtAddCallback(cancel,XtNcallback,PopdownSelect,(XtPointer)watchForm);
XtPopup(watchShell,XtGrabExclusive);
}
globle SYMBOL_HN *GetConstructNameAndComment(
void *theEnv,
char *readSource,
struct token *inputToken,
char *constructName,
void *(*findFunction)(void *,char *),
int (*deleteFunction)(void *,void *),
char *constructSymbol,
int fullMessageCR,
int getComment,
int moduleNameAllowed)
{
#if (MAC_MCW || WIN_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS)
#pragma unused(fullMessageCR)
#endif
SYMBOL_HN *name, *moduleName;
int redefining = FALSE;
void *theConstruct;
unsigned separatorPosition;
struct defmodule *theModule;
/*==========================*/
/* Next token should be the */
/* name of the construct. */
/*==========================*/
GetToken(theEnv,readSource,inputToken);
if (inputToken->type != SYMBOL)
{
PrintErrorID(theEnv,"CSTRCPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"Missing name for ");
EnvPrintRouter(theEnv,WERROR,constructName);
EnvPrintRouter(theEnv,WERROR," construct\n");
return(NULL);
}
name = (SYMBOL_HN *) inputToken->value;
/*===============================*/
/* Determine the current module. */
/*===============================*/
separatorPosition = FindModuleSeparator(ValueToString(name));
if (separatorPosition)
{
if (moduleNameAllowed == FALSE)
{
SyntaxErrorMessage(theEnv,"module specifier");
return(NULL);
}
moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name));
if (moduleName == NULL)
{
SyntaxErrorMessage(theEnv,"construct name");
return(NULL);
}
theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
if (theModule == NULL)
{
CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName));
return(NULL);
}
EnvSetCurrentModule(theEnv,(void *) theModule);
name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name));
if (name == NULL)
{
SyntaxErrorMessage(theEnv,"construct name");
return(NULL);
}
}
/*=====================================================*/
/* If the module was not specified, record the current */
/* module name as part of the pretty-print form. */
/*=====================================================*/
else
{
theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
if (moduleNameAllowed)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule));
SavePPBuffer(theEnv,"::");
SavePPBuffer(theEnv,ValueToString(name));
}
}
/*==================================================================*/
/* Check for import/export conflicts from the construct definition. */
/*==================================================================*/
#if DEFMODULE_CONSTRUCT
if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name)))
{
ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL);
return(NULL);
}
#endif
/*========================================================*/
/* Remove the construct if it is already in the knowledge */
/* base and we're not just checking syntax. */
/*========================================================*/
if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
theConstruct = (*findFunction)(theEnv,ValueToString(name));
if (theConstruct != NULL)
{
redefining = TRUE;
if (deleteFunction != NULL)
{
if ((*deleteFunction)(theEnv,theConstruct) == FALSE)
{
PrintErrorID(theEnv,"CSTRCPSR",4,TRUE);
EnvPrintRouter(theEnv,WERROR,"Cannot redefine ");
EnvPrintRouter(theEnv,WERROR,constructName);
EnvPrintRouter(theEnv,WERROR," ");
EnvPrintRouter(theEnv,WERROR,ValueToString(name));
EnvPrintRouter(theEnv,WERROR," while it is in use.\n");
return(NULL);
}
}
}
}
/*=============================================*/
/* If compilations are being watched, indicate */
/* that a construct is being compiled. */
/*=============================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) &&
GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
{
if (redefining)
{
PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
EnvPrintRouter(theEnv,WDIALOG,"Redefining ");
}
else EnvPrintRouter(theEnv,WDIALOG,"Defining ");
EnvPrintRouter(theEnv,WDIALOG,constructName);
EnvPrintRouter(theEnv,WDIALOG,": ");
EnvPrintRouter(theEnv,WDIALOG,ValueToString(name));
if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n");
else EnvPrintRouter(theEnv,WDIALOG," ");
}
else
#endif
{
if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
{ EnvPrintRouter(theEnv,WDIALOG,constructSymbol); }
}
/*===============================*/
/* Get the comment if it exists. */
/*===============================*/
GetToken(theEnv,readSource,inputToken);
if ((inputToken->type == STRING) && getComment)
{
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,inputToken->printForm);
GetToken(theEnv,readSource,inputToken);
if (inputToken->type != RPAREN)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,"\n ");
SavePPBuffer(theEnv,inputToken->printForm);
}
}
else if (inputToken->type != RPAREN)
{
PPBackup(theEnv);
SavePPBuffer(theEnv,"\n ");
SavePPBuffer(theEnv,inputToken->printForm);
}
/*===================================*/
/* Return the name of the construct. */
/*===================================*/
return(name);
}
globle int LoadConstructsFromLogicalName(
void *theEnv,
char *readSource)
{
int constructFlag;
struct token theToken;
int noErrors = TRUE;
int foundConstruct;
/*=========================================*/
/* Reset the halt execution and evaluation */
/* error flags in preparation for parsing. */
/*=========================================*/
if (EvaluationData(theEnv)->CurrentEvaluationDepth == 0) SetHaltExecution(theEnv,FALSE);
SetEvaluationError(theEnv,FALSE);
/*========================================================*/
/* Find the beginning of the first construct in the file. */
/*========================================================*/
EvaluationData(theEnv)->CurrentEvaluationDepth++;
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
/*==================================================*/
/* Parse the file until the end of file is reached. */
/*==================================================*/
while ((foundConstruct == TRUE) && (GetHaltExecution(theEnv) == FALSE))
{
/*===========================================================*/
/* Clear the pretty print buffer in preparation for parsing. */
/*===========================================================*/
FlushPPBuffer(theEnv);
/*======================*/
/* Parse the construct. */
/*======================*/
constructFlag = ParseConstruct(theEnv,ValueToString(theToken.value),readSource);
/*==============================================================*/
/* If an error occurred while parsing, then find the beginning */
/* of the next construct (but don't generate any more error */
/* messages--in effect, skip everything until another construct */
/* is found). */
/*==============================================================*/
if (constructFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
noErrors = FALSE;
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,TRUE,&noErrors);
}
/*======================================================*/
/* Otherwise, find the beginning of the next construct. */
/*======================================================*/
else
{
GetToken(theEnv,readSource,&theToken);
foundConstruct = FindConstructBeginning(theEnv,readSource,&theToken,FALSE,&noErrors);
}
/*=====================================================*/
/* Yield time if necessary to foreground applications. */
/*=====================================================*/
if (foundConstruct)
{ IncrementSymbolCount(theToken.value); }
EvaluationData(theEnv)->CurrentEvaluationDepth--;
PeriodicCleanup(theEnv,FALSE,TRUE);
YieldTime(theEnv);
EvaluationData(theEnv)->CurrentEvaluationDepth++;
if (foundConstruct)
{ DecrementSymbolCount(theEnv,(SYMBOL_HN *) theToken.value); }
}
EvaluationData(theEnv)->CurrentEvaluationDepth--;
/*========================================================*/
/* Print a carriage return if a single character is being */
/* printed to indicate constructs are being processed. */
/*========================================================*/
#if DEBUGGING_FUNCTIONS
if ((EnvGetWatchItem(theEnv,"compilations") != TRUE) && GetPrintWhileLoading(theEnv))
#else
if (GetPrintWhileLoading(theEnv))
#endif
{ EnvPrintRouter(theEnv,WDIALOG,"\n"); }
/*=============================================================*/
/* Once the load is complete, destroy the pretty print buffer. */
/* This frees up any memory that was used to create the pretty */
/* print forms for constructs during parsing. Thus calls to */
/* the mem-used function will accurately reflect the amount of */
/* memory being used after a load command. */
/*=============================================================*/
DestroyPPBuffer(theEnv);
/*==========================================================*/
/* Return a boolean flag which indicates whether any errors */
/* were encountered while loading the constructs. */
/*==========================================================*/
return(noErrors);
}
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))
{
/*===================================*/
/* 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);
}
/*========================================================*/
/* 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 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);
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. */
/*=====================================================*/
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;
if (emptyLHS)
{ emptyLHS = FALSE; }
else
{ theLHS = theLHS->bottom; }
}
return(topDisjunct);
}
globle int ParseDefrule(
void *theEnv,
const char *readSource)
{
#if (! RUN_TIME) && (! BLOAD_ONLY)
SYMBOL_HN *ruleName;
struct lhsParseNode *theLHS;
struct expr *actions;
struct token theToken;
struct defrule *topDisjunct, *tempPtr;
struct defruleModule *theModuleItem;
int 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",
EnvFindDefruleInModule,EnvUndefrule,"*",FALSE,
TRUE,TRUE,FALSE);
if (ruleName == NULL) return(TRUE);
/*============================*/
/* Parse the LHS of the rule. */
/*============================*/
theLHS = ParseRuleLHS(theEnv,readSource,&theToken,ValueToString(ruleName),&error);
if (error)
{
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;
tempPtr->header.ppForm = topDisjunct->header.ppForm;
}
/*===============================================*/
/* 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);
}
void SaveWatchInformation()
{
HKEY hKey;
DWORD lpdwDisposition;
struct WatchInformation watchInfo;
void *theEnv = GlobalEnv;
if (RegCreateKeyEx(HKEY_CURRENT_USER,TEXT("Software\\CLIPS\\CLIPSWin"),0,"",0,
KEY_READ | KEY_WRITE,NULL,&hKey,&lpdwDisposition) != ERROR_SUCCESS)
{ return; }
watchInfo.compilations = (boolean) EnvGetWatchItem(theEnv,"compilations");
watchInfo.facts = (boolean) EnvGetWatchItem(theEnv,"facts");
watchInfo.instances = (boolean) EnvGetWatchItem(theEnv,"instances");
watchInfo.rules = (boolean) EnvGetWatchItem(theEnv,"rules");
watchInfo.genericFunctions = (boolean) EnvGetWatchItem(theEnv,"generic-functions");
watchInfo.messages = (boolean) EnvGetWatchItem(theEnv,"messages");
watchInfo.deffunctions = (boolean) EnvGetWatchItem(theEnv,"deffunctions");
watchInfo.statistics = (boolean) EnvGetWatchItem(theEnv,"statistics");
watchInfo.globals = (boolean) EnvGetWatchItem(theEnv,"globals");
watchInfo.slots = (boolean) EnvGetWatchItem(theEnv,"slots");
watchInfo.activations = (boolean) EnvGetWatchItem(theEnv,"activations");
watchInfo.methods = (boolean) EnvGetWatchItem(theEnv,"methods");
watchInfo.focus = (boolean) EnvGetWatchItem(theEnv,"focus");
watchInfo.messageHandlers = (boolean) EnvGetWatchItem(theEnv,"message-handlers");
if (RegSetValueEx(hKey,"Watch",0,REG_BINARY,(BYTE *) &watchInfo,
sizeof(struct WatchInformation)) != ERROR_SUCCESS)
{
RegCloseKey(hKey);
return;
}
RegCloseKey(hKey);
}
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);
}
globle int GetWatchItem(
const char *itemName)
{
return EnvGetWatchItem(GetCurrentEnvironment(),itemName);
}
