/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.30  10/19/06            */   /*                                                     */   /*                   RETRACT MODULE                    */   /*******************************************************//*************************************************************//* Purpose:  Handles join network activity associated with   *//*   with the removal of a data entity such as a fact or     *//*   instance.                                               *//*                                                           *//* Principal Programmer(s):                                  *//*      Gary D. Riley                                        *//*                                                           *//* Contributing Programmer(s):                               *//*                                                           *//* Revision History:                                         *//*                                                           *//*      6.24: Removed LOGICAL_DEPENDENCIES compilation flag. *//*                                                           *//*            Renamed BOOLEAN macro type to intBool.         *//*                                                           *//*            Rule with exists CE has incorrect activation.  *//*            DR0867                                         *//*                                                           *//*      6.30: Added support for hashed alpha memories.       *//*                                                           *//*            Added additional developer statistics to help  *//*            analyze join network performance.              *//*                                                           *//*            Removed pseudo-facts used in not CEs.          *//*                                                           *//*************************************************************/#define _RETRACT_SOURCE_#include <stdio.h>#define _STDIO_INCLUDED_#include <stdlib.h>#include "setup.h"#if DEFRULE_CONSTRUCT#include "agenda.h"#include "argacces.h"#include "constant.h"#include "drive.h"#include "engine.h"#include "envrnmnt.h"#include "lgcldpnd.h"#include "match.h"#include "memalloc.h"#include "network.h"#include "reteutil.h"#include "router.h"#include "symbol.h"#include "retract.h"/***************************************//* LOCAL INTERNAL FUNCTION DEFINITIONS *//***************************************/   static void                    ReturnMarkers(void *,struct multifieldMarker *);   static intBool                 FindNextConflictingMatch(void *,struct partialMatch *,                                                           struct partialMatch *,                                                           struct joinNode *,struct partialMatch *,int);   static intBool                 PartialMatchDefunct(void *,struct partialMatch *);   static void                    NegEntryRetractAlpha(void *,struct partialMatch *);   static void                    NegEntryRetractBeta(void *,struct joinNode *,struct partialMatch *,                                                      struct partialMatch *);/************************************************************//* NetworkRetract:  Retracts a data entity (such as a fact  *//*   or instance) from the pattern and join networks given  *//*   a pointer to the list of patterns which the data       *//*   entity matched.                                        *//************************************************************/globle void NetworkRetract(  void *theEnv,  struct patternMatch *listOfMatchedPatterns)  {   struct patternMatch *tempMatch, *nextMatch;   tempMatch = listOfMatchedPatterns;   while (tempMatch != NULL)     {      nextMatch = tempMatch->next;      if (tempMatch->theMatch->children != NULL)        { PosEntryRetractAlpha(theEnv,tempMatch->theMatch); }      if (tempMatch->theMatch->blockList != NULL)        { NegEntryRetractAlpha(theEnv,tempMatch->theMatch); }            /*===================================================*/      /* Remove from the alpha memory of the pattern node. */      /*===================================================*/      RemoveAlphaMemoryMatches(theEnv,tempMatch->matchingPattern,                               tempMatch->theMatch,                               tempMatch->theMatch->binds[0].gm.theMatch);            rtn_struct(theEnv,patternMatch,tempMatch);      tempMatch = nextMatch;     }  }/***************************************************************//* PosEntryRetractAlpha:           *//***************************************************************/globle void PosEntryRetractAlpha(  void *theEnv,  struct partialMatch *alphaMatch)  {   struct partialMatch *betaMatch, *tempMatch;   struct joinNode *joinPtr;      betaMatch = alphaMatch->children;   while (betaMatch != NULL)     {      joinPtr = (struct joinNode *) betaMatch->owner;            if (betaMatch->children != NULL)        { PosEntryRetractBeta(theEnv,betaMatch,betaMatch->children); }      if (betaMatch->rhsMemory)        { NegEntryRetractAlpha(theEnv,betaMatch); }            /* Remove the beta match. */            if ((((struct joinNode *) betaMatch->owner)->ruleToActivate != NULL) ?          (betaMatch->marker != NULL) : FALSE)        { RemoveActivation(theEnv,(struct activation *) betaMatch->marker,TRUE,TRUE); }      tempMatch = betaMatch->nextRightChild;            if (betaMatch->rhsMemory)        { UnlinkBetaPMFromNodeAndLineage(theEnv,betaMatch->owner,betaMatch,RHS); }      else        { UnlinkBetaPMFromNodeAndLineage(theEnv,betaMatch->owner,betaMatch,LHS); }            DeletePartialMatches(theEnv,betaMatch);            betaMatch = tempMatch;          }  }  /***************************************************************//* NegEntryRetractAlpha:           *//***************************************************************/static void NegEntryRetractAlpha(  void *theEnv,  struct partialMatch *alphaMatch)  {   struct partialMatch *betaMatch;   struct joinNode *joinPtr;      betaMatch = alphaMatch->blockList;   while (betaMatch != NULL)     {      joinPtr = (struct joinNode *) betaMatch->owner;            if ((! joinPtr->patternIsNegated) &&          (! joinPtr->patternIsExists) &&          (! joinPtr->joinFromTheRight))        {                        SystemError(theEnv,"RETRACT",117);         betaMatch = betaMatch->nextBlocked;         continue;        }      NegEntryRetractBeta(theEnv,joinPtr,alphaMatch,betaMatch);      betaMatch = alphaMatch->blockList;     }  }/***************************************************************//* NegEntryRetractBeta:           *//***************************************************************/static void NegEntryRetractBeta(  void *theEnv,  struct joinNode *joinPtr,  struct partialMatch *alphaMatch,  struct partialMatch *betaMatch)  {   /*======================================================*/   /* Try to find another RHS partial match which prevents */   /* the LHS partial match from being satisifed.          */   /*======================================================*/   RemoveBlockedLink(betaMatch);   if (FindNextConflictingMatch(theEnv,betaMatch,alphaMatch->nextInMemory,joinPtr,alphaMatch,joinPtr->patternIsExists))     { return; }   else if (joinPtr->patternIsExists)     {       if (betaMatch->children != NULL)        { PosEntryRetractBeta(theEnv,betaMatch,betaMatch->children); }      return;      }   else if (joinPtr->firstJoin && (joinPtr->patternIsNegated || joinPtr->joinFromTheRight) && (! joinPtr->patternIsExists))      {      if (joinPtr->secondaryNetworkTest != NULL)        {         if (EvaluateSecondaryNetworkTest(theEnv,betaMatch,joinPtr) == FALSE)           { return; }        }                EPMDrive(theEnv,betaMatch,joinPtr);      return;     }   if (joinPtr->secondaryNetworkTest != NULL)     {      if (EvaluateSecondaryNetworkTest(theEnv,betaMatch,joinPtr) == FALSE)        { return; }     }              /*=========================================================*/   /* If the LHS partial match now has no RHS partial matches */   /* that conflict with it, then it satisfies the conditions */   /* of the RHS not CE. Create a partial match and send it   */   /* to the joins below.                                     */   /*=========================================================*/         /*===============================*/   /* Create the new partial match. */   /*===============================*/   PPDrive(theEnv,betaMatch,NULL,joinPtr);  }/***************************************************************//* PosEntryRetractBeta:           *//***************************************************************/globle void PosEntryRetractBeta(  void *theEnv,  struct partialMatch *parentMatch,  struct partialMatch *betaMatch)  {   struct partialMatch *tempMatch;    while (betaMatch != NULL)     {      if (betaMatch->children != NULL)        {         betaMatch = betaMatch->children;         continue;        }      if (betaMatch->nextLeftChild != NULL)        { tempMatch = betaMatch->nextLeftChild; }      else        {          tempMatch = betaMatch->leftParent;         betaMatch->leftParent->children = NULL;         }      if (betaMatch->blockList != NULL)        { NegEntryRetractAlpha(theEnv,betaMatch); }      else if ((((struct joinNode *) betaMatch->owner)->ruleToActivate != NULL) ?               (betaMatch->marker != NULL) : FALSE)        { RemoveActivation(theEnv,(struct activation *) betaMatch->marker,TRUE,TRUE); }            if (betaMatch->rhsMemory)        { UnlinkNonLeftLineage(theEnv,betaMatch->owner,betaMatch,RHS); }      else        { UnlinkNonLeftLineage(theEnv,betaMatch->owner,betaMatch,LHS); }       if (betaMatch->dependents != NULL) RemoveLogicalSupport(theEnv,betaMatch);      ReturnPartialMatch(theEnv,betaMatch);          if (tempMatch == parentMatch) return;      betaMatch = tempMatch;           }  }/******************************************************************//* FindNextConflictingMatch: Finds the next conflicting partial   *//*    match in the right memory of a join that prevents a partial *//*    match in the beta memory of the join from being satisfied.  *//******************************************************************/static intBool FindNextConflictingMatch(  void *theEnv,  struct partialMatch *theBind,  struct partialMatch *possibleConflicts,  struct joinNode *theJoin,  struct partialMatch *skipMatch,  int existsCE)  {   int result, restore = FALSE;   struct partialMatch *oldLHSBinds = NULL;   struct partialMatch *oldRHSBinds = NULL;   struct joinNode *oldJoin = NULL;   /*====================================*/   /* Check each of the possible partial */   /* matches which could conflict.      */   /*====================================*/#if DEVELOPER   if (possibleConflicts != NULL)     { EngineData(theEnv)->leftToRightLoops++; }#endif        /*====================================*/   /* Set up the evaluation environment. */   /*====================================*/      if (possibleConflicts != NULL)     {      oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds;      oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds;      oldJoin = EngineData(theEnv)->GlobalJoin;      EngineData(theEnv)->GlobalLHSBinds = theBind;      EngineData(theEnv)->GlobalJoin = theJoin;      restore = TRUE;     }   for (;        possibleConflicts != NULL;        possibleConflicts = possibleConflicts->nextInMemory)     {      theJoin->memoryCompares++;