globle void GetFactPPForm(
char *buffer,
int bufferLength,
void *theFact)
{
OpenStringDestination("FactPPForm",buffer,bufferLength);
PrintFactWithIdentifier("FactPPForm",(struct fact *) theFact);
CloseStringDestination("FactPPForm");
}
globle void EnvFacts(
void *theEnv,
char *logicalName,
void *vTheModule,
long long start,
long long end,
long long max)
{
struct fact *factPtr;
long count = 0;
struct defmodule *oldModule, *theModule = (struct defmodule *) vTheModule;
int allModules = FALSE;
/*==========================*/
/* Save the current module. */
/*==========================*/
oldModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
/*=========================================================*/
/* Determine if facts from all modules are to be displayed */
/* or just facts from the current module. */
/*=========================================================*/
if (theModule == NULL) allModules = TRUE;
else EnvSetCurrentModule(theEnv,(void *) theModule);
/*=====================================*/
/* Get the first fact to be displayed. */
/*=====================================*/
if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,NULL);
else factPtr = (struct fact *) GetNextFactInScope(theEnv,NULL);
/*===============================*/
/* Display facts until there are */
/* no more facts to display. */
/*===============================*/
while (factPtr != NULL)
{
/*==================================================*/
/* Abort the display of facts if the Halt Execution */
/* flag has been set (normally by user action). */
/*==================================================*/
if (GetHaltExecution(theEnv) == TRUE)
{
EnvSetCurrentModule(theEnv,(void *) oldModule);
return;
}
/*===============================================*/
/* If the maximum fact index of facts to display */
/* has been reached, then stop displaying facts. */
/*===============================================*/
if ((factPtr->factIndex > end) && (end != UNSPECIFIED))
{
PrintTally(theEnv,logicalName,count,(char*)"fact",(char*)"facts");
EnvSetCurrentModule(theEnv,(void *) oldModule);
return;
}
/*================================================*/
/* If the maximum number of facts to be displayed */
/* has been reached, then stop displaying facts. */
/*================================================*/
if (max == 0)
{
PrintTally(theEnv,logicalName,count,(char*)"fact",(char*)"facts");
EnvSetCurrentModule(theEnv,(void *) oldModule);
return;
}
/*======================================================*/
/* If the index of the fact is greater than the minimum */
/* starting fact index, then display the fact. */
/*======================================================*/
if (factPtr->factIndex >= start)
{
PrintFactWithIdentifier(theEnv,logicalName,factPtr);
EnvPrintRouter(theEnv,logicalName,(char*)"\n");
count++;
if (max > 0) max--;
}
/*========================================*/
/* Proceed to the next fact to be listed. */
/*========================================*/
if (allModules) factPtr = (struct fact *) EnvGetNextFact(theEnv,factPtr);
else factPtr = (struct fact *) GetNextFactInScope(theEnv,factPtr);
}
/*===================================================*/
/* Print the total of the number of facts displayed. */
/*===================================================*/
PrintTally(theEnv,logicalName,count,(char*)"fact",(char*)"facts");
/*=============================*/
/* Restore the current module. */
/*=============================*/
EnvSetCurrentModule(theEnv,(void *) oldModule);
}
globle void *Assert(
void *vTheFact)
{
int hashValue;
int length, i;
struct field *theField;
struct fact *theFact = (struct fact *) vTheFact;
/*==========================================*/
/* A fact can not be asserted while another */
/* fact is being asserted or retracted. */
/*==========================================*/
if (JoinOperationInProgress)
{
ReturnFact(theFact);
PrintErrorID("FACTMNGR",2,TRUE);
PrintRouter(WERROR,"Facts may not be asserted during pattern-matching\n");
return(NULL);
}
/*=============================================================*/
/* Replace invalid data types in the fact with the symbol nil. */
/*=============================================================*/
length = theFact->theProposition.multifieldLength;
theField = theFact->theProposition.theFields;
for (i = 0; i < length; i++)
{
if (theField[i].type == RVOID)
{
theField[i].type = SYMBOL;
theField[i].value = (void *) AddSymbol("nil");
}
}
/*========================================================*/
/* If fact assertions are being checked for duplications, */
/* then search the fact list for a duplicate fact. */
/*========================================================*/
hashValue = HandleFactDuplication(theFact);
if (hashValue < 0) return(NULL);
/*==========================================================*/
/* If necessary, add logical dependency links between the */
/* fact and the partial match which is its logical support. */
/*==========================================================*/
#if LOGICAL_DEPENDENCIES
if (AddLogicalDependencies((struct patternEntity *) theFact,FALSE) == FALSE)
{
ReturnFact(theFact);
return(NULL);
}
#endif
/*======================================*/
/* Add the fact to the fact hash table. */
/*======================================*/
AddHashedFact(theFact,hashValue);
/*================================*/
/* Add the fact to the fact list. */
/*================================*/
theFact->nextFact = NULL;
theFact->list = NULL;
theFact->previousFact = LastFact;
if (LastFact == NULL)
{ FactList = theFact; }
else
{ LastFact->nextFact = theFact; }
LastFact = theFact;
/*==================================*/
/* Set the fact index and time tag. */
/*==================================*/
theFact->factIndex = NextFactIndex++;
theFact->factHeader.timeTag = CurrentEntityTimeTag++;
/*=====================*/
/* Update busy counts. */
/*=====================*/
FactInstall(theFact);
/*==========================*/
/* Print assert output if */
/* facts are being watched. */
/*==========================*/
#if DEBUGGING_FUNCTIONS
if (theFact->whichDeftemplate->watch)
{
PrintRouter(WTRACE,"==> ");
PrintFactWithIdentifier(WTRACE,theFact);
PrintRouter(WTRACE,"\n");
}
#endif
/*==================================*/
/* Set the change flag to indicate */
/* the fact-list has been modified. */
/*==================================*/
ChangeToFactList = TRUE;
/*==========================================*/
/* Check for constraint errors in the fact. */
/*==========================================*/
CheckTemplateFact(theFact);
/*===================================================*/
/* Reset the evaluation error flag since expressions */
/* will be evaluated as part of the assert . */
/*===================================================*/
SetEvaluationError(FALSE);
/*=============================================*/
/* Pattern match the fact using the associated */
/* deftemplate's pattern network. */
/*=============================================*/
JoinOperationInProgress = TRUE;
FactPatternMatch(theFact,theFact->whichDeftemplate->patternNetwork,0,NULL,NULL);
JoinOperationInProgress = FALSE;
/*===================================================*/
/* Retract other facts that were logically dependent */
/* on the non-existence of the fact just asserted. */
/*===================================================*/
#if LOGICAL_DEPENDENCIES
ForceLogicalRetractions();
#endif
/*=========================================*/
/* Free partial matches that were released */
/* by the assertion of the fact. */
/*=========================================*/
if (ExecutingRule == NULL) FlushGarbagePartialMatches();
/*==========================================*/
/* Force periodic cleanup if the assert was */
/* executed from an embedded application. */
/*==========================================*/
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*===============================*/
/* Return a pointer to the fact. */
/*===============================*/
return((void *) theFact);
}
globle BOOLEAN Retract(
void *vTheFact)
{
struct fact *theFact = (struct fact *) vTheFact;
/*===========================================*/
/* A fact can not be retracted while another */
/* fact is being asserted or retracted. */
/*===========================================*/
if (JoinOperationInProgress)
{
PrintErrorID("FACTMNGR",1,TRUE);
PrintRouter(WERROR,"Facts may not be retracted during pattern-matching\n");
return(FALSE);
}
/*====================================*/
/* A NULL fact pointer indicates that */
/* all facts should be retracted. */
/*====================================*/
if (theFact == NULL)
{
RemoveAllFacts();
return(TRUE);
}
/*======================================================*/
/* Check to see if the fact has already been retracted. */
/*======================================================*/
if (theFact->garbage) return(FALSE);
/*============================*/
/* Print retraction output if */
/* facts are being watched. */
/*============================*/
#if DEBUGGING_FUNCTIONS
if (theFact->whichDeftemplate->watch)
{
PrintRouter(WTRACE,"<== ");
PrintFactWithIdentifier(WTRACE,theFact);
PrintRouter(WTRACE,"\n");
}
#endif
/*==================================*/
/* Set the change flag to indicate */
/* the fact-list has been modified. */
/*==================================*/
ChangeToFactList = TRUE;
/*===============================================*/
/* Remove any links between the fact and partial */
/* matches in the join network. These links are */
/* used to keep track of logical dependencies. */
/*===============================================*/
#if LOGICAL_DEPENDENCIES
RemoveEntityDependencies((struct patternEntity *) theFact);
#endif
/*===========================================*/
/* Remove the fact from the fact hash table. */
/*===========================================*/
RemoveHashedFact(theFact);
/*=====================================*/
/* Remove the fact from the fact list. */
/*=====================================*/
if (theFact == LastFact)
{ LastFact = theFact->previousFact; }
if (theFact->previousFact == NULL)
{
FactList = FactList->nextFact;
if (FactList != NULL)
{ FactList->previousFact = NULL; }
}
else
{
theFact->previousFact->nextFact = theFact->nextFact;
if (theFact->nextFact != NULL)
{ theFact->nextFact->previousFact = theFact->previousFact; }
}
/*==================================*/
/* Update busy counts and ephemeral */
/* garbage information. */
/*==================================*/
FactDeinstall(theFact);
EphemeralItemCount++;
EphemeralItemSize += sizeof(struct fact) + (sizeof(struct field) * theFact->theProposition.multifieldLength);
/*========================================*/
/* Add the fact to the fact garbage list. */
/*========================================*/
theFact->nextFact = GarbageFacts;
GarbageFacts = theFact;
theFact->garbage = TRUE;
/*===================================================*/
/* Reset the evaluation error flag since expressions */
/* will be evaluated as part of the retract. */
/*===================================================*/
SetEvaluationError(FALSE);
/*===========================================*/
/* Loop through the list of all the patterns */
/* that matched the fact and process the */
/* retract operation for each one. */
/*===========================================*/
JoinOperationInProgress = TRUE;
NetworkRetract((struct patternMatch *) theFact->list);
JoinOperationInProgress = FALSE;
/*=========================================*/
/* Free partial matches that were released */
/* by the retraction of the fact. */
/*=========================================*/
if (ExecutingRule == NULL)
{ FlushGarbagePartialMatches(); }
/*=========================================*/
/* Retract other facts that were logically */
/* dependent on the fact just retracted. */
/*=========================================*/
#if LOGICAL_DEPENDENCIES
ForceLogicalRetractions();
#endif
/*===========================================*/
/* Force periodic cleanup if the retract was */
/* executed from an embedded application. */
/*===========================================*/
if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
(CurrentExpression == NULL))
{ PeriodicCleanup(TRUE,FALSE); }
/*==================================*/
/* Return TRUE to indicate the fact */
/* was successfully retracted. */
/*==================================*/
return(TRUE);
}