clsltpsr.c

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

                                    SLOT_PRIVATE_RLN,SLOT_PUBLIC_RLN,NULL,NULL,NULL);
         if (rtnCode == -1)
           goto ParseSlotError;
         slot->publicVisibility = rtnCode;
        }
      else if (strcmp(DOToString(ObjectParseToken),CREATE_ACCESSOR_FACET) == 0)
        {
         rtnCode = ParseSimpleFacet(readSource,specbits,CREATE_ACCESSOR_FACET,
                                    CREATE_ACCESSOR_BIT,
                                    SLOT_READ_RLN,SLOT_WRITE_RLN,SLOT_RDWRT_RLN,
                                    SLOT_NONE_RLN,NULL);
         if (rtnCode == -1)
           goto ParseSlotError;
         if ((rtnCode == 0) || (rtnCode == 2))
           slot->createReadAccessor = CLIPS_TRUE;
         if ((rtnCode == 1) || (rtnCode == 2))
           slot->createWriteAccessor = CLIPS_TRUE;
        }
      else if (strcmp(DOToString(ObjectParseToken),OVERRIDE_MSG_FACET) == 0)
        {
         rtnCode = ParseSimpleFacet(readSource,specbits,OVERRIDE_MSG_FACET,OVERRIDE_MSG_BIT,
                                    NULL,NULL,NULL,SLOT_DEFAULT_RLN,&newOverrideMsg);
         if (rtnCode == -1)
           goto ParseSlotError;
         if (rtnCode == 4)
           {
            DecrementSymbolCount(slot->overrideMessage);
            slot->overrideMessage = newOverrideMsg;
            IncrementSymbolCount(slot->overrideMessage);
           }
         slot->overrideMessageSpecified = CLIPS_TRUE;
        }
      else if (StandardConstraint(DOToString(ObjectParseToken)))
        {
         if (ParseStandardConstraint(readSource,DOToString(ObjectParseToken),
                slot->constraint,&parsedConstraint,CLIPS_TRUE) == CLIPS_FALSE)
           goto ParseSlotError;
        }
      else
        {
         SyntaxErrorMessage("defclass slot");
         goto ParseSlotError;
        }
      GetToken(readSource,&ObjectParseToken);
     }
   if (GetType(ObjectParseToken) != RPAREN)
     {
      SyntaxErrorMessage("defclass slot");
      goto ParseSlotError;
     }
   if (slot->composite)
     BuildCompositeFacets(slot,preclist,specbits,&parsedConstraint);
   if (CheckForFacetConflicts(slot,&parsedConstraint) == CLIPS_FALSE)
     goto ParseSlotError;
   if (CheckConstraintParseConflicts(slot->constraint) == CLIPS_FALSE)
     goto ParseSlotError;
   if (EvaluateSlotDefaultValue(slot,specbits) == CLIPS_FALSE)
     goto ParseSlotError;
   if ((slot->dynamicDefault == 0) && (slot->noWrite == 1) &&
       (slot->initializeOnly == 0))
     slot->shared = 1;
   slot->constraint = AddConstraint(slot->constraint);
   DecrementIndentDepth(3);
   return(slist);
   
ParseSlotError:
   DecrementIndentDepth(3);
   DeleteSlots(slist);
   return(NULL);
  }

/***************************************************
  NAME         : DeleteSlots
  DESCRIPTION  : Deallocates a list of slots and
                   their values
  INPUTS       : The address of the slot list
  RETURNS      : Nothing useful
  SIDE EFFECTS : The slot list is destroyed
  NOTES        : None
 ***************************************************/
globle VOID DeleteSlots(slots)
  TEMP_SLOT_LINK *slots;
  {
   TEMP_SLOT_LINK *stmp;
   
   while (slots != NULL)
     {
      stmp = slots;
      slots = slots->nxt;
      DeleteSlotName(stmp->desc->slotName);
      DecrementSymbolCount(stmp->desc->overrideMessage);
      RemoveConstraint(stmp->desc->constraint);
      if (stmp->desc->dynamicDefault == 1)
        {
         ExpressionDeinstall((EXPRESSION *) stmp->desc->defaultValue);
         ReturnPackedExpression((EXPRESSION *) stmp->desc->defaultValue);
        }
      else if (stmp->desc->defaultValue != NULL)
        {
         ValueDeinstall((DATA_OBJECT *) stmp->desc->defaultValue);
         rtn_struct(dataObject,stmp->desc->defaultValue);
        }
      rtn_struct(slotDescriptor,stmp->desc);
      rtn_struct(tempSlotLink,stmp);
     }
  }
  
/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
  
/**************************************************************
  NAME         : NewSlot
  DESCRIPTION  : Allocates and initalizes a new slot structure
  INPUTS       : The symbolic name of the new slot
  RETURNS      : The address of the new slot
  SIDE EFFECTS : None
  NOTES        : Also adds symbols of the form get-<name> and
                   put-<name> for slot accessors
 **************************************************************/
