prccode.c

一套美国国家宇航局人工智能中心NASA的专家系统工具源代码

  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(bodytype,readSource,tkn,params,
                                    wildcard,altvarfunc,altbindfunc,
                                    lvarcnt,userBuffer)
  char *bodytype;
  char *readSource;
  struct token *tkn;
  EXPRESSION *params;
  SYMBOL_HN *wildcard;
#if ANSI_COMPILER
  int (*altvarfunc)(EXPRESSION *,VOID *);
  int (*altbindfunc)(EXPRESSION *,VOID *);
#else
  int (*altvarfunc)();
  int (*altbindfunc)();
#endif
  int *lvarcnt;
  VOID *userBuffer;
  {
   EXPRESSION *actions,*pactions;
   
   /* ====================================================================
      Clear parsed bind list - so that only local vars from this body will
      be on it.  The position of vars on thsi list are used to generate
      indices into the LocalVarArray at runtime.  The parsing of the
      "bind" function adds vars to this list.
      ==================================================================== */
   ClearParsedBindNames();
   actions = GroupActions(readSource,tkn,CLIPS_TRUE,NULL);
   if (actions == NULL)
     return(NULL);
   
   /* ====================================================================
      Replace any bind functions with special functions before replacing
      any variable references.  This allows those bind names to be removed
      before they can be seen by variable replacement and thus generate
      incorrect indices.
      ==================================================================== */
   if (altbindfunc != NULL)
     {
      if (ReplaceProcBinds(actions,altbindfunc,userBuffer))
        {
         ClearParsedBindNames();
         ReturnExpression(actions);
         return(NULL);
        }
     }

   /* ======================================================================
      The number of names left on the bind list is the number of local
      vars for this procedure body.  Replace all variable reference with
      runtime access functions for ProcParamArray, LocalVarArray or
      other special items, such as direct slot references, global variables,
      or fact field references.
      ====================================================================== */
   *lvarcnt = CountParsedBindNames();
   if (ReplaceProcVars(bodytype,actions,params,wildcard,altvarfunc,userBuffer))
     {
      ClearParsedBindNames();
      ReturnExpression(actions);
      return(NULL);
     }
     
   /* =======================================================================
      Normally, actions are grouped in a progn.  If there is only one action,
      the progn is unnecessary and can be removed.  Also, the actions are
      packed into a contiguous array to save on memory overhead.  The
      intermediate parsed bind names are freed to avoid tying up memory.
      ======================================================================= */
   actions = CompactActions(actions);
   pactions = PackExpression(actions);
   ReturnExpression(actions);
   ClearParsedBindNames();
   return(pactions);
  }
  
/*************************************************************************
  NAME         : ReplaceProcVars
  DESCRIPTION  : Examines an expression for variables
                   and replaces any that correspond to
                   procedure parameters or globals
                   with function calls that get these
                   variables' values at run-time.
                   For example, procedure arguments
                   are stored an array at run-time, so at
                   parse-time, parameter-references are replaced
                   with function calls referencing this array at
                   the appropriate position.
  INPUTS       : 1) The type of procedure being parsed
                 2) The expression-actions to be examined
                 3) The parameter list
                 4) The wildcard parameter symbol (NULL if none)
                 5) 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.
                 6) Data buffer to be passed to alternate parsing
                    function
  RETURNS      : CLIPS_FALSE if OK, CLIPS_TRUE on errors
  SIDE EFFECTS : Variable references replaced with function calls
  NOTES        : This function works from the ParsedBindNames list in
                    SPCLFORM.C to access local binds.  Make sure that
                    the list accurately reflects the binds by calling
                    ClearParsedBindNames() before the parse of the body
                    in which variables are being replaced.
 *************************************************************************/
globle int ReplaceProcVars(bodytype,actions,parameterList,wildcard,altvarfunc,specdata)
  char *bodytype;
  EXPRESSION *actions;
  EXPRESSION *parameterList;
  SYMBOL_HN *wildcard;
#if ANSI_COMPILER
  int (*altvarfunc)(EXPRESSION *,VOID *);
#else
  int (*altvarfunc)();
