strngfun.c

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

   end = CoerceToInteger(theArgument.type,theArgument.value) - 1;

   if (ArgTypeCheck("sub-string",3,SYMBOL_OR_STRING,&theArgument) == CLIPS_FALSE)
     { return((VOID *) AddSymbol("")); }

   /*================================================*/
   /* If parameters are out of range return an error */
   /*================================================*/

   if (start < 0) start = 0;
   if (end > (int) strlen(DOToString(theArgument)))
     { end = strlen(DOToString(theArgument)); }

   /*==================================*/
   /* If the start is greater than the */
   /* end, return a null string.       */
   /*==================================*/

   if (start > end)
     { return((VOID *) AddSymbol("")); }

   /*=============================================*/
   /* Otherwise, allocate the string and copy the */
   /* designated portion of the old string to the */
   /* new string.                                 */
   /*=============================================*/

   else
     {
      returnString = (char *) gm2(end - start +2);  /* (end - start) inclusive + EOS */
      tempString = DOToString(theArgument);
      for(j=0, i=start;i <= end; i++, j++)
        { *(returnString+j) = *(tempString+i); }
      *(returnString+j) = '\0';
     }

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

   returnValue = (VOID *) AddSymbol(returnString);
   rm(returnString,end - start + 2);
   return(returnValue);
  }

/******************************************/
/* StrIndexFunction: CLIPS access routine */
/*   for the sub-index function.          */
/******************************************/
globle VOID StrIndexFunction(result)
  DATA_OBJECT_PTR result;
  {
   DATA_OBJECT theArgument1, theArgument2;
   char *strg1, *strg2;
   int i, j;

   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;

   /*===================================*/
   /* Check and retrieve the arguments. */
   /*===================================*/

   if (ArgCountCheck("str-index",EXACTLY,2) == -1) return;

   if (ArgTypeCheck("str-index",1,SYMBOL_OR_STRING,&theArgument1) == CLIPS_FALSE) return;

   if (ArgTypeCheck("str-index",2,SYMBOL_OR_STRING,&theArgument2) == CLIPS_FALSE) return;

   strg1 = DOToString(theArgument1);
   strg2 = DOToString(theArgument2);

   /*=================================*/
   /* Find the position in string2 of */
   /* string1 (counting from 1).      */
   /*=================================*/

   if (strlen(strg1) == 0)
     {
      result->type = INTEGER;
      result->value = (VOID *) AddLong((long) strlen(strg2) + 1L);
      return;
     }

   for (i=1; *strg2; i++, strg2++)
     {
      for (j=0; *(strg1+j) && *(strg1+j) == *(strg2+j); j++)
        { /* Do Nothing */ }

      if (*(strg1+j) == '\0')
        {
         result->type = INTEGER;
         result->value = (VOID *) AddLong((long) i);
         return;
        }
     }

   return;
  }

#if (! RUN_TIME) && (! BLOAD_ONLY)

/**************************************/
/* EvalFunction: CLIPS access routine */
/*   for the eval function.           */
/**************************************/
globle VOID EvalFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT theArg;

   /*=============================================*/
   /* Function eval expects exactly one argument. */
   /*=============================================*/

   if (ArgCountCheck("eval",EXACTLY,1) == -1)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,CLIPSFalseSymbol);
      return;
     }

   /*==================================================*/
   /* The argument should be of type SYMBOL or STRING. */
   /*==================================================*/

   if (ArgTypeCheck("eval",1,SYMBOL_OR_STRING,&theArg) == CLIPS_FALSE)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,CLIPSFalseSymbol);
      return;
     }

   /*======================*/
   /* Evaluate the string. */
   /*======================*/

   Eval(DOToString(theArg),returnValue);
  }

/****************************/
/* Eval: C access routine   */
/*   for the eval function. */
/****************************/
globle int Eval(theString,returnValue)
  char *theString;
  DATA_OBJECT_PTR returnValue;
  {
   struct expr *top;
   int ov;
   static int depth = 0;
   char logicalNameBuffer[20];
   struct BindInfo *oldBinds;

   /*======================================================*/
   /* Evaluate the string. Create a different logical name */
   /* for use each time the eval function is called.       */
   /*======================================================*/

   depth++;
   sprintf(logicalNameBuffer,"Eval-%d",depth);
   if (OpenStringSource(logicalNameBuffer,theString,0) == 0)
     {
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,CLIPSFalseSymbol);
      depth--;
      return(CLIPS_FALSE);
     }

   /*================================================*/
   /* Save the current parsing state before routines */
   /* are called to parse the eval string.           */
   /*================================================*/
   
   ov = GetPPBufferStatus();
   SetPPBufferStatus(CLIPS_FALSE);
   oldBinds = GetParsedBindNames();
   SetParsedBindNames(NULL);

   /*========================================================*/
   /* Parse the string argument passed to the eval function. */
   /*========================================================*/
   
   top = ParseAtomOrExpression(logicalNameBuffer,NULL);

   /*============================*/
   /* Restore the parsing state. */
   /*============================*/
   
   SetPPBufferStatus(ov);
   ClearParsedBindNames();
   SetParsedBindNames(oldBinds);

   /*===========================================*/
   /* Return if an error occured while parsing. */
   /*===========================================*/
   
   if (top == NULL)
     {
      SetEvaluationError(CLIPS_TRUE);
      CloseStringSource(logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,CLIPSFalseSymbol);
      depth--;
      return(CLIPS_FALSE);
     }
     
   /*==============================================*/
   /* The sequence expansion operator must be used */
   /* within the argument list of a function call. */
   /*==============================================*/
   
   if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE))
     {
      PrintErrorID("MISCFUN",1,CLIPS_FALSE);
      PrintCLIPS(WERROR,"expand$ must be used in the argument list of a function call.\n");
      SetEvaluationError(CLIPS_TRUE);
      CloseStringSource(logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,CLIPSFalseSymbol);
      ReturnExpression(top);
      depth--;
      return(CLIPS_FALSE);
     }
     
   /*=======================================*/
   /* The expression to be evaluated cannot */
   /* contain any local variables.          */
   /*=======================================*/
   
   if (ExpressionContainsVariables(top,CLIPS_FALSE))
     {      
      PrintErrorID("STRNGFUN",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Some variables could not be accessed by the eval function.\n");
      SetEvaluationError(CLIPS_TRUE);
      CloseStringSource(logicalNameBuffer);
      SetpType(returnValue,SYMBOL);
      SetpValue(returnValue,CLIPSFalseSymbol);
      ReturnExpression(top);
      depth--;
      return(CLIPS_FALSE);
     }
   
   /*====================================*/
   /* Evaluate the expression and return */
   /* the memory used to parse it.       */
   /*====================================*/
   
   EvaluateExpression(top,returnValue);
   
   depth--;
   ReturnExpression(top);
   CloseStringSource(logicalNameBuffer);

   if (GetEvaluationError()) return(CLIPS_FALSE);
   return(CLIPS_TRUE);
  }
  
#else

/**********************************************************/
/* EvalFunction: This is the non-functional stub provided */
/*   for use with a run-time version of CLIPS.            */
/**********************************************************/
globle VOID EvalFunction(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   PrintErrorID("STRNGFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Function eval does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,CLIPSFalseSymbol);
  }

/**************************************************/
/* Eval: This is the non-functional stub provided */
/*   for use with a run-time version of CLIPS.    */
/**************************************************/
globle int Eval(theString,returnValue)
  char *theString;
  DATA_OBJECT_PTR returnValue;
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theString)
#endif

   PrintErrorID("STRNGFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Function eval does not work in run time modules.\n");
   SetpType(returnValue,SYMBOL);
   SetpValue(returnValue,CLIPSFalseSymbol);
   return(CLIPS_FALSE);
  }

#endif

#if (! RUN_TIME) && (! BLOAD_ONLY)
/***************************************/
/* BuildFunction: CLIPS access routine */
/*   for the build function.           */
/***************************************/
globle int BuildFunction()
  {
   DATA_OBJECT theArg;

   /*==============================================*/
   /* Function build expects exactly one argument. */
   /*==============================================*/

   if (ArgCountCheck("build",EXACTLY,1) == -1) return(CLIPS_FALSE);

   /*==================================================*/
   /* The argument should be of type SYMBOL or STRING. */
   /*==================================================*/

   if (ArgTypeCheck("build",1,SYMBOL_OR_STRING,&theArg) == CLIPS_FALSE)
     { return(CLIPS_FALSE); }

   /*======================*/
   /* Build the construct. */
   /*======================*/
   
   return(Build(DOToString(theArg)));
  }

/*****************************/
/* Build: C access routine   */
/*   for the build function. */
/*****************************/
globle int Build(theString)
  char *theString;
  {
   char *constructType;
   struct token theToken;
   int errorFlag;

   /*====================================================*/
   /* No additions during defrule join network activity. */
   /*====================================================*/

#if DEFRULE_CONSTRUCT
   if (JoinOperationInProgress) return(CLIPS_FALSE);
#endif

   /*===========================================*/
   /* Create a string source router so that the */
   /* string can be used as an input source.    */
   /*===========================================*/

   if (OpenStringSource("build",theString,0) == 0)
     { return(CLIPS_FALSE); }

   /*================================*/
   /* The first token of a construct */
   /* must be a left parenthesis.    */
   /*================================*/
   
   GetToken("build",&theToken);

   if (theToken.type != LPAREN)
     {
      CloseStringSource("build");
      return(CLIPS_FALSE);
     }

   /*==============================================*/
   /* The next token should be the construct type. */
   /*==============================================*/
   
   GetToken("build",&theToken);
   if (theToken.type != SYMBOL)
     {
      CloseStringSource("build");
      return(CLIPS_FALSE);
     }

   constructType = ValueToString(theToken.value);

   /*======================*/
   /* Parse the construct. */
   /*======================*/
   
   errorFlag = ParseConstruct(constructType,"build");

   /*=================================*/
   /* Close the string source router. */
   /*=================================*/
   
   CloseStringSource("build");

   /*=========================================*/
   /* If an error occured while parsing the   */
   /* construct, then print an error message. */
   /*=========================================*/
   
   if (errorFlag == 1)
     {
      PrintCLIPS(WERROR,"\nERROR:\n");
      PrintInChunks(WERROR,GetPPBuffer());
      PrintCLIPS(WERROR,"\n");
     }

   DestroyPPBuffer();

   /*===============================================*/
   /* Return TRUE if the construct was successfully */
   /* parsed, otherwise return FALSE.               */
   /*===============================================*/
   
   if (errorFlag == 0) return(CLIPS_TRUE);

   return(CLIPS_FALSE);
  }
#else
/***********************************************************/
/* BuildFunction: This is the non-functional stub provided */
/*   for use with a run-time version of CLIPS.             */
/***********************************************************/
globle int BuildFunction()
  {
   PrintErrorID("STRNGFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Function build does not work in run time modules.\n");
   return(CLIPS_FALSE);
  }
  
/***************************************************/
/* Build: This is the non-functional stub provided */
/*   for use with a run-time version of CLIPS.     */
/***************************************************/
globle int Build(theString)
  char *theString;
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theString)
#endif

   PrintErrorID("STRNGFUN",1,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Function build does not work in run time modules.\n");
   return(CLIPS_FALSE);
  }
#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */

#endif /* STRING_FUNCTIONS */