prccode.c

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

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

/***************************************************************/
/* 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:                                           */
/*                                                             */
/***************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

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

#if ANSI_COMPILER
#include <stdlib.h>
#endif
#include <ctype.h>

#include "clipsmem.h"
#include "constant.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"

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

typedef struct ProcParamStack
  {
   DATA_OBJECT *ParamArray;
   
#if DEFGENERIC_CONSTRUCT
   EXPRESSION *ParamExpressions;
#endif

   int ParamArraySize;
   DATA_OBJECT *WildcardValue;
   VOID (*UnboundErrFunc)(VOID_ARG);
   struct ProcParamStack *nxt;
  } PROC_PARAM_STACK;
  
/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static VOID EvaluateProcParameters(EXPRESSION *,int,char *,char *);
static BOOLEAN RtnProcParam(VOID *,DATA_OBJECT *);
static BOOLEAN GetProcBind(VOID *,DATA_OBJECT *);
static BOOLEAN PutProcBind(VOID *,DATA_OBJECT *);
static BOOLEAN RtnProcWild(VOID *,DATA_OBJECT *);

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

#if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT)
static BOOLEAN EvaluateBadCall(VOID *,DATA_OBJECT *);
#endif

#else

static VOID EvaluateProcParameters();
static BOOLEAN RtnProcParam();
static BOOLEAN GetProcBind();
static BOOLEAN PutProcBind();
static BOOLEAN RtnProcWild();

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

#if (! DEFFUNCTION_CONSTRUCT) || (! DEFGENERIC_CONSTRUCT)
static BOOLEAN EvaluateBadCall();
#endif

#endif
      
/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle VOID * NoParamValue = NULL;
globle DATA_OBJECT *ProcParamArray = NULL;
globle int ProcParamArraySize = 0;
globle EXPRESSION * CurrentProcActions = NULL;

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
#if DEFGENERIC_CONSTRUCT
static EXPRESSION *ProcParamExpressions = NULL;
#endif

static PROC_PARAM_STACK *pstack = NULL;
static DATA_OBJECT *WildcardValue = NULL,
                   *LocalVarArray = NULL;
static VOID (*ProcUnboundErrFunc)(VOID_ARG) = NULL;

static ENTITY_RECORD ProcParameterInfo = { PROC_PARAM,0,1,0,NULL,NULL,NULL,
                                           RtnProcParam,NULL,NULL,NULL,NULL,NULL,NULL },
                     ProcWildInfo =      { PROC_WILD_PARAM,0,1,0,NULL,NULL,NULL,
                                           RtnProcWild,NULL,NULL,NULL,NULL,NULL,NULL },
                     ProcGetInfo =       { PROC_GET_BIND,0,1,0,NULL,NULL,NULL,
                                           GetProcBind,NULL,NULL,NULL,NULL,NULL,NULL },
                     ProcBindInfo =      { PROC_BIND,0,1,0,NULL,NULL,NULL,
                                           PutProcBind,NULL,NULL,NULL,NULL,NULL,NULL };

#if ! DEFFUNCTION_CONSTRUCT

static ENTITY_RECORD DeffunctionEntityRecord =
                     { PCALL,0,0,1,
                       NULL,NULL,NULL,
                       EvaluateBadCall,
                       NULL,NULL,NULL,NULL,NULL,NULL,NULL };

#endif

#if ! DEFGENERIC_CONSTRUCT

static ENTITY_RECORD GenericEntityRecord =
                     { GCALL,0,0,1,
                       NULL,NULL,NULL,
                       EvaluateBadCall,
                       NULL,NULL,NULL,NULL,NULL,NULL,NULL };

#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()
  {
   InstallPrimitive(&ProcParameterInfo,PROC_PARAM);
   InstallPrimitive(&ProcWildInfo,PROC_WILD_PARAM);
   InstallPrimitive(&ProcGetInfo,PROC_GET_BIND);
   InstallPrimitive(&ProcBindInfo,PROC_BIND);
   
   /* ===============================================
      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
   InstallPrimitive(&DeffunctionEntityRecord,PCALL);
#endif

#if ! DEFGENERIC_CONSTRUCT
   InstallPrimitive(&GenericEntityRecord,GCALL);
#endif

   /* =============================================
      Install the special empty multifield to
      let callers distinguish between no parameters
      and zero-length multifield parameters
      ============================================= */
   NoParamValue = CreateMultifield2(0L);
   MultifieldInstall((MULTIFIELD_PTR) NoParamValue);
  }
 
#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 CLIPS_FALSE if the parameter is OK, CLIPS_TRUE
                    otherwise.
  RETURNS      : A list of expressions containing the
                   parameter names
  SIDE EFFECTS : Parameters parsed and expressions formed
  NOTES        : None
 ************************************************************/
globle EXPRESSION *ParseProcParameters(readSource,tkn,parameterList,
                                       wildcard,min,max,error,checkfunc)
  char *readSource;
  struct token *tkn;
  EXPRESSION *parameterList;
  SYMBOL_HN **wildcard;
  int *min,*max,*error;
#if ANSI_COMPILER
  int (*checkfunc)(char *);
#else
  int (*checkfunc)();
#endif
  {
   EXPRESSION *nextOne,*lastOne,*check;
   int paramprintp = 0;

   *wildcard = NULL;
   *min = 0;
   *error = CLIPS_TRUE;
   lastOne = nextOne = parameterList;
   while (nextOne != NULL)
     {
      (*min)++;
      lastOne = nextOne;
      nextOne = nextOne->nextArg;
     }
   if (tkn->type != LPAREN)
     {
      SyntaxErrorMessage("parameter list");
      ReturnExpression(parameterList);
      return(NULL);
     }
   GetToken(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("PRCCODE",7,CLIPS_FALSE);
          PrintCLIPS(WERROR,"Duplicate parameter names not allowed.\n");
          ReturnExpression(parameterList);
          return(NULL);
         }
      if (*wildcard != NULL)
        {
         PrintErrorID("PRCCODE",8,CLIPS_FALSE);
         PrintCLIPS(WERROR,"No parameters allowed after wildcard parameter.\n");
         ReturnExpression(parameterList);
         return(NULL);
        }
      if ((checkfunc != NULL) ? (*checkfunc)(ValueToString(tkn->value)) : CLIPS_FALSE)
        {
         ReturnExpression(parameterList);
         return(NULL);
        }
      nextOne = GenConstant(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(" ");
      paramprintp = 1;
      GetToken(readSource,tkn);
     }
   if (tkn->type != RPAREN)
     {
      SyntaxErrorMessage("parameter list");
      ReturnExpression(parameterList);
      return(NULL);
     }
   if (paramprintp)
     {
      PPBackup();
      PPBackup();
      SavePPBuffer(")");
     }
   *error = CLIPS_FALSE;
   *max = (*wildcard != NULL) ? -1 : *min;
   return(parameterList);
  }

#endif

/*************************************************************************