prccode.c

clips源代码

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

/***************************************************************/
/* Purpose: Procedural Code Support Routines for Deffunctions, */
/*          Generic Function Methods,Message-Handlers          */
/*          and Rules                                          */
/*                                                             */
/* Principal Programmer(s):                                    */
/*      Brian L. Donnell                                       */
/*                                                             */
/* Contributing Programmer(s):                                 */
/*                                                             */
/* Revision History:                                           */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859    */
/*                                                             */
/*            Changed name of variable log to logName          */
/*            because of Unix compiler warnings of shadowed    */
/*            definitions.                                     */
/*                                                             */
/*      6.24: Renamed BOOLEAN macro type to intBool.           */
/*                                                             */
/*            Added pragmas to remove compilation warnings.    */
/*                                                             */
/***************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#ifndef _STDIO_INCLUDED_
#include <stdio.h>
#define _STDIO_INCLUDED_
#endif

#include <stdlib.h>
#include <ctype.h>

#include "memalloc.h"
#include "constant.h"
#include "envrnmnt.h"
#if DEFGLOBAL_CONSTRUCT
#include "globlpsr.h"
#endif
#include "exprnpsr.h"
#include "multifld.h"
#if OBJECT_SYSTEM
#include "object.h"
#endif
#include "prcdrpsr.h"
#include "router.h"
#include "utility.h"

#define _PRCCODE_SOURCE_
#include "prccode.h"

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */
typedef struct
  {
   unsigned firstFlag  : 1;
   unsigned first      : 15;
   unsigned secondFlag : 1;
   unsigned second     : 15;
  } PACKED_PROC_VAR;

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */

static void EvaluateProcParameters(void *,EXPRESSION *,int,char *,char *);
static intBool RtnProcParam(void *,void *,DATA_OBJECT *);
static intBool GetProcBind(void *,void *,DATA_OBJECT *);
static intBool PutProcBind(void *,void *,DATA_OBJECT *);
static intBool RtnProcWild(void *,void *,DATA_OBJECT *);
static void DeallocateProceduralPrimitiveData(void *);
static void ReleaseProcParameters(void *);

#if (! BLOAD_ONLY) && (! RUN_TIME)
static int FindProcParameter(SYMBOL_HN *,EXPRESSION *,SYMBOL_HN *);
static int ReplaceProcBinds(void *,EXPRESSION *,
                             int (*)(void *,EXPRESSION *,void *),void *);
static EXPRESSION *CompactActions(void *,EXPRESSION *);
#endif

#if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT)
static intBool EvaluateBadCall(void *,void *,DATA_OBJECT *);
#endif

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/****************************************************
  NAME         : InstallProcedurePrimitives
  DESCRIPTION  : Installs primitive function handlers
                 for accessing parameters and local
                 variables within the bodies of
                 message-handlers, methods, rules and
                 deffunctions.
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Primitive entities installed
  NOTES        : None
 ****************************************************/
