drive.c

clips源代码

      oldJoin = EngineData(theEnv)->GlobalJoin;
      EngineData(theEnv)->GlobalLHSBinds = lhsBinds;
      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 (rhsBinds != NULL)
     {
      join->memoryCompares++;

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

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

      /*====================================================*/
      /* 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->patternIsExists == FALSE) &&
             (join->joinFromTheRight == FALSE))
           { PPDrive(theEnv,lhsBinds,rhsBinds,join); }

         /*==================================================*/
         /* At most, one partial match will be generated for */
         /* a match from the right memory of an exists CE.   */
         /*==================================================*/
         
         else if (join->patternIsExists)
           { 
            AddBlockedLink(lhsBinds,rhsBinds);
            PPDrive(theEnv,lhsBinds,NULL,join);
            EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds;
            EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds;
            EngineData(theEnv)->GlobalJoin = oldJoin;
            return;
           }
           
         /*===========================================================*/
         /* 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
           {
            AddBlockedLink(lhsBinds,rhsBinds);
            break;
           }
        }

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

      rhsBinds = rhsBinds->nextInMemory;
     }

   /*==================================================================*/
   /* 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) && 
       (! join->patternIsExists) &&
       (lhsBinds->marker == NULL))
     {
      if (join->secondaryNetworkTest != NULL)
        {
         EngineData(theEnv)->GlobalRHSBinds = NULL;
         
         exprResult = EvaluateJoinExpression(theEnv,join->secondaryNetworkTest,join);
         if (EvaluationData(theEnv)->EvaluationError)
           { SetEvaluationError(theEnv,FALSE); }
           
         if (exprResult)
            { PPDrive(theEnv,lhsBinds,NULL,join); }
         else
           { exprResult = FALSE; }
        }
      else
        { PPDrive(theEnv,lhsBinds,NULL,join); } 
     }

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

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

   return;
  }

/*******************************************************/
/* EvaluateJoinExpression: Evaluates join expressions. */
/*   Performs a faster evaluation for join expressions */
/*   than if EvaluateExpression was used directly.     */
/*******************************************************/
globle intBool EvaluateJoinExpression(
  void *theEnv,
  struct expr *joinExpr,
  struct joinNode *joinPtr)
  {
   DATA_OBJECT theResult;
   int andLogic, result = TRUE;

   /*======================================*/
   /* A NULL expression evaluates to TRUE. */
   /*======================================*/

   if (joinExpr == NULL) return(TRUE);

   /*====================================================*/
   /* Initialize some variables which allow this routine */
   /* to avoid calling the "and" and "or" functions if   */
   /* they are the first part of the expression to be    */
   /* evaluated. Most of the join expressions do not use */
   /* deeply nested and/or functions so this technique   */
   /* speeds up evaluation.                              */
   /*====================================================*/

   if (joinExpr->value == ExpressionData(theEnv)->PTR_AND)
     {
      andLogic = TRUE;
      joinExpr = joinExpr->argList;
     }
   else if (joinExpr->value == ExpressionData(theEnv)->PTR_OR)
     {
      andLogic = FALSE;
      joinExpr = joinExpr->argList;
     }
   else
     { andLogic = TRUE; }

   /*=========================================*/
   /* Evaluate each of the expressions linked */
   /* together in the join expression.        */
   /*=========================================*/

   while (joinExpr != NULL)
     {
      /*================================*/
      /* Evaluate a primitive function. */
      /*================================*/

      if ((EvaluationData(theEnv)->PrimitivesArray[joinExpr->type] == NULL) ?
          FALSE :
          EvaluationData(theEnv)->PrimitivesArray[joinExpr->type]->evaluateFunction != NULL)
        {
         struct expr *oldArgument;

         oldArgument = EvaluationData(theEnv)->CurrentExpression;
         EvaluationData(theEnv)->CurrentExpression = joinExpr;
         result = (*EvaluationData(theEnv)->PrimitivesArray[joinExpr->type]->evaluateFunction)(theEnv,joinExpr->value,&theResult);
         EvaluationData(theEnv)->CurrentExpression = oldArgument;
        }

      /*=============================*/
      /* Evaluate the "or" function. */
      /*=============================*/

      else if (joinExpr->value == ExpressionData(theEnv)->PTR_OR)
        {
         result = FALSE;
         if (EvaluateJoinExpression(theEnv,joinExpr,joinPtr) == TRUE)
           {
            if (EvaluationData(theEnv)->EvaluationError)
              { return(FALSE); }
            result = TRUE;
           }
         else if (EvaluationData(theEnv)->EvaluationError)
           { return(FALSE); }
        }

      /*==============================*/
      /* Evaluate the "and" function. */
      /*==============================*/

      else if (joinExpr->value == ExpressionData(theEnv)->PTR_AND)
        {
         result = TRUE;
         if (EvaluateJoinExpression(theEnv,joinExpr,joinPtr) == FALSE)
           {
            if (EvaluationData(theEnv)->EvaluationError)
              { return(FALSE); }
            result = FALSE;
           }
         else if (EvaluationData(theEnv)->EvaluationError)
           { return(FALSE); }
        }

      /*==========================================================*/
      /* Evaluate all other expressions using EvaluateExpression. */
      /*==========================================================*/

      else
        {
         EvaluateExpression(theEnv,joinExpr,&theResult);

         if (EvaluationData(theEnv)->EvaluationError)
           {
            JoinNetErrorMessage(theEnv,joinPtr);
            return(FALSE);
           }

         if ((theResult.value == EnvFalseSymbol(theEnv)) && (theResult.type == SYMBOL))
           { result = FALSE; }
         else
           { result = TRUE; }
        }

      /*====================================*/
      /* Handle the short cut evaluation of */
      /* the "and" and "or" functions.      */
      /*====================================*/

      if ((andLogic == TRUE) && (result == FALSE))
        { return(FALSE); }
      else if ((andLogic == FALSE) && (result == TRUE))
        { return(TRUE); }

      /*==============================================*/
      /* Move to the next expression to be evaluated. */
      /*==============================================*/

      joinExpr = joinExpr->nextArg;
     }

   /*=================================================*/
   /* Return the result of evaluating the expression. */
   /*=================================================*/

   return(result);
  }

/*******************************************************/
/* EvaluateSecondaryNetworkTest:     */
/*******************************************************/
globle intBool EvaluateSecondaryNetworkTest(
  void *theEnv,
  struct partialMatch *leftMatch,
  struct joinNode *joinPtr)
  {
   int joinExpr;
   struct partialMatch *oldLHSBinds;
   struct partialMatch *oldRHSBinds;
   struct joinNode *oldJoin;

   if (joinPtr->secondaryNetworkTest == NULL)
     { return(TRUE); }
        
#if DEVELOPER
   EngineData(theEnv)->rightToLeftComparisons++;
#endif
   oldLHSBinds = EngineData(theEnv)->GlobalLHSBinds;
   oldRHSBinds = EngineData(theEnv)->GlobalRHSBinds;
   oldJoin = EngineData(theEnv)->GlobalJoin;
   EngineData(theEnv)->GlobalLHSBinds = leftMatch;
   EngineData(theEnv)->GlobalRHSBinds = NULL;
   EngineData(theEnv)->GlobalJoin = joinPtr;

   joinExpr = EvaluateJoinExpression(theEnv,joinPtr->secondaryNetworkTest,joinPtr);
   EvaluationData(theEnv)->EvaluationError = FALSE;

   EngineData(theEnv)->GlobalLHSBinds = oldLHSBinds;
   EngineData(theEnv)->GlobalRHSBinds = oldRHSBinds;
   EngineData(theEnv)->GlobalJoin = oldJoin;

   return(joinExpr);
  }

/*******************************************************/
/* BetaMemoryHashValue:     */
/*******************************************************/
globle unsigned long BetaMemoryHashValue(
  void *theEnv,
  struct expr *hashExpr,
  struct partialMatch *lbinds,
  struct partialMatch *rbinds,
  struct joinNode *joinPtr,
  struct compareFrame *frame)
  {
   DATA_OBJECT theResult;
   struct partialMatch *oldLHSBinds;
   struct partialMatch *oldRHSBinds;
   struct joinNode *oldJoin;
   int i = 0;
   unsigned long hashValue = 0;
   unsigned long multiplier = 1;
   
   /*======================================*/
   /* A NULL expression evaluates to zero. */
   /*======================================*/

   if (hashExpr == NULL) return(0);

   /*=========================================*/