rulecstr.c

一套美国国家宇航局人工智能中心NASA的专家系统工具源代码

            temp = GetLHSParseNode();
            temp->derivedConstraints = CLIPS_TRUE;
            temp->value = list1->value;
            temp->constraints = UnionConstraints(list1->constraints,trace->constraints);
            temp->right = list3;
            list3 = temp;
            break;
           }
        }
        
      /*==============================*/
      /* Move on to the next variable */
      /* in the first list.           */
      /*==============================*/
      
      temp = list1->right;
      list1->right = NULL;
      ReturnLHSParseNodes(list1);
      list1 = temp;
     }
     
   /*====================================*/
   /* Free the items in the second list. */
   /*====================================*/
   
   ReturnLHSParseNodes(list2);

   /*======================*/
   /* Return the new list. */
   /*======================*/
   
   return(list3);
  }
  
/*****************************************************************/
/* GetExpressionVarConstraints: Given an expression stored using */
/*   the LHS parse node data structures, determines and returns  */
/*   the constraints on variables caused by that expression. For */
/*   example, the expression (+ ?x 1) would imply a numeric type */
/*   constraint for the variable ?x since the addition function  */
/*   expects numeric arguments.                                  */
/*****************************************************************/
globle struct lhsParseNode *GetExpressionVarConstraints(theExpression)
  struct lhsParseNode *theExpression;
  {
   struct lhsParseNode *list1 = NULL, *list2;
   
   for (; theExpression != NULL; theExpression = theExpression->bottom)
     {
      if (theExpression->right != NULL)
        { 
         list2 = GetExpressionVarConstraints(theExpression->right); 
         list1 = AddToVariableConstraints(list2,list1);
        }
      
      if (theExpression->type == SF_VARIABLE)
        {
         list2 = GetLHSParseNode();
         if (theExpression->referringNode != NULL)
           { list2->type = theExpression->referringNode->type; }
         else
           { list2->type = SF_VARIABLE; }
         list2->value = theExpression->value;
         list2->derivedConstraints = CLIPS_TRUE;
         list2->constraints = CopyConstraintRecord(theExpression->constraints);
         list1 = AddToVariableConstraints(list2,list1);
        }
     }
     
   return(list1);   
  }
  
/***********************************************/
/* DeriveVariableConstraints: Derives the list */
/*   of variable constraints associated with a */
/*   single connected constraint.              */
/***********************************************/
globle struct lhsParseNode *DeriveVariableConstraints(theNode)
  struct lhsParseNode *theNode;
  {
   struct lhsParseNode *orNode, *andNode;
   struct lhsParseNode *list1, *list2, *list3 = NULL;
   int first = CLIPS_TRUE;
     
   /*===============================*/
   /* Process the constraints for a */
   /* single connected constraint.  */
   /*===============================*/     
   
   for (orNode = theNode->bottom; orNode != NULL; orNode = orNode->bottom)
     {
      /*=================================================*/
      /* Intersect all of the &'ed constraints together. */
      /*=================================================*/
     
      list2 = NULL;
      for (andNode = orNode; andNode != NULL; andNode = andNode->right)
        {
         if ((andNode->type == RETURN_VALUE_CONSTRAINT) ||
             (andNode->type == PREDICATE_CONSTRAINT))
           {
            list1 = GetExpressionVarConstraints(andNode->expression);
            list2 = AddToVariableConstraints(list2,list1);
           }
        }
        
      if (first)
        {
         list3 = list2;
         first = CLIPS_FALSE;
        }
      else
        { list3 = UnionVariableConstraints(list3,list2); }
     }
     
   return(list3);
  }
  
/*******************************************/
/* CheckRHSForConstraintErrors: Checks the */
/*   RHS of a rule for constraint errors.  */
/*******************************************/
globle BOOLEAN CheckRHSForConstraintErrors(expressionList,theLHS)
  struct expr *expressionList;
  struct lhsParseNode *theLHS;
  {
   struct FunctionDefinition *theFunction;
   int i;
   struct expr *lastOne = NULL, *checkList, *tmpPtr;
   
   if (expressionList == NULL) return(CLIPS_FALSE);
      
   for (checkList = expressionList; 
        checkList != NULL;
        checkList = checkList->nextArg)
      {
       expressionList = checkList->argList;
       i = 1;
       if (checkList->type == FCALL)
         {
          lastOne = checkList;
          theFunction = (struct FunctionDefinition *) checkList->value;
         }
       else
         { theFunction = NULL; }
   
       while (expressionList != NULL)
         {
          if (CheckArgumentForConstraintError(expressionList,lastOne,i,
                                              theFunction,theLHS))
            { return(CLIPS_TRUE); }
        
          i++;   
          tmpPtr = expressionList->nextArg;
          expressionList->nextArg = NULL;
          if (CheckRHSForConstraintErrors(expressionList,theLHS)) return(CLIPS_TRUE);
          expressionList->nextArg = tmpPtr;
          expressionList = expressionList->nextArg;
         }
      }
     
   return(CLIPS_FALSE);
  }

