objrtbld.c

clips源代码

   MarkBitMapClassesBusy(theEnv,alphaPtr->classbmp,-1);
   DeleteClassBitMap(theEnv,alphaPtr->classbmp);
   if (alphaPtr->slotbmp != NULL)
     { DecrementBitMapCount(theEnv,alphaPtr->slotbmp); }

   /*=========================================*/
   /* Only continue deleting this pattern if  */
   /* this is the last alpha memory attached. */
   /*=========================================*/
   
   prv = NULL;
   terminalPtr = ObjectNetworkTerminalPointer(theEnv);
   while (terminalPtr != alphaPtr)
     {
      prv = terminalPtr;
      terminalPtr = terminalPtr->nxtTerminal;
     }
     
   if (prv == NULL)
     { SetObjectNetworkTerminalPointer(theEnv,terminalPtr->nxtTerminal); }
   else
     { prv->nxtTerminal = terminalPtr->nxtTerminal; }

   prv = NULL;
   terminalPtr = alphaPtr->patternNode->alphaNode;
   while (terminalPtr != alphaPtr)
     {
      prv = terminalPtr;
      terminalPtr = terminalPtr->nxtInGroup;
     }
     
   if (prv == NULL)
     {
      if (alphaPtr->nxtInGroup != NULL)
        {
         alphaPtr->patternNode->alphaNode = alphaPtr->nxtInGroup;
         RemoveHashedExpression(theEnv,alphaPtr->header.rightHash);
         rtn_struct(theEnv,objectAlphaNode,alphaPtr);
         return;
        }
     }
   else
     {
      prv->nxtInGroup = alphaPtr->nxtInGroup;
      RemoveHashedExpression(theEnv,alphaPtr->header.rightHash);
      rtn_struct(theEnv,objectAlphaNode,alphaPtr);
      return;
     }
   alphaPtr->patternNode->alphaNode = NULL;
   RemoveHashedExpression(theEnv,alphaPtr->header.rightHash);
   rtn_struct(theEnv,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(theEnv,NULL);
         else
           {
           if (upperLevel->selector)
              { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); }

            upperLevel->nextLevel = NULL;
            if (upperLevel->alphaNode != NULL)
              upperLevel = NULL;
           }
           
         RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest);
         rtn_struct(theEnv,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;
         
         if ((patternPtr->lastLevel != NULL) && 
             (patternPtr->lastLevel->selector))
           { RemoveHashedPatternNode(theEnv,patternPtr->lastLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); }

         upperLevel->leftNode->rightNode = upperLevel->rightNode;
         if (upperLevel->rightNode != NULL)
           { upperLevel->rightNode->leftNode = upperLevel->leftNode; }

         RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest);
         rtn_struct(theEnv,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(theEnv,patternPtr->rightNode); }
         else
           { 
            if (upperLevel->selector)
              { RemoveHashedPatternNode(theEnv,upperLevel,patternPtr,patternPtr->networkTest->type,patternPtr->networkTest->value); }

            upperLevel->nextLevel = patternPtr->rightNode; 
           }
         patternPtr->rightNode->leftNode = NULL;

         RemoveHashedExpression(theEnv,(EXPRESSION *) patternPtr->networkTest);
         rtn_struct(theEnv,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(
  void *theEnv,
  OBJECT_ALPHA_NODE *alphaPtr)
  {
   INSTANCE_TYPE *ins;
   IGARBAGE *igrb;

   /* =============================================
      Loop through every active and queued instance
      ============================================= */
   ins = InstanceData(theEnv)->InstanceList;
   while (ins != NULL)
     {
      RemoveObjectPartialMatches(theEnv,(INSTANCE_TYPE *) ins,(struct patternNodeHeader *) alphaPtr);
      ins = ins->nxtList;
     }

   /* ============================
      Check for garbaged instances
      ============================ */
   igrb = InstanceData(theEnv)->InstanceGarbageList;
   while (igrb != NULL)
     {
      RemoveObjectPartialMatches(theEnv,(INSTANCE_TYPE *) 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(
  void *theEnv,
  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(theEnv,patternMatch,match_ptr);
            match_ptr = (struct patternMatch *) ins->partialMatchList;
           }
         else
          {
           match_before->next = match_ptr->next;
           rtn_struct(theEnv,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      : TRUE if a definition already
                 exists, FALSE otherwise
  SIDE EFFECTS : An error message is printed if a
                 duplicate is found
  NOTES        : None
 ******************************************************/
static intBool CheckDuplicateSlots(
  void *theEnv,
  struct lhsParseNode *nodeList,
  SYMBOL_HN *slotName)
  {
   while (nodeList != NULL)
     {
      if (nodeList->slot == slotName)
        {
         PrintErrorID(theEnv,"OBJRTBLD",4,TRUE);
         EnvPrintRouter(theEnv,WERROR,"Multiple restrictions on attribute ");
         EnvPrintRouter(theEnv,WERROR,ValueToString(slotName));
         EnvPrintRouter(theEnv,WERROR," not allowed.\n");
         return(TRUE);
        }
      nodeList = nodeList->right;
     }
   return(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(
  void *theEnv,
  char *readSource,
  struct token *theToken)
  {
   struct lhsParseNode *tmpNode;
   SYMBOL_HN *rln;
   CONSTRAINT_RECORD *rv;
   
   rv = GetConstraintRecord(theEnv);
   rv->anyAllowed = 0;
   rv->symbolsAllowed = 1;
   rln = (SYMBOL_HN *) theToken->value;
   SavePPBuffer(theEnv," ");
   GetToken(theEnv,readSource,theToken);
   tmpNode = RestrictionParse(theEnv,readSource,theToken,FALSE,rln,ISA_ID,rv,0);
   if (tmpNode == NULL)
     {
      RemoveConstraint(theEnv,rv);
      return(NULL);
     }
   if ((theToken->type != RPAREN) ||
       (tmpNode->type == MF_WILDCARD) ||
       (tmpNode->type == MF_VARIABLE))
     {
      PPBackup(theEnv);
      if (theToken->type != RPAREN)
        {
         SavePPBuffer(theEnv," ");
         SavePPBuffer(theEnv,theToken->printForm);
        }
      SyntaxErrorMessage(theEnv,"class restriction in object pattern");
      ReturnLHSParseNodes(theEnv,tmpNode);
      RemoveConstraint(theEnv,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(
  void *theEnv,
  char *readSource,
  struct token *theToken)
  {
   struct lhsParseNode *tmpNode;
   SYMBOL_HN *rln;
   CONSTRAINT_RECORD *rv;
   
   rv = GetConstraintRecord(theEnv);
   rv->anyAllowed = 0;
   rv->instanceNamesAllowed = 1;
   rln = (SYMBOL_HN *) theToken->value;
   SavePPBuffer(theEnv," ");
   GetToken(theEnv,readSource,theToken);
   tmpNode = RestrictionParse(theEnv,readSource,theToken,FALSE,rln,NAME_ID,rv,0);
   if (tmpNode == NULL)
     {
      RemoveConstraint(theEnv,rv);
      return(NULL);
     }
   if ((theToken->type != RPAREN) ||
       (tmpNode->type == MF_WILDCARD) ||
       (tmpNode->type == MF_VARIABLE))
     {