#endif
  VOID *specdata;
  {
   int position,altcode;
   BOOLEAN boundPosn;
   EXPRESSION *arg_lvl,*altvarexp;
   SYMBOL_HN *bindName;
   PACKED_PROC_VAR pvar;
   
   while (actions != NULL)
     {
      if (actions->type == SF_VARIABLE)
        {
         /*===============================================*/
         /* See if the variable is in the parameter list. */
         /*===============================================*/
         bindName = (SYMBOL_HN *) actions->value;
         position = FindProcParameter(bindName,parameterList,wildcard);

         /*=============================================================*/
         /* Check to see if the variable is bound within the procedure. */
         /*=============================================================*/
         boundPosn = SearchParsedBindNames(bindName);
         
         /*=============================================*/
         /* If variable is not defined in the parameter */
         /* list or as part of a bind action then...    */
         /*=============================================*/

         if ((position == 0) && (boundPosn == 0))
           {
            /*================================================================*/
            /* Check to see if the variable has a special access function,    */
            /* such as direct slot reference or a rule RHS pattern reference. */
            /*================================================================*/
            if ((altvarfunc != NULL) ? ((*altvarfunc)(actions,specdata) != 1) : CLIPS_TRUE)
              {
               PrintErrorID("PRCCODE",3,CLIPS_TRUE);
               PrintCLIPS(WERROR,"Undefined variable ");
               PrintCLIPS(WERROR,ValueToString(bindName));
               PrintCLIPS(WERROR," referenced in ");
               PrintCLIPS(WERROR,bodytype);
               PrintCLIPS(WERROR,".\n");
               return(CLIPS_TRUE);
              }
           }

         /*===================================================*/
         /* Else if variable is defined in the parameter list */
         /* and not rebound within the procedure then...      */
         /*===================================================*/

         else if ((position > 0) && (boundPosn == 0))
           {
            actions->type = (short) ((bindName != wildcard) ? PROC_PARAM : PROC_WILD_PARAM);
            actions->value = AddBitMap((VOID *) &position,(int) sizeof(int));
           }

         /*=========================================================*/
         /* Else the variable is rebound within the procedure so... */
         /*=========================================================*/

         else
           {
            if (altvarfunc != NULL)
              {
               altvarexp = GenConstant(actions->type,actions->value);
               altcode = (*altvarfunc)(altvarexp,specdata);
               if (altcode == 0)
                 {
                  rtn_struct(expr,altvarexp);
                  altvarexp = NULL;
                 }
               else if (altcode == -1)
                 {
                  rtn_struct(expr,altvarexp);
                  return(CLIPS_TRUE);
                 }
              }
            else
              altvarexp = NULL;
            actions->type = PROC_GET_BIND;
            ClearBitString((VOID *) &pvar,(int) sizeof(PACKED_PROC_VAR));
            pvar.first = boundPosn;
            pvar.second = position;
            pvar.secondFlag = (bindName != wildcard) ? 0 : 1;
            actions->value = AddBitMap((VOID *) &pvar,(int) sizeof(PACKED_PROC_VAR));
            actions->argList = GenConstant(SYMBOL,(VOID *) bindName);
            actions->argList->nextArg = altvarexp;
           }
        }
#if DEFGLOBAL_CONSTRUCT
      else if (actions->type == GBL_VARIABLE)
        {
         if (ReplaceGlobalVariable(actions) == CLIPS_FALSE)
           return(-1);
        }
#endif
      if ((altvarfunc != NULL) ? ((*altvarfunc)(actions,specdata) == -1) : CLIPS_FALSE)
        return(CLIPS_TRUE);
      if (actions->argList != NULL)
        {
         if (ReplaceProcVars(bodytype,actions->argList,parameterList,
                                        wildcard,altvarfunc,specdata))
           return(CLIPS_TRUE);

         /* ====================================================================
            Check to see if this is a call to the bind function.  If so (and the
            second argument is a symbol) then it is a locally bound variable
            (as opposed to a global).
            
            Replace the call to "bind" with a call to PROC_BIND - the
            special internal function for procedure local variables.
            ==================================================================== */
         if ((actions->value == (VOID *) FindFunction("bind")) && 
             (actions->argList->type == SYMBOL))
           {
            actions->type = PROC_BIND;
            boundPosn = SearchParsedBindNames((SYMBOL_HN *) actions->argList->value);
            actions->value = AddBitMap((VOID *) &boundPosn,(int) sizeof(BOOLEAN));
            arg_lvl = actions->argList->nextArg;
            rtn_struct(expr,actions->argList);
            actions->argList = arg_lvl;
           }
        }
      actions = actions->nextArg;
     }
   return(CLIPS_FALSE);
  }
  
#if DEFGENERIC_CONSTRUCT

/*****************************************************
  NAME         : GenProcWildcardReference
  DESCRIPTION  : Returns an expression to access the
                    wildcard parameter for a method
  INPUTS       : The starting index of the wildcard
  RETURNS      : An expression containing the wildcard
                 reference
  SIDE EFFECTS : Expression allocated
  NOTES        : None
 *****************************************************/
globle EXPRESSION *GenProcWildcardReference(index)
  int index;
  {
   return(GenConstant(PROC_WILD_PARAM,AddBitMap((VOID *) &index,(int) sizeof(int))));
  }
  
#endif

#endif

/*******************************************************************
  NAME         : PushProcParameters
  DESCRIPTION  : Given a list of parameter expressions,
                   this function evaluates each expression
                   and stores the results in a contiguous
                   array of DATA_OBJECTS.  Used in creating a new
                   ProcParamArray for the execution of a
                   procedure
                 The current arrays are saved on a stack.
  INPUTS       : 1) The paramter expression list
                 2) The number of parameters in the list
                 3) The name of the procedure for which
                    these parameters are being evaluated
                 4) The type of procedure
                 5) A pointer to a function to print out a trace
                    message about the currently executing
                    procedure when unbound variables are detected
                    at runtime (The function should take no
                    arguments and have no return value.  The
                    function should print its synopsis to WERROR
                    and include the final carriage-return.)
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any side-effects of the evaluation of the
                   parameter expressions
                 DATA_OBJECT array allocated (deallocated on errors)
                 ProcParamArray set
  NOTES        : EvaluationError set on errors
 *******************************************************************/
globle VOID PushProcParameters(parameterList,numberOfParameters,pname,
                               bodytype,UnboundErrFunc)
  EXPRESSION *parameterList;
  int numberOfParameters;
  char *pname,*bodytype;
  VOID (*UnboundErrFunc)(VOID_ARG);
  {
   register PROC_PARAM_STACK *ptmp;
   
   ptmp = get_struct(ProcParamStack);
   ptmp->ParamArray = ProcParamArray;
   ptmp->ParamArraySize = ProcParamArraySize;
   ptmp->UnboundErrFunc = ProcUnboundErrFunc;
   ptmp->nxt = pstack;