/*************************************************************/
/* CheckArgumentForConstraintError: Checks a single argument */
/*   found in the RHS of a rule for constraint errors.       */
/*   Returns TRUE if an error is detected, otherwise FALSE.  */
/*************************************************************/
static BOOLEAN CheckArgumentForConstraintError(expressionList,lastOne,i,
                                               theFunction,theLHS)
  struct expr *expressionList;
  struct expr *lastOne;
  int i;  
  struct FunctionDefinition *theFunction;
  struct lhsParseNode *theLHS;
  {
   int theRestriction;
   CONSTRAINT_RECORD *constraint1, *constraint2, *constraint3, *constraint4;
   struct lhsParseNode *theVariable;
   struct expr *tmpPtr;
   int rv = CLIPS_FALSE;
   
   /*=============================================================*/
   /* Skip anything that isn't a variable or isn't an argument to */
   /* a user defined function (i.e. deffunctions and generic have */
   /* no constraint information so they aren't checked).          */
   /*=============================================================*/
   
   if ((expressionList->type != SF_VARIABLE) || (theFunction == NULL)) 
     { return (rv); }
   
   /*===========================================*/
   /* Get the restrictions for the argument and */
   /* convert them to a constraint record.      */
   /*===========================================*/
   
   theRestriction = GetNthRestriction(theFunction,i);
   constraint1 = ArgumentTypeToConstraintRecord(theRestriction);
         
   /*================================================*/
   /* Look for the constraint record associated with */
   /* binding the variable in the LHS of the rule.   */
   /*================================================*/
   
   theVariable = FindVariable((SYMBOL_HN *) expressionList->value,theLHS);
   if (theVariable != NULL)
     {
      if (theVariable->type == MF_VARIABLE)
        {
         constraint2 = GetConstraintRecord();
         SetConstraintType(MULTIFIELD,constraint2);
        }
      else if (theVariable->constraints == NULL)
        { constraint2 = GetConstraintRecord(); }
      else
        { constraint2 = CopyConstraintRecord(theVariable->constraints); }
     }
   else
     { constraint2 = NULL; }
           
   /*================================================*/
   /* Look for the constraint record associated with */
   /* binding the variable on the RHS of the rule.   */
   /*================================================*/
   
   constraint3 = FindBindConstraints((SYMBOL_HN *) expressionList->value);
   
   /*====================================================*/
   /* Union the LHS and RHS variable binding constraints */
   /* (the variable must satisfy one or the other).      */
   /*====================================================*/
   
   constraint3 = UnionConstraints(constraint3,constraint2);
   
   /*====================================================*/
   /* Intersect the LHS/RHS variable binding constraints */
   /* with the function argument restriction constraints */
   /* (the variable must satisfy both).                  */
   /*====================================================*/
   
   constraint4 = IntersectConstraints(constraint3,constraint1);
         
   /*====================================*/
   /* Check for unmatchable constraints. */
   /*====================================*/

   if (UnmatchableConstraint(constraint4) && GetStaticConstraintChecking())
     {
      PrintErrorID("RULECSTR",3,CLIPS_TRUE);
      PrintCLIPS(WERROR,"Previous variable bindings of ?");
      PrintCLIPS(WERROR,ValueToString((SYMBOL_HN *) expressionList->value));
      PrintCLIPS(WERROR," caused the type restrictions");
      PrintCLIPS(WERROR,"\nfor argument #");
      PrintLongInteger(WERROR,(long int) i);
      PrintCLIPS(WERROR," of the expression ");
      tmpPtr = lastOne->nextArg;
      lastOne->nextArg = NULL;
      PrintExpression(WERROR,lastOne);
      lastOne->nextArg = tmpPtr;
      PrintCLIPS(WERROR,"\nfound in the rule's RHS to be violated.\n");
            
      rv = CLIPS_TRUE;
     }
           
   /*===========================================*/
   /* Free the temporarily created constraints. */
   /*===========================================*/
   
   RemoveConstraint(constraint1);
   RemoveConstraint(constraint2);
   RemoveConstraint(constraint3);
   RemoveConstraint(constraint4);
   
   /*========================================*/
   /* Return TRUE if unmatchable constraints */
   /* were detected, otherwise FALSE.        */
   /*========================================*/
   
   return(rv);
  }
  
#endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */