classexm.c

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

   DEFCLASS *cls;
   SLOT_DESC *sd;
   int inheritFlag = CLIPS_FALSE;
   DATA_OBJECT dobj;
   
   sd = CheckSlotExists("slot-existp",&cls,CLIPS_FALSE,CLIPS_TRUE);
   if (sd == NULL)
     return(CLIPS_FALSE);
   if (RtnArgCount() == 3)
     {
      if (ArgTypeCheck("slot-existp",3,SYMBOL,&dobj) == CLIPS_FALSE)
        return(CLIPS_FALSE);
      if (strcmp(DOToString(dobj),"inherit") != 0)
        {
         ExpectedTypeError1("slot-existp",3,"keyword \"inherit\"");
         SetEvaluationError(CLIPS_TRUE);
         return(CLIPS_FALSE);
        }
      inheritFlag = CLIPS_TRUE;
     }
   return((sd->cls == cls) ? CLIPS_TRUE : inheritFlag);
  }

/***************************************************
  NAME         : SlotExistP
  DESCRIPTION  : Determines if a slot exists
  INPUTS       : 1) The class
                 2) The slot name
                 3) A flag indicating if the slot
                    can be inherited or not
  RETURNS      : CLIPS_TRUE if slot exists,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle BOOLEAN SlotExistP(theDefclass,slotName,inheritFlag)
  VOID *theDefclass;
  char *slotName;
  BOOLEAN inheritFlag;
  {
   return((LookupSlot((DEFCLASS *) theDefclass,slotName,inheritFlag) != NULL)
           ? CLIPS_TRUE : CLIPS_FALSE);
  }
  
/************************************************************************************
  NAME         : MessageHandlerExistPCommand
  DESCRIPTION  : Determines if a message-handler is present in a class
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if the message header is present, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (message-handler-existp <class> <hnd> [<type>])
 ************************************************************************************/
