clips-sys 0.4.0

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*            CLIPS Version 6.40  02/19/20             */
   /*                                                     */
   /*                                                     */
   /*******************************************************/

/*************************************************************/
/* Purpose: Generic Functions Interface Routines             */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Dantes                                      */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*            Corrected compilation errors for files         */
/*            generated by constructs-to-c. DR0861           */
/*                                                           */
/*            Changed name of variable log to logName        */
/*            because of Unix compiler warnings of shadowed  */
/*            definitions.                                   */
/*                                                           */
/*      6.24: Removed IMPERATIVE_METHODS compilation flag.   */
/*                                                           */
/*            Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*            Corrected code to remove run-time program      */
/*            compiler warning.                              */
/*                                                           */
/*      6.30: Removed conditional code for unsupported       */
/*            compilers/operating systems (IBM_MCW,          */
/*            MAC_MCW, and IBM_TBC).                         */
/*                                                           */
/*            Changed integer type/precision.                */
/*                                                           */
/*            Added const qualifiers to remove C++           */
/*            deprecation warnings.                          */
/*                                                           */
/*            Converted API macros to function calls.        */
/*                                                           */
/*            Fixed linkage issue when DEBUGGING_FUNCTIONS   */
/*            is set to 0 and PROFILING_FUNCTIONS is set to  */
/*            1.                                             */
/*                                                           */
/*            Changed find construct functionality so that   */
/*            imported modules are search when locating a    */
/*            named construct.                               */
/*                                                           */
/*            Added code to keep track of pointers to        */
/*            constructs that are contained externally to    */
/*            to constructs, DanglingConstructs.             */
/*                                                           */
/*      6.40: Added Env prefix to GetEvaluationError and     */
/*            SetEvaluationError functions.                  */
/*                                                           */
/*            Pragma once and other inclusion changes.       */
/*                                                           */
/*            Added support for booleans with <stdbool.h>.   */
/*                                                           */
/*            Removed use of void pointers for specific      */
/*            data structures.                               */
/*                                                           */
/*            ALLOW_ENVIRONMENT_GLOBALS no longer supported. */
/*                                                           */
/*            UDF redesign.                                  */
/*                                                           */
/*            Pretty print functions accept optional logical */
/*            name argument.                                 */
/*                                                           */
/*************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if DEFGENERIC_CONSTRUCT

#include <string.h>

#include "argacces.h"
#if BLOAD || BLOAD_AND_BSAVE
#include "bload.h"
#endif
#if OBJECT_SYSTEM
#include "classcom.h"
#include "inscom.h"
#endif
#include "constrct.h"
#include "cstrccom.h"
#include "cstrcpsr.h"
#include "envrnmnt.h"
#include "evaluatn.h"
#include "extnfunc.h"
#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
#include "genrcbin.h"
#endif
#if CONSTRUCT_COMPILER
#include "genrccmp.h"
#endif
#include "genrcexe.h"
#if (! BLOAD_ONLY) && (! RUN_TIME)
#include "genrcpsr.h"
#endif
#include "memalloc.h"
#include "modulpsr.h"
#include "modulutl.h"
#include "multifld.h"
#include "router.h"
#include "strngrtr.h"
#if DEBUGGING_FUNCTIONS
#include "watch.h"
#endif
#include "prntutil.h"

#include "genrccom.h"

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */

   static void                    PrintGenericCall(Environment *,const char *,Defgeneric *);
   static bool                    EvaluateGenericCall(Environment *,Defgeneric *,UDFValue *);
   static void                    DecrementGenericBusyCount(Environment *,Defgeneric *);
   static void                    IncrementGenericBusyCount(Environment *,Defgeneric *);
   static void                    DeallocateDefgenericData(Environment *);

#if ! RUN_TIME
   static void                    DestroyDefgenericAction(Environment *,ConstructHeader *,void *);
#endif

#if (! BLOAD_ONLY) && (! RUN_TIME)

   static void                    SaveDefgenerics(Environment *,Defmodule *,const char *,void *);
   static void                    SaveDefmethods(Environment *,Defmodule *,const char *,void *);
   static void                    SaveDefmethodsForDefgeneric(Environment *,ConstructHeader *,void *);
   static void                    RemoveDefgenericMethod(Environment *,Defgeneric *,unsigned short);

#endif

#if DEBUGGING_FUNCTIONS
   static unsigned short          ListMethodsForGeneric(Environment *,const char *,Defgeneric *);
   static bool                    DefgenericWatchAccess(Environment *,int,bool,Expression *);
   static bool                    DefgenericWatchPrint(Environment *,const char *,int,Expression *);
   static bool                    DefmethodWatchAccess(Environment *,int,bool,Expression *);
   static bool                    DefmethodWatchPrint(Environment *,const char *,int,Expression *);
   static bool                    DefmethodWatchSupport(Environment *,const char *,const char *,bool,
                                                        void (*)(Environment *,const char *,Defgeneric *,unsigned short),
                                                        void (*)(Defgeneric *,unsigned short,bool),
                                                        Expression *);
   static void                    PrintMethodWatchFlag(Environment *,const char *,Defgeneric *,unsigned short);
#endif

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***********************************************************
  NAME         : SetupGenericFunctions
  DESCRIPTION  : Initializes all generic function
                   data structures, constructs and functions
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Generic function H/L functions set up
  NOTES        : None
 ***********************************************************/
