objrtbld.c

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

         alphaPtr->patternNode->alphaNode = alphaPtr->nxtInGroup;
         rtn_struct(objectAlphaNode,alphaPtr);
         return;
        }
     }
   else
     {
      prv->nxtInGroup = alphaPtr->nxtInGroup;
      rtn_struct(objectAlphaNode,alphaPtr);
      return;
     }
   alphaPtr->patternNode->alphaNode = NULL;
   rtn_struct(objectAlphaNode,alphaPtr);
   
   upperLevel = alphaPtr->patternNode;
   if (upperLevel->nextLevel != NULL)
     return;
     
   /*==============================================================*/
   /* Loop until all appropriate pattern nodes have been detached. */
   /*==============================================================*/
   while (upperLevel != NULL)
     {
      if ((upperLevel->leftNode == NULL) &&
          (upperLevel->rightNode == NULL))
        {
         /*===============================================*/
         /* Pattern node is the only node on this level.  */
         /* Remove it and continue detaching other nodes  */
         /* above this one, because no other patterns are */
         /* dependent upon this node.                     */
         /*===============================================*/
         patternPtr = upperLevel;
         upperLevel = patternPtr->lastLevel;
         if (upperLevel == NULL)
           SetObjectNetworkPointer(NULL);
         else
           {
            upperLevel->nextLevel = NULL;
            if (upperLevel->alphaNode != NULL)
              upperLevel = NULL;
           }
         RemoveHashedExpression((EXPRESSION *) patternPtr->networkTest);
         rtn_struct(objectPatternNode,patternPtr);
        }
      else if (upperLevel->leftNode != NULL)
        {
         /*====================================================*/
         /* Pattern node has another pattern node which must   */
         /* be checked preceding it.  Remove the pattern node, */
         /* but do not detach any nodes above this one.        */
         /*====================================================*/
         patternPtr = upperLevel;
         upperLevel->leftNode->rightNode = upperLevel->rightNode;
         if (upperLevel->rightNode != NULL)
           { upperLevel->rightNode->leftNode = upperLevel->leftNode; }

         RemoveHashedExpression((EXPRESSION *) patternPtr->networkTest);
         rtn_struct(objectPatternNode,patternPtr);
         upperLevel = NULL;
        }
      else
        {
         /*====================================================*/
         /* Pattern node has no pattern node preceding it, but */
         /* does have one succeeding it. Remove the pattern    */
         /* node, but do not detach any nodes above this one.  */
         /*====================================================*/
         patternPtr = upperLevel;
         upperLevel = upperLevel->lastLevel;
         if (upperLevel == NULL)
           { SetObjectNetworkPointer(patternPtr->rightNode); }
         else
           { upperLevel->nextLevel = patternPtr->rightNode; }
         patternPtr->rightNode->leftNode = NULL;

         RemoveHashedExpression((EXPRESSION *) patternPtr->networkTest);
         rtn_struct(objectPatternNode,patternPtr);
         upperLevel = NULL;
        }
     }
  }

/***************************************************
  NAME         : ClearObjectPatternMatches
  DESCRIPTION  : Removes a pattern node alpha memory
                 from the list of partial matches
                 on all instances (active or
                 garbage collected)
  INPUTS       : The pattern node to remove
  RETURNS      : Nothing useful
  SIDE EFFECTS : Pattern alpha memory removed
                 from all object partial match lists
  NOTES        : Used when a pattern is removed
 ***************************************************/
static VOID ClearObjectPatternMatches(alphaPtr)
  OBJECT_ALPHA_NODE *alphaPtr;
  {
   INSTANCE_TYPE *ins;
   IGARBAGE *igrb;

   /* =============================================
      Loop through every active and queued instance
      ============================================= */   
   ins = InstanceList;
   while (ins != NULL)
     {
      RemoveObjectPartialMatches((VOID *) ins,(struct patternNodeHeader *) alphaPtr);
      ins = ins->nxtList;
     }
     
   /* ============================
      Check for garbaged instances
      ============================ */
   igrb = InstanceGarbageList;
   while (igrb != NULL)
     {
      RemoveObjectPartialMatches((VOID *) igrb->ins,(struct patternNodeHeader *) alphaPtr);
      igrb = igrb->nxt;
     }
  }
  
