reorder.c

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

      topNode->right = (*theParser->initialPatternFunction)();
      PropagatePatternType(topNode,theParser);
      return(topNode);
     }
   
   /*=============================================*/
   /* If neither a pattern type was supplied nor  */
   /* the initial fact pattern was available, use */
   /* any available initial pattern.              */
   /*=============================================*/
   
   for (theParser = ListOfPatternParsers;
        theParser != NULL;
        theParser = theParser->next)
     {
      if (theParser->initialPatternFunction != NULL)
        { 
         topNode->right = (*theParser->initialPatternFunction)();
         PropagatePatternType(topNode,theParser);
         return(topNode);
        }
     }
     
   /*===========================================*/
   /* There must be at least one pattern parser */
   /* capable of creating an initial pattern.   */
   /*===========================================*/
   
   CLIPSSystemError("REORDER",2);
   
   return(NULL);
  }

/*****************************************************************/
/* 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 VOID AddRemainingInitialPatterns(theLHS,defaultType)
  struct lhsParseNode *theLHS;
  struct patternParser *defaultType;
  {
   struct lhsParseNode *trackNode, *tempNode, *lastNode;
   
   /*====================================================*/
   /* Set the mark flag for each CE in the LHS to FALSE. */
   /*====================================================*/
   
   for (trackNode = theLHS; trackNode != NULL; trackNode = trackNode->bottom)
     { trackNode->marked = CLIPS_FALSE; }
   
   /*==================================*/
   /* Loop through each CE in the LHS. */
   /*==================================*/
   
   lastNode = NULL;
   while (theLHS != NULL)
     {
      /*===================================*/
      /* A "not" CE will not propagate its */
      /* pattern type to following CEs.    */
      /*===================================*/
      
      if ((theLHS->negated) && (theLHS->marked))
        { trackNode = NULL; }
        
      /*==================================================*/
      /* A "test" or "not" CE was found that has not been */
      /* marked. Add an initial pattern before the CE.    */
      /*==================================================*/
      
      else if (((theLHS->type == TEST_CE) || (theLHS->negated)) && 
               (theLHS->marked == CLIPS_FALSE))
        {
         if (theLHS->negated) tempNode = CreateInitialPattern(theLHS->patternType);
         else tempNode = CreateInitialPattern(defaultType);
         
         tempNode->logical = theLHS->logical;
         tempNode->beginNandDepth = theLHS->beginNandDepth;
         tempNode->endNandDepth = theLHS->beginNandDepth;
            
         if (lastNode == NULL)
           { CLIPSSystemError("REORDER",3); }
              
         lastNode->bottom = tempNode;
         tempNode->bottom = theLHS;
         theLHS = tempNode;
         
         trackNode = theLHS->bottom;
        }
        
      /*===================================================*/
      /* If a pattern CE is found, then propagate its type */
      /* to following test CEs in the same lexical scope.  */
      /*===================================================*/
      
      else
        { trackNode = theLHS->bottom; }
      
      /*=======================================================*/
      /* Mark the pattern type of a "test" or "not" CE as the  */
      /* same type as the last pattern CE found that is within */   
      /* the same lexical scope as the "test" or "not" CE.     */
      /*=======================================================*/
      
      for (;
           trackNode != NULL;
           trackNode = trackNode->bottom)
        {        
         /*=====================================*/
         /* If the CE isn't in the same lexical */
         /* scope, move on to the next CE.      */
         /*=====================================*/
         
         if (trackNode->beginNandDepth != theLHS->beginNandDepth)
           { continue; }
           
         /*=======================================================*/
         /* Mark a negated CE that is in the same lexical scope.  */
         /* This signifies that there is a preceeding non-negated */
         /* pattern and thus no need for an initial pattern to be */
         /* placed before this CE.                                */
         /*=======================================================*/
         
         else if (trackNode->negated)
           { trackNode->marked = CLIPS_TRUE; }
         
         /*====================================================*/
         /* If another non-negated pattern in the same lexical */
         /* scope if found, stop propagation of the current    */
         /* pattern type.                                      */
         /*====================================================*/
         
         else if (trackNode->type == PATTERN_CE)
           { break; }
         
         /*====================================================*/
         /* A "test" CE in the same lexical scope is marked to */
         /* indicate that it has a non-negated pattern that it */
         /* can be attached to.                                */
         /*====================================================*/
         
         else if (trackNode->type == TEST_CE)
           {
            trackNode->marked = CLIPS_TRUE;
            trackNode->patternType = theLHS->patternType;
           }
        }
      
      /*====================================*/
      /* Move on to the next CE in the LHS. */
      /*====================================*/
      
      lastNode = theLHS;
      theLHS = theLHS->bottom;
     }
  } 
  