void SetupGenericFunctions(
  Environment *theEnv)
  {
   EntityRecord genericEntityRecord =
                     { "GCALL", GCALL,0,0,1,
                       (EntityPrintFunction *) PrintGenericCall,
                       (EntityPrintFunction *) PrintGenericCall,
                       NULL,
                       (EntityEvaluationFunction *) EvaluateGenericCall,
                       NULL,
                       (EntityBusyCountFunction *) DecrementGenericBusyCount,
                       (EntityBusyCountFunction *) IncrementGenericBusyCount,
                       NULL,NULL,NULL,NULL,NULL };

   AllocateEnvironmentData(theEnv,DEFGENERIC_DATA,sizeof(struct defgenericData),DeallocateDefgenericData);
   memcpy(&DefgenericData(theEnv)->GenericEntityRecord,&genericEntityRecord,sizeof(struct entityRecord));

   InstallPrimitive(theEnv,&DefgenericData(theEnv)->GenericEntityRecord,GCALL);

   DefgenericData(theEnv)->DefgenericModuleIndex =
                RegisterModuleItem(theEnv,"defgeneric",
#if (! RUN_TIME)
                                    AllocateDefgenericModule,
                                    FreeDefgenericModule,
#else
                                    NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
                                    BloadDefgenericModuleReference,
#else
                                    NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
                                    DefgenericCModuleReference,
#else
                                    NULL,
#endif
                                    (FindConstructFunction *) FindDefgenericInModule);

   DefgenericData(theEnv)->DefgenericConstruct =  AddConstruct(theEnv,"defgeneric","defgenerics",
#if (! BLOAD_ONLY) && (! RUN_TIME)
                                       ParseDefgeneric,
#else
                                       NULL,
#endif
                                       (FindConstructFunction *) FindDefgeneric,
                                       GetConstructNamePointer,GetConstructPPForm,
                                       GetConstructModuleItem,
                                       (GetNextConstructFunction *) GetNextDefgeneric,
                                       SetNextConstruct,
                                       (IsConstructDeletableFunction *) DefgenericIsDeletable,
                                       (DeleteConstructFunction *) Undefgeneric,
#if (! BLOAD_ONLY) && (! RUN_TIME)
                                       (FreeConstructFunction *) RemoveDefgeneric
#else
                                       NULL
#endif
                                       );


#if ! RUN_TIME
   AddClearReadyFunction(theEnv,"defgeneric",ClearDefgenericsReady,0,NULL);

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   SetupGenericsBload(theEnv);
#endif

#if CONSTRUCT_COMPILER
   SetupGenericsCompiler(theEnv);
#endif

#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
   AddPortConstructItem(theEnv,"defgeneric",SYMBOL_TOKEN);
#endif
   AddConstruct(theEnv,"defmethod","defmethods",ParseDefmethod,
                NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);

  /* ================================================================
     Make sure defmethods are cleared last, for other constructs may
       be using them and need to be cleared first

     Need to be cleared in two stages so that mutually dependent
       constructs (like classes) can be cleared
     ================================================================ */
   AddSaveFunction(theEnv,"defgeneric",SaveDefgenerics,1000,NULL);
   AddSaveFunction(theEnv,"defmethod",SaveDefmethods,-1000,NULL);
   AddUDF(theEnv,"undefgeneric","v",1,1,"y",UndefgenericCommand,"UndefgenericCommand",NULL);
   AddUDF(theEnv,"undefmethod","v",2,2,"*;y;ly",UndefmethodCommand,"UndefmethodCommand",NULL);
#endif

   AddUDF(theEnv,"call-next-method","*",0,0,NULL,CallNextMethod,"CallNextMethod",NULL);
   FuncSeqOvlFlags(theEnv,"call-next-method",true,false);
   AddUDF(theEnv,"call-specific-method","*",2,UNBOUNDED,"*;y;l",CallSpecificMethod,"CallSpecificMethod",NULL);
   FuncSeqOvlFlags(theEnv,"call-specific-method",true,false);
   AddUDF(theEnv,"override-next-method","*",0,UNBOUNDED,NULL,OverrideNextMethod,"OverrideNextMethod",NULL);
   FuncSeqOvlFlags(theEnv,"override-next-method",true,false);
   AddUDF(theEnv,"next-methodp","b",0,0,NULL,NextMethodPCommand,"NextMethodPCommand",NULL);
   FuncSeqOvlFlags(theEnv,"next-methodp",true,false);

   AddUDF(theEnv,"(gnrc-current-arg)","*",0,UNBOUNDED,NULL,GetGenericCurrentArgument,"GetGenericCurrentArgument",NULL);

#if DEBUGGING_FUNCTIONS
   AddUDF(theEnv,"ppdefgeneric","vs",1,2,";y;ldsyn",PPDefgenericCommand,"PPDefgenericCommand",NULL);
   AddUDF(theEnv,"list-defgenerics","v",0,1,"y",ListDefgenericsCommand,"ListDefgenericsCommand",NULL);
   AddUDF(theEnv,"ppdefmethod","v",2,3,"*;y;l;ldsyn",PPDefmethodCommand,"PPDefmethodCommand",NULL);
   AddUDF(theEnv,"list-defmethods","v",0,1,"y",ListDefmethodsCommand,"ListDefmethodsCommand",NULL);
   AddUDF(theEnv,"preview-generic","v",1,UNBOUNDED,"*;y",PreviewGeneric,"PreviewGeneric",NULL);
#endif

   AddUDF(theEnv,"get-defgeneric-list","m",0,1,"y",GetDefgenericListFunction,"GetDefgenericListFunction",NULL);
   AddUDF(theEnv,"get-defmethod-list","m",0,1,"y",GetDefmethodListCommand,"GetDefmethodListCommand",NULL);
   AddUDF(theEnv,"get-method-restrictions","m",2,2,"l;y",GetMethodRestrictionsCommand,"GetMethodRestrictionsCommand",NULL);
   AddUDF(theEnv,"defgeneric-module","y",1,1,"y",GetDefgenericModuleCommand,"GetDefgenericModuleCommand",NULL);

#if OBJECT_SYSTEM
   AddUDF(theEnv,"type","*",1,1,"*",ClassCommand,"ClassCommand",NULL);
#else
   AddUDF(theEnv,"type","*",1,1,"*",TypeCommand,"TypeCommand",NULL);
#endif

#endif

#if DEBUGGING_FUNCTIONS
   AddWatchItem(theEnv,"generic-functions",0,&DefgenericData(theEnv)->WatchGenerics,34,
                DefgenericWatchAccess,DefgenericWatchPrint);
   AddWatchItem(theEnv,"methods",0,&DefgenericData(theEnv)->WatchMethods,33,
                DefmethodWatchAccess,DefmethodWatchPrint);
#endif
  }

/*****************************************************/
/* DeallocateDefgenericData: Deallocates environment */
/*    data for the defgeneric construct.             */
/*****************************************************/
static void DeallocateDefgenericData(
  Environment *theEnv)
  {
#if ! RUN_TIME
   struct defgenericModule *theModuleItem;
   Defmodule *theModule;

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv)) return;
#endif

   DoForAllConstructs(theEnv,
                      DestroyDefgenericAction,
                      DefgenericData(theEnv)->DefgenericModuleIndex,false,NULL);

   for (theModule = GetNextDefmodule(theEnv,NULL);
        theModule != NULL;
        theModule = GetNextDefmodule(theEnv,theModule))
     {
      theModuleItem = (struct defgenericModule *)
                      GetModuleItem(theEnv,theModule,
                                    DefgenericData(theEnv)->DefgenericModuleIndex);

      rtn_struct(theEnv,defgenericModule,theModuleItem);
     }
#else
#if MAC_XCD
#pragma unused(theEnv)
#endif
#endif
  }

#if ! RUN_TIME
/****************************************************/
/* DestroyDefgenericAction: Action used to remove   */
/*   defgenerics as a result of DestroyEnvironment. */
/****************************************************/
static void DestroyDefgenericAction(
  Environment *theEnv,
  ConstructHeader *theConstruct,
  void *buffer)
  {
#if MAC_XCD
#pragma unused(buffer)
#endif
#if (! BLOAD_ONLY) && (! RUN_TIME)
   Defgeneric *theDefgeneric = (Defgeneric *) theConstruct;
   long i;

   if (theDefgeneric == NULL) return;

   for (i = 0 ; i < theDefgeneric->mcnt ; i++)
     { DestroyMethodInfo(theEnv,theDefgeneric,&theDefgeneric->methods[i]); }

   if (theDefgeneric->mcnt != 0)
     { rm(theEnv,theDefgeneric->methods,(sizeof(Defmethod) * theDefgeneric->mcnt)); }

   DestroyConstructHeader(theEnv,&theDefgeneric->header);

   rtn_struct(theEnv,defgeneric,theDefgeneric);
#else
#if MAC_XCD
#pragma unused(theEnv,theConstruct)
#endif
#endif
  }
#endif