globle void InstallProcedurePrimitives(
  void *theEnv)
  {
   ENTITY_RECORD procParameterInfo = { "PROC_PARAM", PROC_PARAM,0,1,0,NULL,NULL,NULL,
                                           RtnProcParam,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },
                     procWildInfo =      { "PROC_WILD_PARAM", PROC_WILD_PARAM,0,1,0,NULL,NULL,NULL,
                                           RtnProcWild,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },
                     procGetInfo =       { "PROC_GET_BIND", PROC_GET_BIND,0,1,0,NULL,NULL,NULL,
                                           GetProcBind,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL },
                     procBindInfo =      { "PROC_BIND", PROC_BIND,0,1,0,NULL,NULL,NULL,
                                           PutProcBind,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };
#if ! DEFFUNCTION_CONSTRUCT
   ENTITY_RECORD deffunctionEntityRecord =
                     { "PCALL", PCALL,0,0,1,
                       NULL,NULL,NULL,
                       EvaluateBadCall,
                       NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };
#endif
#if ! DEFGENERIC_CONSTRUCT
   ENTITY_RECORD genericEntityRecord =
                     { "GCALL", GCALL,0,0,1,
                       NULL,NULL,NULL,
                       EvaluateBadCall,
                       NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL };
#endif

   AllocateEnvironmentData(theEnv,PROCEDURAL_PRIMITIVE_DATA,sizeof(struct proceduralPrimitiveData),DeallocateProceduralPrimitiveData);

   memcpy(&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,&procParameterInfo,sizeof(struct entityRecord));  
   memcpy(&ProceduralPrimitiveData(theEnv)->ProcWildInfo,&procWildInfo,sizeof(struct entityRecord));  
   memcpy(&ProceduralPrimitiveData(theEnv)->ProcGetInfo,&procGetInfo,sizeof(struct entityRecord));  
   memcpy(&ProceduralPrimitiveData(theEnv)->ProcBindInfo,&procBindInfo,sizeof(struct entityRecord));  

   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcParameterInfo,PROC_PARAM);
   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcWildInfo,PROC_WILD_PARAM);
   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcGetInfo,PROC_GET_BIND);
   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->ProcBindInfo,PROC_BIND);

   ProceduralPrimitiveData(theEnv)->Oldindex = -1;
   
   /* ===============================================
      Make sure a default evaluation function is
      in place for deffunctions and generic functions
      in the event that a binary image containing
      these items is loaded into a configuration
      that does not support them.
      =============================================== */

#if ! DEFFUNCTION_CONSTRUCT
   memcpy(&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord));  
   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->DeffunctionEntityRecord,PCALL);
#endif

#if ! DEFGENERIC_CONSTRUCT
   memcpy(&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord));  
   InstallPrimitive(theEnv,&ProceduralPrimitiveData(theEnv)->GenericEntityRecord,GCALL);
#endif

   /* =============================================
      Install the special empty multifield to
      let callers distinguish between no parameters
      and zero-length multifield parameters
      ============================================= */
   ProceduralPrimitiveData(theEnv)->NoParamValue = CreateMultifield2(theEnv,0L);
   MultifieldInstall(theEnv,(MULTIFIELD_PTR) ProceduralPrimitiveData(theEnv)->NoParamValue);
  }

/**************************************************************/
/* DeallocateProceduralPrimitiveData: Deallocates environment */
/*    data for the procedural primitives functionality.       */
/**************************************************************/
static void DeallocateProceduralPrimitiveData(
  void *theEnv)
  {
   ReturnMultifield(theEnv,(struct multifield *) ProceduralPrimitiveData(theEnv)->NoParamValue);
   ReleaseProcParameters(theEnv);
  }

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

#if DEFFUNCTION_CONSTRUCT || OBJECT_SYSTEM

/************************************************************
  NAME         : ParseProcParameters
  DESCRIPTION  : Parses a parameter list for a
                  procedural routine, such as a
                  deffunction or message-handler
  INPUTS       : 1) The logical name of the input
                 2) A buffer for scanned tokens
                 3) The partial list of parameters so far
                    (can be NULL)
                 3) A buffer for a wildcard symbol (if any)
                 4) A buffer for a minimum of parameters
                 5) A buffer for a maximum of parameters
                    (will be set to -1 if there is a wilcard)
                 6) A buffer for an error flag
                 7) The address of a function to do specialized
                    checking on a parameter (can be NULL)
                    The function should accept a string and
                    return FALSE if the parameter is OK, TRUE
                    otherwise.
  RETURNS      : A list of expressions containing the
                   parameter names
  SIDE EFFECTS : Parameters parsed and expressions formed
  NOTES        : None
 ************************************************************/
