genrccom.c

clips源代码

 ***************************************************/
globle DEFGENERIC *LookupDefgenericByMdlOrScope(
  void *theEnv,
  char *defgenericName)
  {
   return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,TRUE));
  }

/***************************************************
  NAME         : LookupDefgenericInScope
  DESCRIPTION  : Finds a defgeneric in current or
                   imported modules (module
                   specifier is not allowed)
  INPUTS       : The defgeneric name
  RETURNS      : The defgeneric (NULL if not found)
  SIDE EFFECTS : Error message printed on
                  ambiguous references
  NOTES        : None
 ***************************************************/
globle DEFGENERIC *LookupDefgenericInScope(
  void *theEnv,
  char *defgenericName)
  {
   return((DEFGENERIC *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,FALSE));
  }

/***********************************************************
  NAME         : EnvGetNextDefgeneric
  DESCRIPTION  : Finds first or next generic function
  INPUTS       : The address of the current generic function
  RETURNS      : The address of the next generic function
                   (NULL if none)
  SIDE EFFECTS : None
  NOTES        : If ptr == NULL, the first generic function
                    is returned.
 ***********************************************************/
globle void *EnvGetNextDefgeneric(
  void *theEnv,
  void *ptr)
  {
   return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DefgenericData(theEnv)->DefgenericModuleIndex));
  }

/***********************************************************
  NAME         : EnvGetNextDefmethod
  DESCRIPTION  : Find the next method for a generic function
  INPUTS       : 1) The generic function address
                 2) The index of the current method
  RETURNS      : The index of the next method
                    (0 if none)
  SIDE EFFECTS : None
  NOTES        : If index == 0, the index of the first
                   method is returned
 ***********************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle long EnvGetNextDefmethod(
  void *theEnv,
  void *ptr,
  long theIndex)
  {
   DEFGENERIC *gfunc;
   long mi;
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv)
#endif

   gfunc = (DEFGENERIC *) ptr;
   if (theIndex == 0)
     {
      if (gfunc->methods != NULL)
        return(gfunc->methods[0].index);
      return(0);
     }
   mi = FindMethodByIndex(gfunc,theIndex);
   if ((mi+1) == gfunc->mcnt)
     return(0);
   return(gfunc->methods[mi+1].index);
  }

/*****************************************************
  NAME         : GetDefmethodPointer
  DESCRIPTION  : Returns a pointer to a method
  INPUTS       : 1) Pointer to a defgeneric
                 2) Array index of method in generic's
                    method array (+1)
  RETURNS      : Pointer to the method.
  SIDE EFFECTS : None
  NOTES        : None
 *****************************************************/
globle DEFMETHOD *GetDefmethodPointer(
  void *ptr,
  long theIndex)
  {
   return(&((DEFGENERIC *) ptr)->methods[theIndex-1]);
  }

/***************************************************
  NAME         : EnvIsDefgenericDeletable
  DESCRIPTION  : Determines if a generic function
                   can be deleted
  INPUTS       : Address of the generic function
  RETURNS      : TRUE if deletable, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle int EnvIsDefgenericDeletable(
  void *theEnv,
  void *ptr)
  {
   if (! ConstructsDeletable(theEnv))
     { return FALSE; }

   return ((((DEFGENERIC *) ptr)->busy == 0) ? TRUE : FALSE);
  }

/***************************************************
  NAME         : EnvIsDefmethodDeletable
  DESCRIPTION  : Determines if a generic function
                   method can be deleted
  INPUTS       : 1) Address of the generic function
                 2) Index of the method
  RETURNS      : TRUE if deletable, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle int EnvIsDefmethodDeletable(
  void *theEnv,
  void *ptr,
  long theIndex)
  {
   if (! ConstructsDeletable(theEnv))
     { return FALSE; }

   if (((DEFGENERIC *) ptr)->methods[FindMethodByIndex((DEFGENERIC *) ptr,theIndex)].system)
     return(FALSE);
   
#if (! BLOAD_ONLY) && (! RUN_TIME)
   return((MethodsExecuting((DEFGENERIC *) ptr) == FALSE) ? TRUE : FALSE);
#else
   return FALSE;
#endif
  }

/**********************************************************
  NAME         : UndefgenericCommand
  DESCRIPTION  : Deletes all methods for a generic function
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : methods deallocated
  NOTES        : H/L Syntax: (undefgeneric <name> | *)
 **********************************************************/
globle void UndefgenericCommand(
  void *theEnv)
  {
   UndefconstructCommand(theEnv,"undefgeneric",DefgenericData(theEnv)->DefgenericConstruct);
  }

/****************************************************************
  NAME         : GetDefgenericModuleCommand
  DESCRIPTION  : Determines to which module a defgeneric belongs
  INPUTS       : None
  RETURNS      : The symbolic name of the module
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (defgeneric-module <generic-name>)
 ****************************************************************/
globle void *GetDefgenericModuleCommand(
  void *theEnv)
  {
   return(GetConstructModuleCommand(theEnv,"defgeneric-module",DefgenericData(theEnv)->DefgenericConstruct));
  }

/**************************************************************
  NAME         : UndefmethodCommand
  DESCRIPTION  : Deletes one method for a generic function
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : methods deallocated
  NOTES        : H/L Syntax: (undefmethod <name> <index> | *)
 **************************************************************/
