reorder.c

clips源代码

   newList->value = expressionList->value;
   newList->right = ExpressionToLHSParseNodes(theEnv,expressionList->nextArg);
   newList->bottom = ExpressionToLHSParseNodes(theEnv,expressionList->argList);

   /*==================================================*/
   /* If the expression is a function call, then store */
   /* the constraint information for the functions     */
   /* arguments in the lshParseNode data structures.   */
   /*==================================================*/

   if (newList->type != FCALL) return(newList);

   theFunction = (struct FunctionDefinition *) newList->value;
   for (theList = newList->bottom, i = 1;
        theList != NULL;
        theList = theList->right, i++)
     {
      if (theList->type == SF_VARIABLE)
        {
         theRestriction = GetNthRestriction(theFunction,i);
         theList->constraints = ArgumentTypeToConstraintRecord(theEnv,theRestriction);
         theList->derivedConstraints = TRUE;
        }
     }

   /*==================================*/
   /* Return the converted expression. */
   /*==================================*/

   return(newList);
  }

/******************************************************************/
/* LHSParseNodesToExpression: Copies lhsParseNode data structures */
/*   into the equivalent expression data structures.              */
/******************************************************************/
globle struct expr *LHSParseNodesToExpression(
  void *theEnv,
  struct lhsParseNode *nodeList)
  {
   struct expr *newList;

   if (nodeList == NULL)
     { return(NULL); }

   newList = get_struct(theEnv,expr);
   newList->type = nodeList->type;
   newList->value = nodeList->value;
   newList->nextArg = LHSParseNodesToExpression(theEnv,nodeList->right);
   newList->argList = LHSParseNodesToExpression(theEnv,nodeList->bottom);

   return(newList);
  }

/************************************************************/
/* IncrementNandDepth: Increments the nand depth of a group */
/*   of CEs. The nand depth is used to indicate the nesting */
/*   of not/and or not/not CEs which are implemented using  */
/*   joins from the right. A single pattern within a "not"  */
/*   CE does not require a join from the right and its nand */
/*   depth is normally not increased (except when it's      */
/*   within a not/and or not/not CE. The begin nand depth   */
/*   indicates the current nesting for a CE. The end nand   */
/*   depth indicates the nand depth in the following CE     */
/*   (assuming that the next CE is not the beginning of a   */
/*   new group of nand CEs). All but the last CE in a nand  */
/*   group should have the same begin and end nand depths.  */
/*   Since a single CE can be the last CE of several nand   */
/*   groups, it is possible to have an end nand depth that  */
/*   is more than 1 less than the begin nand depth of the   */
/*   CE.                                                    */
/************************************************************/
static void IncrementNandDepth(
  void *theEnv,
  struct lhsParseNode *theLHS,
  int lastCE)
  {
   /*======================================*/
   /* Loop through each CE in the group of */
   /* CEs having its nand depth increased. */
   /*======================================*/

   for (;
        theLHS != NULL;
        theLHS = theLHS->bottom)
     {
      /*=========================================================*/
      /* Increment the begin nand depth of pattern and test CEs. */
      /* The last CE in the original list doesn't have its end   */
      /* nand depth incremented. All other last CEs in other CEs */
      /* entered recursively do have their end depth incremented */
      /* (unless the last CE in the recursively entered CE is    */
      /* the same last CE as contained in the original group     */
      /* when this function was first entered).                  */
      /*=========================================================*/

      if ((theLHS->type == PATTERN_CE) || (theLHS->type == TEST_CE))
        {
         theLHS->beginNandDepth++;

         if (lastCE == FALSE) theLHS->endNandDepth++;
         else if (theLHS->bottom != NULL) theLHS->endNandDepth++;
        }

      /*==============================================*/
      /* Recursively increase the nand depth of other */
      /* CEs contained within the CE having its nand  */
      /* depth increased.                             */
      /*==============================================*/

      else if ((theLHS->type == AND_CE) || (theLHS->type == NOT_CE))
        {
         IncrementNandDepth(theEnv,theLHS->right,
                            (lastCE ? (theLHS->bottom == NULL) : FALSE));
        }

      /*=====================================*/
      /* All or CEs should have been removed */
      /* from the LHS at this point.         */
      /*=====================================*/

      else if (theLHS->type == OR_CE)
        { SystemError(theEnv,"REORDER",1); }
     }
  }

