argacces.c

来自「clips源代码」· C语言 代码 · 共 1,029 行 · 第 1/3 页

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*             CLIPS Version 6.24  06/05/06            */
   /*                                                     */
   /*               ARGUMENT ACCESS MODULE                */
   /*******************************************************/

/*************************************************************/
/* Purpose: Provides access routines for accessing arguments */
/*   passed to user or system functions defined using the    */
/*   DefineFunction protocol.                                */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Gary D. Riley                                        */
/*                                                           */
/* Contributing Programmer(s):                               */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*      6.24: Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*            Added IllegalLogicalNameMessage function.      */
/*                                                           */
/*************************************************************/

#define _ARGACCES_SOURCE_

#include "setup.h"

#include <stdio.h>
#define _STDIO_INCLUDED_
#include <string.h>
#include <ctype.h>
#include <stdlib.h>

#include "envrnmnt.h"
#include "extnfunc.h"
#include "router.h"
#include "cstrnchk.h"
#include "insfun.h"
#include "factmngr.h"
#include "prntutil.h"
#include "sysdep.h"

#include "argacces.h"

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

   static void                    NonexistantError(void *,char *,char *,int);
   static void                    ExpectedTypeError3(void *,char *,char *,int,char *);

/*******************************************************************/
/* EnvRtnLexeme: 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 *EnvRtnLexeme(
  void *theEnv,
  int argumentPosition)
  {
   int count = 1;
   DATA_OBJECT result;
   struct expr *argPtr;

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

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

   if (argPtr == NULL)
     {
      NonexistantError(theEnv,"RtnLexeme",
                       ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }

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

   EvaluateExpression(theEnv,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(theEnv,"RtnLexeme",
                  ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                  argumentPosition,"symbol, string, or instance name");
   SetHaltExecution(theEnv,TRUE);
   SetEvaluationError(theEnv,TRUE);
   return(NULL);
  }

/*******************************************************************/
/* EnvRtnDouble: 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 EnvRtnDouble(
  void *theEnv,
  int argumentPosition)
  {
   int count = 1;
   DATA_OBJECT result;
   struct expr *argPtr;

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

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

   if (argPtr == NULL)
     {
      NonexistantError(theEnv,"RtnDouble",
                       ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      return(1.0);
     }

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

   EvaluateExpression(theEnv,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(theEnv,"RtnDouble",
                  ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                  argumentPosition,"number");
   SetHaltExecution(theEnv,TRUE);
   SetEvaluationError(theEnv,TRUE);
   return(1.0);
  }

/*****************************************************************/
/* EnvRtnLong: 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 long EnvRtnLong(
  void *theEnv,
  int argumentPosition)
  {
   int count = 1;
   DATA_OBJECT result;
   struct expr *argPtr;

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

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

   if (argPtr == NULL)
     {
      NonexistantError(theEnv,"RtnLong",
                       ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      return(1L);
     }

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

   EvaluateExpression(theEnv,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(theEnv,"RtnLong",
                  ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                  argumentPosition,"number");
   SetHaltExecution(theEnv,TRUE);
   SetEvaluationError(theEnv,TRUE);
   return(1L);
  }

/********************************************************************/
/* EnvRtnUnknown: 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 EnvRtnUnknown(
  void *theEnv,
  int argumentPosition,
  DATA_OBJECT_PTR returnValue)
  {
   int count = 1;
   struct expr *argPtr;

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

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

   if (argPtr == NULL)
     {
      NonexistantError(theEnv,"RtnUnknown",
                       ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                       argumentPosition);
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }

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

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

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

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

   return(count);
  }
  
/************************************************************************/
/* EnvArgCountCheck: 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 EnvArgCountCheck(
  void *theEnv,
  char *functionName,
  int countRelation,
  int expectedNumber)
  {
   int numberOfArguments;

   /*==============================================*/
   /* Get the number of arguments for the function */
   /* currently being evaluated.                   */
   /*==============================================*/

   numberOfArguments = EnvRtnArgCount(theEnv);

   /*=========================================================*/
   /* If the function satisfies expected number of arguments, */
   /* constraint, then return the number of arguments found.  */
   /*=========================================================*/

   if (countRelation == EXACTLY)
     { if (numberOfArguments == expectedNumber) return(numberOfArguments); }
   else if (countRelation == AT_LEAST)
     { if (numberOfArguments >= expectedNumber) return(numberOfArguments); }
   else if (countRelation == NO_MORE_THAN)
     { if (numberOfArguments <= expectedNumber) return(numberOfArguments); }

   /*================================================*/
   /* The correct number of arguments was not found. */
   /* Generate an error message and return -1.       */
   /*================================================*/

   ExpectedCountError(theEnv,functionName,countRelation,expectedNumber);

   SetHaltExecution(theEnv,TRUE);
   SetEvaluationError(theEnv,TRUE);