genrccom.c

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

  DESCRIPTION  : Determines if a generic function
                   method can be deleted
  INPUTS       : 1) Address of the generic function
                 2) Index of the method
  RETURNS      : CLIPS_TRUE if deletable, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle int IsDefmethodDeletable(ptr,index)
  VOID *ptr;
  unsigned index;
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(ptr)
#pragma unused(index)
#endif

#if BLOAD_ONLY || RUN_TIME
   return(CLIPS_FALSE);
#else
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded())
     return(CLIPS_FALSE);
#endif
   if (((DEFGENERIC *) ptr)->methods[FindMethodByIndex((DEFGENERIC *) ptr,index)].system)
     return(CLIPS_FALSE);
   return((MethodsExecuting((DEFGENERIC *) ptr) == CLIPS_FALSE) ? CLIPS_TRUE : CLIPS_FALSE);
#endif
  }

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

/****************************************************************
  NAME         : GetDefgenericModuleCommand
  DESCRIPTION  : Determines to which module a defgeneric belongs
  INPUTS       : None
  RETURNS      : The symbolic name of the module
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax: (defgeneric-module <generic-name>)
 ****************************************************************/
globle SYMBOL_HN *GetDefgenericModuleCommand()
  {
   return(GetConstructModuleCommand("defgeneric-module",DefgenericConstruct));
  }
  
/**************************************************************
  NAME         : UndefmethodCommand
  DESCRIPTION  : Deletes one method for a generic function
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : methods deallocated
  NOTES        : CLIPS Syntax: (undefmethod <name> <index> | *)
 **************************************************************/