globle int MessageHandlerExistPCommand()
  {
   DEFCLASS *cls;
   SYMBOL_HN *mname;
   DATA_OBJECT temp;
   unsigned mtype = MPRIMARY;
   
   if (ArgTypeCheck("message-handler-existp",1,SYMBOL,&temp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   cls = LookupDefclassByMdlOrScope(DOToString(temp));
   if (cls == NULL)
     {
      ClassExistError("message-handler-existp",DOToString(temp));
      return(CLIPS_FALSE);
     }
   if (ArgTypeCheck("message-handler-existp",2,SYMBOL,&temp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   mname = (SYMBOL_HN *) GetValue(temp);
   if (RtnArgCount() == 3)
     {
      if (ArgTypeCheck("message-handler-existp",3,SYMBOL,&temp) == CLIPS_FALSE)
        return(CLIPS_FALSE);
      mtype = HandlerType("message-handler-existp",DOToString(temp));
      if (mtype == MERROR)
        {
         SetEvaluationError(CLIPS_TRUE);
         return(CLIPS_FALSE);
        }
     }
   if (FindHandlerByAddress(cls,mname,mtype) != NULL)
     return(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }
  
/**********************************************************************
  NAME         : SlotWritablePCommand
  DESCRIPTION  : Determines if an existing slot can be written to
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if the slot is writable, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (slot-writablep <class> <slot>)
 **********************************************************************/
globle BOOLEAN SlotWritablePCommand()
  {
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   sd = CheckSlotExists("slot-writablep",&theDefclass,CLIPS_TRUE,CLIPS_TRUE);
   if (sd == NULL)
     return(CLIPS_FALSE);
   return(sd->noWrite ? CLIPS_FALSE : CLIPS_TRUE);
  }
  
/***************************************************
  NAME         : SlotWritableP
  DESCRIPTION  : Determines if a slot is writable
  INPUTS       : 1) The class
                 2) The slot name
  RETURNS      : CLIPS_TRUE if slot is writable,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle BOOLEAN SlotWritableP(theDefclass,slotName)
  VOID *theDefclass;
  char *slotName;
  {
   SLOT_DESC *sd;
   
   if ((sd = LookupSlot((DEFCLASS *) theDefclass,slotName,CLIPS_TRUE)) == NULL)
     return(CLIPS_FALSE);
   return(sd->noWrite ? CLIPS_FALSE : CLIPS_TRUE);
  }
  
/**********************************************************************
  NAME         : SlotInitablePCommand
  DESCRIPTION  : Determines if an existing slot can be initialized
                   via an init message-handler or slot-override
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if the slot is writable, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (slot-initablep <class> <slot>)
 **********************************************************************/
globle BOOLEAN SlotInitablePCommand()
  {
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   sd = CheckSlotExists("slot-initablep",&theDefclass,CLIPS_TRUE,CLIPS_TRUE);
   if (sd == NULL)
     return(CLIPS_FALSE);
   return((sd->noWrite && (sd->initializeOnly == 0)) ? CLIPS_FALSE : CLIPS_TRUE);
  }
  
/***************************************************
  NAME         : SlotInitableP
  DESCRIPTION  : Determines if a slot is initable
  INPUTS       : 1) The class
                 2) The slot name
  RETURNS      : CLIPS_TRUE if slot is initable,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle BOOLEAN SlotInitableP(theDefclass,slotName)
  VOID *theDefclass;
  char *slotName;
  {
   SLOT_DESC *sd;
   
   if ((sd = LookupSlot((DEFCLASS *) theDefclass,slotName,CLIPS_TRUE)) == NULL)
     return(CLIPS_FALSE);
   return((sd->noWrite && (sd->initializeOnly == 0)) ? CLIPS_FALSE : CLIPS_TRUE);
  }
  
/**********************************************************************
  NAME         : SlotPublicPCommand
  DESCRIPTION  : Determines if an existing slot is publicly visible
                   for direct reference by subclasses
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if the slot is public, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (slot-publicp <class> <slot>)
 **********************************************************************/
globle BOOLEAN SlotPublicPCommand()
  {
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   sd = CheckSlotExists("slot-publicp",&theDefclass,CLIPS_TRUE,CLIPS_FALSE);
   if (sd == NULL)
     return(CLIPS_FALSE);
   return(sd->publicVisibility ? CLIPS_TRUE : CLIPS_FALSE);
  }
    
/***************************************************
  NAME         : SlotPublicP
  DESCRIPTION  : Determines if a slot is public
  INPUTS       : 1) The class
                 2) The slot name
  RETURNS      : CLIPS_TRUE if slot is public,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle BOOLEAN SlotPublicP(theDefclass,slotName)
  VOID *theDefclass;
  char *slotName;
  {
   SLOT_DESC *sd;
   
   if ((sd = LookupSlot((DEFCLASS *) theDefclass,slotName,CLIPS_FALSE)) == NULL)
     return(CLIPS_FALSE);
   return(sd->publicVisibility ? CLIPS_TRUE : CLIPS_FALSE);
  }
  
/**********************************************************************
  NAME         : SlotDirectAccessPCommand
  DESCRIPTION  : Determines if an existing slot can be directly
                   referenced by the class - i.e., if the slot is
                   private, is the slot defined in the class
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if the slot is private,
                    CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (slot-direct-accessp <class> <slot>)
 **********************************************************************/
globle BOOLEAN SlotDirectAccessPCommand()
  {
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   sd = CheckSlotExists("slot-direct-accessp",&theDefclass,CLIPS_TRUE,CLIPS_TRUE);
   if (sd == NULL)
     return(CLIPS_FALSE);
   return((sd->publicVisibility || (sd->cls == theDefclass)) ? CLIPS_TRUE : CLIPS_FALSE);
  }
  
/***************************************************
  NAME         : SlotDirectAccessP
  DESCRIPTION  : Determines if a slot is directly
                 accessible from message-handlers
                 on class
  INPUTS       : 1) The class
                 2) The slot name
  RETURNS      : CLIPS_TRUE if slot is directly
                 accessible, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle BOOLEAN SlotDirectAccessP(theDefclass,slotName)
  VOID *theDefclass;
  char *slotName;
  {
   SLOT_DESC *sd;
   
   if ((sd = LookupSlot((DEFCLASS *) theDefclass,slotName,CLIPS_TRUE)) == NULL)
     return(CLIPS_FALSE);
   return((sd->publicVisibility || (sd->cls == (DEFCLASS *) theDefclass)) ? 
           CLIPS_TRUE : CLIPS_FALSE);
  }

/**********************************************************************
  NAME         : SlotDefaultValueCommand
  DESCRIPTION  : Determines the default avlue for the specified slot
                 of the specified class
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (slot-default-value <class> <slot>)
 **********************************************************************/
globle VOID SlotDefaultValueCommand(theValue)
  DATA_OBJECT_PTR theValue;
  {
   DEFCLASS *theDefclass;
   SLOT_DESC *sd;
   
   SetpType(theValue,SYMBOL);
   SetpValue(theValue,CLIPSFalseSymbol);
   sd = CheckSlotExists("slot-default-value",&theDefclass,CLIPS_TRUE,CLIPS_TRUE);
   if (sd == NULL)
     return;
   if (sd->dynamicDefault)
     EvaluateAndStoreInDataObject((int) sd->multiple,
                                  (EXPRESSION *) sd->defaultValue,
                                  theValue);
   else
     CopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
  }
  
/*********************************************************
  NAME         : SlotDefaultValue
  DESCRIPTION  : Determines the default avlue for
                 the specified slot of the specified class
  INPUTS       : 1) The class
                 2) The slot name
  RETURNS      : CLIPS_TRUE if slot default value is set,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : Slot default value evaluated - dynamic
                 defaults will cause any side effects
  NOTES        : None
 *********************************************************/
globle BOOLEAN SlotDefaultValue(theDefclass,slotName,theValue)
  VOID *theDefclass;
  char *slotName;
  DATA_OBJECT_PTR theValue;
  {
   SLOT_DESC *sd;
   
   SetpType(theValue,SYMBOL);
   SetpValue(theValue,CLIPSFalseSymbol);
   if ((sd = LookupSlot((DEFCLASS *) theDefclass,slotName,CLIPS_TRUE)) == NULL)
     return(CLIPS_FALSE);
   if (sd->dynamicDefault)
     return(EvaluateAndStoreInDataObject((int) sd->multiple,
                                         (EXPRESSION *) sd->defaultValue,
                                         theValue));
   CopyMemory(DATA_OBJECT,1,theValue,sd->defaultValue);
   return(CLIPS_TRUE);
  }

/*****************************************************************
  NAME         : ClassExistPCommand
  DESCRIPTION  : Determines if a class exists
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if class exists, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (class-existp <arg>)
 *****************************************************************/
globle BOOLEAN ClassExistPCommand()
  {
   DATA_OBJECT temp;

   if (ArgTypeCheck("class-existp",1,SYMBOL,&temp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   return((LookupDefclassByMdlOrScope(DOToString(temp)) != NULL) ? CLIPS_TRUE : CLIPS_FALSE);
  }
  
/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/******************************************************
  NAME         : CheckTwoClasses
  DESCRIPTION  : Checks for exactly two class arguments
                    for a CLIPS function
  INPUTS       : 1) The function name
                 2) Caller's buffer for first class
                 3) Caller's buffer for second class
  RETURNS      : CLIPS_TRUE if both found, CLIPS_FALSE otherwise
  SIDE EFFECTS : Caller's buffers set
  NOTES        : Assumes exactly 2 arguments
 ******************************************************/
static int CheckTwoClasses(func,c1,c2)
  char *func;
  DEFCLASS **c1,**c2;
  {
   DATA_OBJECT temp;

   if (ArgTypeCheck(func,1,SYMBOL,&temp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   *c1 = LookupDefclassByMdlOrScope(DOToString(temp));
   if (*c1 == NULL)
     {
      ClassExistError(func,ValueToString(temp.value));
      return(CLIPS_FALSE);
     }
   if (ArgTypeCheck(func,2,SYMBOL,&temp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   *c2 = LookupDefclassByMdlOrScope(DOToString(temp));
   if (*c2 == NULL)
     {
      ClassExistError(func,ValueToString(temp.value));
      return(CLIPS_FALSE);
     }
   return(CLIPS_TRUE);
  }
    
/***************************************************
  NAME         : CheckSlotExists
  DESCRIPTION  : Checks first two arguments of
                 a function for a valid class
                 and (inherited) slot
  INPUTS       : 1) The name of the function
                 2) A buffer to hold the found class
                 3) A flag indicating whether the
                    non-existence of the slot should
                    be an error
                 4) A flag indicating if the slot
                    can be inherited or not
  RETURNS      : NULL if slot not found, slot
                 descriptor otherwise
  SIDE EFFECTS : Class buffer set if no errors,
                 NULL on errors
  NOTES        : None
 ***************************************************/
static SLOT_DESC *CheckSlotExists(func,classBuffer,existsErrorFlag,inheritFlag)
  char *func;
  DEFCLASS **classBuffer;
  BOOLEAN existsErrorFlag,inheritFlag;
  {
   SYMBOL_HN *ssym;
   int slotIndex;
   SLOT_DESC *sd;
   
   ssym = CheckClassAndSlot(func,classBuffer);
   if (ssym == NULL)
     return(NULL);
   slotIndex = FindInstanceTemplateSlot(*classBuffer,ssym);
   if (slotIndex == -1)
     {