/***************************************************
  NAME         : FindDefgeneric
  DESCRIPTION  : Searches for a generic
  INPUTS       : The name of the generic
                 (possibly including a module name)
  RETURNS      : Pointer to the generic if
                 found, otherwise NULL
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
Defgeneric *FindDefgeneric(
  Environment *theEnv,
  const char *genericModuleAndName)
  {
   return (Defgeneric *) FindNamedConstructInModuleOrImports(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct);
  }

/***************************************************
  NAME         : FindDefgenericInModule
  DESCRIPTION  : Searches for a generic
  INPUTS       : The name of the generic
                 (possibly including a module name)
  RETURNS      : Pointer to the generic if
                 found, otherwise NULL
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
Defgeneric *FindDefgenericInModule(
  Environment *theEnv,
  const char *genericModuleAndName)
  {
   return (Defgeneric *) FindNamedConstructInModule(theEnv,genericModuleAndName,DefgenericData(theEnv)->DefgenericConstruct);
  }

/***************************************************
  NAME         : LookupDefgenericByMdlOrScope
  DESCRIPTION  : Finds a defgeneric anywhere (if
                 module is specified) or in current
                 or imported modules
  INPUTS       : The defgeneric name
  RETURNS      : The defgeneric (NULL if not found)
  SIDE EFFECTS : Error message printed on
                  ambiguous references
  NOTES        : None
 ***************************************************/
Defgeneric *LookupDefgenericByMdlOrScope(
  Environment *theEnv,
  const 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
 ***************************************************/
Defgeneric *LookupDefgenericInScope(
  Environment *theEnv,
  const char *defgenericName)
  {
   return (Defgeneric *) LookupConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,defgenericName,false);
  }

/***********************************************************
  NAME         : GetNextDefgeneric
  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.
 ***********************************************************/
Defgeneric *GetNextDefgeneric(
  Environment *theEnv,
  Defgeneric *theDefgeneric)
  {
   return (Defgeneric *) GetNextConstructItem(theEnv,&theDefgeneric->header,DefgenericData(theEnv)->DefgenericModuleIndex);
  }

/***********************************************************
  NAME         : GetNextDefmethod
  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
 ***********************************************************/