/***************************************************
  NAME         : RemoveObjectPartialMatches
  DESCRIPTION  : Removes a partial match from a
                 list of partial matches for
                 an instance
  INPUTS       : 1) The instance
                 2) The pattern node header
                    corresponding to the match
  RETURNS      : Nothing useful
  SIDE EFFECTS : Match removed
  NOTES        : None
 ***************************************************/
static VOID RemoveObjectPartialMatches(ins,phead)
  INSTANCE_TYPE *ins;
  struct patternNodeHeader *phead;
  {
   struct patternMatch *match_before, *match_ptr;
  
   match_before = NULL;
   match_ptr = (struct patternMatch *) ins->partialMatchList;

   /* ======================================= 
      Loop through every match for the object
      ======================================= */
   while (match_ptr != NULL)
     {
      if (match_ptr->matchingPattern == phead)
        {
         ins->busy--;
         if (match_before == NULL)
           {
            ins->partialMatchList = (VOID *) match_ptr->next;
            rtn_struct(patternMatch,match_ptr);
            match_ptr = (struct patternMatch *) ins->partialMatchList;
           }
         else
          {
           match_before->next = match_ptr->next;
           rtn_struct(patternMatch,match_ptr);
           match_ptr = match_before->next;
          }
        }
      else
       {
        match_before = match_ptr;
        match_ptr = match_ptr->next;
       }
     }
  }

/******************************************************
  NAME         : CheckDuplicateSlots
  DESCRIPTION  : Determines if a restriction has
                 already been defined in a pattern
  INPUTS       : The list of already built restrictions
  RETURNS      : CLIPS_TRUE if a definition already
                 exists, CLIPS_FALSE otherwise
  SIDE EFFECTS : An error message is printed if a
                 duplicate is found
  NOTES        : None
 ******************************************************/
static BOOLEAN CheckDuplicateSlots(nodeList,slotName)
  struct lhsParseNode *nodeList;
  SYMBOL_HN *slotName;
  {
   while (nodeList != NULL)
     {
      if (nodeList->slot == slotName)
        {
         PrintErrorID("OBJRTBLD",4,CLIPS_TRUE);
         PrintCLIPS(WERROR,"Multiple restrictions on attribute ");
         PrintCLIPS(WERROR,ValueToString(slotName));
         PrintCLIPS(WERROR," not allowed.\n");
         return(CLIPS_TRUE);
        }
      nodeList = nodeList->right;
     }
   return(CLIPS_FALSE);
  }
  
/**********************************************************
  NAME         : ParseClassRestriction
  DESCRIPTION  : Parses the single-field constraint
                  on the class an object pattern
  INPUTS       : 1) The logical input source
                 2) A buffer for tokens
  RETURNS      : The intermediate pattern nodes 
                 representing the class constraint
                 (NULL on errors)
  SIDE EFFECTS : Intermediate pattern nodes allocated
  NOTES        : None
 **********************************************************/
static struct lhsParseNode *ParseClassRestriction(readSource,theToken)
  char *readSource;
  struct token *theToken;
  {
   struct lhsParseNode *tmpNode;
   SYMBOL_HN *rln;
   CONSTRAINT_RECORD *rv;
   
   rv = GetConstraintRecord();
   rv->anyAllowed = 0;
   rv->symbolsAllowed = 1;
   rln = (SYMBOL_HN *) theToken->value;
   SavePPBuffer(" ");
   GetToken(readSource,theToken);
   tmpNode = RestrictionParse(readSource,theToken,CLIPS_FALSE,rln,ISA_ID,rv,0);
   if (tmpNode == NULL)
     {
      RemoveConstraint(rv);
      return(NULL);
     }
   if ((theToken->type != RPAREN) || 
       (tmpNode->type == MF_WILDCARD) || 
       (tmpNode->type == MF_VARIABLE))
     {
      PPBackup();
      if (theToken->type != RPAREN)
        {
         SavePPBuffer(" ");
         SavePPBuffer(theToken->print_rep);
        }
      SyntaxErrorMessage("class restriction in object pattern");
      ReturnLHSParseNodes(tmpNode);
      RemoveConstraint(rv);
      return(NULL);
     }
   tmpNode->derivedConstraints = 1;
   return(tmpNode);
  }
  
