rulecstr.c

NASA 开发使用的一个专家系统

   
      andConstraints = NULL;
      for (andNode = orNode; andNode != NULL; andNode = andNode->right)
        {
         if (! andNode->negated)
           {
            if (andNode->type == RETURN_VALUE_CONSTRAINT)
              {
               if (andNode->expression->type == FCALL)
                 {
                  rvConstraints = FunctionCallToConstraintRecord(andNode->expression->value);
                  tmpConstraints = andConstraints;
                  andConstraints = IntersectConstraints(andConstraints,rvConstraints);
                  RemoveConstraint(tmpConstraints);
                  RemoveConstraint(rvConstraints);
                 }
              }
            else if (ConstantType(andNode->type))
              {
               tmpExpr = GenConstant(andNode->type,andNode->value);
               rvConstraints = ExpressionToConstraintRecord(tmpExpr);
               tmpConstraints = andConstraints;
               andConstraints = IntersectConstraints(andConstraints,rvConstraints);
               RemoveConstraint(tmpConstraints);
               RemoveConstraint(rvConstraints);
               ReturnExpression(tmpExpr); 
              }
            else if (andNode->constraints != NULL)
              {
               tmpConstraints = andConstraints;
               andConstraints = IntersectConstraints(andConstraints,andNode->constraints);
               RemoveConstraint(tmpConstraints);
              }
           }
        }
        
      /*===========================================================*/
      /* Intersect the &'ed constraints with the slot constraints. */
      /*===========================================================*/
      
      tmpConstraints = andConstraints;
      andConstraints = IntersectConstraints(andConstraints,theNode->constraints);
      RemoveConstraint(tmpConstraints);
               
      /*===============================================================*/
      /* Remove any negated constants from the list of allowed values. */
      /*===============================================================*/
      
      for (andNode = orNode; andNode != NULL; andNode = andNode->right)
        {
         if ((andNode->negated) && ConstantType(andNode->type))
             { RemoveConstantFromConstraint(andNode->type,andNode->value,andConstraints); }
        }
        
      /*=======================================================*/
      /* Union the &'ed constraints with the |'ed constraints. */
      /*=======================================================*/
      
      tmpConstraints = orConstraints;
      orConstraints = UnionConstraints(orConstraints,andConstraints);
      RemoveConstraint(tmpConstraints);
      RemoveConstraint(andConstraints);
     }
     
   /*===============================================*/
   /* Replace the constraints for the slot with the */
   /* constraints derived from the connected        */
   /* constraints (which should be a subset.        */
   /*===============================================*/
   
   if (orConstraints != NULL) 
     {
      if (theNode->derivedConstraints) RemoveConstraint(theNode->constraints);
      theNode->constraints = orConstraints;
      theNode->derivedConstraints = CLIPS_TRUE;
     }
   
   /*==================================*/
   /* Check for constraint violations. */
   /*==================================*/
   
   if (CheckForUnmatchableConstraints(theNode,(int) patternHead->whichCE)) 
     { return(CLIPS_TRUE); }
          
   /*=========================================*/
   /* If the constraints are for a multifield */
   /* slot, check for cardinality violations. */
   /*=========================================*/
   
   if ((multifieldHeader != NULL) && (theNode->right == NULL))
     {
      if (MultifieldCardinalityViolation(multifieldHeader)) 
        { 
         ConstraintViolationErrorMessage("The group of restrictions",
                                                  NULL,CLIPS_FALSE,
                                                  (int) patternHead->whichCE,
                                                  multifieldHeader->slot,
                                                  multifieldHeader->index,
                                                  CARDINALITY_VIOLATION,
                                                  multifieldHeader->constraints,CLIPS_TRUE);
          return(CLIPS_TRUE);
         }
      }
      
   /*=======================================*/
   /* Return FALSE indicating no constraint */
   /* violations were detected.             */
   /*=======================================*/
   
   return(CLIPS_FALSE);
  }

