multifun.c

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

        }
      CopyMemory(DATA_OBJECT,1,&resultValue,&tmpVal);
      mink[0] = 1L;
      mink[1] = j + replLen - 1L;
      minkp = mink;
     }
   rm((VOID *) delVals,delSize);
   CopyMemory(DATA_OBJECT,1,returnValue,&resultValue);
  }
  
/****************************************/
/* InsertFunction: CLIPS access routine */
/*   for the insert$ function.          */
/****************************************/
globle VOID InsertFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT value1, value2, value3;
   EXPRESSION *fieldarg;

   /*=======================================*/
   /* Check for the correct argument types. */
   /*=======================================*/
   
   if ((ArgTypeCheck("insert$",1,MULTIFIELD,&value1) == CLIPS_FALSE) ||
       (ArgTypeCheck("insert$",2,INTEGER,&value2) == CLIPS_FALSE))
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
      return;
     }
     
   /*=============================*/
   /* Create the insertion value. */
   /*=============================*/
   
   fieldarg = GetFirstArgument()->nextArg->nextArg;
   if (fieldarg->nextArg != NULL)
     StoreInMultifield(&value3,fieldarg,CLIPS_TRUE);
   else
     EvaluateExpression(fieldarg,&value3);
     
   /*===========================================*/
   /* Insert the value in the multifield value. */
   /*===========================================*/

   if (InsertMultiValueField(returnValue,&value1,DOToLong(value2),
                             &value3,"insert$") == CLIPS_FALSE)
     {
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(returnValue);
     }
  }
  
/*****************************************/
/* ExplodeFunction: CLIPS access routine */
/*   for the explode$ function.          */
/*****************************************/
globle VOID ExplodeFunction(str_value)
  DATA_OBJECT_PTR str_value;
  {
   DATA_OBJECT value;
   struct multifield *theMultifield;
   long end; /* 6.04 Bug Fix */
   
   /*=====================================*/
   /* Explode$ expects a single argument. */
   /*=====================================*/

   if (ArgCountCheck("explode$",EXACTLY,1) == -1)
     {
      SetHaltExecution(CLIPS_TRUE);
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(str_value);
      return;
     }
     
   /*==================================*/
   /* The argument should be a string. */
   /*==================================*/

   if (ArgTypeCheck("explode$",1,STRING,&value) == CLIPS_FALSE)
     {
      SetHaltExecution(CLIPS_TRUE);
      SetEvaluationError(CLIPS_TRUE);
      SetMultifieldErrorValue(str_value);
      return;
     }

   /*=====================================*/
   /* Convert the string to a multifield. */
   /*=====================================*/
  
   theMultifield = StringToMultifield(DOToString(value));
   if (theMultifield == NULL)
     {
      theMultifield = (struct multifield *) CreateMultifield(0L);
      end = 0;
     }
   else
     { end = GetMFLength(theMultifield); }

   /*========================*/
   /* Return the multifield. */
   /*========================*/

   SetpType(str_value,MULTIFIELD);
   SetpDOBegin(str_value,1);
   SetpDOEnd(str_value,end);
   SetpValue(str_value,(VOID *) theMultifield);
   return;
  }

/*****************************************/
/* ImplodeFunction: CLIPS access routine */
/*   for the implode$ function.          */
/*****************************************/
globle VOID *ImplodeFunction()
  {
   DATA_OBJECT value;
   long strsize = 0;
   long i, j;
   char *tmp_str;
   char *ret_str;
   struct multifield *theMultifield;
   VOID *rv;
   
   /*=====================================*/
   /* Implode$ expects a single argument. */
   /*=====================================*/

   if (ArgCountCheck("implode$",EXACTLY,1) == -1)
     { return(AddSymbol("")); }
     
   /*======================================*/
   /* The argument should be a multifield. */
   /*======================================*/

   if (ArgTypeCheck("implode$",1,MULTIFIELD,&value) == CLIPS_FALSE)
     { return(AddSymbol("")); }

   /*===================================================*/
   /* Determine the size of the string to be allocated. */
   /*===================================================*/

   theMultifield = (struct multifield *) GetValue(value);
   for (i = GetDOBegin(value) ; i <= GetDOEnd(value) ; i++)
     {
      if (GetMFType(theMultifield,i) == FLOAT)
        {
         tmp_str = FloatToString(ValueToDouble(GetMFValue(theMultifield,i)));
         strsize += strlen(tmp_str) + 1;
        }
      else if (GetMFType(theMultifield,i) == INTEGER)
        {
         tmp_str = LongIntegerToString(ValueToLong(GetMFValue(theMultifield,i)));
         strsize += strlen(tmp_str) + 1;
        }
      else if (GetMFType(theMultifield,i) == STRING)
        {
         strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3;
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         while(*tmp_str)
           {
            if(*tmp_str == '"')
              { strsize++; }
            tmp_str++;
           }
        }
#if OBJECT_SYSTEM
      else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
        { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 3; }
      else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
        { strsize += strlen(ValueToString(((INSTANCE_TYPE *)
                            GetMFValue(theMultifield,i))->name)) + 3; }
#endif

      else
        { strsize += strlen(ValueToString(GetMFValue(theMultifield,i))) + 1; }
     }

   /*=============================================*/
   /* Allocate the string and copy all components */
   /* of the MULTIFIELD variable to it.             */
   /*=============================================*/

   if (strsize == 0) return(AddSymbol(""));
   ret_str = (char *) gm2(strsize);
   for(j=0, i=GetDOBegin(value); i <= GetDOEnd(value) ; i++)
     {

      /*============================*/
      /* Convert numbers to strings */
      /*============================*/

      if (GetMFType(theMultifield,i) == FLOAT)
        {
         tmp_str = FloatToString(ValueToDouble(GetMFValue(theMultifield,i)));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
        }
      else if (GetMFType(theMultifield,i) == INTEGER)
        {
         tmp_str = LongIntegerToString(ValueToLong(GetMFValue(theMultifield,i)));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
        }

      /*=======================================*/
      /* Enclose strings in quotes and preceed */
      /* imbedded quotes with a backslash      */
      /*=======================================*/

      else if (GetMFType(theMultifield,i) == STRING)
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         *(ret_str+j) = '"';
         j++;
         while(*tmp_str)
           {
            if(*tmp_str == '"')
              {
               *(ret_str+j) = '\\';
               j++;
              }
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str+j) = '"';
         j++;
        }
#if OBJECT_SYSTEM
      else if (GetMFType(theMultifield,i) == INSTANCE_NAME)
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         *(ret_str + j++) = '[';
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str + j++) = ']';
        }
      else if (GetMFType(theMultifield,i) == INSTANCE_ADDRESS)
        {
         tmp_str = ValueToString(((INSTANCE_TYPE *) GetMFValue(theMultifield,i))->name);
         *(ret_str + j++) = '[';
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         *(ret_str + j++) = ']';
        }
