rulecstr.c

clips源代码

           {
            temp = GetLHSParseNode(theEnv);
            temp->derivedConstraints = TRUE;
            temp->value = list1->value;
            temp->constraints = UnionConstraints(theEnv,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(theEnv,list1);
      list1 = temp;
     }

   /*====================================*/
   /* Free the items in the second list. */
   /*====================================*/

   ReturnLHSParseNodes(theEnv,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(
  void *theEnv,
  struct lhsParseNode *theExpression)
  {
   struct lhsParseNode *list1 = NULL, *list2;

   for (; theExpression != NULL; theExpression = theExpression->bottom)
     {
      if (theExpression->right != NULL)
        {
         list2 = GetExpressionVarConstraints(theEnv,theExpression->right);
         list1 = AddToVariableConstraints(theEnv,list2,list1);
        }

      if (theExpression->type == SF_VARIABLE)
        {
         list2 = GetLHSParseNode(theEnv);
         if (theExpression->referringNode != NULL)
           { list2->type = theExpression->referringNode->type; }
         else
           { list2->type = SF_VARIABLE; }
         list2->value = theExpression->value;
         list2->derivedConstraints = TRUE;
         list2->constraints = CopyConstraintRecord(theEnv,theExpression->constraints);
         list1 = AddToVariableConstraints(theEnv,list2,list1);
        }
     }

   return(list1);
  }

/***********************************************/
/* DeriveVariableConstraints: Derives the list */
/*   of variable constraints associated with a */
/*   single connected constraint.              */
/***********************************************/
globle struct lhsParseNode *DeriveVariableConstraints(
  void *theEnv,
  struct lhsParseNode *theNode)
  {
   struct lhsParseNode *orNode, *andNode;
   struct lhsParseNode *list1, *list2, *list3 = NULL;
   int first = 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(theEnv,andNode->expression);
            list2 = AddToVariableConstraints(theEnv,list2,list1);
           }
        }

      if (first)
        {
         list3 = list2;
         first = FALSE;
        }
      else
        { list3 = UnionVariableConstraints(theEnv,list3,list2); }
     }

   return(list3);
  }

/*******************************************/
/* CheckRHSForConstraintErrors: Checks the */
/*   RHS of a rule for constraint errors.  */
/*******************************************/
globle intBool CheckRHSForConstraintErrors(
  void *theEnv,
  struct expr *expressionList,
  struct lhsParseNode *theLHS)
  {
   struct FunctionDefinition *theFunction;
   int i;
   struct expr *lastOne = NULL, *checkList, *tmpPtr;

   if (expressionList == NULL) return(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(theEnv,expressionList,lastOne,i,
                                              theFunction,theLHS))
            { return(TRUE); }

          i++;
          tmpPtr = expressionList->nextArg;
          expressionList->nextArg = NULL;
          if (CheckRHSForConstraintErrors(theEnv,expressionList,theLHS)) return(TRUE);
          expressionList->nextArg = tmpPtr;
          expressionList = expressionList->nextArg;
         }
      }

   return(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 intBool CheckArgumentForConstraintError(
  void *theEnv,
  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 = 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(theEnv,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(theEnv);
         SetConstraintType(MULTIFIELD,constraint2);
        }
      else if (theVariable->constraints == NULL)
        { constraint2 = GetConstraintRecord(theEnv); }
      else
        { constraint2 = CopyConstraintRecord(theEnv,theVariable->constraints); }
     }
   else
     { constraint2 = NULL; }

   /*================================================*/
   /* Look for the constraint record associated with */
   /* binding the variable on the RHS of the rule.   */
   /*================================================*/

   constraint3 = FindBindConstraints(theEnv,(SYMBOL_HN *) expressionList->value);

   /*====================================================*/
   /* Union the LHS and RHS variable binding constraints */
   /* (the variable must satisfy one or the other).      */
   /*====================================================*/

   constraint3 = UnionConstraints(theEnv,constraint3,constraint2);

   /*====================================================*/
   /* Intersect the LHS/RHS variable binding constraints */
   /* with the function argument restriction constraints */
   /* (the variable must satisfy both).                  */
   /*====================================================*/

   constraint4 = IntersectConstraints(theEnv,constraint3,constraint1);

   /*====================================*/
   /* Check for unmatchable constraints. */
   /*====================================*/

   if (UnmatchableConstraint(constraint4) && EnvGetStaticConstraintChecking(theEnv))
     {
      PrintErrorID(theEnv,"RULECSTR",3,TRUE);
      EnvPrintRouter(theEnv,WERROR,"Previous variable bindings of ?");
      EnvPrintRouter(theEnv,WERROR,ValueToString((SYMBOL_HN *) expressionList->value));
      EnvPrintRouter(theEnv,WERROR," caused the type restrictions");
      EnvPrintRouter(theEnv,WERROR,"\nfor argument #");
      PrintLongInteger(theEnv,WERROR,(long int) i);
      EnvPrintRouter(theEnv,WERROR," of the expression ");
      tmpPtr = lastOne->nextArg;
      lastOne->nextArg = NULL;
      PrintExpression(theEnv,WERROR,lastOne);
      lastOne->nextArg = tmpPtr;
      EnvPrintRouter(theEnv,WERROR,"\nfound in the rule's RHS to be violated.\n");

      rv = TRUE;
     }

   /*===========================================*/
   /* Free the temporarily created constraints. */
   /*===========================================*/

   RemoveConstraint(theEnv,constraint1);
   RemoveConstraint(theEnv,constraint2);
   RemoveConstraint(theEnv,constraint3);
   RemoveConstraint(theEnv,constraint4);

   /*========================================*/
   /* Return TRUE if unmatchable constraints */
   /* were detected, otherwise FALSE.        */
   /*========================================*/

   return(rv);
  }

#endif /* (! RUN_TIME) && (! BLOAD_ONLY) && DEFRULE_CONSTRUCT */