unsigned short GetNextDefmethod(
  Defgeneric *theDefgeneric,
  unsigned short theIndex)
  {
   unsigned short mi;

   if (theIndex == 0)
     {
      if (theDefgeneric->methods != NULL)
        { return theDefgeneric->methods[0].index; }
        
      return 0;
     }
     
   mi = FindMethodByIndex(theDefgeneric,theIndex);
   
   if ((mi+1) == theDefgeneric->mcnt)
     { return 0; }
     
   return theDefgeneric->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
 *****************************************************/
Defmethod *GetDefmethodPointer(
  Defgeneric *theDefgeneric,
  long theIndex)
  {
   return &theDefgeneric->methods[theIndex-1];
  }

/***************************************************
  NAME         : IsDefgenericDeletable
  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
 ***************************************************/
bool DefgenericIsDeletable(
  Defgeneric *theDefgeneric)
  {
   Environment *theEnv = theDefgeneric->header.env;
   
   if (! ConstructsDeletable(theEnv))
     { return false; }

   return (theDefgeneric->busy == 0) ? true : false;
  }

/***************************************************
  NAME         : DefmethodIsDeletable
  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
 ***************************************************/
bool DefmethodIsDeletable(
  Defgeneric *theDefgeneric,
  unsigned short theIndex)
  {
   Environment *theEnv = theDefgeneric->header.env;
   unsigned short mi;
   
   if (! ConstructsDeletable(theEnv))
     { return false; }

   mi = FindMethodByIndex(theDefgeneric,theIndex);
   if (mi == METHOD_NOT_FOUND) return false;
   
   if (theDefgeneric->methods[mi].system)
     return false;

#if (! BLOAD_ONLY) && (! RUN_TIME)
   return (MethodsExecuting(theDefgeneric) == 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> | *)
 **********************************************************/
void UndefgenericCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UndefconstructCommand(context,"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>)
 ****************************************************************/
void GetDefgenericModuleCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   returnValue->value = GetConstructModuleCommand(context,"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> | *)
 **************************************************************/
void UndefmethodCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   Defgeneric *gfunc;
   unsigned short mi;

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;

   gfunc = LookupDefgenericByMdlOrScope(theEnv,theArg.lexemeValue->contents);
   if ((gfunc == NULL) ? (strcmp(theArg.lexemeValue->contents,"*") != 0) : false)
     {
      PrintErrorID(theEnv,"GENRCCOM",1,false);
      WriteString(theEnv,STDERR,"No such generic function '");
      WriteString(theEnv,STDERR,theArg.lexemeValue->contents);
      WriteString(theEnv,STDERR,"' in function undefmethod.\n");
      return;
     }

   if (! UDFNextArgument(context,ANY_TYPE_BITS,&theArg)) return;

   if (CVIsType(&theArg,SYMBOL_BIT))
     {
      if (strcmp(theArg.lexemeValue->contents,"*") != 0)
        {
         PrintErrorID(theEnv,"GENRCCOM",2,false);
         WriteString(theEnv,STDERR,"Expected a valid method index in function undefmethod.\n");
         return;
        }
      mi = 0;
     }
   else if (CVIsType(&theArg,INTEGER_BIT))
     {
      mi = (unsigned short) theArg.integerValue->contents;
      if (mi == 0)
        {
         PrintErrorID(theEnv,"GENRCCOM",2,false);
         WriteString(theEnv,STDERR,"Expected a valid method index in function undefmethod.\n");
         return;
        }
     }
   else
     {
      PrintErrorID(theEnv,"GENRCCOM",2,false);
      WriteString(theEnv,STDERR,"Expected a valid method index in function undefmethod.\n");
      return;
     }
   Undefmethod(gfunc,mi,theEnv);
  }

/**************************************************************
  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
 **************************************************************/
bool Undefgeneric(
  Defgeneric *theDefgeneric,
  Environment *allEnv)
  {
#if RUN_TIME || BLOAD_ONLY
   return false;
#else
   Environment *theEnv;
   bool success = true;
   GCBlock gcb;

   if (theDefgeneric == NULL)
     { theEnv = allEnv; }
   else
     { theEnv = theDefgeneric->header.env; }
     
   GCBlockStart(theEnv,&gcb);
   if (theDefgeneric == NULL)
     {
      if (ClearDefmethods(theEnv) == false)
        success = false;
      if (ClearDefgenerics(theEnv) == false)
        success = false;
        
      GCBlockEnd(theEnv,&gcb);
        
      return success ;
     }
     
   if (DefgenericIsDeletable(theDefgeneric) == false)
     {
      GCBlockEnd(theEnv,&gcb);
      return false;
     }
      
   RemoveConstructFromModule(theEnv,&theDefgeneric->header);
   RemoveDefgeneric(theEnv,theDefgeneric);
   
   GCBlockEnd(theEnv,&gcb);

   return 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      : True if method deleted successfully,
                 false otherwise
  SIDE EFFECTS : methods deallocated
  NOTES        : None
 **************************************************************/
bool Undefmethod(
  Defgeneric *theDefgeneric,
  unsigned short mi,
  Environment *allEnv)
  {
   Environment *theEnv;
#if (! RUN_TIME) && (! BLOAD_ONLY)
   GCBlock gcb;
#endif
 
   if (theDefgeneric == NULL)
     { theEnv = allEnv; }
   else
     { theEnv = theDefgeneric->header.env; }
   
#if RUN_TIME || BLOAD_ONLY
   PrintErrorID(theEnv,"PRNTUTIL",4,false);
   WriteString(theEnv,STDERR,"Unable to delete method ");
   if (theDefgeneric != NULL)
     {
      WriteString(theEnv,STDERR,"'");
      PrintGenericName(theEnv,STDERR,theDefgeneric);
      WriteString(theEnv,STDERR,"'");
      WriteString(theEnv,STDERR," #");
      PrintUnsignedInteger(theEnv,STDERR,mi);
     }
   else
     WriteString(theEnv,STDERR,"*");
   WriteString(theEnv,STDERR,".\n");
   return false;
#else

#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv) == true)
     {
      PrintErrorID(theEnv,"PRNTUTIL",4,false);
      WriteString(theEnv,STDERR,"Unable to delete method ");
      if (theDefgeneric != NULL)
        {
         WriteString(theEnv,STDERR,"'");
         WriteString(theEnv,STDERR,DefgenericName(theDefgeneric));
         WriteString(theEnv,STDERR,"'");
         WriteString(theEnv,STDERR," #");
         PrintUnsignedInteger(theEnv,STDERR,mi);
        }
      else
        WriteString(theEnv,STDERR,"*");
      WriteString(theEnv,STDERR,".\n");
      return false;
     }
#endif

   GCBlockStart(theEnv,&gcb);
   if (theDefgeneric == NULL)
     {
      bool success;
      
      if (mi != 0)
        {
         PrintErrorID(theEnv,"GENRCCOM",3,false);
         WriteString(theEnv,STDERR,"Incomplete method specification for deletion.\n");
         GCBlockEnd(theEnv,&gcb);
         return false;
        }
        
      success = ClearDefmethods(theEnv);
      GCBlockEnd(theEnv,&gcb);
      return success;
     }
     
   if (MethodsExecuting(theDefgeneric))
     {
      MethodAlterError(theEnv,theDefgeneric);
      GCBlockEnd(theEnv,&gcb);
      return false;
     }
     
   if (mi == 0)
     { RemoveAllExplicitMethods(theEnv,theDefgeneric); }
   else
     {
      unsigned short nmi = CheckMethodExists(theEnv,"undefmethod",theDefgeneric,mi);
      if (nmi == METHOD_NOT_FOUND)
        {
         GCBlockEnd(theEnv,&gcb);
         return false;
        }
      RemoveDefgenericMethod(theEnv,theDefgeneric,nmi);
     }
     
   GCBlockEnd(theEnv,&gcb);
   return true;
#endif
  }

#if DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS

/*****************************************************
  NAME         : DefmethodDescription
  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
 *****************************************************/
void DefmethodDescription(
  Defgeneric *theDefgeneric,
  unsigned short theIndex,
  StringBuilder *theSB)
  {
   long mi;
   Environment *theEnv = theDefgeneric->header.env;

   mi = FindMethodByIndex(theDefgeneric,theIndex);

   OpenStringBuilderDestination(theEnv,"MethodDescription",theSB);

   if (mi != METHOD_NOT_FOUND)
     { PrintMethod(theEnv,&theDefgeneric->methods[mi],theSB); }
   
   CloseStringBuilderDestination(theEnv,"MethodDescription");

  }
#endif /* DEBUGGING_FUNCTIONS || PROFILING_FUNCTIONS */

#if DEBUGGING_FUNCTIONS

/*********************************************************
  NAME         : GetDefgenericWatch
  DESCRIPTION  : Determines if trace messages are
                 gnerated when executing generic function
  INPUTS       : A pointer to the generic
  RETURNS      : True if a trace is active,
                 false otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
bool DefgenericGetWatch(
  Defgeneric *theGeneric)
  {
   return theGeneric->trace;
  }

/*********************************************************
  NAME         : SetDefgenericWatch
  DESCRIPTION  : Sets the trace to ON/OFF for the
                 generic function
  INPUTS       : 1) True to set the trace on,
                    False to set it off
                 2) A pointer to the generic
  RETURNS      : Nothing useful
  SIDE EFFECTS : Watch flag for the generic set
  NOTES        : None
 *********************************************************/
void DefgenericSetWatch(
  Defgeneric *theGeneric,
  bool newState)
  {
   theGeneric->trace = newState;
  }

/*********************************************************
  NAME         : DefmethodGetWatch
  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      : True if a trace is active,
                 false otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
bool DefmethodGetWatch(
  Defgeneric *theGeneric,
  unsigned short theIndex)
  {
   unsigned short mi;

   mi = FindMethodByIndex(theGeneric,theIndex);
   
   if (mi != METHOD_NOT_FOUND)
     { return theGeneric->methods[mi].trace; }
     
   return false;
  }

/*********************************************************
  NAME         : DefmethodSetWatch
  DESCRIPTION  : Sets the trace to ON/OFF for the
                 calling of the method
  INPUTS       : 1) True to set the trace on,
                    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
 *********************************************************/
void DefmethodSetWatch(
  Defgeneric *theGeneric,
  unsigned short theIndex,
  bool newState)
  {
   unsigned short mi;

   mi = FindMethodByIndex(theGeneric,theIndex);
   
   if (mi != METHOD_NOT_FOUND)
     { theGeneric->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        : H/L Syntax: (ppdefgeneric <name>)
 ********************************************************/
void PPDefgenericCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   PPConstructCommand(context,"ppdefgeneric",DefgenericData(theEnv)->DefgenericConstruct,returnValue);
  }

/**********************************************************
  NAME         : PPDefmethodCommand
  DESCRIPTION  : Displays the pretty-print form of
                  a method
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (ppdefmethod <name> <index>)
 **********************************************************/
void PPDefmethodCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   const char *gname;
   const char *logicalName;
   Defgeneric *gfunc;
   unsigned short gi;

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;
   gname = theArg.lexemeValue->contents;

   if (! UDFNextArgument(context,INTEGER_BIT,&theArg)) return;

   if (UDFHasNextArgument(context))
     {
      logicalName = GetLogicalName(context,STDOUT);
      if (logicalName == NULL)
        {
         IllegalLogicalNameMessage(theEnv,"ppdefmethod");
         SetHaltExecution(theEnv,true);
         SetEvaluationError(theEnv,true);
         return;
        }
     }
   else
     { logicalName = STDOUT; }

   gfunc = CheckGenericExists(theEnv,"ppdefmethod",gname);
   if (gfunc == NULL)
     return;

   gi = CheckMethodExists(theEnv,"ppdefmethod",gfunc,(unsigned short) theArg.integerValue->contents);
   if (gi == METHOD_NOT_FOUND)
     return;
     
   if (strcmp(logicalName,"nil") == 0)
     {
      if (gfunc->methods[gi].header.ppForm != NULL)
        { returnValue->lexemeValue = CreateString(theEnv,gfunc->methods[gi].header.ppForm); }
      else
        { returnValue->lexemeValue = CreateString(theEnv,""); }
     }
   else
     {
      if (gfunc->methods[gi].header.ppForm != NULL)
        WriteString(theEnv,logicalName,gfunc->methods[gi].header.ppForm);
     }
  }

/******************************************************
  NAME         : ListDefmethodsCommand
  DESCRIPTION  : Lists a brief description of methods
                   for a particular generic function
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (list-defmethods <name>)
 ******************************************************/
void ListDefmethodsCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   Defgeneric *gfunc;

   if (! UDFHasNextArgument(context))
     { ListDefmethods(theEnv,STDOUT,NULL); }
   else
     {
      if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg)) return;

      gfunc = CheckGenericExists(theEnv,"list-defmethods",theArg.lexemeValue->contents);
      if (gfunc != NULL)
        { ListDefmethods(theEnv,STDOUT,gfunc); }
     }
  }

/***************************************************************
  NAME         : DefmethodPPForm
  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
 ***************************************************************/
const char *DefmethodPPForm(
  Defgeneric *theDefgeneric,
  unsigned short theIndex)
  {
   unsigned short mi;

   mi = FindMethodByIndex(theDefgeneric,theIndex);
   
   if (mi != METHOD_NOT_FOUND)
     { return theDefgeneric->methods[mi].header.ppForm; }
     
   return "";
  }

/***************************************************
  NAME         : ListDefgenericsCommand
  DESCRIPTION  : Displays all defgeneric names
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric names printed
  NOTES        : H/L Interface
 ***************************************************/
void ListDefgenericsCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   ListConstructCommand(context,DefgenericData(theEnv)->DefgenericConstruct);
  }

