drive.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.30  10/19/06            */
   /*                                                     */
   /*                    DRIVE MODULE                     */
   /*******************************************************/

/*************************************************************/
/* Purpose: Handles join network activity associated with    */
/*   with the addition of a data entity such as a fact or    */
/*   instance.                                               */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*      6.24: Removed INCREMENTAL_RESET and                  */
/*            LOGICAL_DEPENDENCIES compilation flags.        */
/*                                                           */
/*            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 CE.           */
/*                                                           */
/*************************************************************/

#define _DRIVE_SOURCE_

#include <stdio.h>
#define _STDIO_INCLUDED_
#include <stdlib.h>

#include "setup.h"

#if DEFRULE_CONSTRUCT

#include "agenda.h"
#include "constant.h"
#include "engine.h"
#include "envrnmnt.h"
#include "memalloc.h"
#include "prntutil.h"
#include "reteutil.h"
#include "retract.h"
#include "router.h"
#include "lgcldpnd.h"
#include "incrrset.h"

#include "drive.h"  
  
/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

   static void                    EmptyDrive(void *,struct joinNode *,struct partialMatch *);
   static void                    JoinNetErrorMessage(void *,struct joinNode *);
   
/************************************************/
/* NetworkAssert: Primary routine for filtering */
/*   a partial match through the join network.  */
/************************************************/
globle void NetworkAssert(
  void *theEnv,
  struct partialMatch *binds,
  struct joinNode *join)
  {
   /*=========================================================*/
   /* If an incremental reset is being performed and the join */
   /* is not part of the network to be reset, then return.    */
   /*=========================================================*/

#if (! BLOAD_ONLY) && (! RUN_TIME)
   if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return;
#endif

   /*==================================================*/
   /* Use a special routine if this is the first join. */
   /*==================================================*/

   if (join->firstJoin)
     {
      EmptyDrive(theEnv,join,binds);
      return;
     }

   /*================================*/
   /* Enter the join from the right. */
   /*================================*/

   NetworkAssertRight(theEnv,binds,join);

   return;
  }