globle EXPRESSION *ParseProcParameters(
  void *theEnv,
  char *readSource,
  struct token *tkn,
  EXPRESSION *parameterList,
  SYMBOL_HN **wildcard,
  int *min,
  int *max,
  int *error,
  int (*checkfunc)(void *,char *))
  {
   EXPRESSION *nextOne,*lastOne,*check;
   int paramprintp = 0;

   *wildcard = NULL;
   *min = 0;
   *error = TRUE;
   lastOne = nextOne = parameterList;
   while (nextOne != NULL)
     {
      (*min)++;
      lastOne = nextOne;
      nextOne = nextOne->nextArg;
     }
   if (tkn->type != LPAREN)
     {
      SyntaxErrorMessage(theEnv,"parameter list");
      ReturnExpression(theEnv,parameterList);
      return(NULL);
     }
   GetToken(theEnv,readSource,tkn);
   while ((tkn->type == SF_VARIABLE) || (tkn->type == MF_VARIABLE))
     {
      for (check = parameterList ; check != NULL ; check = check->nextArg)
        if (check->value == tkn->value)
         {
          PrintErrorID(theEnv,"PRCCODE",7,FALSE);
          EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n");
          ReturnExpression(theEnv,parameterList);
          return(NULL);
         }
      if (*wildcard != NULL)
        {
         PrintErrorID(theEnv,"PRCCODE",8,FALSE);
         EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n");
         ReturnExpression(theEnv,parameterList);
         return(NULL);
        }
      if ((checkfunc != NULL) ? (*checkfunc)(theEnv,ValueToString(tkn->value)) : FALSE)
        {
         ReturnExpression(theEnv,parameterList);
         return(NULL);
        }
      nextOne = GenConstant(theEnv,tkn->type,tkn->value);
      if (tkn->type == MF_VARIABLE)
        *wildcard = (SYMBOL_HN *) tkn->value;
      else
        (*min)++;
      if (lastOne == NULL)
        { parameterList = nextOne; }
      else
        { lastOne->nextArg = nextOne; }
      lastOne = nextOne;
      SavePPBuffer(theEnv," ");
      paramprintp = 1;
      GetToken(theEnv,readSource,tkn);
     }
   if (tkn->type != RPAREN)
     {
      SyntaxErrorMessage(theEnv,"parameter list");
      ReturnExpression(theEnv,parameterList);
      return(NULL);
     }
   if (paramprintp)
     {
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,")");
     }
   *error = FALSE;
   *max = (*wildcard != NULL) ? -1 : *min;
   return(parameterList);
  }

#endif

/*************************************************************************
  NAME         : ParseProcActions
  DESCRIPTION  : Parses the bodies of deffunctions, generic function
                 methods and message-handlers.  Replaces parameter
                 and local variable references with appropriate
                 runtime access functions
  INPUTS       : 1) The type of procedure body being parsed
                 2) The logical name of the input
                 3) A buffer for scanned tokens
                 4) A list of expressions containing the names
                    of the parameters
                 5) The wilcard parameter symbol (NULL if none)
                 6) A pointer to a function to parse variables not
                    recognized by the standard parser
                    The function should accept the variable
                    expression and a generic pointer for special
                    data (can be NULL) as arguments.  If the variable
                    is recognized, the function should modify the
                    expression to access this variable.  Return 1
                    if recognized, 0 if not, -1 on errors
                    This argument can be NULL.
                 7) A pointer to a function to handle binds in a
                    special way. The function should accept the
                    bind function call expression as an argument.
                    If the variable is recognized and treated specially,
                    the function should modify the expression
                    appropriately (including attaching/removing
                    any necessary argument expressions).  Return 1
                    if recognized, 0 if not, -1 on errors.
                    This argument can be NULL.
                 8) A buffer for holding the number of local vars
                    used by this procedure body.
                 9) Special user data buffer to pass to variable
                    reference and bind replacement functions
RETURNS      : A packed expression containing the body, NULL on
                   errors.
SIDE EFFECTS : Variable references replaced with runtime calls
                  to access the paramter and local variable array
NOTES        : None
*************************************************************************/
globle EXPRESSION *ParseProcActions(
  void *theEnv,
  char *bodytype,
  char *readSource,
  struct token *tkn,
  EXPRESSION *params,
  SYMBOL_HN *wildcard,