/***************************************************
  NAME         : ListDefgenerics
  DESCRIPTION  : Displays all defgeneric names
  INPUTS       : 1) The logical name of the output
                 2) The module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric names printed
  NOTES        : C Interface
 ***************************************************/
void ListDefgenerics(
  Environment *theEnv,
  const char *logicalName,
  Defmodule *theModule)
  {
   ListConstruct(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logicalName,theModule);
  }

/******************************************************
  NAME         : ListDefmethods
  DESCRIPTION  : Lists a brief description of methods
                   for a particular generic function
  INPUTS       : 1) The logical name of the output
                 2) Generic function to list methods for
                    (NULL means list all methods)
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ******************************************************/
void ListDefmethods(
  Environment *theEnv,
  const char *logicalName,
  Defgeneric *theDefgeneric)
  {
   Defgeneric *gfunc;
   unsigned long count;
   if (theDefgeneric != NULL)
     count = ListMethodsForGeneric(theEnv,logicalName,theDefgeneric);
   else
     {
      count = 0;
      for (gfunc = GetNextDefgeneric(theEnv,NULL) ;
           gfunc != NULL ;
           gfunc = GetNextDefgeneric(theEnv,gfunc))
        {
         count += ListMethodsForGeneric(theEnv,logicalName,gfunc);
         if (GetNextDefgeneric(theEnv,gfunc) != NULL)
           WriteString(theEnv,logicalName,"\n");
        }
     }
   PrintTally(theEnv,logicalName,count,"method","methods");
  }

#endif /* DEBUGGING_FUNCTIONS */

/***************************************************************
  NAME         : GetDefgenericListFunction
  DESCRIPTION  : Groups all defgeneric names into
                 a multifield list
  INPUTS       : A data object buffer to hold
                 the multifield result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : H/L Syntax: (get-defgeneric-list [<module>])
 ***************************************************************/
void GetDefgenericListFunction(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   GetConstructListFunction(context,returnValue,DefgenericData(theEnv)->DefgenericConstruct);
  }

/***************************************************************
  NAME         : GetDefgenericList
  DESCRIPTION  : Groups all defgeneric names into
                 a multifield list
  INPUTS       : 1) A data object buffer to hold
                    the multifield result
                 2) The module from which to obtain defgenerics
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : External C access
 ***************************************************************/
void GetDefgenericList(
  Environment *theEnv,
  CLIPSValue *returnValue,
  Defmodule *theModule)
  {
   UDFValue result;
   
   GetConstructList(theEnv,&result,DefgenericData(theEnv)->DefgenericConstruct,theModule);
   NormalizeMultifield(theEnv,&result);
   returnValue->value = result.value;
  }

/***********************************************************
  NAME         : GetDefmethodListCommand
  DESCRIPTION  : Groups indices of all methdos for a generic
                 function into a multifield variable
                 (NULL means get methods for all generics)
  INPUTS       : A data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield set to list of method indices
  NOTES        : None
 ***********************************************************/
void GetDefmethodListCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   Defgeneric *gfunc;
   CLIPSValue result;

   if (! UDFHasNextArgument(context))
     {
      GetDefmethodList(theEnv,&result,NULL);
      CLIPSToUDFValue(&result,returnValue);
     }
   else
     {
      if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
        { return; }
      gfunc = CheckGenericExists(theEnv,"get-defmethod-list",theArg.lexemeValue->contents);
      if (gfunc != NULL)
        {
         GetDefmethodList(theEnv,&result,gfunc);
         CLIPSToUDFValue(&result,returnValue);
        }
      else
        { SetMultifieldErrorValue(theEnv,returnValue); }
     }
  }

/***********************************************************
  NAME         : GetDefmethodList
  DESCRIPTION  : Groups indices of all methdos for a generic
                 function into a multifield variable
                 (NULL means get methods for all generics)
  INPUTS       : 1) A pointer to a generic function
                 2) A data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield set to list of method indices
  NOTES        : None
 ***********************************************************/
void GetDefmethodList(
  Environment *theEnv,
  CLIPSValue *returnValue,
  Defgeneric *theDefgeneric)
  {
   Defgeneric *gfunc, *svg, *svnxt;
   long i,j;
   unsigned long count;
   Multifield *theList;

   if (theDefgeneric != NULL)
     {
      gfunc = theDefgeneric;
      svnxt = GetNextDefgeneric(theEnv,theDefgeneric);
      SetNextDefgeneric(theDefgeneric,NULL);
     }
   else
     {
      gfunc = GetNextDefgeneric(theEnv,NULL);
      svnxt = (gfunc != NULL) ? GetNextDefgeneric(theEnv,gfunc) : NULL;
     }
   count = 0;
   for (svg = gfunc ;
        gfunc != NULL ;
        gfunc = GetNextDefgeneric(theEnv,gfunc))
     count += gfunc->mcnt;
   count *= 2;
   theList = CreateMultifield(theEnv,count);
   returnValue->value = theList;
   for (gfunc = svg , i = 0 ;
        gfunc != NULL ;
        gfunc = GetNextDefgeneric(theEnv,gfunc))
     {
      for (j = 0 ; j < gfunc->mcnt ; j++)
        {
         theList->contents[i++].value = GetDefgenericNamePointer(gfunc);
         theList->contents[i++].integerValue = CreateInteger(theEnv,(long long) gfunc->methods[j].index);
        }
     }
   if (svg != NULL)
     SetNextDefgeneric(svg,svnxt);
  }

/***********************************************************************************
  NAME         : GetMethodRestrictionsCommand
  DESCRIPTION  : Stores restrictions of a method in multifield
  INPUTS       : A data object buffer to hold a multifield
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield created (length zero on errors)
  NOTES        : Syntax: (get-method-restrictions <generic-function> <method-index>)
 ***********************************************************************************/
void GetMethodRestrictionsCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue theArg;
   Defgeneric *gfunc;
   CLIPSValue result;
   unsigned short mi;

   if (! UDFFirstArgument(context,SYMBOL_BIT,&theArg))
     { return; }
   gfunc = CheckGenericExists(theEnv,"get-method-restrictions",theArg.lexemeValue->contents);
   if (gfunc == NULL)
     {
      SetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   if (! UDFNextArgument(context,INTEGER_BIT,&theArg))
     { return; }

   mi = (unsigned short) theArg.integerValue->contents;
   
   if (CheckMethodExists(theEnv,"get-method-restrictions",gfunc,mi) == METHOD_NOT_FOUND)
     {
      SetMultifieldErrorValue(theEnv,returnValue);
      return;
     }
     
   GetMethodRestrictions(gfunc,mi,&result);
   CLIPSToUDFValue(&result,returnValue);
  }