/*****************************************************/
/* NetworkAssertRight: Primary routine for filtering */
/*   a partial match through the join network from   */
/*   the RHS of a join.                              */
/*****************************************************/
globle void NetworkAssertRight(
  void *theEnv,
  struct partialMatch *rhsBinds,
  struct joinNode *join)
  {
   struct partialMatch *lhsBinds, *nextBind;
   int exprResult, restore = FALSE;
   struct partialMatch *oldLHSBinds = NULL;
   struct partialMatch *oldRHSBinds = NULL;
   struct joinNode *oldJoin = NULL;

   /*=========================================================*/
   /* If an incremental reset is being performed and the join */
   /* is not part of the network to be reset, then return.    */
   /*=========================================================*/

#if (! BLOAD_ONLY) && (! RUN_TIME)
   if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return;
#endif

   if (join->firstJoin)
     {
      EmptyDrive(theEnv,join,rhsBinds);
      return;
     }
  
   /*=====================================================*/
   /* The partial matches entering from the LHS of a join */
   /* are stored in the left beta memory of the join.     */
   /*=====================================================*/

   lhsBinds = GetLeftBetaMemory(join,rhsBinds->hashValue);

#if DEVELOPER
   if (lhsBinds != NULL)
     { EngineData(theEnv)->rightToLeftLoops++; }
#endif

   /*====================================*/
   /* Set up the evaluation environment. */
   /*====================================*/
   
   if (lhsBinds != NULL)
     {
      oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds;
      oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds;
      oldJoin = EngineData(theEnv)->GlobalJoin;
      EngineData(theEnv)->GlobalRHSBinds = rhsBinds;
      EngineData(theEnv)->GlobalJoin = join;
      restore = TRUE;
     }
    
   /*===================================================*/
   /* 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 (lhsBinds != NULL)
     {
      nextBind = lhsBinds->nextInMemory;
      join->memoryCompares++;
      
      /*===========================================================*/
      /* Initialize some variables pointing to the partial matches */
      /* in the LHS and RHS of the join.                           */
      /*===========================================================*/

      if (lhsBinds->hashValue != rhsBinds->hashValue)
        {
#if DEVELOPER
         if (join->leftMemory->size == 1)
           { EngineData(theEnv)->betaHashListSkips++; }
         else
           { EngineData(theEnv)->betaHashHTSkips++; }
           
         if (lhsBinds->marker != NULL)
           { EngineData(theEnv)->unneededMarkerCompare++; }
#endif
         lhsBinds = nextBind;
         continue;
        }
        
      /*===============================================================*/
      /* If there already is an associated RHS partial match stored in */
      /* the LHS partial match from the beta memory of this join, then */
      /* the exists/nand CE has already been satisfied and we can move */
      /* on to the next partial match found in the beta memory.        */
      /*===============================================================*/
        
      if (lhsBinds->marker != NULL)
        { 
#if DEVELOPER
         EngineData(theEnv)->unneededMarkerCompare++;
#endif
         lhsBinds = nextBind;
         continue;
        }

      /*===================================================*/
      /* If the join has no expression associated with it, */
      /* then the new partial match derived from the LHS   */
      /* and RHS partial matches is valid.                 */
      /*===================================================*/

      if (join->networkTest == NULL)
        { exprResult = TRUE; }

      /*=========================================================*/
      /* 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
        {
#if DEVELOPER
         EngineData(theEnv)->rightToLeftComparisons++;
#endif
         EngineData(theEnv)->GlobalLHSBinds = lhsBinds;
         exprResult = EvaluateJoinExpression(theEnv,join->networkTest,join);
         if (EvaluationData(theEnv)->EvaluationError)
           {
            if (join->patternIsNegated) exprResult = TRUE;
            SetEvaluationError(theEnv,FALSE);
           }

#if DEVELOPER
         if (exprResult)
           { EngineData(theEnv)->rightToLeftSucceeds++; }
#endif
        }

      if ((join->secondaryNetworkTest != NULL) && exprResult)
        {
         /* EngineData(theEnv)->GlobalRHSBinds = NULL; */
         
         exprResult = EvaluateJoinExpression(theEnv,join->secondaryNetworkTest,join);
         if (EvaluationData(theEnv)->EvaluationError)
           { 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)
        {
         if (join->patternIsExists)
           {
            AddBlockedLink(lhsBinds,rhsBinds);
            PPDrive(theEnv,lhsBinds,NULL,join);
           }
         else if (join->patternIsNegated || join->joinFromTheRight)
           {
            AddBlockedLink(lhsBinds,rhsBinds);
            if (lhsBinds->children != NULL)
              { PosEntryRetractBeta(theEnv,lhsBinds,lhsBinds->children); }
            if (lhsBinds->dependents != NULL) 
              { RemoveLogicalSupport(theEnv,lhsBinds); }
           } 
         else
           { PPDrive(theEnv,lhsBinds,rhsBinds,join); }
        }

      /*====================================*/
      /* Move on to the next partial match. */
      /*====================================*/

      lhsBinds = nextBind;
     }

   /*=========================================*/
   /* Restore the old evaluation environment. */
   /*=========================================*/

   if (restore)
     {
      EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds;
      EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds;
      EngineData(theEnv)->GlobalJoin = oldJoin;
     }
     
   return;
  }

/****************************************************/
/* NetworkAssertLeft: Primary routine for filtering */
/*   a partial match through the join network when  */
/*   entering through the left side of a join.      */
/****************************************************/
globle void NetworkAssertLeft(
  void *theEnv,
  struct partialMatch *lhsBinds,
  struct joinNode *join)
  {
   struct partialMatch *rhsBinds;
   int exprResult, restore = FALSE;
   unsigned long entryHashValue;
   struct partialMatch *oldLHSBinds = NULL;
   struct partialMatch *oldRHSBinds = NULL;
   struct joinNode *oldJoin = NULL;

   /*=========================================================*/
   /* If an incremental reset is being performed and the join */
   /* is not part of the network to be reset, then return.    */
   /*=========================================================*/

#if (! BLOAD_ONLY) && (! RUN_TIME)
   if (EngineData(theEnv)->IncrementalResetInProgress && (join->initialize == FALSE)) return;
#endif

   /*===================================*/
   /* The only action for the last join */
   /* of a rule is to activate it.      */
   /*===================================*/
   
   if (join->ruleToActivate != NULL)
     {
      AddActivation(theEnv,join->ruleToActivate,lhsBinds);
      return;
     }

   /*==================================================*/
   /* Initialize some variables used to indicate which */
   /* side is being compared to the new partial match. */
   /*==================================================*/

   entryHashValue = lhsBinds->hashValue;
   if (join->joinFromTheRight)
     { rhsBinds = GetRightBetaMemory(join,entryHashValue); }
   else
     { rhsBinds = GetAlphaMemory(theEnv,(struct patternNodeHeader *) join->rightSideEntryStructure,entryHashValue); }
       
#if DEVELOPER
   if (rhsBinds != NULL)
     { EngineData(theEnv)->leftToRightLoops++; }
#endif
   
   /*====================================*/
   /* Set up the evaluation environment. */
   /*====================================*/
   
   if ((rhsBinds != NULL) || (join->secondaryNetworkTest != NULL))
     {
      oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds;
      oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds;