argacces.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.05  04/09/97            */
   /*                                                     */
   /*               ARGUMENT ACCESS MODULE                */
   /*******************************************************/

/*************************************************************/
/* Purpose: Provides access routines for accessing arguments */
/*   passed to user or system functions defined using the    */
/*   DefineFunction protocol for extending CLIPS.            */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/

#define _ARGACCES_SOURCE_

#include "setup.h"

#include <stdio.h>
#define _CLIPS_STDIO_
#include <string.h>
#include <ctype.h>
#if ANSI_COMPILER
#include <stdlib.h>
#endif

#include "extnfunc.h"
#include "router.h"
#include "cstrnchk.h"
#include "prntutil.h"

#include "argacces.h"

/***************************************/
/* LOCAL INTERNAL FUNCTION DEFINITIONS */
/***************************************/

#if ANSI_COMPILER
   static VOID                    NonexistantError(char *,char *,int);
   static VOID                    ExpectedTypeError3(char *,char *,int,char *);
#else
   static VOID                    NonexistantError();
   static VOID                    ExpectedTypeError3();
#endif

/****************************************************************/
/* RtnLexeme: Access function to retrieve the nth argument from */
/*   a user or system function defined using the DefineFunction */
/*   protocol. The argument retrieved must be a symbol, string, */
/*   or instance name, otherwise an error is generated. Only    */
/*   the value of the argument is returned (i.e. the string "a" */
/*   would be returned for a, "a", and [a]).                    */
/****************************************************************/
globle char *RtnLexeme(argumentPosition)
  int argumentPosition;
  {
   int count = 1;
   DATA_OBJECT result;
   struct expr *argPtr;

   /*=====================================================*/
   /* Find the appropriate argument in the argument list. */
   /*=====================================================*/

   for (argPtr = CurrentExpression->argList;
        (argPtr != NULL) && (count < argumentPosition);
        argPtr = argPtr->nextArg)
     { count++; }

   if (argPtr == NULL)
     {
      NonexistantError("RtnLexeme",
                       ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(CLIPS_TRUE);
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }

   /*============================================*/
   /* Return the value of the nth argument if it */
   /* is a symbol, string, or instance name.     */
   /*============================================*/

   EvaluateExpression(argPtr,&result);
   
   if ((result.type == SYMBOL) ||
#if OBJECT_SYSTEM
       (result.type == INSTANCE_NAME) ||
#endif
       (result.type == STRING))
     { return(ValueToString(result.value));}

   /*======================================================*/
   /* Generate an error if the argument is the wrong type. */
   /*======================================================*/
   
   ExpectedTypeError3("RtnLexeme",
                  ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                  argumentPosition,"symbol, string, or instance name");
   SetHaltExecution(CLIPS_TRUE);
   SetEvaluationError(CLIPS_TRUE);
   return(NULL);
  }

/****************************************************************/
/* RtnDouble: Access function to retrieve the nth argument from */
/*   a user or system function defined using the DefineFunction */
/*   protocol. The argument retrieved must be a either a float  */
/*   or an integer (type conversion to a float is performed for */
/*   integers), otherwise an error is generated. Only the value */
/*   of the argument is returned (i.e. the float 3.0 would be   */
/*   returned for 3.0 and 3).                                   */
/****************************************************************/
globle double RtnDouble(argumentPosition)
  int argumentPosition;
  {
   int count = 1;
   DATA_OBJECT result;
   struct expr *argPtr;

   /*=====================================================*/
   /* Find the appropriate argument in the argument list. */
   /*=====================================================*/

   for (argPtr = CurrentExpression->argList;
        (argPtr != NULL) && (count < argumentPosition);
        argPtr = argPtr->nextArg)
     { count++; }

   if (argPtr == NULL)
     {
      NonexistantError("RtnDouble",
                       ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(CLIPS_TRUE);
      SetEvaluationError(CLIPS_TRUE);
      return(1.0);
     }

   /*======================================*/
   /* Return the value of the nth argument */
   /* if it is a float or integer.         */
   /*======================================*/

   EvaluateExpression(argPtr,&result);

   if (result.type == FLOAT)
     { return(ValueToDouble(result.value)); }
   else if (result.type == INTEGER)
     { return((double) ValueToLong(result.value)); }
   
   /*======================================================*/
   /* Generate an error if the argument is the wrong type. */
   /*======================================================*/
   
   ExpectedTypeError3("RtnDouble",
                  ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                  argumentPosition,"number");
   SetHaltExecution(CLIPS_TRUE);
   SetEvaluationError(CLIPS_TRUE);
   return(1.0);
  }

/****************************************************************/
/* RtnLong: Access function to retrieve the nth argument from   */
/*   a user or system function defined using the DefineFunction */
/*   protocol. The argument retrieved must be a either a float  */
/*   or an integer (type conversion to an integer is performed  */
/*   for floats), otherwise an error is generated. Only the     */
/*   value of the argument is returned (i.e. the integer 4      */
/*   would be returned for 4.3 and 4).                          */
/****************************************************************/
globle long RtnLong(argumentPosition)
  int argumentPosition;
  {
   int count = 1;
   DATA_OBJECT result;
   struct expr *argPtr;

   /*=====================================================*/
   /* Find the appropriate argument in the argument list. */
   /*=====================================================*/

   for (argPtr = CurrentExpression->argList;
        (argPtr != NULL) && (count < argumentPosition);
        argPtr = argPtr->nextArg)
     { count++; }

   if (argPtr == NULL)
     {
      NonexistantError("RtnLong",
                       ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(CLIPS_TRUE);
      SetEvaluationError(CLIPS_TRUE);
      return(1L);
     }

   /*======================================*/
   /* Return the value of the nth argument */
   /* if it is a float or integer.         */
   /*======================================*/

   EvaluateExpression(argPtr,&result);

   if (result.type == FLOAT)
     { return((long) ValueToDouble(result.value)); }
   else if (result.type == INTEGER)
     { return(ValueToLong(result.value)); }
     
   /*======================================================*/
   /* Generate an error if the argument is the wrong type. */
   /*======================================================*/
   
   ExpectedTypeError3("RtnLong",
                  ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                  argumentPosition,"number");
   SetHaltExecution(CLIPS_TRUE);
   SetEvaluationError(CLIPS_TRUE);
   return(1L);
  }

/******************************************************************/
/* RtnUnknown: Access function to retrieve the nth argument from  */
/*   a user or system function defined using the DefineFunction   */
/*   protocol. The argument retrieved can be of any type. The     */
/*   value and type of the argument are returned in a DATA_OBJECT */
/*   structure provided by the calling function.                  */
/******************************************************************/
globle DATA_OBJECT_PTR RtnUnknown(argumentPosition,returnValue)
  int argumentPosition;
  DATA_OBJECT_PTR returnValue;
  {
  int count = 1;
   struct expr *argPtr;

   /*=====================================================*/
   /* Find the appropriate argument in the argument list. */
   /*=====================================================*/

   for (argPtr = CurrentExpression->argList;
        (argPtr != NULL) && (count < argumentPosition);
        argPtr = argPtr->nextArg)
     { count++; }

   if (argPtr == NULL)
     {
      NonexistantError("RtnUnknown",
                       ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(CLIPS_TRUE);
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }

   /*=======================================*/
   /* Return the value of the nth argument. */
   /*=======================================*/

   EvaluateExpression(argPtr,returnValue);
   return(returnValue);
  }

/********************************************************/
/* RtnArgCount: Returns the length of the argument list */
/*   for the function call currently being evaluated.   */
/********************************************************/
globle int RtnArgCount()
  {
   int count = 0;
   struct expr *argPtr;

   for (argPtr = CurrentExpression->argList;
        argPtr != NULL;
        argPtr = argPtr->nextArg)
     { count++; }

   return(count);
  }

/**********************************************************************/
/* ArgCountCheck: Given the expected number of arguments, determines  */
/*   if the function currently being evaluated has the correct number */
/*   of arguments. Three types of argument checking are provided by   */
/*   this function: 1) The function has exactly the expected number   */
/*   of arguments; 2) The function has at least the expected number   */
/*   of arguments; 3) The function has at most the expected number of */
/*   arguments. The number of arguments is returned if no error       */
/*   occurs, otherwise -1 is returned.                                */
/**********************************************************************/
globle int ArgCountCheck(functionName,countRelation,expectedNumber)
  char *functionName;
  int countRelation, expectedNumber;
  {
   int numberOfArguments;