classcom.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.24  06/02/06          */
   /*                                                     */
   /*                  CLASS COMMANDS MODULE              */
   /*******************************************************/

/**************************************************************/
/* Purpose: Kernel Interface Commands for Object System       */
/*                                                            */
/* Principal Programmer(s):                                   */
/*      Brian L. Donnell                                      */
/*                                                            */
/* Contributing Programmer(s):                                */
/*                                                            */
/* Revision History:                                          */
/*      6.23: 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: Renamed BOOLEAN macro type to intBool.          */
/*                                                            */
/*            Added pragmas to remove compilation warnings.   */
/*                                                            */
/**************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */

#include <string.h>

#include "setup.h"

#if OBJECT_SYSTEM

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
#include "bload.h"
#endif

#include "argacces.h"
#include "classfun.h"
#include "classini.h"
#include "envrnmnt.h"
#include "modulutl.h"
#include "msgcom.h"
#include "router.h"

#define _CLASSCOM_SOURCE_
#include "classcom.h"

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

#if (! BLOAD_ONLY) && (! RUN_TIME) && DEBUGGING_FUNCTIONS
static void SaveDefclass(void *,struct constructHeader *,void *);
#endif
static char *GetClassDefaultsModeName(unsigned short);

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

/*******************************************************************
  NAME         : EnvFindDefclass
  DESCRIPTION  : Looks up a specified class in the class hash table
                 (Only looks in current or specified module)
  INPUTS       : The name-string of the class (including module)
  RETURNS      : The address of the found class, NULL otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ******************************************************************/
globle void *EnvFindDefclass(
  void *theEnv,
  char *classAndModuleName)
  {
   SYMBOL_HN *classSymbol = NULL;
   DEFCLASS *cls;
   struct defmodule *theModule = NULL;
   char *className;

   SaveCurrentModule(theEnv);
   className = ExtractModuleAndConstructName(theEnv,classAndModuleName);
   if (className != NULL)
     {
      classSymbol = FindSymbolHN(theEnv,ExtractModuleAndConstructName(theEnv,classAndModuleName));
      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
     }
   RestoreCurrentModule(theEnv);

   if (classSymbol == NULL)
     return(NULL);
   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
   while (cls != NULL)
     {
      if (cls->header.name == classSymbol)
        {
         if (cls->system || (cls->header.whichModule->theModule == theModule))
           return(cls->installed ? (void *) cls : NULL);
        }
      cls = cls->nxtHash;
     }
   return(NULL);
  }

/***************************************************
  NAME         : LookupDefclassByMdlOrScope
  DESCRIPTION  : Finds a class anywhere (if module
                 is specified) or in current or
                 imported modules
  INPUTS       : The class name
  RETURNS      : The class (NULL if not found)
  SIDE EFFECTS : Error message printed on
                  ambiguous references
  NOTES        : Assumes no two classes of the same
                 name are ever in the same scope
 ***************************************************/
globle DEFCLASS *LookupDefclassByMdlOrScope(
  void *theEnv,
  char *classAndModuleName)
  {
   DEFCLASS *cls;
   char *className;
   SYMBOL_HN *classSymbol;
   struct defmodule *theModule;

   if (FindModuleSeparator(classAndModuleName) == FALSE)
     return(LookupDefclassInScope(theEnv,classAndModuleName));

   SaveCurrentModule(theEnv);
   className = ExtractModuleAndConstructName(theEnv,classAndModuleName);
   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
   RestoreCurrentModule(theEnv);
   if(className == NULL)
     return(NULL);
   if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
     return(NULL);
   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
   while (cls != NULL)
     {
      if ((cls->header.name == classSymbol) &&
          (cls->header.whichModule->theModule == theModule))
        return(cls->installed ? cls : NULL);
      cls = cls->nxtHash;
     }
   return(NULL);
  }

/****************************************************
  NAME         : LookupDefclassInScope
  DESCRIPTION  : Finds a class in current or imported
                   modules (module specifier
                   is not allowed)
  INPUTS       : The class name
  RETURNS      : The class (NULL if not found)
  SIDE EFFECTS : Error message printed on
                  ambiguous references
  NOTES        : Assumes no two classes of the same
                 name are ever in the same scope
 ****************************************************/
globle DEFCLASS *LookupDefclassInScope(
  void *theEnv,
  char *className)
  {
   DEFCLASS *cls;
   SYMBOL_HN *classSymbol;

   if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
     return(NULL);
   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
   while (cls != NULL)
     {
      if ((cls->header.name == classSymbol) && DefclassInScope(theEnv,cls,NULL))
        return(cls->installed ? cls : NULL);
      cls = cls->nxtHash;
     }
   return(NULL);
  }

/******************************************************
  NAME         : LookupDefclassAnywhere
  DESCRIPTION  : Finds a class in specified
                 (or any) module
  INPUTS       : 1) The module (NULL if don't care)
                 2) The class name (module specifier
                    in name not allowed)
  RETURNS      : The class (NULL if not found)
  SIDE EFFECTS : None
  NOTES        : Does *not* generate an error if
                 multiple classes of the same name
                 exist as do the other lookup functions
 ******************************************************/
