static int GetcString( void *theEnv, char *logicalName) { struct stringRouter *head; int rc; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,(char*)"ROUTER",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != READ_STRING) return(EOF); if (head->currentPosition >= head->maximumPosition) { head->currentPosition++; return(EOF); } rc = (unsigned char) head->str[head->currentPosition]; head->currentPosition++; return(rc); }
globle void *RequestChunk( void *theEnv, size_t requestSize) { struct chunkInfo *chunkPtr; struct blockInfo *blockPtr; /*==================================================*/ /* Allocate initial memory pool block if it has not */ /* already been allocated. */ /*==================================================*/ if (MemoryData(theEnv)->BlockMemoryInitialized == FALSE) { if (InitializeBlockMemory(theEnv,requestSize) == 0) return(NULL); } /*====================================================*/ /* Make sure that the amount of memory requested will */ /* fall on a boundary of strictest alignment */ /*====================================================*/ requestSize = (((requestSize - 1) / STRICT_ALIGN_SIZE) + 1) * STRICT_ALIGN_SIZE; /*=====================================================*/ /* Search through the list of free memory for a block */ /* of the appropriate size. If a block is found, then */ /* allocate and return a pointer to it. */ /*=====================================================*/ blockPtr = MemoryData(theEnv)->TopMemoryBlock; while (blockPtr != NULL) { chunkPtr = blockPtr->nextFree; while (chunkPtr != NULL) { if ((chunkPtr->size == requestSize) || (chunkPtr->size > (requestSize + MemoryData(theEnv)->ChunkInfoSize))) { AllocateChunk(theEnv,blockPtr,chunkPtr,requestSize); return((void *) (((char *) chunkPtr) + MemoryData(theEnv)->ChunkInfoSize)); } chunkPtr = chunkPtr->nextFree; } if (blockPtr->nextBlock == NULL) { if (AllocateBlock(theEnv,blockPtr,requestSize) == 0) /* get another block */ { return(NULL); } } blockPtr = blockPtr->nextBlock; } SystemError(theEnv,(char*)"MEMORY",2); EnvExitRouter(theEnv,EXIT_FAILURE); return(NULL); /* Unreachable, but prevents warning. */ }
globle void InitializeConstraints( void *theEnv) { #if (! RUN_TIME) && (! BLOAD_ONLY) int i; #endif AllocateEnvironmentData(theEnv,CONSTRAINT_DATA,sizeof(struct constraintData),DeallocateConstraintData); ConstraintData(theEnv)->StaticConstraintChecking = TRUE; #if (! RUN_TIME) && (! BLOAD_ONLY) ConstraintData(theEnv)->ConstraintHashtable = (struct constraintRecord **) gm2(theEnv,(int) sizeof (struct constraintRecord *) * SIZE_CONSTRAINT_HASH); if (ConstraintData(theEnv)->ConstraintHashtable == NULL) EnvExitRouter(theEnv,EXIT_FAILURE); for (i = 0; i < SIZE_CONSTRAINT_HASH; i++) ConstraintData(theEnv)->ConstraintHashtable[i] = NULL; #endif #if (! RUN_TIME) EnvDefineFunction2(theEnv,"get-dynamic-constraint-checking",'b',GDCCommand,"GDCCommand", "00"); EnvDefineFunction2(theEnv,"set-dynamic-constraint-checking",'b',SDCCommand,"SDCCommand", "11"); EnvDefineFunction2(theEnv,"get-static-constraint-checking",'b',GSCCommand,"GSCCommand", "00"); EnvDefineFunction2(theEnv,"set-static-constraint-checking",'b',SSCCommand,"SSCCommand", "11"); #endif }
globle void InitializeMemory( void *theEnv) { AllocateEnvironmentData(theEnv,MEMORY_DATA,sizeof(struct memoryData),NULL); MemoryData(theEnv)->OutOfMemoryFunction = DefaultOutOfMemoryFunction; #if (MEM_TABLE_SIZE > 0) MemoryData(theEnv)->MemoryTable = (struct memoryPtr **) malloc((STD_SIZE) (sizeof(struct memoryPtr *) * MEM_TABLE_SIZE)); if (MemoryData(theEnv)->MemoryTable == NULL) { PrintErrorID(theEnv,"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); } else { int i; for (i = 0; i < MEM_TABLE_SIZE; i++) MemoryData(theEnv)->MemoryTable[i] = NULL; } #else // MEM_TABLE_SIZE == 0 MemoryData(theEnv)->MemoryTable = NULL; #endif }
static int PrintString( void *theEnv, char *logicalName, char *str) { struct stringRouter *head; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,(char*)"ROUTER",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != WRITE_STRING) return(1); if (head->maximumPosition == 0) return(1); if ((head->currentPosition + 1) >= head->maximumPosition) return(1); genstrncpy(&head->str[head->currentPosition], str,(STD_SIZE) (head->maximumPosition - head->currentPosition) - 1); head->currentPosition += strlen(str); return(1); }
globle void ExitCommand( void *theEnv) { int argCnt; int status; if ((argCnt = EnvArgCountCheck(theEnv,"exit",NO_MORE_THAN,1)) == -1) return; if (argCnt == 0) { EnvExitRouter(theEnv,EXIT_SUCCESS); } else { status = (int) EnvRtnLong(theEnv,1); if (GetEvaluationError(theEnv)) return; EnvExitRouter(theEnv,status); } return; }
/******************************************************************************* Name: InitializeInterface Description: initializes the the X window interface Arguments: None Returns: None *******************************************************************************/ void InitializeInterface() { void *theEnv = GetCurrentEnvironment(); if (! InitalizeLogTable()) { EnvPrintRouter(theEnv,"werror", "Could not initialize logical name hash table\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } //SetDribbleStatusFunction(GetCurrentEnvironment(),NULL); /*==================================================================*/ /* Tell CLIPS which GetEvent function to call when an event needed. */ /*==================================================================*/ SetEventFunction(theEnv,GetEvent); /* SetMemoryStatusFunction((int(*)())ActivateTheMenus());*/ /*=================================================*/ /* Tell CLIPS which function to call periodically. */ /*=================================================*/ EnvAddPeriodicFunction(theEnv,"PeriodicUpdate",PeriodicUpdate,90); /*========================*/ /* Add a main I/O router. */ /*========================*/ if (! EnvAddRouter(theEnv,"wclips", 10, XclipsQuery, XclipsPrint, XclipsGetc, XclipsUngetc, XclipsExit)) { printf("Could not allocate xclips router!\n"); XclipsExit(theEnv,0); EnvExitRouter(theEnv,0); } EnvPrintRouter(theEnv,"wclips", " XCLIPS for:"); }
globle int DefaultOutOfMemoryFunction( void *theEnv, unsigned long size) { #if MAC_MCW || IBM_MCW || MAC_XCD #pragma unused(size) #endif PrintErrorID(theEnv,"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); return(TRUE); }
globle void InstallPrimitive( void *theEnv, struct entityRecord *thePrimitive, int whichPosition) { if (EvaluationData(theEnv)->PrimitivesArray[whichPosition] != NULL) { SystemError(theEnv,"EVALUATN",5); EnvExitRouter(theEnv,EXIT_FAILURE); } EvaluationData(theEnv)->PrimitivesArray[whichPosition] = thePrimitive; }
globle int DefaultOutOfMemoryFunction( void *theEnv, size_t size) { #if MAC_MCW || WIN_MCW || MAC_XCD #pragma unused(size) #endif PrintErrorID(theEnv,(char*)"MEMORY",1,TRUE); EnvPrintRouter(theEnv,WERROR,(char*)"Out of memory.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); return(TRUE); }
void ExitCommand( UDFContext *context, CLIPSValue *returnValue) { int argCnt; int status; CLIPSValue value; Environment *theEnv = UDFContextEnvironment(context); argCnt = UDFArgumentCount(context); if (argCnt == 0) { EnvExitRouter(theEnv,EXIT_SUCCESS); } else { if (! UDFFirstArgument(context,INTEGER_TYPE,&value)) { EnvExitRouter(theEnv,EXIT_SUCCESS); } status = (int) mCVToInteger(&value); if (EnvGetEvaluationError(theEnv)) return; EnvExitRouter(theEnv,status); } return; }
globle void InitExpressionPointers( void *theEnv) { ExpressionData(theEnv)->PTR_AND = (void *) FindFunction(theEnv,(char*)"and"); ExpressionData(theEnv)->PTR_OR = (void *) FindFunction(theEnv,(char*)"or"); ExpressionData(theEnv)->PTR_EQ = (void *) FindFunction(theEnv,(char*)"eq"); ExpressionData(theEnv)->PTR_NEQ = (void *) FindFunction(theEnv,(char*)"neq"); ExpressionData(theEnv)->PTR_NOT = (void *) FindFunction(theEnv,(char*)"not"); if ((ExpressionData(theEnv)->PTR_AND == NULL) || (ExpressionData(theEnv)->PTR_OR == NULL) || (ExpressionData(theEnv)->PTR_EQ == NULL) || (ExpressionData(theEnv)->PTR_NEQ == NULL) || (ExpressionData(theEnv)->PTR_NOT == NULL)) { SystemError(theEnv,(char*)"EXPRESSN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } }
globle void RemoveConstructFromModule( void *theEnv, struct constructHeader *theConstruct) { struct constructHeader *lastConstruct,*currentConstruct; /*==============================*/ /* Find the specified construct */ /* in the module's list. */ /*==============================*/ lastConstruct = NULL; currentConstruct = theConstruct->whichModule->firstItem; while (currentConstruct != theConstruct) { lastConstruct = currentConstruct; currentConstruct = currentConstruct->next; } /*========================================*/ /* If it wasn't there, something's wrong. */ /*========================================*/ if (currentConstruct == NULL) { SystemError(theEnv,"CSTRCPSR",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*==========================*/ /* Remove it from the list. */ /*==========================*/ if (lastConstruct == NULL) { theConstruct->whichModule->firstItem = theConstruct->next; } else { lastConstruct->next = theConstruct->next; } /*=================================================*/ /* Update the pointer to the last item in the list */ /* if the construct just deleted was at the end. */ /*=================================================*/ if (theConstruct == theConstruct->whichModule->lastItem) { theConstruct->whichModule->lastItem = lastConstruct; } }
globle int InstallExternalAddressType( void *theEnv, struct externalAddressType *theAddressType) { struct externalAddressType *copyEAT; int rv = EvaluationData(theEnv)->numberOfAddressTypes; if (EvaluationData(theEnv)->numberOfAddressTypes == MAXIMUM_EXTERNAL_ADDRESS_TYPES) { SystemError(theEnv,"EVALUATN",6); EnvExitRouter(theEnv,EXIT_FAILURE); } copyEAT = (struct externalAddressType *) genalloc(theEnv,sizeof(struct externalAddressType)); memcpy(copyEAT,theAddressType,sizeof(struct externalAddressType)); EvaluationData(theEnv)->ExternalAddressTypes[EvaluationData(theEnv)->numberOfAddressTypes++] = copyEAT; return rv; }
static int UngetcString( void *theEnv, int ch, char *logicalName) { struct stringRouter *head; head = FindStringRouter(theEnv,logicalName); if (head == NULL) { SystemError(theEnv,(char*)"ROUTER",2); EnvExitRouter(theEnv,EXIT_FAILURE); } if (head->readWriteType != READ_STRING) return(0); if (head->currentPosition > 0) { head->currentPosition--; } return(1); }
globle int rm3( void *theEnv, void *str, size_t size) { struct memoryPtr *memPtr; if (size == 0) { SystemError(theEnv,(char*)"MEMORY",1); EnvExitRouter(theEnv,EXIT_FAILURE); } if (size < (long) sizeof(char *)) size = sizeof(char *); if (size >= MEM_TABLE_SIZE) return(genfree(theEnv,(void *) str,(unsigned long) size)); memPtr = (struct memoryPtr *) str; memPtr->next = MemoryData(theEnv)->MemoryTable[(int) size]; MemoryData(theEnv)->MemoryTable[(int) size] = memPtr; return(1); }
static void EmptyDrive( void *theEnv, struct joinNode *join, struct partialMatch *rhsBinds) { struct partialMatch *linker; struct joinNode *listOfJoins; int joinExpr; /*======================================================*/ /* Determine if the alpha memory partial match satifies */ /* the join expression. If it doesn't then no further */ /* action is taken. */ /*======================================================*/ if (join->networkTest != NULL) { joinExpr = EvaluateJoinExpression(theEnv,join->networkTest,NULL,rhsBinds,join); EvaluationData(theEnv)->EvaluationError = FALSE; if (joinExpr == FALSE) return; } /*===========================================================*/ /* The first join of a rule cannot be connected to a NOT CE. */ /*===========================================================*/ if (join->patternIsNegated == TRUE) { SystemError(theEnv,"DRIVE",2); EnvExitRouter(theEnv,EXIT_FAILURE); } /*=========================================================*/ /* If the join's RHS entry is associated with a pattern CE */ /* (positive entry), then copy the alpha memory partial */ /* match and send it to all child joins. */ /*=========================================================*/ linker = CopyPartialMatch(theEnv,rhsBinds, (join->ruleToActivate == NULL) ? 0 : 1, (int) join->logicalJoin); /*=======================================================*/ /* Add the partial match to the beta memory of the join. */ /*=======================================================*/ linker->next = join->beta; join->beta = linker; /*====================================================*/ /* Activate the rule satisfied by this partial match. */ /*====================================================*/ if (join->ruleToActivate != NULL) AddActivation(theEnv,join->ruleToActivate,linker); /*============================================*/ /* Send the partial match to all child joins. */ /*============================================*/ listOfJoins = join->nextLevel; while (listOfJoins != NULL) { NetworkAssert(theEnv,linker,listOfJoins,LHS); listOfJoins = listOfJoins->rightDriveNode; } }
globle void NetworkAssert( void *theEnv, struct partialMatch *binds, struct joinNode *join, int enterDirection) { struct partialMatch *lhsBinds = NULL, *rhsBinds = NULL; struct partialMatch *comparePMs = NULL, *newBinds; int exprResult; /*=========================================================*/ /* If an incremental reset is being performed and the join */ /* is not part of the network to be reset, then return. */ /*=========================================================*/ #if INCREMENTAL_RESET && (! BLOAD_ONLY) && (! RUN_TIME) if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return; #endif /*=========================================================*/ /* If the associated LHS pattern is a not CE or the join */ /* is a nand join, then we need an additional field in the */ /* partial match to keep track of the pseudo fact if one */ /* is created. The partial match is automatically stored */ /* in the beta memory and the counterf slot is used to */ /* determine if it is an actual partial match. If counterf */ /* is TRUE, there are one or more fact or instances */ /* keeping the not or nand join from being satisfied. */ /*=========================================================*/ if ((enterDirection == LHS) && ((join->patternIsNegated) || (join->joinFromTheRight))) { newBinds = AddSingleMatch(theEnv,binds,NULL, (join->ruleToActivate == NULL) ? 0 : 1, (int) join->logicalJoin); newBinds->notOriginf = TRUE; newBinds->counterf = TRUE; binds = newBinds; binds->next = join->beta; join->beta = binds; } /*==================================================*/ /* Use a special routine if this is the first join. */ /*==================================================*/ if (join->firstJoin) { EmptyDrive(theEnv,join,binds); return; } /*==================================================*/ /* Initialize some variables used to indicate which */ /* side is being compared to the new partial match. */ /*==================================================*/ if (enterDirection == LHS) { if (join->joinFromTheRight) { comparePMs = ((struct joinNode *) join->rightSideEntryStructure)->beta;} else { comparePMs = ((struct patternNodeHeader *) join->rightSideEntryStructure)->alphaMemory; } lhsBinds = binds; } else if (enterDirection == RHS) { if (join->patternIsNegated || join->joinFromTheRight) { comparePMs = join->beta; } else { comparePMs = join->lastLevel->beta; } rhsBinds = binds; } else { SystemError(theEnv,"DRIVE",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*===================================================*/ /* Compare each set of binds on the opposite side of */ /* the join with the set of binds that entered this */ /* join. If the binds don't mismatch, then perform */ /* the appropriate action for the logic of the join. */ /*===================================================*/ while (comparePMs != NULL) { /*===========================================================*/ /* Initialize some variables pointing to the partial matches */ /* in the LHS and RHS of the join. In addition, check for */ /* certain conditions under which the partial match can be */ /* skipped since it's not a "real" partial match. */ /*===========================================================*/ if (enterDirection == RHS) { lhsBinds = comparePMs; /*=====================================================*/ /* The partial matches entering from the LHS of a join */ /* are stored in the beta memory of the previous join */ /* (unless the current join is a join from the right */ /* or is attached to a not CE). If the previous join */ /* is a join from the right or associated with a not */ /* CE, then some of its partial matches in its beta */ /* memory will not be "real" partial matches. That is, */ /* there may be a partial match in the alpha memory */ /* that prevents the partial match from satisfying the */ /* join's conditions. If this is the case, then the */ /* counterf flag in the partial match will be set to */ /* TRUE and in this case, we move on to the next */ /* partial match to be checked. */ /*=====================================================*/ if (lhsBinds->counterf && (join->patternIsNegated == FALSE) && (join->joinFromTheRight == FALSE)) { comparePMs = comparePMs->next; continue; } /*==================================================*/ /* If the join is associated with a not CE or has a */ /* join from the right, then the LHS partial match */ /* currently being checked may already have a */ /* partial match from the alpha memory preventing */ /* it from being satisfied. If this is the case, */ /* then move on to the next partial match in the */ /* beta memory of the join. */ /*==================================================*/ if ((join->patternIsNegated || join->joinFromTheRight) && (lhsBinds->counterf)) { comparePMs = comparePMs->next; continue; } } else { rhsBinds = comparePMs; } /*========================================================*/ /* If the join has no expression associated with it, then */ /* the new partial match derived from the LHS and RHS */ /* partial matches is valid. In the event that the join */ /* is a join from the right, it must also be checked that */ /* the RHS partial match is the same partial match that */ /* the LHS partial match was generated from. Each LHS */ /* partial match in a join from the right corresponds */ /* uniquely to a partial match from the RHS of the join. */ /* To determine whether the LHS partial match is the one */ /* associated with the RHS partial match, we compare the */ /* the entity addresses found in the partial matches to */ /* make sure they're equal. */ /*========================================================*/ if (join->networkTest == NULL) { exprResult = TRUE; if (join->joinFromTheRight) { int i; for (i = 0; i < (int) (lhsBinds->bcount - 1); i++) { if (lhsBinds->binds[i].gm.theMatch != rhsBinds->binds[i].gm.theMatch) { exprResult = FALSE; break; } } } } /*=========================================================*/ /* If the join has an expression associated with it, then */ /* evaluate the expression to determine if the new partial */ /* match derived from the LHS and RHS partial matches is */ /* valid (i.e. variable bindings are consistent and */ /* predicate expressions evaluate to TRUE). */ /*=========================================================*/ else { exprResult = EvaluateJoinExpression(theEnv,join->networkTest,lhsBinds,rhsBinds,join); if (EvaluationData(theEnv)->EvaluationError) { if (join->patternIsNegated) exprResult = TRUE; SetEvaluationError(theEnv,FALSE); } } /*====================================================*/ /* If the join expression evaluated to TRUE (i.e. */ /* there were no conflicts between variable bindings, */ /* all tests were satisfied, etc.), then perform the */ /* appropriate action given the logic of this join. */ /*====================================================*/ if (exprResult != FALSE) { /*==============================================*/ /* Use the PPDrive routine when the join isn't */ /* associated with a not CE and it doesn't have */ /* a join from the right. */ /*==============================================*/ if ((join->patternIsNegated == FALSE) && (join->joinFromTheRight == FALSE)) { PPDrive(theEnv,lhsBinds,rhsBinds,join); } /*=====================================================*/ /* Use the PNRDrive routine when the new partial match */ /* enters from the RHS of the join and the join either */ /* is associated with a not CE or has a join from the */ /* right. */ /*=====================================================*/ else if (enterDirection == RHS) { PNRDrive(theEnv,join,comparePMs,rhsBinds); } /*===========================================================*/ /* If the new partial match entered from the LHS of the join */ /* and the join is either associated with a not CE or the */ /* join has a join from the right, then mark the LHS partial */ /* match indicating that there is a RHS partial match */ /* preventing this join from being satisfied. Once this has */ /* happened, the other RHS partial matches don't have to be */ /* tested since it only takes one partial match to prevent */ /* the LHS from being satisfied. */ /*===========================================================*/ else if (enterDirection == LHS) { binds->binds[binds->bcount - 1].gm.theValue = (void *) rhsBinds; comparePMs = NULL; continue; } } /*====================================*/ /* Move on to the next partial match. */ /*====================================*/ comparePMs = comparePMs->next; } /*==================================================================*/ /* If a join with an associated not CE or join from the right was */ /* entered from the LHS side of the join, and the join expression */ /* failed for all sets of matches for the new bindings on the LHS */ /* side (there was no RHS partial match preventing the LHS partial */ /* match from being satisfied), then the LHS partial match appended */ /* with an pseudo-fact that represents the instance of the not */ /* pattern or join from the right that was satisfied should be sent */ /* to the joins below this join. */ /*==================================================================*/ if ((join->patternIsNegated || join->joinFromTheRight) && (enterDirection == LHS) && (binds->binds[binds->bcount - 1].gm.theValue == NULL)) { PNLDrive(theEnv,join,binds); } return; }
static struct lhsParseNode *ConjuctiveRestrictionParse( void *theEnv, char *readSource, struct token *theToken, int *error) { struct lhsParseNode *bindNode; struct lhsParseNode *theNode, *nextOr, *nextAnd; int connectorType; /*=====================================*/ /* Get the first node and determine if */ /* it is a binding variable. */ /*=====================================*/ theNode = LiteralRestrictionParse(theEnv,readSource,theToken,error); if (*error == TRUE) { return(NULL); } GetToken(theEnv,readSource,theToken); if (((theNode->type == SF_VARIABLE) || (theNode->type == MF_VARIABLE)) && (theNode->negated == FALSE) && (theToken->type != OR_CONSTRAINT)) { theNode->bindingVariable = TRUE; bindNode = theNode; nextOr = NULL; nextAnd = NULL; } else { bindNode = GetLHSParseNode(theEnv); if (theNode->type == MF_VARIABLE) bindNode->type = MF_WILDCARD; else bindNode->type = SF_WILDCARD; bindNode->negated = FALSE; bindNode->bottom = theNode; nextOr = theNode; nextAnd = theNode; } /*===================================*/ /* Process the connected constraints */ /* within the constraint */ /*===================================*/ while ((theToken->type == OR_CONSTRAINT) || (theToken->type == AND_CONSTRAINT)) { /*==========================*/ /* Get the next constraint. */ /*==========================*/ connectorType = theToken->type; GetToken(theEnv,readSource,theToken); theNode = LiteralRestrictionParse(theEnv,readSource,theToken,error); if (*error == TRUE) { ReturnLHSParseNodes(theEnv,bindNode); return(NULL); } /*=======================================*/ /* Attach the new constraint to the list */ /* of constraints for this field. */ /*=======================================*/ if (connectorType == OR_CONSTRAINT) { if (nextOr == NULL) { bindNode->bottom = theNode; } else { nextOr->bottom = theNode; } nextOr = theNode; nextAnd = theNode; } else if (connectorType == AND_CONSTRAINT) { if (nextAnd == NULL) { bindNode->bottom = theNode; nextOr = theNode; } else { nextAnd->right = theNode; } nextAnd = theNode; } else { SystemError(theEnv,"RULEPSR",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*==================================================*/ /* Determine if any more restrictions are connected */ /* to the current list of restrictions. */ /*==================================================*/ GetToken(theEnv,readSource,theToken); } /*==========================================*/ /* Check for illegal mixing of single and */ /* multifield values within the constraint. */ /*==========================================*/ if (CheckForVariableMixing(theEnv,bindNode)) { *error = TRUE; ReturnLHSParseNodes(theEnv,bindNode); return(NULL); } /*========================*/ /* Return the constraint. */ /*========================*/ return(bindNode); }
globle void GetNextPatternEntity( void *theEnv, struct patternParser **theParser, struct patternEntity **theEntity) { /*=============================================================*/ /* If the current parser is NULL, then we want to retrieve the */ /* very first data entity. The traversal of entities is done */ /* by entity type (e.g. all facts are traversed followed by */ /* all instances). To get the first entity type to traverse, */ /* the current parser is set to the first parser on the list */ /* of pattern parsers. */ /*=============================================================*/ if (*theParser == NULL) { *theParser = PatternData(theEnv)->ListOfPatternParsers; *theEntity = NULL; } /*================================================================*/ /* Otherwise try to retrieve the next entity following the entity */ /* returned by the last call to GetNextEntity. If that entity was */ /* the last of its data type, then move on to the next pattern */ /* parser, otherwise return that entity as the next one. */ /*================================================================*/ else if (theEntity != NULL) { *theEntity = (struct patternEntity *) (*(*theParser)->entityType->base.getNextFunction)(theEnv,*theEntity); if ((*theEntity) != NULL) return; *theParser = (*theParser)->next; } /*===============================================================*/ /* Otherwise, we encountered a situation which should not occur. */ /* Once a NULL entity is returned from GetNextEntity, it should */ /* not be passed back to GetNextEntity. */ /*===============================================================*/ else { SystemError(theEnv,"PATTERN",1); EnvExitRouter(theEnv,EXIT_FAILURE); } /*================================================*/ /* Keep looping through the lists of entities and */ /* pattern parsers until an entity is found. */ /*================================================*/ while ((*theEntity == NULL) && (*theParser != NULL)) { *theEntity = (struct patternEntity *) (*(*theParser)->entityType->base.getNextFunction)(theEnv,*theEntity); if (*theEntity != NULL) return; *theParser = (*theParser)->next; } return; }
globle void FieldConversion( void *theEnv, struct lhsParseNode *theField, struct lhsParseNode *thePattern, struct nandFrame *theNandFrames) { int testInPatternNetwork = TRUE; struct lhsParseNode *patternPtr; struct expr *headOfPNExpression, *headOfJNExpression; struct expr *lastPNExpression, *lastJNExpression; struct expr *tempExpression; struct expr *patternNetTest = NULL; struct expr *joinNetTest = NULL; struct expr *constantSelector = NULL; struct expr *constantValue = NULL; /*==================================================*/ /* Consider a NULL pointer to be an internal error. */ /*==================================================*/ if (theField == NULL) { SystemError(theEnv,"ANALYSIS",3); EnvExitRouter(theEnv,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); } } /*=============================================================*/ /* 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; for (patternPtr = theField->bottom; patternPtr != NULL; patternPtr = patternPtr->bottom) { /*=============================================*/ /* Extract pattern and join network tests from */ /* the or'ed constraint being examined. */ /*=============================================*/ ExtractAnds(theEnv,patternPtr,testInPatternNetwork,&patternNetTest,&joinNetTest, &constantSelector,&constantValue,theNandFrames); /*=============================================================*/ /* 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,constantSelector); ReturnExpression(theEnv,constantValue); ReturnExpression(theEnv,theField->constantSelector); ReturnExpression(theEnv,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; } } /*==========================================================*/ /* 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,FCALL,ExpressionData(theEnv)->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,FCALL,ExpressionData(theEnv)->PTR_OR); tempExpression->argList = headOfJNExpression; headOfJNExpression = 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,theField,theField->referringNode); headOfPNExpression = CombineExpressions(theEnv,tempExpression,headOfPNExpression); } /*====================================*/ /* Otherwise, the variable comparison */ /* must occur in the join network. */ /*====================================*/ else if (theField->referringNode->pattern > 0) { AddNandUnification(theEnv,theField,theNandFrames); /*====================================*/ /* Generate an expression to test the */ /* variable in a non-nand join. */ /*====================================*/ tempExpression = GenJNVariableComparison(theEnv,theField,theField->referringNode,FALSE); headOfJNExpression = CombineExpressions(theEnv,tempExpression,headOfJNExpression); /*==========================*/ /* Generate the hash index. */ /*==========================*/ if (theField->patternType->genGetPNValueFunction != NULL) { tempExpression = (*theField->patternType->genGetPNValueFunction)(theEnv,theField); thePattern->rightHash = AppendExpressions(tempExpression,thePattern->rightHash); } if (theField->referringNode->patternType->genGetJNValueFunction) { tempExpression = (*theField->referringNode->patternType->genGetJNValueFunction)(theEnv,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,thePattern->networkTest,headOfJNExpression); }
globle int EvaluateExpression( void *theEnv, struct expr *problem, DATA_OBJECT_PTR returnValue) { struct expr *oldArgument; void *oldContext; struct FunctionDefinition *fptr; #if PROFILING_FUNCTIONS struct profileFrameInfo profileFrame; #endif if (problem == NULL) { returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); return(EvaluationData(theEnv)->EvaluationError); } switch (problem->type) { case STRING: case SYMBOL: case FLOAT: case INTEGER: #if OBJECT_SYSTEM case INSTANCE_NAME: case INSTANCE_ADDRESS: #endif case EXTERNAL_ADDRESS: returnValue->type = problem->type; returnValue->value = problem->value; break; case DATA_OBJECT_ARRAY: /* TBD Remove with AddPrimitive */ returnValue->type = problem->type; returnValue->value = problem->value; break; case FCALL: { fptr = (struct FunctionDefinition *) problem->value; oldContext = SetEnvironmentFunctionContext(theEnv,fptr->context); #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &fptr->usrData, ProfileFunctionData(theEnv)->ProfileUserFunctions); #endif oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = problem; switch(fptr->returnValueType) { case 'v' : if (fptr->environmentAware) { (* (void (*)(void *)) fptr->functionPointer)(theEnv); } else { (* (void (*)(void)) fptr->functionPointer)(); } returnValue->type = RVOID; returnValue->value = EnvFalseSymbol(theEnv); break; case 'b' : returnValue->type = SYMBOL; if (fptr->environmentAware) { if ((* (int (*)(void *)) fptr->functionPointer)(theEnv)) returnValue->value = EnvTrueSymbol(theEnv); else returnValue->value = EnvFalseSymbol(theEnv); } else { if ((* (int (*)(void)) fptr->functionPointer)()) returnValue->value = EnvTrueSymbol(theEnv); else returnValue->value = EnvFalseSymbol(theEnv); } break; case 'a' : returnValue->type = EXTERNAL_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } break; case 'g' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(* (long long (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(* (long long (*)(void)) fptr->functionPointer)()); } break; case 'i' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (int (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (int (*)(void)) fptr->functionPointer)()); } break; case 'l' : returnValue->type = INTEGER; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (long int (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddLong(theEnv,(long long) (* (long int (*)(void)) fptr->functionPointer)()); } break; case 'f' : returnValue->type = FLOAT; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddDouble(theEnv,(double) (* (float (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddDouble(theEnv,(double) (* (float (*)(void)) fptr->functionPointer)()); } break; case 'd' : returnValue->type = FLOAT; if (fptr->environmentAware) { returnValue->value = (void *) EnvAddDouble(theEnv,(* (double (*)(void *)) fptr->functionPointer)(theEnv)); } else { returnValue->value = (void *) EnvAddDouble(theEnv,(* (double (*)(void)) fptr->functionPointer)()); } break; case 's' : returnValue->type = STRING; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; case 'w' : returnValue->type = SYMBOL; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; #if OBJECT_SYSTEM case 'x' : returnValue->type = INSTANCE_ADDRESS; if (fptr->environmentAware) { returnValue->value = (* (void *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (* (void *(*)(void)) fptr->functionPointer)(); } break; case 'o' : returnValue->type = INSTANCE_NAME; if (fptr->environmentAware) { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void *)) fptr->functionPointer)(theEnv); } else { returnValue->value = (void *) (* (SYMBOL_HN *(*)(void)) fptr->functionPointer)(); } break; #endif case 'c' : { char cbuff[2]; if (fptr->environmentAware) { cbuff[0] = (* (char (*)(void *)) fptr->functionPointer)(theEnv); } else { cbuff[0] = (* (char (*)(void)) fptr->functionPointer)(); } cbuff[1] = EOS; returnValue->type = SYMBOL; returnValue->value = (void *) EnvAddSymbol(theEnv,cbuff); break; } case 'j' : case 'k' : case 'm' : case 'n' : case 'u' : if (fptr->environmentAware) { (* (void (*)(void *,DATA_OBJECT_PTR)) fptr->functionPointer)(theEnv,returnValue); } else { (* (void (*)(DATA_OBJECT_PTR)) fptr->functionPointer)(returnValue); } break; default : SystemError(theEnv,"EVALUATN",2); EnvExitRouter(theEnv,EXIT_FAILURE); break; } #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif SetEnvironmentFunctionContext(theEnv,oldContext); EvaluationData(theEnv)->CurrentExpression = oldArgument; break; } case MULTIFIELD: returnValue->type = MULTIFIELD; returnValue->value = ((DATA_OBJECT_PTR) (problem->value))->value; returnValue->begin = ((DATA_OBJECT_PTR) (problem->value))->begin; returnValue->end = ((DATA_OBJECT_PTR) (problem->value))->end; break; case MF_VARIABLE: case SF_VARIABLE: if (GetBoundVariable(theEnv,returnValue,(SYMBOL_HN *) problem->value) == FALSE) { PrintErrorID(theEnv,"EVALUATN",1,FALSE); EnvPrintRouter(theEnv,WERROR,"Variable "); EnvPrintRouter(theEnv,WERROR,ValueToString(problem->value)); EnvPrintRouter(theEnv,WERROR," is unbound\n"); returnValue->type = SYMBOL; returnValue->value = EnvFalseSymbol(theEnv); SetEvaluationError(theEnv,TRUE); } break; default: if (EvaluationData(theEnv)->PrimitivesArray[problem->type] == NULL) { SystemError(theEnv,"EVALUATN",3); EnvExitRouter(theEnv,EXIT_FAILURE); } if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->copyToEvaluate) { returnValue->type = problem->type; returnValue->value = problem->value; break; } if (EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction == NULL) { SystemError(theEnv,"EVALUATN",4); EnvExitRouter(theEnv,EXIT_FAILURE); } oldArgument = EvaluationData(theEnv)->CurrentExpression; EvaluationData(theEnv)->CurrentExpression = problem; #if PROFILING_FUNCTIONS StartProfile(theEnv,&profileFrame, &EvaluationData(theEnv)->PrimitivesArray[problem->type]->usrData, ProfileFunctionData(theEnv)->ProfileUserFunctions); #endif (*EvaluationData(theEnv)->PrimitivesArray[problem->type]->evaluateFunction)(theEnv,problem->value,returnValue); #if PROFILING_FUNCTIONS EndProfile(theEnv,&profileFrame); #endif EvaluationData(theEnv)->CurrentExpression = oldArgument; break; } return(EvaluationData(theEnv)->EvaluationError); }
globle void *genlongalloc( void *theEnv, unsigned long size) { #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) unsigned int test; #else void *memPtr; #endif #if BLOCK_MEMORY struct longMemoryPtr *theLongMemory; #endif if (sizeof(int) == sizeof(long)) { return(genalloc(theEnv,(unsigned) size)); } #if (! MAC) && (! IBM_TBC) && (! IBM_MSC) && (! IBM_ICB) && (! IBM_ZTC) && (! IBM_SC) && (! IBM_MCW) test = (unsigned int) size; if (test != size) { PrintErrorID(theEnv,"MEMORY",3,TRUE); EnvPrintRouter(theEnv,WERROR,"Unable to allocate memory block > 32K.\n"); EnvExitRouter(theEnv,EXIT_FAILURE); } return((void *) genalloc(theEnv,(unsigned) test)); #else #if BLOCK_MEMORY size += sizeof(struct longMemoryPtr); #endif memPtr = (void *) SpecialMalloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,(long) ((size * 5 > 4096) ? size * 5 : 4096),FALSE); memPtr = (void *) SpecialMalloc(size); if (memPtr == NULL) { EnvReleaseMem(theEnv,-1L,TRUE); memPtr = (void *) SpecialMalloc(size); while (memPtr == NULL) { if ((*MemoryData(theEnv)->OutOfMemoryFunction)(theEnv,size)) return(NULL); memPtr = (void *) SpecialMalloc(size); } } } MemoryData(theEnv)->MemoryAmount += (long) size; MemoryData(theEnv)->MemoryCalls++; #if BLOCK_MEMORY theLongMemory = (struct longMemoryPtr *) memPtr; theLongMemory->next = MemoryData(theEnv)->TopLongMemoryPtr; theLongMemory->prev = NULL; theLongMemory->size = (long) size; memPtr = (void *) (theLongMemory + 1); #endif return(memPtr); #endif }
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 void NetworkRetract( void *theEnv, struct patternMatch *listOfMatchedPatterns) { struct patternMatch *tempMatch; struct partialMatch *deletedMatches, *theLast; struct joinNode *joinPtr; /*===============================*/ /* Remember the beginning of the */ /* list of matched patterns. */ /*===============================*/ tempMatch = listOfMatchedPatterns; /*============================================*/ /* Remove the data entity from all joins that */ /* aren't directly enclosed by a not CE. */ /*============================================*/ for (; listOfMatchedPatterns != NULL; listOfMatchedPatterns = listOfMatchedPatterns->next) { /*====================================*/ /* Loop through the list of all joins */ /* attached to this pattern. */ /*====================================*/ for (joinPtr = listOfMatchedPatterns->matchingPattern->entryJoin; joinPtr != NULL; joinPtr = joinPtr->rightMatchNode) { if (joinPtr->patternIsNegated == FALSE) { PosEntryRetract(theEnv,joinPtr, listOfMatchedPatterns->theMatch->binds[0].gm.theMatch, listOfMatchedPatterns->theMatch, (int) joinPtr->depth - 1,TRUE); } } } /*============================================*/ /* Remove the data entity from all joins that */ /* are directly enclosed by a not CE. */ /*============================================*/ listOfMatchedPatterns = tempMatch; while (listOfMatchedPatterns != NULL) { /*====================================*/ /* Loop through the list of all joins */ /* attached to this pattern. */ /*====================================*/ for (joinPtr = listOfMatchedPatterns->matchingPattern->entryJoin; joinPtr != NULL; joinPtr = joinPtr->rightMatchNode) { if (joinPtr->patternIsNegated == TRUE) { if (joinPtr->firstJoin == TRUE) { SystemError(theEnv,"RETRACT",3); EnvExitRouter(theEnv,EXIT_FAILURE); } else { NegEntryRetract(theEnv,joinPtr,listOfMatchedPatterns->theMatch,TRUE); } } } /*===================================================*/ /* Remove from the alpha memory of the pattern node. */ /*===================================================*/ theLast = NULL; listOfMatchedPatterns->matchingPattern->alphaMemory = RemovePartialMatches(theEnv,listOfMatchedPatterns->theMatch->binds[0].gm.theMatch, listOfMatchedPatterns->matchingPattern->alphaMemory, &deletedMatches,0,&theLast); listOfMatchedPatterns->matchingPattern->endOfQueue = theLast; DeletePartialMatches(theEnv,deletedMatches,0); tempMatch = listOfMatchedPatterns->next; rtn_struct(theEnv,patternMatch,listOfMatchedPatterns); listOfMatchedPatterns = tempMatch; } /*=========================================*/ /* Filter new partial matches generated by */ /* retraction through the join network. */ /*=========================================*/ DriveRetractions(theEnv); }