static SLOT_DESC *NewSlot(name)
  SYMBOL_HN *name;
  {
   SLOT_DESC *slot;
   
   slot = get_struct(slotDescriptor);
   slot->dynamicDefault = 1;
   slot->defaultSpecified = 0;
   slot->noDefault = 0;
#if INSTANCE_PATTERN_MATCHING
   slot->reactive = 1;
#endif
   slot->noInherit = 0;
   slot->noWrite = 0;
   slot->initializeOnly = 0;
   slot->shared = 0;
   slot->multiple = 0;
   slot->composite = 0;
   slot->sharedCount = 0;
   slot->publicVisibility = 0;
   slot->createReadAccessor = 0;
   slot->createWriteAccessor = 0;
   slot->overrideMessageSpecified = 0;
   slot->cls = NULL;
   slot->defaultValue = NULL;
   slot->constraint = GetConstraintRecord();
   slot->slotName = AddSlotName(name,0,CLIPS_FALSE);
   slot->overrideMessage = slot->slotName->putHandlerName;
   IncrementSymbolCount(slot->overrideMessage);
   return(slot);
  }
  
/**********************************************************
  NAME         : InsertSlot
  DESCRIPTION  : Inserts a slot into the list of slots
  INPUTS       : 1) The current head of the slot list
                 2) The slot to be inserted
  RETURNS      : The head of the slot list
  SIDE EFFECTS : The slot is inserted if no errors,
                   otherwise the original list and the
                   new slot are destroyed
  NOTES        : None
 **********************************************************/
static TEMP_SLOT_LINK *InsertSlot(slist,slot)
  TEMP_SLOT_LINK *slist;
  SLOT_DESC *slot;
  {
   TEMP_SLOT_LINK *stmp,*sprv,*tmp;
   
   tmp = get_struct(tempSlotLink);
   tmp->desc = slot;
   tmp->nxt = NULL;
   if (slist == NULL)
     slist = tmp;
   else
     {
      stmp = slist;
      sprv = NULL;
      while (stmp != NULL)
        {
         if (stmp->desc->slotName == slot->slotName)
           {
            tmp->nxt = slist;
            DeleteSlots(tmp);
            PrintErrorID("CLSLTPSR",1,CLIPS_FALSE);
            PrintCLIPS(WERROR,"Duplicate slots not allowed.\n");
            return(NULL);
           }
         sprv = stmp;
         stmp = stmp->nxt;
        }
      sprv->nxt = tmp;
     }
   return(slist);
  }
  
/****************************************************************
  NAME         : ParseSimpleFacet
  DESCRIPTION  : Parses the following facets for a slot:
                   access, source, propagation, storage,
                   pattern-match, visibility and override-message
  INPUTS       : 1) The input logical name
                 2) The bitmap indicating which facets have
                    already been parsed
                 3) The name of the facet
                 4) The bit to test/set in arg #2 for this facet
                 5) The facet value string which indicates the
                    facet should be false
                 6) The facet value string which indicates the
                    facet should be true
                 7) An alternate value string for use when the
                    first two don't match (can be NULL)
                 7) An alternate value string for use when the
                    first three don't match (can be NULL)
                    (will be an SF_VARIABLE type)
                 9) A buffer to hold the facet value symbol
                    (can be NULL - only set if args #5 and #6
                     are both NULL)
  RETURNS      : -1 on errors
                  0 if first value string matched
                  1 if second value string matched
                  2 if alternate value string matched
                  3 if variable value string matched
                  4 if facet value buffer was set
  SIDE EFFECTS : Messages printed on errors
                 Bitmap marked indicating facet was parsed
                 Facet value symbol buffer set, if appropriate
  NOTES        : None
 *****************************************************************/
static int ParseSimpleFacet(readSource,specbits,facetName,testBit,
                            clearRelation,setRelation,alternateRelation,
                            varRelation,facetSymbolicValue)
  char *readSource,*specbits,*facetName;
  int testBit;
  char *clearRelation,*setRelation,
       *alternateRelation,*varRelation;
  SYMBOL_HN **facetSymbolicValue;
  {
   int rtnCode;
  
   if (TestBitMap(specbits,testBit))
     {
      PrintErrorID("CLSLTPSR",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,facetName);
      PrintCLIPS(WERROR," facet already specified.\n");
      return(-1);
     }
   SetBitMap(specbits,testBit);
   SavePPBuffer(" ");
   GetToken(readSource,&ObjectParseToken);
     
   /* ===============================
      Check for the variable relation
      =============================== */
   if (ObjectParseToken.type == SF_VARIABLE)
     {
      if ((varRelation == NULL) ? CLIPS_FALSE :
          (strcmp(DOToString(ObjectParseToken),varRelation) == 0))
        rtnCode = 3;
      else
        goto ParseSimpleFacetError;
     }
   else
     {
      if (ObjectParseToken.type != SYMBOL)
        goto ParseSimpleFacetError;

      /* ===================================================
         If the facet value buffer is non-NULL
         simply get the value and do not check any relations
         =================================================== */
      if (facetSymbolicValue == NULL)
        {
         if (strcmp(DOToString(ObjectParseToken),clearRelation) == 0)
           rtnCode = 0;
         else if (strcmp(DOToString(ObjectParseToken),setRelation) == 0)
           rtnCode = 1;
         else if ((alternateRelation == NULL) ? CLIPS_FALSE :
                  (strcmp(DOToString(ObjectParseToken),alternateRelation) == 0))
           rtnCode = 2;
         else
           goto ParseSimpleFacetError;
        }
      else
        {
         rtnCode = 4;
         *facetSymbolicValue = (SYMBOL_HN *) ObjectParseToken.value;
        }
     }
   GetToken(readSource,&ObjectParseToken);
   if (ObjectParseToken.type != RPAREN)
     goto ParseSimpleFacetError;
   return(rtnCode);

ParseSimpleFacetError:
   SyntaxErrorMessage("slot facet");
   return(-1);