globle DEFCLASS *LookupDefclassAnywhere(
  void *theEnv,
  struct defmodule *theModule,
  char *className)
  {
   DEFCLASS *cls;
   SYMBOL_HN *classSymbol;

   if ((classSymbol = FindSymbolHN(theEnv,className)) == NULL)
     return(NULL);
   cls = DefclassData(theEnv)->ClassTable[HashClass(classSymbol)];
   while (cls != NULL)
     {
      if ((cls->header.name == classSymbol) &&
          ((theModule == NULL) ||
           (cls->header.whichModule->theModule == theModule)))
        return(cls->installed ? cls : NULL);
      cls = cls->nxtHash;
     }
   return(NULL);
  }

/***************************************************
  NAME         : DefclassInScope
  DESCRIPTION  : Determines if a defclass is in
                 scope of the given module
  INPUTS       : 1) The defclass
                 2) The module (NULL for current
                    module)
  RETURNS      : TRUE if in scope,
                 FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
#if IBM_TBC && (! DEFMODULE_CONSTRUCT)
#pragma argsused
#endif
globle intBool DefclassInScope(
  void *theEnv,
  DEFCLASS *theDefclass,
  struct defmodule *theModule)
  {
#if DEFMODULE_CONSTRUCT
   int moduleID;
   char *scopeMap;

   scopeMap = (char *) ValueToBitMap(theDefclass->scopeMap);
   if (theModule == NULL)
     theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
   moduleID = (int) theModule->bsaveID;
   return(TestBitMap(scopeMap,moduleID) ? TRUE : FALSE);
#else
#if MAC_MCW || IBM_MCW || MAC_XCD
#pragma unused(theEnv,theDefclass,theModule)
#endif
   return(TRUE);
#endif
  }

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

/***************************************************
  NAME         : EnvIsDefclassDeletable
  DESCRIPTION  : Determines if a defclass
                   can be deleted
  INPUTS       : Address of the defclass
  RETURNS      : TRUE if deletable,
                 FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle intBool EnvIsDefclassDeletable(
  void *theEnv,
  void *ptr)
  {
   DEFCLASS *cls;

   if (! ConstructsDeletable(theEnv))
     { return FALSE; }

   cls = (DEFCLASS *) ptr;
   if (cls->system == 1)
     return(FALSE);
   
#if (! BLOAD_ONLY) && (! RUN_TIME)
   return((IsClassBeingUsed(cls) == FALSE) ? TRUE : FALSE);
#else
   return FALSE;
#endif
  }

/*************************************************************
  NAME         : UndefclassCommand
  DESCRIPTION  : Deletes a class and its subclasses, as
                 well as their associated instances
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Syntax : (undefclass <class-name> | *)
 *************************************************************/
globle void UndefclassCommand(
  void *theEnv)
  {
   UndefconstructCommand(theEnv,"undefclass",DefclassData(theEnv)->DefclassConstruct);
  }

/********************************************************
  NAME         : EnvUndefclass
  DESCRIPTION  : Deletes the named defclass
  INPUTS       : None
  RETURNS      : TRUE if deleted, or FALSE
  SIDE EFFECTS : Defclass and handlers removed
  NOTES        : Interface for AddConstruct()
 ********************************************************/
globle intBool EnvUndefclass(
  void *theEnv,
  void *theDefclass)
  {
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,theDefclass)
#endif

#if RUN_TIME || BLOAD_ONLY
   return(FALSE);
#else
   DEFCLASS *cls;

   cls = (DEFCLASS *) theDefclass;
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded(theEnv))
     return(FALSE);
#endif
   if (cls == NULL)
     return(RemoveAllUserClasses(theEnv));
   return(DeleteClassUAG(theEnv,cls));
#endif
  }


#if DEBUGGING_FUNCTIONS

/*********************************************************
  NAME         : PPDefclassCommand
  DESCRIPTION  : Displays the pretty print form of
                 a class to the wdialog router.
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Syntax : (ppdefclass <class-name>)
 *********************************************************/
globle void PPDefclassCommand(
  void *theEnv)
  {   
   PPConstructCommand(theEnv,"ppdefclass",DefclassData(theEnv)->DefclassConstruct);
  }

/***************************************************
  NAME         : ListDefclassesCommand
  DESCRIPTION  : Displays all defclass names
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defclass names printed
  NOTES        : H/L Interface
 ***************************************************/
globle void ListDefclassesCommand(
  void *theEnv)
  {
   ListConstructCommand(theEnv,"list-defclasses",DefclassData(theEnv)->DefclassConstruct);
  }

/***************************************************
  NAME         : EnvListDefclasses
  DESCRIPTION  : Displays all defclass names
  INPUTS       : 1) The logical name of the output
                 2) The module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defclass names printed
  NOTES        : C Interface
 ***************************************************/
globle void EnvListDefclasses(
  void *theEnv,
  char *logicalName,
  struct defmodule *theModule)
  {
   ListConstruct(theEnv,DefclassData(theEnv)->DefclassConstruct,logicalName,theModule);
  }

/*********************************************************
  NAME         : EnvGetDefclassWatchInstances
  DESCRIPTION  : Determines if deletions/creations of
                 instances of this class will generate
                 trace messages or not
  INPUTS       : A pointer to the class
  RETURNS      : TRUE if a trace is active,
                 FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
#if IBM_TBC
#pragma argsused
#endif
globle unsigned EnvGetDefclassWatchInstances(
  void *theEnv,
  void *theClass)
  {