/**************************************************/
/* ConstraintReferenceErrorMessage: Generic error */
/*   message for LHS constraint violation errors  */
/*   that occur within an expression.             */
/**************************************************/
globle VOID ConstraintReferenceErrorMessage(theVariable,theExpression,whichArgument,
                                            whichCE,slotName,theField)
  struct symbolHashNode *theVariable;
  struct lhsParseNode *theExpression;
  int whichArgument;
  int whichCE;
  struct symbolHashNode *slotName;
  int theField;
  {
   struct expr *temprv;
   
   PrintErrorID("RULECSTR",2,CLIPS_TRUE);

   /*==========================*/
   /* Print the variable name. */
   /*==========================*/
   
   PrintCLIPS(WERROR,"Previous variable bindings of ?");
   PrintCLIPS(WERROR,ValueToString(theVariable));
   PrintCLIPS(WERROR," caused the type restrictions");
   
   /*============================*/
   /* Print the argument number. */
   /*============================*/
   
   PrintCLIPS(WERROR,"\nfor argument #");
   PrintLongInteger(WERROR,(long int) whichArgument);
   
   /*=======================*/
   /* Print the expression. */
   /*=======================*/
   
   PrintCLIPS(WERROR," of the expression ");
   temprv = LHSParseNodesToExpression(theExpression);
   ReturnExpression(temprv->nextArg);
   temprv->nextArg = NULL;
   PrintExpression(WERROR,temprv);
   PrintCLIPS(WERROR,"\n");
   ReturnExpression(temprv);
   
   /*========================================*/
   /* Print out the index of the conditional */
   /* element and the slot name or field     */
   /* index where the violation occured.     */
   /*========================================*/
         
   PrintCLIPS(WERROR,"found in CE #");
   PrintLongInteger(WERROR,(long int) whichCE);
   if (slotName == NULL)
     {
      if (theField > 0)
        {
         PrintCLIPS(WERROR," field #");
         PrintLongInteger(WERROR,(long int) theField);
        }
     }
   else
     {
      PrintCLIPS(WERROR," slot ");
      PrintCLIPS(WERROR,ValueToString(slotName));
     }
           
   PrintCLIPS(WERROR," to be violated.\n");
  }
  
/********************************************************/
/* AddToVariableConstraints: Adds the constraints for a */
/*   variable to a list of constraints. If the variable */
/*   is already in the list, the constraints for the    */
/*   variable are intersected with the new constraints. */
/********************************************************/
static struct lhsParseNode *AddToVariableConstraints(oldList,newItems)
  struct lhsParseNode *oldList, *newItems;
  {
   CONSTRAINT_RECORD *newConstraints;
   struct lhsParseNode *temp, *trace;
      
   /*=================================================*/
   /* Loop through each of the new constraints adding */
   /* it to the list if it's not already present or   */
   /* modifying the constraint if it is.              */
   /*=================================================*/
   
   while (newItems != NULL)
     {
      /*==========================================*/
      /* Get the next item since the next pointer */
      /* value (right) needs to be set to NULL.   */
      /*==========================================*/
      
      temp = newItems->right;
      newItems->right = NULL;
            
      /*===================================*/
      /* Search the list for the variable. */
      /*===================================*/
      
      for (trace = oldList; trace != NULL; trace = trace->right)
        {
         /*=========================================*/
         /* If the variable is already in the list, */
         /* modify the constraint already there to  */
         /* include the new constraint.             */
         /*=========================================*/
         
         if (trace->value == newItems->value)
           {
            newConstraints = IntersectConstraints(trace->constraints,
                                                  newItems->constraints);
            RemoveConstraint(trace->constraints);
            trace->constraints = newConstraints;
            ReturnLHSParseNodes(newItems);
            break;
           }
        }
        
      /*=================================*/
      /* Add the variable constraints to */
      /* the list if it wasn't found.    */
      /*=================================*/
      
      if (trace == NULL)
        {
         newItems->right = oldList;
         oldList = newItems;
        }
        
      /*===========================*/
      /* Move on to the next item. */
      /*===========================*/
      
      newItems = temp;
     }
     
   return(oldList);
  }
  
/***********************************************************/
/* UnionVariableConstraints: Unions two lists of variable  */
/*   constraints. If a variable appears in one list  but   */
/*   not the other, then the variable is unconstrained and */
/*   thus not included in the unioned list.                */
/***********************************************************/
static struct lhsParseNode *UnionVariableConstraints(list1,list2)
  struct lhsParseNode *list1, *list2;
  {
   struct lhsParseNode *list3 = NULL, *trace, *temp;
   
   /*===================================*/
   /* Loop through all of the variables */
   /* in the first list.                */
   /*===================================*/
   
   while (list1 != NULL)
     {
      /*=============================================*/
      /* Search for the variable in the second list. */
      /*=============================================*/
      
      for (trace = list2; trace != NULL; trace = trace->right)
        {
         /*============================================*/
         /* If the variable is found in both lists,    */
         /* union the constraints and add the variable */
         /* to the new list being constructed.         */
         /*============================================*/
         
         if (list1->value == trace->value)
           {