/***********************************************************************
  NAME         : GetMethodRestrictions
  DESCRIPTION  : Stores restrictions of a method in multifield
  INPUTS       : 1) Pointer to the generic function
                 2) The method index
                 3) A data object buffer to hold a multifield
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield created (length zero on errors)
  NOTES        : The restrictions are stored in the multifield
                 in the following format:

                 <min-number-of-arguments>
                 <max-number-of-arguments> (-1 if wildcard allowed)
                 <restriction-count>
                 <index of 1st restriction>
                       .
                       .
                 <index of nth restriction>
                 <restriction 1>
                     <query TRUE/FALSE>
                     <number-of-classes>
                     <class 1>
                        .
                        .
                     <class n>
                    .
                    .
                    .
                  <restriction n>

                  Thus, for the method
                  (defmethod foo ((?a NUMBER SYMBOL_TYPE) (?b (= 1 1)) $?c))
                  (get-method-restrictions foo 1) would yield

                  (2 -1 3 7 11 13 FALSE 2 NUMBER SYMBOL_TYPE TRUE 0 FALSE 0)
 ***********************************************************************/
void GetMethodRestrictions(
  Defgeneric *theDefgeneric,
  unsigned short mi,
  CLIPSValue *returnValue)
  {
   short i,j;
   Defmethod *meth;
   RESTRICTION *rptr;
   size_t count;
   int roffset,rstrctIndex;
   Multifield *theList;
   Environment *theEnv = theDefgeneric->header.env;

   meth = theDefgeneric->methods + FindMethodByIndex(theDefgeneric,mi);
   count = 3;
   for (i = 0 ; i < meth->restrictionCount ; i++)
     count += meth->restrictions[i].tcnt + 3;
   theList = CreateMultifield(theEnv,count);

   returnValue->value = theList;
   if (meth->minRestrictions == RESTRICTIONS_UNBOUNDED)
     { theList->contents[0].integerValue = CreateInteger(theEnv,-1); }
   else
     { theList->contents[0].integerValue = CreateInteger(theEnv,(long long) meth->minRestrictions); }
   if (meth->maxRestrictions == RESTRICTIONS_UNBOUNDED)
     { theList->contents[1].integerValue = CreateInteger(theEnv,-1); }
   else
     { theList->contents[1].integerValue = CreateInteger(theEnv,(long long) meth->maxRestrictions); }
   theList->contents[2].integerValue = CreateInteger(theEnv,(long long) meth->restrictionCount);
   roffset = 3 + meth->restrictionCount;
   rstrctIndex = 3;
   for (i = 0 ; i < meth->restrictionCount ; i++)
     {
      rptr = meth->restrictions + i;
      theList->contents[rstrctIndex++].integerValue = CreateInteger(theEnv,(long long) roffset + 1);
      theList->contents[roffset++].lexemeValue = (rptr->query != NULL) ? TrueSymbol(theEnv) : FalseSymbol(theEnv);
      theList->contents[roffset++].integerValue = CreateInteger(theEnv,(long long) rptr->tcnt);
      for (j = 0 ; j < rptr->tcnt ; j++)
        {
#if OBJECT_SYSTEM
         theList->contents[roffset++].lexemeValue = CreateSymbol(theEnv,DefclassName((Defclass *) rptr->types[j]));
#else
         theList->contents[roffset++].lexemeValue = CreateSymbol(theEnv,TypeName(theEnv,((CLIPSInteger *) rptr->types[j])->contents));
#endif
        }
     }
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***************************************************
  NAME         : PrintGenericCall
  DESCRIPTION  : PrintExpression() support function
                 for generic function calls
  INPUTS       : 1) The output logical name
                 2) The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : Call expression printed
  NOTES        : None
 ***************************************************/
static void PrintGenericCall(
  Environment *theEnv,
  const char *logName,
  Defgeneric *theDefgeneric)
  {
#if DEVELOPER

   WriteString(theEnv,logName,"(");
   WriteString(theEnv,logName,DefgenericName(theDefgeneric));
   if (GetFirstArgument() != NULL)
     {
      WriteString(theEnv,logName," ");
      PrintExpression(theEnv,logName,GetFirstArgument());
     }
   WriteString(theEnv,logName,")");
#else
#if MAC_XCD
#pragma unused(theEnv)
#pragma unused(logName)
#pragma unused(theDefgeneric)
#endif
#endif
  }

/*******************************************************
  NAME         : EvaluateGenericCall
  DESCRIPTION  : Primitive support function for
                 calling a generic function
  INPUTS       : 1) The generic function
                 2) A data object buffer to hold
                    the evaluation result
  RETURNS      : False if the generic function
                 returns the symbol false,
                 true otherwise
  SIDE EFFECTS : Data obejct buffer set and any
                 side-effects of calling the generic
  NOTES        : None
 *******************************************************/
static bool EvaluateGenericCall(
  Environment *theEnv,
  Defgeneric *theDefgeneric,
  UDFValue *returnValue)
  {
   GenericDispatch(theEnv,theDefgeneric,NULL,NULL,GetFirstArgument(),returnValue);
   if ((returnValue->header->type == SYMBOL_TYPE) &&
       (returnValue->value == FalseSymbol(theEnv)))
     return false;
   return true;
  }

/***************************************************
  NAME         : DecrementGenericBusyCount
  DESCRIPTION  : Lowers the busy count of a
                 generic function construct
  INPUTS       : The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : Busy count decremented if a clear
                 is not in progress (see comment)
  NOTES        : None
 ***************************************************/
static void DecrementGenericBusyCount(
  Environment *theEnv,
  Defgeneric *theDefgeneric)
  {
   /* ==============================================
      The generics to which expressions in other
      constructs may refer may already have been
      deleted - thus, it is important not to modify
      the busy flag during a clear.
      ============================================== */
   if (! ConstructData(theEnv)->ClearInProgress)
     { theDefgeneric->busy--; }
  }

/***************************************************
  NAME         : IncrementGenericBusyCount
  DESCRIPTION  : Raises the busy count of a
                 generic function construct
  INPUTS       : The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : Busy count incremented
  NOTES        : None
 ***************************************************/
static void IncrementGenericBusyCount(
  Environment *theEnv,
  Defgeneric *theDefgeneric)
  {
#if MAC_XCD
#pragma unused(theEnv)
#endif
#if (! RUN_TIME) && (! BLOAD_ONLY)
   if (! ConstructData(theEnv)->ParsingConstruct)
     { ConstructData(theEnv)->DanglingConstructs++; }
#endif

   theDefgeneric->busy++;
  }

#if (! BLOAD_ONLY) && (! RUN_TIME)

/**********************************************************************
  NAME         : SaveDefgenerics
  DESCRIPTION  : Outputs pretty-print forms of generic function headers
  INPUTS       : The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 **********************************************************************/
static void SaveDefgenerics(
  Environment *theEnv,
  Defmodule *theModule,
  const char *logName,
  void *context)
  {
   SaveConstruct(theEnv,theModule,logName,DefgenericData(theEnv)->DefgenericConstruct);
  }

/**********************************************************************
  NAME         : SaveDefmethods
  DESCRIPTION  : Outputs pretty-print forms of generic function methods
  INPUTS       : The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 **********************************************************************/