#endif
      else
        {
         tmp_str = ValueToString(GetMFValue(theMultifield,i));
         while(*tmp_str)
           {
            *(ret_str+j) = *tmp_str;
            j++, tmp_str++;
           }
         }
      *(ret_str+j) = ' ';
      j++;
     }
   *(ret_str+j-1) = '\0';

   /*====================*/
   /* Return the string. */
   /*====================*/

   rv = AddSymbol(ret_str);
   rm(ret_str,strsize);
   return(rv);
  }

/****************************************/
/* SubseqFunction: CLIPS access routine */
/*   for the subseq$ function.          */
/****************************************/
globle VOID SubseqFunction(sub_value)
  DATA_OBJECT_PTR sub_value;
  {
   DATA_OBJECT value;
   struct multifield *theList;
   long offset, start, end, length; /* 6.04 Bug Fix */

   /*===================================*/
   /* Get the segment to be subdivided. */
   /*===================================*/
  
   if (ArgTypeCheck("subseq$",1,MULTIFIELD,&value) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   theList = (struct multifield *) DOToPointer(value);
   offset = GetDOBegin(value);
   length = GetDOLength(value);
   
   /*=============================================*/
   /* Get range arguments. If they are not within */
   /* appropriate ranges, return a null segment.  */
   /*=============================================*/
   
   if (ArgTypeCheck("subseq$",2,INTEGER,&value) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   start = DOToInteger(value);

   if (ArgTypeCheck("subseq$",3,INTEGER,&value) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   end = DOToInteger(value);

   if ((end < 1) || (end < start))
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }

   /*===================================================*/
   /* Adjust lengths  to conform to segment boundaries. */
   /*===================================================*/

   if (start > length)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   if (end > length) end = length;
   if (start < 1) start = 1;

   /*=========================*/
   /* Return the new segment. */
   /*=========================*/

   SetpType(sub_value,MULTIFIELD);
   SetpValue(sub_value,theList);
   SetpDOEnd(sub_value,offset + end - 1);
   SetpDOBegin(sub_value,offset + start - 1);
  }

/******************************************/
/* MVSubseqFunction: CLIPS access routine */
/*   for the mv-subseq function.          */
/******************************************/
globle VOID MVSubseqFunction(sub_value)
  DATA_OBJECT_PTR sub_value;
  {
   DATA_OBJECT value;
   struct multifield *theList;
   long offset, start, end, length; /* 6.04 Bug Fix */
   
   /*=============================================*/
   /* Get range arguments. If they are not within */
   /* appropriate ranges, return a null segment.  */
   /*=============================================*/
   
   if (ArgTypeCheck("mv-subseq",1,INTEGER,&value) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   start = DOToInteger(value);

   if (ArgTypeCheck("mv-subseq",2,INTEGER,&value) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   end = DOToInteger(value);

   if ((end < 1) || (end < start))
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }

   /*===================================*/
   /* Get the segment to be subdivided. */
   /*===================================*/
  
   if (ArgTypeCheck("mv-subseq",3,MULTIFIELD,&value) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   theList = (struct multifield *) DOToPointer(value);
   offset = GetDOBegin(value);
   
   /*===================================================*/
   /* Adjust lengths  to conform to segment boundaries. */
   /*===================================================*/

   length = GetDOLength(value);
   if (start > length)
     {
      SetMultifieldErrorValue(sub_value);
      return;
     }
   if (end > length) end = length;
   if (start < 1) start = 1;

   /*=========================*/
   /* Return the new segment. */
   /*=========================*/

   SetpType(sub_value,MULTIFIELD);
   SetpValue(sub_value,theList);
   SetpDOEnd(sub_value,offset + end - 1);
   SetpDOBegin(sub_value,offset + start - 1);
  }