globle void UndefmethodCommand(
  void *theEnv)
  {
   DATA_OBJECT temp;
   DEFGENERIC *gfunc;
   long mi;

   if (EnvArgTypeCheck(theEnv,"undefmethod",1,SYMBOL,&temp) == FALSE)
     return;
   gfunc = LookupDefgenericByMdlOrScope(theEnv,DOToString(temp));
   if ((gfunc == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE)
     {
      PrintErrorID(theEnv,"GENRCCOM",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"No such generic function ");
      EnvPrintRouter(theEnv,WERROR,DOToString(temp));
      EnvPrintRouter(theEnv,WERROR," in function undefmethod.\n");
      return;
     }
   EnvRtnUnknown(theEnv,2,&temp);
   if (temp.type == SYMBOL)
     {
      if (strcmp(DOToString(temp),"*") != 0)
        {
         PrintErrorID(theEnv,"GENRCCOM",2,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n");
         return;
        }
      mi = 0;
     }
   else if (temp.type == INTEGER)
     {
      mi = (long) DOToLong(temp);
      if (mi == 0)
        {
         PrintErrorID(theEnv,"GENRCCOM",2,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n");
         return;
        }
     }
   else
     {
      PrintErrorID(theEnv,"GENRCCOM",2,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Expected a valid method index in function undefmethod.\n");
      return;
     }
   EnvUndefmethod(theEnv,(void *) gfunc,mi);
  }

/**************************************************************
  NAME         : EnvUndefgeneric
  DESCRIPTION  : Deletes all methods for a generic function
  INPUTS       : The generic-function address (NULL for all)
  RETURNS      : TRUE if generic successfully deleted,
                 FALSE otherwise
  SIDE EFFECTS : methods deallocated
  NOTES        : None
 **************************************************************/
globle intBool EnvUndefgeneric(
  void *theEnv,
  void *vptr)
  {
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,vptr)
#endif

#if RUN_TIME || BLOAD_ONLY
   return(FALSE);
#else
   DEFGENERIC *gfunc;
   int success = TRUE;

   gfunc = (DEFGENERIC *) vptr;
   if (gfunc == NULL)
     {
      if (ClearDefmethods(theEnv) == FALSE)
        success = FALSE;
      if (ClearDefgenerics(theEnv) == FALSE)
        success = FALSE;
      return(success);
     }
   if (EnvIsDefgenericDeletable(theEnv,vptr) == FALSE)
     return(FALSE);
   RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
   RemoveDefgeneric(theEnv,gfunc);
   return(TRUE);
#endif
  }

/**************************************************************
  NAME         : EnvUndefmethod
  DESCRIPTION  : Deletes one method for a generic function
  INPUTS       : 1) Address of generic function (can be NULL)
                 2) Method index (0 for all)
  RETURNS      : TRUE if method deleted successfully,
                 FALSE otherwise
  SIDE EFFECTS : methods deallocated
  NOTES        : None
 **************************************************************/
globle intBool EnvUndefmethod(
  void *theEnv,
  void *vptr,
  long mi)
  {
   DEFGENERIC *gfunc;

#if RUN_TIME || BLOAD_ONLY
   gfunc = (DEFGENERIC *) vptr;
   PrintErrorID(theEnv,"PRNTUTIL",4,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Unable to delete method ");
   if (gfunc != NULL)
     {
      PrintGenericName(theEnv,WERROR,gfunc);
      EnvPrintRouter(theEnv,WERROR," #");
      PrintLongInteger(theEnv,WERROR,(long long) mi);
     }
   else
     EnvPrintRouter(theEnv,WERROR,"*");
   EnvPrintRouter(theEnv,WERROR,".\n");
   return(FALSE);
#else
   long nmi;

   gfunc = (DEFGENERIC *) vptr;
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv) == TRUE)
     {
      PrintErrorID(theEnv,"PRNTUTIL",4,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Unable to delete method ");
      if (gfunc != NULL)
        {
         EnvPrintRouter(theEnv,WERROR,EnvGetDefgenericName(theEnv,(void *) gfunc));
         EnvPrintRouter(theEnv,WERROR," #");
         PrintLongInteger(theEnv,WERROR,(long long) mi);
        }
      else
        EnvPrintRouter(theEnv,WERROR,"*");
      EnvPrintRouter(theEnv,WERROR,".\n");
      return(FALSE);
     }
#endif
   if (gfunc == NULL)
     {
      if (mi != 0)
        {
         PrintErrorID(theEnv,"GENRCCOM",3,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Incomplete method specification for deletion.\n");
         return(FALSE);
        }
      return(ClearDefmethods(theEnv));
     }
   if (MethodsExecuting(gfunc))
     {
      MethodAlterError(theEnv,gfunc);
      return(FALSE);
     }
   if (mi == 0)
     RemoveAllExplicitMethods(theEnv,gfunc);
   else
     {
      nmi = CheckMethodExists(theEnv,"undefmethod",gfunc,mi);
      if (nmi == -1)
        return(FALSE);
      RemoveDefgenericMethod(theEnv,gfunc,nmi);
     }
   return(TRUE);
#endif
  }

#if DEBUGGING_FUNCTIONS

/*****************************************************
  NAME         : EnvGetDefmethodDescription
  DESCRIPTION  : Prints a synopsis of method parameter
                   restrictions into caller's buffer
  INPUTS       : 1) Caller's buffer
                 2) Buffer size (not including space
                    for terminating '\0')
                 3) Address of generic function
                 4) Index of method
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's buffer written
  NOTES        : Terminating '\n' not written
 *****************************************************/
globle void EnvGetDefmethodDescription(
  void *theEnv,
  char *buf,
  int buflen,
  void *ptr,
  long theIndex)
  {