/***********************************************************/
/* CreateInitialPattern: Creates a default pattern used in */
/*  the LHS of a rule under certain cirmustances (such as  */
/*  when a "not" or "test" CE is the first CE in an "and"  */
/*  CE or when no CEs are specified in the LHS of a rule.  */
/***********************************************************/
static struct lhsParseNode *CreateInitialPattern(
  void *theEnv)
  {
   struct lhsParseNode *topNode;

   /*==========================================*/
   /* Create the top most node of the pattern. */
   /*==========================================*/

   topNode = GetLHSParseNode(theEnv);
   topNode->type = PATTERN_CE;
   topNode->userCE = FALSE;
   topNode->bottom = NULL;
   
   return(topNode);
  }

/*****************************************************************/
/* AddRemainingInitialPatterns: Finishes adding initial patterns */
/*   where needed on the LHS of a rule. Assumes that an initial  */
/*   pattern has been added to the beginning of the rule if one  */
/*   was needed.                                                 */
/*****************************************************************/
static struct lhsParseNode *AddRemainingInitialPatterns(
  void *theEnv,
  struct lhsParseNode *theLHS)
  {
   struct lhsParseNode *lastNode = NULL, *thePattern, *rv = theLHS;
   int currentDepth = 1;
   
   while (theLHS != NULL)
     {
      if ((theLHS->type == TEST_CE) &&
          (theLHS->beginNandDepth  > currentDepth))
        {
         thePattern = CreateInitialPattern(theEnv);
         thePattern->beginNandDepth = theLHS->beginNandDepth;
         thePattern->endNandDepth = theLHS->beginNandDepth;
         thePattern->logical = theLHS->logical;
         thePattern->existsNand = theLHS->existsNand;
         theLHS->existsNand = FALSE;
     
         thePattern->bottom = theLHS;
               
         if (lastNode == NULL)
           { rv = thePattern; }
         else
           { lastNode->bottom = thePattern; }
        }
        
      lastNode = theLHS;
      currentDepth = theLHS->endNandDepth;
      theLHS = theLHS->bottom;
     }
     
   return(rv);
  }   