static void SaveDefmethods(
  Environment *theEnv,
  Defmodule *theModule,
  const char *logName,
  void *context)
  {
   DoForAllConstructsInModule(theEnv,theModule,
                              SaveDefmethodsForDefgeneric,
                              DefgenericData(theEnv)->DefgenericModuleIndex,
                              false,(void *) logName);
  }

/***************************************************
  NAME         : SaveDefmethodsForDefgeneric
  DESCRIPTION  : Save the pretty-print forms of
                 all methods for a generic function
                 to a file
  INPUTS       : 1) The defgeneric
                 2) The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : Methods written
  NOTES        : None
 ***************************************************/
static void SaveDefmethodsForDefgeneric(
  Environment *theEnv,
  ConstructHeader *theDefgeneric,
  void *userBuffer)
  {
   Defgeneric *gfunc = (Defgeneric *) theDefgeneric;
   const char *logName = (const char *) userBuffer;
   long i;

   for (i = 0 ; i < gfunc->mcnt ; i++)
     {
      if (gfunc->methods[i].header.ppForm != NULL)
        {
         WriteString(theEnv,logName,gfunc->methods[i].header.ppForm);
         WriteString(theEnv,logName,"\n");
        }
     }
  }

/****************************************************
  NAME         : RemoveDefgenericMethod
  DESCRIPTION  : Removes a generic function method
                   from the array and removes the
                   generic too if its the last method
  INPUTS       : 1) The generic function
                 2) The array index of the method
  RETURNS      : Nothing useful
  SIDE EFFECTS : List adjusted
                 Nodes deallocated
  NOTES        : Assumes deletion is safe
 ****************************************************/
static void RemoveDefgenericMethod(
  Environment *theEnv,
  Defgeneric *gfunc,
  unsigned short gi)
  {
   Defmethod *narr;
   unsigned short b,e;

   if (gfunc->methods[gi].system)
     {
      SetEvaluationError(theEnv,true);
      PrintErrorID(theEnv,"GENRCCOM",4,false);
      WriteString(theEnv,STDERR,"Cannot remove implicit system function method for generic function '");
      WriteString(theEnv,STDERR,DefgenericName(gfunc));
      WriteString(theEnv,STDERR,"'.\n");
      return;
     }
   DeleteMethodInfo(theEnv,gfunc,&gfunc->methods[gi]);
   if (gfunc->mcnt == 1)
     {
      rm(theEnv,gfunc->methods,sizeof(Defmethod));
      gfunc->mcnt = 0;
      gfunc->methods = NULL;
     }
   else
     {
      gfunc->mcnt--;
      narr = (Defmethod *) gm2(theEnv,(sizeof(Defmethod) * gfunc->mcnt));
      for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++)
        {
         if (b == gi)
           e++;
         GenCopyMemory(Defmethod,1,&narr[b],&gfunc->methods[e]);
        }
      rm(theEnv,gfunc->methods,(sizeof(Defmethod) * (gfunc->mcnt+1)));
      gfunc->methods = narr;
     }
  }

#endif

#if DEBUGGING_FUNCTIONS

/******************************************************
  NAME         : ListMethodsForGeneric
  DESCRIPTION  : Lists a brief description of methods
                   for a particular generic function
  INPUTS       : 1) The logical name of the output
                 2) Generic function to list methods for
  RETURNS      : The number of methods printed
  SIDE EFFECTS : None
  NOTES        : None
 ******************************************************/
static unsigned short ListMethodsForGeneric(
  Environment *theEnv,
  const char *logicalName,
  Defgeneric *gfunc)
  {
   unsigned short gi;
   StringBuilder *theSB;
   
   theSB = CreateStringBuilder(theEnv,256);

   for (gi = 0 ; gi < gfunc->mcnt ; gi++)
     {
      WriteString(theEnv,logicalName,DefgenericName(gfunc));
      WriteString(theEnv,logicalName," #");
      PrintMethod(theEnv,&gfunc->methods[gi],theSB);
      WriteString(theEnv,logicalName,theSB->contents);
      WriteString(theEnv,logicalName,"\n");
     }
     
   SBDispose(theSB);
   
   return gfunc->mcnt;
  }

/******************************************************************
  NAME         : DefgenericWatchAccess
  DESCRIPTION  : Parses a list of generic names passed by
                 AddWatchItem() and sets the traces accordingly
  INPUTS       : 1) A code indicating which trace flag is to be set
                    Ignored
                 2) The value to which to set the trace flags
                 3) A list of expressions containing the names
                    of the generics for which to set traces
  RETURNS      : True if all OK, false otherwise
  SIDE EFFECTS : Watch flags set in specified generics
  NOTES        : Accessory function for AddWatchItem()
 ******************************************************************/
static bool DefgenericWatchAccess(
  Environment *theEnv,
  int code,
  bool newState,
  Expression *argExprs)
  {
#if MAC_XCD
#pragma unused(code)
#endif

   return(ConstructSetWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,newState,argExprs,
                                  (ConstructGetWatchFunction *) DefgenericGetWatch,
                                  (ConstructSetWatchFunction *) DefgenericSetWatch));
  }

/***********************************************************************
  NAME         : DefgenericWatchPrint
  DESCRIPTION  : Parses a list of generic names passed by
                 AddWatchItem() and displays the traces accordingly
  INPUTS       : 1) The logical name of the output
                 2) A code indicating which trace flag is to be examined
                    Ignored
                 3) A list of expressions containing the names
                    of the generics for which to examine traces
  RETURNS      : True if all OK, false otherwise
  SIDE EFFECTS : Watch flags displayed for specified generics
  NOTES        : Accessory function for AddWatchItem()
 ***********************************************************************/
static bool DefgenericWatchPrint(
  Environment *theEnv,
  const char *logName,
  int code,
  Expression *argExprs)
  {
#if MAC_XCD
#pragma unused(code)
#endif

   return(ConstructPrintWatchAccess(theEnv,DefgenericData(theEnv)->DefgenericConstruct,logName,argExprs,
                                    (ConstructGetWatchFunction *) DefgenericGetWatch,
                                    (ConstructSetWatchFunction *) DefgenericSetWatch));
  }

/******************************************************************
  NAME         : DefmethodWatchAccess
  DESCRIPTION  : Parses a list of methods passed by
                 AddWatchItem() and sets the traces accordingly
  INPUTS       : 1) A code indicating which trace flag is to be set
                    Ignored
                 2) The value to which to set the trace flags
                 3) A list of expressions containing the methods
                   for which to set traces
  RETURNS      : True if all OK, false otherwise
  SIDE EFFECTS : Watch flags set in specified methods
  NOTES        : Accessory function for AddWatchItem()
 ******************************************************************/
static bool DefmethodWatchAccess(
  Environment *theEnv,
  int code,
  bool newState,
  Expression *argExprs)
  {
#if MAC_XCD
#pragma unused(code)
#endif
   if (newState)
     return(DefmethodWatchSupport(theEnv,"watch",NULL,newState,NULL,DefmethodSetWatch,argExprs));
   else
     return(DefmethodWatchSupport(theEnv,"unwatch",NULL,newState,NULL,DefmethodSetWatch,argExprs));
  }

/***********************************************************************
  NAME         : DefmethodWatchPrint
  DESCRIPTION  : Parses a list of methods passed by
                 AddWatchItem() and displays the traces accordingly
  INPUTS       : 1) The logical name of the output
                 2) A code indicating which trace flag is to be examined
                    Ignored
                 3) A list of expressions containing the methods for
                    which to examine traces
  RETURNS      : True if all OK, false otherwise
  SIDE EFFECTS : Watch flags displayed for specified methods
  NOTES        : Accessory function for AddWatchItem()
 ***********************************************************************/
