insmult.c

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

   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   int rb,re;
   DATA_OBJECT newval,newseg,oldseg;
   
   if (CheckCurrentMessage("direct-slot-replace$",CLIPS_TRUE) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   ins = GetActiveInstance();
   sp = CheckMultifieldSlotModify(REPLACE,"direct-slot-replace$",ins,
                            GetFirstArgument(),&rb,&re,&newval);
   if (sp == NULL)
     return(CLIPS_FALSE);
   AssignSlotToDataObject(&oldseg,sp);
   if (ReplaceMultiValueField(&newseg,&oldseg,rb,re,&newval,"direct-slot-replace$")
           == CLIPS_FALSE)
     return(CLIPS_FALSE);
   if (PutSlotValue(ins,sp,&newseg,&newval,"function direct-slot-replace$"))
     return(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }

/************************************************************************
  NAME         : DirectMVInsertCommand
  DESCRIPTION  : Directly inserts a slot's value
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if put OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Slot modified
  NOTES        : CLIPS Syntax: (direct-slot-insert$ <slot> <index> <value>)
 ************************************************************************/
globle BOOLEAN DirectMVInsertCommand()
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   int index;
   DATA_OBJECT newval,newseg,oldseg;
   
   if (CheckCurrentMessage("direct-slot-insert$",CLIPS_TRUE) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   ins = GetActiveInstance();
   sp = CheckMultifieldSlotModify(INSERT,"direct-slot-insert$",ins,
                            GetFirstArgument(),&index,NULL,&newval);
   if (sp == NULL)
     return(CLIPS_FALSE);
   AssignSlotToDataObject(&oldseg,sp);
   if (InsertMultiValueField(&newseg,&oldseg,index,&newval,"direct-slot-insert$")
          == CLIPS_FALSE)
     return(CLIPS_FALSE);
   if (PutSlotValue(ins,sp,&newseg,&newval,"function direct-slot-insert$"))
     return(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }

/*****************************************************************
  NAME         : DirectMVDeleteCommand
  DESCRIPTION  : Directly deletes a slot's value
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if put OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Slot modified
  NOTES        : CLIPS Syntax: (direct-slot-delete$ <slot> 
                                <range-begin> <range-end>)
 *****************************************************************/
globle BOOLEAN DirectMVDeleteCommand()
  {
   INSTANCE_SLOT *sp;
   INSTANCE_TYPE *ins;
   int rb,re;
   DATA_OBJECT newseg,oldseg;
   
   if (CheckCurrentMessage("direct-slot-delete$",CLIPS_TRUE) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   ins = GetActiveInstance();
   sp = CheckMultifieldSlotModify(DELETE,"direct-slot-delete$",ins,
                                  GetFirstArgument(),&rb,&re,NULL);
   if (sp == NULL)
     return(CLIPS_FALSE);
   AssignSlotToDataObject(&oldseg,sp);
   if (DeleteMultiValueField(&newseg,&oldseg,rb,re,"direct-slot-delete$")
         == CLIPS_FALSE)
     return(CLIPS_FALSE);
   if (PutSlotValue(ins,sp,&newseg,&oldseg,"function direct-slot-delete$"))
     return(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }
  
/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/**********************************************************************
  NAME         : CheckMultifieldSlotInstance
  DESCRIPTION  : Gets the instance for the functions slot-replace$,
                    insert and delete
  INPUTS       : The function name
  RETURNS      : The instance address, NULL on errors
  SIDE EFFECTS : None
  NOTES        : None
 **********************************************************************/
static INSTANCE_TYPE *CheckMultifieldSlotInstance(func)
  char *func;
  {
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   if (ArgTypeCheck(func,1,INSTANCE_OR_INSTANCE_NAME,&temp) == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   if (temp.type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) temp.value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress(func);
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
     }
   else
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) temp.value);
      if (ins == NULL)
        NoInstanceError(ValueToString(temp.value),func);
     }
   return(ins);
  }
        
/*********************************************************************
  NAME         : CheckMultifieldSlotModify
  DESCRIPTION  : For the functions slot-replace$, insert, & delete
                    as well as direct-slot-replace$, insert, & delete
                    this function gets the slot, index, and optional
                    field-value for these functions
  INPUTS       : 1) A code indicating the type of operation 
                      INSERT  (0) : Requires one index
                      REPLACE (1) : Requires two indices
                      DELETE  (2) : Requires two indices
                 2) Function name-string
                 3) Instance address
                 4) Argument expression chain
                 5) Caller's buffer for index (or beginning of range)
                 6) Caller's buffer for end of range 
                     (can be NULL for INSERT)
                 7) Caller's new-field value buffer
                     (can be NULL for DELETE)
  RETURNS      : The address of the instance-slot,
                    NULL on errors
  SIDE EFFECTS : Caller's index buffer set
                 Caller's new-field value buffer set (if not NULL)
                   Will allocate an ephemeral segment to store more
                     than 1 new field value
                 EvaluationError set on errors
  NOTES        : Assume the argument chain is at least 2
                   expressions deep - slot, index, and optional values
 *********************************************************************/
static INSTANCE_SLOT *CheckMultifieldSlotModify(code,func,ins,args,rb,re,newval)
  int code;
  char *func;
  INSTANCE_TYPE *ins;
  EXPRESSION *args;
  int *rb,*re;
  DATA_OBJECT *newval;
  {
   DATA_OBJECT temp;
   INSTANCE_SLOT *sp;
   int start;
   
   start = (args == GetFirstArgument()) ? 1 : 2;
   EvaluationError = CLIPS_FALSE;
   EvaluateExpression(args,&temp);
   if (temp.type != SYMBOL)
     {
      ExpectedTypeError1(func,start,"symbol");
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   sp = FindInstanceSlot(ins,(SYMBOL_HN *) temp.value);
   if (sp == NULL)
     {
      SlotExistError(ValueToString(temp.value),func);
      return(NULL);
     }
   if (sp->desc->multiple == 0)
     {
      PrintErrorID("INSMULT",1,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Function ");
      PrintCLIPS(WERROR,func);
      PrintCLIPS(WERROR," cannot be used on single-field slot ");
      PrintCLIPS(WERROR,ValueToString(sp->desc->slotName->name));
      PrintCLIPS(WERROR," in instance ");
      PrintCLIPS(WERROR,ValueToString(ins->name));
      PrintCLIPS(WERROR,".\n");
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   EvaluateExpression(args->nextArg,&temp);
   if (temp.type != INTEGER)
     {
      ExpectedTypeError1(func,start+1,"integer");
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   args = args->nextArg->nextArg;
   *rb = ValueToInteger(temp.value);
   if ((code == REPLACE) || (code == DELETE))
     {
      EvaluateExpression(args,&temp);
      if (temp.type != INTEGER)
        {
         ExpectedTypeError1(func,start+2,"integer");
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
      *re = ValueToInteger(temp.value);
      args = args->nextArg;
     }
   if ((code == INSERT) || (code == REPLACE))
     {
      if (EvaluateAndStoreInDataObject(1,args,newval) == CLIPS_FALSE)
        return(NULL);
     }
   return(sp);
  }

/***************************************************
  NAME         : AssignSlotToDataObject
  DESCRIPTION  : Assigns the value of a multifield
                 slot to a data object
  INPUTS       : 1) The data object buffer
                 2) The instance slot
  RETURNS      : Nothing useful
  SIDE EFFECTS : Data object fields set
  NOTES        : Assumes slot is a multislot
 ***************************************************/
static VOID AssignSlotToDataObject(theDataObject,theSlot)
  DATA_OBJECT *theDataObject;
  INSTANCE_SLOT *theSlot;
  {
   theDataObject->type = theSlot->type;
   theDataObject->value = theSlot->value;
   theDataObject->begin = 0;
   theDataObject->end = GetInstanceSlotLength(theSlot) - 1;
  }
  
#endif
 
/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/