genrcpsr.c

clips源代码

   if (gname == NULL)
     return(NULL);
   if (GetType(DefgenericData(theEnv)->GenericInputToken) == INTEGER)
     {
      int tmp;

      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm);
      tmp = (int) ValueToLong(GetValue(DefgenericData(theEnv)->GenericInputToken));
      if (tmp < 1)
        {
         PrintErrorID(theEnv,"GENRCPSR",6,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Method index out of range.\n");
         return(NULL);
        }
      *theIndex = tmp;
      PPCRAndIndent(theEnv);
      GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
     }
   if (GetType(DefgenericData(theEnv)->GenericInputToken) == STRING)
     {
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,DefgenericData(theEnv)->GenericInputToken.printForm);
      PPCRAndIndent(theEnv);
      GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
     }
   return(gname);
  }

/************************************************************************
  NAME         : ParseMethodParameters
  DESCRIPTION  : Parses method restrictions
                   (parameter names with class and expression specifiers)
  INPUTS       : 1) The logical name of the input source
                 2) Caller's buffer for the parameter name list
                    (Restriction structures are attached to
                     argList pointers of parameter nodes)
                 3) Caller's buffer for wildcard symbol (if any)
  RETURNS      : The number of parameters, or -1 on errors
  SIDE EFFECTS : Memory allocated for parameters and restrictions
                 Parameter names stored in expression list
                 Parameter restrictions stored in contiguous array
  NOTES        : Any memory allocated is freed on errors
                 Assumes first opening parenthesis has been scanned
 ************************************************************************/