/**********************************************/
/* PrintNodes: Debugging routine which prints */
/*   the representation of a CE.              */
/**********************************************/
static void PrintNodes(
  void *theEnv,
  char *fileid,
  struct lhsParseNode *theNode)
  {
   if (theNode == NULL) return;

   while (theNode != NULL)
     {
      switch (theNode->type)
        {
         case PATTERN_CE:
           EnvPrintRouter(theEnv,fileid,"(");
           if (theNode->negated) EnvPrintRouter(theEnv,fileid,"n");
           if (theNode->exists) EnvPrintRouter(theEnv,fileid,"x");
           if (theNode->logical) EnvPrintRouter(theEnv,fileid,"l");
           PrintLongInteger(theEnv,fileid,(long long) theNode->beginNandDepth);
           EnvPrintRouter(theEnv,fileid,"-");
           PrintLongInteger(theEnv,fileid,(long long) theNode->endNandDepth);
           EnvPrintRouter(theEnv,fileid," ");
           EnvPrintRouter(theEnv,fileid,ValueToString(theNode->right->bottom->value));
           EnvPrintRouter(theEnv,fileid,")");
           break;

         case TEST_CE:
           EnvPrintRouter(theEnv,fileid,"(test ");
           PrintLongInteger(theEnv,fileid,(long long) theNode->beginNandDepth);
           EnvPrintRouter(theEnv,fileid,"-");
           PrintLongInteger(theEnv,fileid,(long long) theNode->endNandDepth);
           EnvPrintRouter(theEnv,fileid,")");
           break;

         case NOT_CE:
           if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(lnot ");
           else EnvPrintRouter(theEnv,fileid,"(not ");;
           PrintNodes(theEnv,fileid,theNode->right);
           EnvPrintRouter(theEnv,fileid,")");
           break;

         case OR_CE:
           if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(lor ");
           else EnvPrintRouter(theEnv,fileid,"(or ");
           PrintNodes(theEnv,fileid,theNode->right);
           EnvPrintRouter(theEnv,fileid,")");
           break;

         case AND_CE:
           if (theNode->logical) EnvPrintRouter(theEnv,fileid,"(land ");
           else EnvPrintRouter(theEnv,fileid,"(and ");
           PrintNodes(theEnv,fileid,theNode->right);
           EnvPrintRouter(theEnv,fileid,")");
           break;

         default:
           EnvPrintRouter(theEnv,fileid,"(unknown)");
           break;

        }

      theNode = theNode->bottom;
      if (theNode != NULL) EnvPrintRouter(theEnv,fileid," ");
     }

   return;
  }

/*************************************************************/
/* AssignPatternIndices: For each pattern CE in the LHS of a */
/*   rule, determines the pattern index for the CE. A simple */
/*   1 to N numbering can't be used since a join from the    */
/*   right only counts as a single CE to other CEs outside   */
/*   the lexical scope of the join from the right. For       */
/*   example, the patterns in the following LHS              */
/*                                                           */
/*     (a) (not (b) (c) (d)) (e)                             */
/*                                                           */
/*   would be assigned the following numbers: a-1, b-2, c-3, */
/*   d-4, and e-3.                                           */
/*************************************************************/
static struct lhsParseNode *AssignPatternIndices(
  struct lhsParseNode *theLHS,
  short startIndex,
  int depth)
  {
   struct lhsParseNode *theField;
   int joinDepth = 0;

   /*====================================*/
   /* Loop through the CEs at this level */
   /* assigning each CE a pattern index. */
   /*====================================*/

   while (theLHS != NULL)
     {
      /*============================================================*/
      /* If we're entering a group of CEs requiring a join from the */
      /* right, compute the pattern indices for that group and then */
      /* proceed with the next CE in this group. A join from the    */
      /* right only counts as one CE on this level regardless of    */
      /* the number of CEs it contains. If the end of this level is */
      /* encountered while processing the join from right, then     */
      /* return to the previous level.                              */
      /*============================================================*/

      if (theLHS->beginNandDepth > depth)
        {
         theLHS = AssignPatternIndices(theLHS,startIndex,theLHS->beginNandDepth);
         if (theLHS->endNandDepth < depth) return(theLHS);
         startIndex++;
         joinDepth++;
        }

      /*=====================================================*/
      /* A test CE is not assigned a pattern index, however, */
      /* if it is the last CE at the end of this level, then */
      /* return to the previous level.                       */
      /*=====================================================*/

      else if (theLHS->type == TEST_CE)
        { 
         theLHS->joinDepth = joinDepth - 1;
         PropagateJoinDepth(theLHS->expression,joinDepth - 1);
         PropagateNandDepth2(theLHS->expression,theLHS->beginNandDepth,theLHS->endNandDepth);
         if (theLHS->endNandDepth < depth) return(theLHS); 
        }

      /*==========================================================*/
      /* The fields of a pattern CE need to be assigned a pattern */
      /* index, field index, and/or slot names. If this CE is the */
      /* last CE at the end of this level, then return to the     */
      /* previous level.                                          */
      /*==========================================================*/

      else if (theLHS->type == PATTERN_CE)
        {
         theLHS->pattern = startIndex;
         theLHS->joinDepth = joinDepth;
         PropagateJoinDepth(theLHS->right,joinDepth);
         for (theField = theLHS->right; theField != NULL; theField = theField->right)
           {
            theField->pattern = startIndex;
            PropagateIndexSlotPatternValues(theField,theField->pattern,
                                            theField->index,theField->slot,
                                            theField->slotNumber);
            PropagateNandDepth(theField,theLHS->beginNandDepth,theLHS->endNandDepth);
           }

         if (theLHS->endNandDepth < depth) return(theLHS);
         startIndex++;
         joinDepth++;
        }

      /*=========================*/
      /* Move on to the next CE. */
      /*=========================*/

      theLHS = theLHS->bottom;
     }

   /*========================================*/
   /* There are no more CEs left to process. */
   /* Return to the previous level.          */
   /*========================================*/

   return(NULL);
  }

/***********************************************************/
/* PropagateIndexSlotPatternValues: Assigns pattern, field */
/*   and slot identifiers to a field in a pattern.         */
/**************************