/**********************************************/
/* PrintNodes: Debugging routine which prints */
/*   the representation of a CE.              */
/**********************************************/
static VOID PrintNodes(fileid,theNode)
  char *fileid;
  struct lhsParseNode *theNode;
  {
   if (theNode == NULL) return;

   while (theNode != NULL)
     {
      switch (theNode->type)
        {
         case PATTERN_CE:
           PrintCLIPS(fileid,"(");
           if (theNode->negated) PrintCLIPS(fileid,"n");
           if (theNode->logical) PrintCLIPS(fileid,"l");
           PrintLongInteger(fileid,(long) theNode->beginNandDepth);
           PrintCLIPS(fileid,"-");
           PrintLongInteger(fileid,(long) theNode->endNandDepth);
           PrintCLIPS(fileid," ");
           PrintCLIPS(fileid,ValueToString(theNode->right->bottom->value));
           PrintCLIPS(fileid,")");
           break;
            
         case TEST_CE:
           PrintCLIPS(fileid,"(test ");
           PrintLongInteger(fileid,(long) theNode->beginNandDepth);
           PrintCLIPS(fileid,"-");
           PrintLongInteger(fileid,(long) theNode->endNandDepth);
           PrintCLIPS(fileid,")");
           break;
         
         case NOT_CE:
           if (theNode->logical) PrintCLIPS(fileid,"(lnot ");
           else PrintCLIPS(fileid,"(not ");;
           PrintNodes(fileid,theNode->right);
           PrintCLIPS(fileid,")");
           break;

         case OR_CE:
           if (theNode->logical) PrintCLIPS(fileid,"(lor ");
           else PrintCLIPS(fileid,"(or ");
           PrintNodes(fileid,theNode->right);
           PrintCLIPS(fileid,")");
           break;
         
         case AND_CE:
           if (theNode->logical) PrintCLIPS(fileid,"(land ");
           else PrintCLIPS(fileid,"(and "); 
           PrintNodes(fileid,theNode->right);
           PrintCLIPS(fileid,")");
           break;
                    
         default:
           PrintCLIPS(fileid,"(???)");
           break;

        }

      theNode = theNode->bottom;
      if (theNode != NULL) PrintCLIPS(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(theLHS,startIndex)
  struct lhsParseNode *theLHS;
  int startIndex;
  {
   int depth;
   struct lhsParseNode *theField;
   
   depth = theLHS->beginNandDepth;
   
   /*====================================*/
   /* 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); 
         if (theLHS->endNandDepth < depth) return(theLHS);
         startIndex++;
        }
        
      /*=====================================================*/
      /* 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)
        { 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; 
         for (theField = theLHS->right; theField != NULL; theField = theField->right) 
           { 
            theField->pattern = startIndex; 
            PropagateIndexSlotPatternValues(theField,theField->pattern,
                                            theField->index,theField->slot,
                                            theField->slotNumber);
           }
           
         if (theLHS->endNandDepth < depth) return(theLHS);
         startIndex++;
        }
      
      /*=========================*/
      /* 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.         */
/***********************************************************/
static VOID PropagateIndexSlotPatternValues(theField,thePattern,theIndex,theSlot,theSlotNumber)
  struct lhsParseNode *theField;
  int thePattern, theIndex;
  struct symbolHashNode *theSlot;
  int theSlotNumber;
  {
   struct lhsParseNode *tmpNode, *andField;
   
   /*=============================================*/
   /* A NULL field does not have to be processed. */
   /*=============================================*/
   
   if (theField == NULL) return;
   
   /*=====================================================*/
   /* Assign the appropriate identifiers for a multifield */
   /* slot by calling this routine recursively.           */
   /*=====================================================*/
   
   if (theField->multifieldSlot)
     {
      theField->pattern = thePattern;
      if (theIndex > 0) theField->index = theIndex;
      theField->slot = theSlot;
      theField->slotNumber = theSlotNumber;
      
      for (tmpNode = theField->bottom;
           tmpNode != NULL;
           tmpNode = tmpNode->right)
        {
         tmpNode->pattern = thePattern;
         tmpNode->slot = theSlot;
         PropagateIndexSlotPatternValues(tmpNode,thePattern,tmpNode->index,
                                         theSlot,theSlotNumber);
        }
        
      return;
     }
        
   /*=======================================================*/
   /* Loop through each of the or'ed constraints (connected */
   /* by a |) in this field of the pattern.                 */
   /*=======================================================*/
   
   for (theField = theField->bottom;
        theField != NULL;
        theField = theField->bottom)
     {
      /*===========================================================*/
      /* Loop through each of the and'ed constraints (connected by */
      /* a &) in this field of the pattern. Assign the pattern,    */
      /* field, and slot identifiers.                              */
      /*===========================================================*/
      
      for (andField = theField; andField != NULL; andField = andField->right)
        {
         andField->pattern = thePattern;
         if (theIndex > 0) andField->index = theIndex;
         andField->slot = theSlot;
         andField->slotNumber = theSlotNumber;
        }
     }
   }
     
#endif