/**********************************************************
  NAME         : ParseNameRestriction
  DESCRIPTION  : Parses the single-field constraint
                  on the name of an object pattern
  INPUTS       : 1) The logical input source
                 2) A buffer for tokens
  RETURNS      : The intermediate pattern nodes 
                 representing the name constraint
                 (NULL on errors)
  SIDE EFFECTS : Intermediate pattern nodes allocated
  NOTES        : None
 **********************************************************/
static struct lhsParseNode *ParseNameRestriction(readSource,theToken)
  char *readSource;
  struct token *theToken;
  {
   struct lhsParseNode *tmpNode;
   SYMBOL_HN *rln;
   CONSTRAINT_RECORD *rv;
   
   rv = GetConstraintRecord();
   rv->anyAllowed = 0;
   rv->instanceNamesAllowed = 1;
   rln = (SYMBOL_HN *) theToken->value;
   SavePPBuffer(" ");
   GetToken(readSource,theToken);
   tmpNode = RestrictionParse(readSource,theToken,CLIPS_FALSE,rln,NAME_ID,rv,0);
   if (tmpNode == NULL)
     {
      RemoveConstraint(rv);
      return(NULL);
     }
   if ((theToken->type != RPAREN) || 
       (tmpNode->type == MF_WILDCARD) || 
       (tmpNode->type == MF_VARIABLE))
     {
      PPBackup();                        
      if (theToken->type != RPAREN)
        {
         SavePPBuffer(" ");
         SavePPBuffer(theToken->print_rep);
        }
      SyntaxErrorMessage("name restriction in object pattern");
      ReturnLHSParseNodes(tmpNode);
      RemoveConstraint(rv);
      return(NULL);
     }
   
   tmpNode->derivedConstraints = 1;
   return(tmpNode);
  }
  
/***************************************************
  NAME         : ParseSlotRestriction
  DESCRIPTION  : Parses the field constraint(s)
                  on a slot of an object pattern
  INPUTS       : 1) The logical input source
                 2) A buffer for tokens
                 3) Constraint record holding the
                    unioned constraints of all the
                    slots which could match the
                    slot pattern
                 4) A flag indicating if any
                    multifield slots match the name
  RETURNS      : The intermediate pattern nodes 
                 representing the slot constraint(s)
                 (NULL on errors)
  SIDE EFFECTS : Intermediate pattern nodes
                 allocated
  NOTES        : None
 ***************************************************/
static struct lhsParseNode *ParseSlotRestriction(readSource,theToken,slotConstraints,multip)
  char *readSource;
  struct token *theToken;
  CONSTRAINT_RECORD *slotConstraints;
  int multip;
  {
   struct lhsParseNode *tmpNode;
   SYMBOL_HN *slotName;
   
   slotName = (SYMBOL_HN *) theToken->value;
   SavePPBuffer(" ");
   GetToken(readSource,theToken);
   tmpNode = RestrictionParse(readSource,theToken,multip,slotName,FindSlotNameID(slotName),
                              slotConstraints,1);
   if (tmpNode == NULL)
     {
      RemoveConstraint(slotConstraints);
      return(NULL);
     }
   if (theToken->type != RPAREN)
     {
      PPBackup();                        
      SavePPBuffer(" ");                  
      SavePPBuffer(theToken->print_rep); 
      SyntaxErrorMessage("object slot pattern");
      ReturnLHSParseNodes(tmpNode);
      RemoveConstraint(slotConstraints);