static int ParseMethodParameters(
  void *theEnv,
  char *readSource,
  EXPRESSION **params,
  SYMBOL_HN **wildcard)
  {
   EXPRESSION *phead = NULL,*pprv;
   SYMBOL_HN *pname;
   RESTRICTION *rtmp;
   int rcnt = 0;

   *wildcard = NULL;
   *params = NULL;
   if (GetType(DefgenericData(theEnv)->GenericInputToken) != LPAREN)
     {
      PrintErrorID(theEnv,"GENRCPSR",7,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Expected a '(' to begin method parameter restrictions.\n");
      return(-1);
     }
   GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
   while (DefgenericData(theEnv)->GenericInputToken.type != RPAREN)
     {
      if (*wildcard != NULL)
        {
         DeleteTempRestricts(theEnv,phead);
         PrintErrorID(theEnv,"PRCCODE",8,FALSE);
         EnvPrintRouter(theEnv,WERROR,"No parameters allowed after wildcard parameter.\n");
         return(-1);
        }
      if ((DefgenericData(theEnv)->GenericInputToken.type == SF_VARIABLE) || (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE))
        {
         pname = (SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value;
         if (DuplicateParameters(theEnv,phead,&pprv,pname))
           {
            DeleteTempRestricts(theEnv,phead);
            return(-1);
           }
         if (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE)
           *wildcard = pname;
         rtmp = get_struct(theEnv,restriction);
         PackRestrictionTypes(theEnv,rtmp,NULL);
         rtmp->query = NULL;
         phead = AddParameter(theEnv,phead,pprv,pname,rtmp);
         rcnt++;
        }
      else if (DefgenericData(theEnv)->GenericInputToken.type == LPAREN)
        {
         GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
         if ((DefgenericData(theEnv)->GenericInputToken.type != SF_VARIABLE) &&
             (DefgenericData(theEnv)->GenericInputToken.type != MF_VARIABLE))
           {
            DeleteTempRestricts(theEnv,phead);
            PrintErrorID(theEnv,"GENRCPSR",8,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Expected a variable for parameter specification.\n");
            return(-1);
           }
         pname = (SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value;
         if (DuplicateParameters(theEnv,phead,&pprv,pname))
           {
            DeleteTempRestricts(theEnv,phead);
            return(-1);
           }
         if (DefgenericData(theEnv)->GenericInputToken.type == MF_VARIABLE)
           *wildcard = pname;
         SavePPBuffer(theEnv," ");
         rtmp = ParseRestriction(theEnv,readSource);
         if (rtmp == NULL)
           {
            DeleteTempRestricts(theEnv,phead);
            return(-1);
           }
         phead = AddParameter(theEnv,phead,pprv,pname,rtmp);
         rcnt++;
        }
      else
        {
         DeleteTempRestricts(theEnv,phead);
         PrintErrorID(theEnv,"GENRCPSR",9,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Expected a variable or '(' for parameter specification.\n");
         return(-1);
        }
      PPCRAndIndent(theEnv);
      GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
     }
   if (rcnt != 0)
     {
      PPBackup(theEnv);
      PPBackup(theEnv);
      SavePPBuffer(theEnv,")");
     }
   *params = phead;
   return(rcnt);
  }

/************************************************************
  NAME         : ParseRestriction
  DESCRIPTION  : Parses the restriction for a parameter of a
                   method
                 This restriction is comprised of:
                   1) A list of classes (or types) that are
                      allowed for the parameter (None
                      if no type restriction)
                   2) And an optional restriction-query
                      expression
  INPUTS       : The logical name of the input source
  RETURNS      : The address of a RESTRICTION node, NULL on
                   errors
  SIDE EFFECTS : RESTRICTION node allocated
                   Types are in a contiguous array of void *
                   Query is an expression
  NOTES        : Assumes "(?<var> " has already been parsed
                 H/L Syntax: <type>* [<query>])
 ************************************************************/
static RESTRICTION *ParseRestriction(
  void *theEnv,
  char *readSource)
  {
   EXPRESSION *types = NULL,*new_types,
              *typesbot,*tmp,*tmp2,
              *query = NULL;
   RESTRICTION *rptr;

   GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
   while (DefgenericData(theEnv)->GenericInputToken.type != RPAREN)
     {
      if (query != NULL)
        {
         PrintErrorID(theEnv,"GENRCPSR",10,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Query must be last in parameter restriction.\n");
         ReturnExpression(theEnv,query);
         ReturnExpression(theEnv,types);
         return(NULL);
        }
      if (DefgenericData(theEnv)->GenericInputToken.type == SYMBOL)
        {
         new_types = ValidType(theEnv,(SYMBOL_HN *) DefgenericData(theEnv)->GenericInputToken.value);
         if (new_types == NULL)
           {
            ReturnExpression(theEnv,types);
            ReturnExpression(theEnv,query);
            return(NULL);
           }
         if (types == NULL)
           types = new_types;
         else
           {
            for (typesbot = tmp = types ; tmp != NULL ; tmp = tmp->nextArg)
              {
               for (tmp2 = new_types ; tmp2 != NULL ; tmp2 = tmp2->nextArg)
                 {
                  if (tmp->value == tmp2->value)
                    {
                     PrintErrorID(theEnv,"GENRCPSR",11,FALSE);
#if OBJECT_SYSTEM
                     EnvPrintRouter(theEnv,WERROR,"Duplicate classes not allowed in parameter restriction.\n");
#else
                     EnvPrintRouter(theEnv,WERROR,"Duplicate types not allowed in parameter restriction.\n");
#endif
                     ReturnExpression(theEnv,query);
                     ReturnExpression(theEnv,types);
                     ReturnExpression(theEnv,new_types);
                     return(NULL);
                    }
                  if (RedundantClasses(theEnv,tmp->value,tmp2->value))
                    {
                     ReturnExpression(theEnv,query);
                     ReturnExpression(theEnv,types);
                     ReturnExpression(theEnv,new_types);
                     return(NULL);
                    }
                 }
               typesbot = tmp;
              }
            typesbot->nextArg = new_types;
           }
        }
      else if (DefgenericData(theEnv)->GenericInputToken.type == LPAREN)
        {
         query = Function1Parse(theEnv,readSource);
         if (query == NULL)
           {
            ReturnExpression(theEnv,types);
            return(NULL);
           }
         if (GetParsedBindNames(theEnv) != NULL)
           {
            PrintErrorID(theEnv,"GENRCPSR",12,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in query expressions.\n");
            ReturnExpression(theEnv,query);
            ReturnExpression(theEnv,types);
            return(NULL);
           }
        }
#if DEFGLOBAL_CONSTRUCT
      else if (DefgenericData(theEnv)->GenericInputToken.type == GBL_VARIABLE)
        query = GenConstant(theEnv,GBL_VARIABLE,DefgenericData(theEnv)->GenericInputToken.value);
#endif
      else
        {
         PrintErrorID(theEnv,"GENRCPSR",13,FALSE);
#if OBJECT_SYSTEM
         EnvPrintRouter(theEnv,WERROR,"Expected a valid class name or query.\n");
#else
         EnvPrintRouter(theEnv,WERROR,"Expected a valid type name or query.\n");
#endif
         ReturnExpression(theEnv,query);
         ReturnExpression(theEnv,types);
         return(NULL);
        }
      SavePPBuffer(theEnv," ");
      GetToken(theEnv,readSource,&DefgenericData(theEnv)->GenericInputToken);
     }
   PPBackup(theEnv);
   PPBackup(theEnv);
   SavePPBuffer(theEnv,")");
   if ((types == NULL) && (query == NULL))
     {
      PrintErrorID(theEnv,"GENRCPSR",13,FALSE);
#if OBJECT_SYSTEM
      EnvPrintRouter(theEnv,WERROR,"Expected a valid class name or query.\n");
#else
      EnvPrintRouter(theEnv,WERROR,"Expected a valid type name or query.\n");
#endif
      return(NULL);
     }
   rptr = get_struct(theEnv,restriction);
   rptr->query = query;
   PackRestrictionTypes(theEnv,rptr,types);
   return(rptr);
  }

/*****************************************************************
  NAME         : ReplaceCurrentArgRefs
  DESCRIPTION  : Replaces all references to ?current-argument in
                  method parameter queries with special calls
                  to (gnrc-current-arg)
  INPUTS       : The query expression
  RETURNS      : Nothing useful
  SIDE EFFECTS : Variable references to ?current-argument replaced
  NOTES        : None
 *****************************************************************/
static void ReplaceCurrentArgRefs(
  void *theEnv,
  EXPRESSION *query)
  {
   while (query != NULL)
     {
      if ((query->type != SF_VARIABLE) ? FALSE :
          (strcmp(ValueToString(query->value),CURR_ARG_VAR) == 0))
        {
         query->type = FCALL;
         query->value = (void *) FindFunction(theEnv,"(gnrc-current-arg)");
        }
      if (query->argList != NULL)
        ReplaceCurrentArgRefs(theEnv,query->argList);
      query = query->nextArg;
     }
  }

/**********************************************************
  NAME         : DuplicateParameters
  DESCRIPTION  : Examines the parameter expression
                   chain for a method looking duplicates.
  INPUTS       : 1) The parameter chain (can be NULL)
                 2) Caller's buffer for address of
                    last node searched (can be used to
                    later attach new parameter)
                 3) The name of the parameter being checked
  RETURNS      : TRUE if duplicates found, FALSE otherwise
  SIDE EFFECTS : Caller's prv address set
  NOTES        : Assumes all parameter list nodes are WORDS
 **********************************************************/
static int DuplicateParameters(
  void *theEnv,
  EXPRESSION *head,
  EXPRESSION **prv,
  SYMBOL_HN *name)
  {
   *prv = NULL;
   while (head != NULL)
     {
      if (head->value == (void *) name)
        {
         PrintErrorID(theEnv,"PRCCODE",7,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Duplicate parameter names not allowed.\n");
         return(TRUE);
        }
      *prv = head;
      head = head->nextArg;
     }
   return(FALSE);
  }

/*****************************************************************
  NAME         : AddParameter
  DESCRIPTION  : Shoves a new paramter with its restriction
                   onto the list for a method
                 The parameter list is a list of expressions
                   linked by neext_arg pointers, and the
                   argList pointers are used for the restrictions
  INPUTS       : 1) The head of the list
                 2) The bottom of the list
                 3) The parameter name
                 4) The parameter restriction
  RETURNS      : The (new) head of the list
  SIDE EFFECTS : New parameter expression node allocated, set,
                   and attached
  NOTES        : None
 *****************************************************************/
static EXPRESSION *AddParameter(
  void *theEnv,
  EXPRESSION *phead,
  EXPRESSION *pprv,
  SYMBOL_HN *pname,
  RESTRICTION *rptr)
  {
   EXPRESSION *ptmp;

   ptmp = GenConstant(theEnv,SYMBOL,(void *) pname);
   if (phead == NULL)
     phead = ptmp;
   else
     pprv->nextArg = ptmp;
   ptmp->argList = (EXPRESSION *) rptr;
   return(phead);
  }

/**************************************************************
  NAME         : ValidType
  DESCRIPTION  : Examines the name of a restriction type and
                   forms a list of integer-code expressions
                   corresponding to the primitive types
                 (or a Class address if COOL is installed)
  INPUTS       : The type name
  RETURNS      : The expression chain (NULL on errors)
  SIDE EFFECTS : Expression type chain allocated
                   one or more nodes holding codes for types