globle VOID UndefmethodCommand()
  {
   DATA_OBJECT temp;
   DEFGENERIC *gfunc;
   unsigned mi;
   
   if (ArgTypeCheck("undefmethod",1,SYMBOL,&temp) == CLIPS_FALSE)
     return;
   gfunc = LookupDefgenericByMdlOrScope(DOToString(temp));
   if ((gfunc == NULL) ? (strcmp(DOToString(temp),"*") != 0) : CLIPS_FALSE)
     { 
      PrintErrorID("GENRCCOM",1,CLIPS_FALSE);
      PrintCLIPS(WERROR,"No such generic function ");
      PrintCLIPS(WERROR,DOToString(temp));
      PrintCLIPS(WERROR," in function undefmethod.\n");
      return;
     }
   RtnUnknown(2,&temp);
   if (temp.type == SYMBOL)
     {
      if (strcmp(DOToString(temp),"*") != 0)
        {
         PrintErrorID("GENRCCOM",2,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Expected a valid method index in function undefmethod.\n");
         return;
        }
      mi = 0;
     }
   else if (temp.type == INTEGER)
     {
      mi = (unsigned) DOToInteger(temp);
      if (mi == 0)
        {
         PrintErrorID("GENRCCOM",2,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Expected a valid method index in function undefmethod.\n");
         return;
        }
     }
   else
     {
      PrintErrorID("GENRCCOM",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Expected a valid method index in function undefmethod.\n");
      return;
     }
   Undefmethod((VOID *) gfunc,mi);
  }

/**************************************************************
  NAME         : Undefgeneric
  DESCRIPTION  : Deletes all methods for a generic function
  INPUTS       : The generic-function address (NULL for all)
  RETURNS      : CLIPS_TRUE if generic successfully deleted,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : methods deallocated
  NOTES        : None
 **************************************************************/
globle BOOLEAN Undefgeneric(vptr)
  VOID *vptr;
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(vptr)
#endif

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

   gfunc = (DEFGENERIC *) vptr;
   if (gfunc == NULL)
     {
      if (ClearDefmethods() == CLIPS_FALSE)
        success = CLIPS_FALSE;
      if (ClearDefgenerics() == CLIPS_FALSE)
        success = CLIPS_FALSE;
      return(success);
     }
   if (IsDefgenericDeletable(vptr) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   RemoveConstructFromModule((struct constructHeader *) vptr);
   RemoveDefgeneric(gfunc);
   return(CLIPS_TRUE);
#endif
  }
  
/**************************************************************
  NAME         : Undefmethod
  DESCRIPTION  : Deletes one method for a generic function
  INPUTS       : 1) Address of generic function (can be NULL)
                 2) Method index (0 for all)
  RETURNS      : CLIPS_TRUE if method deleted successfully,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : methods deallocated
  NOTES        : None
 **************************************************************/
globle BOOLEAN Undefmethod(vptr,mi)
  VOID *vptr;
  unsigned mi;
  {
   DEFGENERIC *gfunc;
   
#if RUN_TIME || BLOAD_ONLY
   gfunc = (DEFGENERIC *) vptr;
   PrintErrorID("PRNTUTIL",4,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Unable to delete method ");
   if (gfunc != NULL)
     {
      PrintGenericName(WERROR,gfunc);
      PrintCLIPS(WERROR," #");
      PrintLongInteger(WERROR,(long) mi);
     }
   else
     PrintCLIPS(WERROR,"*");
   PrintCLIPS(WERROR,".\n");
   return(CLIPS_FALSE);
#else
   int nmi;

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

/*****************************************************
  NAME         : GetDefmethodDescription
  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 GetDefmethodDescription(buf,buflen,ptr,index)
  char *buf;
  int buflen;
  VOID *ptr;
  unsigned index;
  {
   DEFGENERIC *gfunc;
   int mi;
   
   gfunc = (DEFGENERIC *) ptr;
   mi = FindMethodByIndex(gfunc,index);
   PrintMethod(buf,buflen,&gfunc->methods[mi]);
  }
  
/*********************************************************
  NAME         : GetDefgenericWatch
  DESCRIPTION  : Determines if trace messages are
                 gnerated when executing generic function
  INPUTS       : A pointer to the generic
  RETURNS      : CLIPS_TRUE if a trace is active,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
globle BOOLEAN GetDefgenericWatch(theGeneric)
  VOID *theGeneric;
  {
   return(((DEFGENERIC *) theGeneric)->trace);
  }
  
/*********************************************************
  NAME         : SetDefgenericWatch
  DESCRIPTION  : Sets the trace to ON/OFF for the
                 generic function
  INPUTS       : 1) CLIPS_TRUE to set the trace on,
                    CLIPS_FALSE to set it off
                 2) A pointer to the generic
  RETURNS      : Nothing useful
  SIDE EFFECTS : Watch flag for the generic set
  NOTES        : None
 *********************************************************/
globle VOID SetDefgenericWatch(newState,theGeneric)
  int newState;
  VOID *theGeneric;
  {
   ((DEFGENERIC *) theGeneric)->trace = newState;
  }
  
/*********************************************************
  NAME         : GetDefmethodWatch
  DESCRIPTION  : Determines if trace messages for calls
                 to this method will be generated or not
  INPUTS       : 1) A pointer to the generic
                 2) The index of the method
  RETURNS      : CLIPS_TRUE if a trace is active,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
globle BOOLEAN GetDefmethodWatch(theGeneric,theIndex)
  VOID *theGeneric;
  unsigned theIndex;
  {
   DEFGENERIC *gfunc;
   int mi;
   
   gfunc = (DEFGENERIC *) theGeneric;
   mi = FindMethodByIndex(gfunc,theIndex);
   return(gfunc->methods[mi].trace);
  }
  
/*********************************************************
  NAME         : SetDefmethodWatch
  DESCRIPTION  : Sets the trace to ON/OFF for the
                 calling of the method
  INPUTS       : 1) CLIPS_TRUE to set the trace on,
                    CLIPS_FALSE to set it off
                 2) A pointer to the generic
                 3) The index of the method
  RETURNS      : Nothing useful
  SIDE EFFECTS : Watch flag for the method set
  NOTES        : None
 *********************************************************/
globle VOID SetDefmethodWatch(newState,theGeneric,theIndex)
  int newState;
  VOID *theGeneric;
  unsigned theIndex;
  {
   DEFGENERIC *gfunc;
   int mi;
   
   gfunc = (DEFGENERIC *) theGeneric;
   mi = FindMethodByIndex(gfunc,theIndex);
   gfunc->methods[mi].trace = newState;
  }


/********************************************************
  NAME         : PPDefgenericCommand
  DESCRIPTION  : Displays the pretty-print form of
                  a generic function header
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax: (ppdefgeneric <name>)
 ********************************************************/
globle VOID PPDefgenericCommand()
  {
   PPConstructCommand("ppdefgeneric",DefgenericConstruct);
  }
  
/**********************************************************
  NAME         : PPDefmethodCommand
  DESCRIPTION  : Displays the pretty-print form of
                  a method
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax: (ppdefmethod <name> <index>)
 **********************************************************/
globle VOID PPDefmethodCommand()
  {
   DATA_OBJECT temp;
   char *gname;
   DEFGENERIC *gfunc;
   int gi;

   if (ArgTypeCheck("ppdefmethod",1,SYMBOL,&temp) == CLIPS_FALSE)
     return;
   gname = DOToString(temp);
   if (ArgTypeCheck("ppdefmethod",2,INTEGER,&temp) == CLIPS_FALSE)
     return;
   gfunc = CheckGenericExists("ppdefmethod",gname);
   if (gfunc == NULL)
     return;
   gi = CheckMethodExists("ppdefmethod",gfunc,DOToInteger(temp));
   if (gi == -1)
     return;
   if (gfunc->methods[gi].ppForm != NULL)
     PrintInChunks(WDISPLAY,gfunc->methods[gi].ppForm);
  }
  
/******************************************************
  NAME         : ListDefmethodsCommand
  DESCRIPTION  : Lists a brief description of methods
                   for a particular generic function
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax: (list-defmethods <name>)
 ******************************************************/
globle VOID ListDefmethodsCommand()
  {
   DATA_OBJECT temp;
   DEFGENERIC *gfunc;
   
   if (RtnArgCount() == 0)
     ListDefmethods(WDISPLAY,NULL);
   else
     {
      if (ArgTypeCheck("list-defmethods",1,SYMBOL,&temp) == CLIPS_FALSE)
        return;
      gfunc = CheckGenericExists("list-defmethods",DOToString(temp));
      if (gfunc != NULL)
        ListDefmethods(WDISPLAY,(VOID *) gfunc);
     }
  }

/***************************************************************
  NAME         : GetDefmethodPPForm
  DESCRIPTION  : Getsa generic function method pretty print form
  INPUTS       : 1) Address of the generic function
                 2) Index of the method
  RETURNS      : Method ppform
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************************/
globle char *GetDefmethodPPForm(ptr,index)
  VOID *ptr;
  unsigned index;
  {
   DEFGENERIC *gfunc;
   int mi;
   
   gfunc = (DEFGENERIC *) ptr;
   mi = FindMethodByIndex(gfunc,index);