static bool DefmethodWatchPrint(
  Environment *theEnv,
  const char *logName,
  int code,
  Expression *argExprs)
  {
#if MAC_XCD
#pragma unused(code)
#endif
   return(DefmethodWatchSupport(theEnv,"list-watch-items",logName,0,
                                PrintMethodWatchFlag,NULL,argExprs));
  }

/*******************************************************
  NAME         : DefmethodWatchSupport
  DESCRIPTION  : Sets or displays methods specified
  INPUTS       : 1) The calling function name
                 2) The logical output name for displays
                    (can be NULL)
                 3) The new set state
                 4) The print function (can be NULL)
                 5) The trace function (can be NULL)
                 6) The methods expression list
  RETURNS      : True if all OK,
                 false otherwise
  SIDE EFFECTS : Method trace flags set or displayed
  NOTES        : None
 *******************************************************/
static bool DefmethodWatchSupport(
  Environment *theEnv,
  const char *funcName,
  const char *logName,
  bool newState,
  void (*printFunc)(Environment *,const char *,Defgeneric *,unsigned short),
  void (*traceFunc)(Defgeneric *,unsigned short,bool),
  Expression *argExprs)
  {
   Defgeneric *theGeneric = NULL;
   unsigned short theMethod = 0;
   unsigned int argIndex = 2;
   UDFValue genericName, methodIndex;
   Defmodule *theModule;

   /* ==============================
      If no methods are specified,
      show the trace for all methods
      in all generics
      ============================== */
   if (argExprs == NULL)
     {
      SaveCurrentModule(theEnv);
      theModule = GetNextDefmodule(theEnv,NULL);
      while (theModule != NULL)
        {
         SetCurrentModule(theEnv,theModule);
         if (traceFunc == NULL)
           {
            WriteString(theEnv,logName,DefmoduleName(theModule));
            WriteString(theEnv,logName,":\n");
           }
         theGeneric = GetNextDefgeneric(theEnv,NULL);
         while (theGeneric != NULL)
            {
             theMethod = GetNextDefmethod(theGeneric,0);
             while (theMethod != 0)
               {
                if (traceFunc != NULL)
                  (*traceFunc)(theGeneric,theMethod,newState);
                else
                  {
                   WriteString(theEnv,logName,"   ");
                   (*printFunc)(theEnv,logName,theGeneric,theMethod);
                  }
                theMethod = GetNextDefmethod(theGeneric,theMethod);
               }
             theGeneric = GetNextDefgeneric(theEnv,theGeneric);
            }
         theModule = GetNextDefmodule(theEnv,theModule);
        }
      RestoreCurrentModule(theEnv);
      return true;
     }

   /* =========================================
      Set the traces for every method specified
      ========================================= */
   while (argExprs != NULL)
     {
      if (EvaluateExpression(theEnv,argExprs,&genericName))
        return false;
      if ((genericName.header->type != SYMBOL_TYPE) ? true :
          ((theGeneric =
              LookupDefgenericByMdlOrScope(theEnv,genericName.lexemeValue->contents)) == NULL))
        {
         ExpectedTypeError1(theEnv,funcName,argIndex,"'generic function name'");
         return false;
        }
      if (GetNextArgument(argExprs) == NULL)
        theMethod = 0;
      else
        {
         argExprs = GetNextArgument(argExprs);
         argIndex++;
         if (EvaluateExpression(theEnv,argExprs,&methodIndex))
           return false;
         if ((methodIndex.header->type != INTEGER_TYPE) ? false :
             ((methodIndex.integerValue->contents <= 0) ? false :
              (FindMethodByIndex(theGeneric,theMethod) != METHOD_NOT_FOUND)))
           theMethod = (unsigned short) methodIndex.integerValue->contents;
         else
           {
            ExpectedTypeError1(theEnv,funcName,argIndex,"'method index'");
            return false;
           }
        }
      if (theMethod == 0)
        {
         theMethod = GetNextDefmethod(theGeneric,0);
         while (theMethod != 0)
           {
            if (traceFunc != NULL)
              (*traceFunc)(theGeneric,theMethod,newState);
            else
              (*printFunc)(theEnv,logName,theGeneric,theMethod);
            theMethod = GetNextDefmethod(theGeneric,theMethod);
           }
        }
      else
        {
         if (traceFunc != NULL)
           (*traceFunc)(theGeneric,theMethod,newState);
         else
           (*printFunc)(theEnv,logName,theGeneric,theMethod);
        }
      argExprs = GetNextArgument(argExprs);
      argIndex++;
     }
   return true;
  }

/***************************************************
  NAME         : PrintMethodWatchFlag
  DESCRIPTION  : Displays trace value for method
  INPUTS       : 1) The logical name of the output
                 2) The generic function
                 3) The method index
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
static void PrintMethodWatchFlag(
  Environment *theEnv,
  const char *logName,
  Defgeneric *theGeneric,
  unsigned short theMethod)
  {
   StringBuilder *theSB = CreateStringBuilder(theEnv,60);

   WriteString(theEnv,logName,DefgenericName(theGeneric));
   WriteString(theEnv,logName," ");
   DefmethodDescription(theGeneric,theMethod,theSB);
   WriteString(theEnv,logName,theSB->contents);
   if (DefmethodGetWatch(theGeneric,theMethod))
     WriteString(theEnv,logName," = on\n");
   else
     WriteString(theEnv,logName," = off\n");
     
   SBDispose(theSB);
  }

#endif

#if ! OBJECT_SYSTEM

/***************************************************
  NAME         : TypeCommand
  DESCRIPTION  : Works like "class" in COOL
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : H/L Syntax: (type <primitive>)
 ***************************************************/
void TypeCommand(
  Environment *theEnv,
  UDFContext *context,
  UDFValue *returnValue)
  {
   UDFValue result;
   
   EvaluateExpression(theEnv,GetFirstArgument(),&result);

   returnValue->lexemeValue = CreateSymbol(theEnv,TypeName(theEnv,result.header->type));
  }

#endif

/*#############################*/
/* Additional Access Functions */
/*#############################*/

void SetNextDefgeneric(
  Defgeneric *theDefgeneric,
  Defgeneric *targetDefgeneric)
  {
   SetNextConstruct(&theDefgeneric->header,
                    &targetDefgeneric->header);
  }

/*##################################*/
/* Additional Environment Functions */
/*##################################*/

const char *DefgenericModule(
  Defgeneric *theDefgeneric)
  {
   return GetConstructModuleName(&theDefgeneric->header);
  }

const char *DefgenericName(
  Defgeneric *theDefgeneric)
  {
   return GetConstructNameString(&theDefgeneric->header);
  }

const char *DefgenericPPForm(
  Defgeneric *theDefgeneric)
  {
   return GetConstructPPForm(&theDefgeneric->header);
  }

CLIPSLexeme *GetDefgenericNamePointer(
  Defgeneric *theDefgeneric)
  {
   return GetConstructNamePointer(&theDefgeneric->header);
  }

void SetDefgenericPPForm(
  Environment *theEnv,
  Defgeneric *theDefgeneric,
  const char *thePPForm)
  {
   SetConstructPPForm(theEnv,&theDefgeneric->header,thePPForm);
  }


#endif /* DEFGENERIC_CONSTRUCT */