/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.24  07/01/05            */   /*                                                     */   /*                 CLASS EXAMINATION MODULE            */   /*******************************************************//**************************************************************//* Purpose: Class browsing and examination commands           *//*                                                            *//* Principal Programmer(s):                                   *//*      Brian L. Donnell                                      *//*                                                            *//* Contributing Programmer(s):                                *//*                                                            *//* Revision History:                                          *//*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859   *//*                                                            *//*            Modified the slot-writablep function to return  *//*            FALSE for slots having initialize-only access.  *//*            DR0860                                          *//*                                                            *//*      6.24: Added allowed-classes slot facet.               *//*                                                            *//*            Converted INSTANCE_PATTERN_MATCHING to          *//*            DEFRULE_CONSTRUCT.                              *//*                                                            *//*            Renamed BOOLEAN macro type to intBool.          *//*                                                            *//*            The slot-default-value function crashes when no *//*            default exists for a slot (the ?NONE value was  *//*            specified). DR0870                              *//*                                                            *//*      6.30: Used %zd for printing size_t arguments.         *//*                                                            *//**************************************************************//* =========================================   *****************************************               EXTERNAL DEFINITIONS   =========================================   ***************************************** */#include "setup.h"#if OBJECT_SYSTEM#include <string.h>#include "argacces.h"#include "classcom.h"#include "classfun.h"#include "classini.h"#include "envrnmnt.h"#include "insfun.h"#include "memalloc.h"#include "msgcom.h"#include "msgfun.h"#include "router.h"#include "strngrtr.h"#include "sysdep.h"#define _CLASSEXM_SOURCE_#include "classexm.h"/* =========================================   *****************************************      INTERNALLY VISIBLE FUNCTION HEADERS   =========================================   ***************************************** */static int CheckTwoClasses(void *,char *,DEFCLASS **,DEFCLASS **);static SLOT_DESC *CheckSlotExists(void *,char *,DEFCLASS **,intBool,intBool);static SLOT_DESC *LookupSlot(void *,DEFCLASS *,char *,intBool);#if DEBUGGING_FUNCTIONSstatic DEFCLASS *CheckClass(void *,char *,char *);static char *GetClassNameArgument(void *,char *);static void PrintClassBrowse(void *,char *,DEFCLASS *,long);static void DisplaySeparator(void *,char *,char *,int,int);static void DisplaySlotBasicInfo(void *,char *,char *,char *,char *,DEFCLASS *);static intBool PrintSlotSources(void *,char *,SYMBOL_HN *,PACKED_CLASS_LINKS *,long,int);static void DisplaySlotConstraintInfo(void *,char *,char *,char *,unsigned,DEFCLASS *);static char *ConstraintCode(CONSTRAINT_RECORD *,unsigned,unsigned);#endif/* =========================================   *****************************************          EXTERNALLY VISIBLE FUNCTIONS   =========================================   ***************************************** */#if DEBUGGING_FUNCTIONS/****************************************************************  NAME         : BrowseClassesCommand  DESCRIPTION  : Displays a "graph" of the class hierarchy  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : Syntax : (browse-classes [<class>]) ****************************************************************/globle void BrowseClassesCommand(  void *theEnv)  {   register DEFCLASS *cls;      if (EnvRtnArgCount(theEnv) == 0)      /* ================================================         Find the OBJECT root class (has no superclasses)         ================================================ */      cls = LookupDefclassByMdlOrScope(theEnv,OBJECT_TYPE_NAME);   else     {      DATA_OBJECT tmp;      if (EnvArgTypeCheck(theEnv,"browse-classes",1,SYMBOL,&tmp) == FALSE)        return;      cls = LookupDefclassByMdlOrScope(theEnv,DOToString(tmp));      if (cls == NULL)        {         ClassExistError(theEnv,"browse-classes",DOToString(tmp));         return;        }     }   EnvBrowseClasses(theEnv,WDISPLAY,(void *) cls);  }/****************************************************************  NAME         : EnvBrowseClasses  DESCRIPTION  : Displays a "graph" of the class hierarchy  INPUTS       : 1) The logical name of the output                 2) Class pointer  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : None ****************************************************************/globle void EnvBrowseClasses(  void *theEnv,  char *logicalName,  void *clsptr)  {   PrintClassBrowse(theEnv,logicalName,(DEFCLASS *) clsptr,0);  }/****************************************************************  NAME         : DescribeClassCommand  DESCRIPTION  : Displays direct superclasses and                   subclasses and the entire precedence                   list for a class  INPUTS       : None  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : Syntax : (describe-class <class-name>) ****************************************************************/globle void DescribeClassCommand(  void *theEnv)  {   char *cname;   DEFCLASS *cls;      cname = GetClassNameArgument(theEnv,"describe-class");   if (cname == NULL)     return;   cls = CheckClass(theEnv,"describe-class",cname);   if (cls == NULL)     return;   EnvDescribeClass(theEnv,WDISPLAY,(void *) cls);  }/******************************************************  NAME         : EnvDescribeClass  DESCRIPTION  : Displays direct superclasses and                   subclasses and the entire precedence                   list for a class  INPUTS       : 1) The logical name of the output                 2) Class pointer  RETURNS      : Nothing useful  SIDE EFFECTS : None  NOTES        : None ******************************************************/globle void EnvDescribeClass(  void *theEnv,  char *logicalName,  void *clsptr)  {   DEFCLASS *cls;   char buf[83],        slotNamePrintFormat[12],        overrideMessagePrintFormat[12];   int messageBanner;   long i;   size_t slotNameLength, maxSlotNameLength;   size_t overrideMessageLength, maxOverrideMessageLength;   cls = (DEFCLASS *) clsptr;   DisplaySeparator(theEnv,logicalName,buf,82,'=');   DisplaySeparator(theEnv,logicalName,buf,82,'*');   if (cls->abstract)     EnvPrintRouter(theEnv,logicalName,"Abstract: direct instances of this class cannot be created.\n\n");   else     {      EnvPrintRouter(theEnv,logicalName,"Concrete: direct instances of this class can be created.\n");#if DEFRULE_CONSTRUCT      if (cls->reactive)        EnvPrintRouter(theEnv,logicalName,"Reactive: direct instances of this class can match defrule patterns.\n\n");      else        EnvPrintRouter(theEnv,logicalName,"Non-reactive: direct instances of this class cannot match defrule patterns.\n\n");#else      EnvPrintRouter(theEnv,logicalName,"\n");#endif     }   PrintPackedClassLinks(theEnv,logicalName,"Direct Superclasses:",&cls->directSuperclasses);   PrintPackedClassLinks(theEnv,logicalName,"Inheritance Precedence:",&cls->allSuperclasses);   PrintPackedClassLinks(theEnv,logicalName,"Direct Subclasses:",&cls->directSubclasses);   if (cls->instanceTemplate != NULL)     {      DisplaySeparator(theEnv,logicalName,buf,82,'-');      maxSlotNameLength = 5;      maxOverrideMessageLength = 8;      for (i = 0 ; i < cls->instanceSlotCount ; i++)        {         slotNameLength = strlen(ValueToString(cls->instanceTemplate[i]->slotName->name));         if (slotNameLength > maxSlotNameLength)           maxSlotNameLength = slotNameLength;         if (cls->instanceTemplate[i]->noWrite == 0)           {            overrideMessageLength =              strlen(ValueToString(cls->instanceTemplate[i]->overrideMessage));            if (overrideMessageLength > maxOverrideMessageLength)              maxOverrideMessageLength = overrideMessageLength;           }        }      if (maxSlotNameLength > 16)        maxSlotNameLength = 16;      if (maxOverrideMessageLength > 12)        maxOverrideMessageLength = 12;#if IBM_MSC      gensprintf(slotNamePrintFormat,"%%-%Id.%Ids : ",maxSlotNameLength,maxSlotNameLength);      gensprintf(overrideMessagePrintFormat,"%%-%Id.%Ids ",maxOverrideMessageLength,                                              maxOverrideMessageLength);#else      gensprintf(slotNamePrintFormat,"%%-%zd.%zds : ",maxSlotNameLength,maxSlotNameLength);      gensprintf(overrideMessagePrintFormat,"%%-%zd.%zds ",maxOverrideMessageLength,                                              maxOverrideMessageLength);#endif      DisplaySlotBasicInfo(theEnv,logicalName,slotNamePrintFormat,overrideMessagePrintFormat,buf,cls);      EnvPrintRouter(theEnv,logicalName,"\nConstraint information for slots:\n\n");      DisplaySlotConstraintInfo(theEnv,logicalName,slotNamePrintFormat,buf,82,cls);     }   if (cls->handlerCount > 0)     messageBanner = TRUE;   else     {      messageBanner = FALSE;      for (i = 1 ; i < cls->allSuperclasses.classCount ; i++)        if (cls->allSuperclasses.classArray[i]->handlerCount > 0)          {           messageBanner = TRUE;           break;          }     }   if (messageBanner)     {      DisplaySeparator(theEnv,logicalName,buf,82,'-');      EnvPrintRouter(theEnv,logicalName,"Recognized message-handlers:\n");      DisplayHandlersInLinks(theEnv,logicalName,&cls->allSuperclasses,0);     }   DisplaySeparator(theEnv,logicalName,buf,82,'*');   DisplaySeparator(theEnv,logicalName,buf,82,'=');  }#endif/**********************************************************  NAME         : GetCreateAccessorString  DESCRIPTION  : Gets a string describing which                 accessors are implicitly created                 for a slot: R, W, RW or NIL  INPUTS       : The slot descriptor  RETURNS      : The string description  SIDE EFFECTS : None  NOTES        : Used by (describe-class) and (slot-facets) **********************************************************/globle char *GetCreateAccessorString(  void *vsd)  {   SLOT_DESC *sd = (SLOT_DESC *) vsd;   if (sd->createReadAccessor && sd->createWriteAccessor)     return("RW");   if ((sd->createReadAccessor == 0) && (sd->createWriteAccessor == 0))     return("NIL");   else     return((char *) (sd->createReadAccessor ? "R" : "W"));  }/************************************************************  NAME         : GetDefclassModuleCommand  DESCRIPTION  : Determines to which module a class belongs  INPUTS       : None  RETURNS      : The symbolic name of the module  SIDE EFFECTS : None  NOTES        : H/L Syntax: (defclass-module <class-name>) ************************************************************/globle void *GetDefclassModuleCommand(  void *theEnv)  {   return(GetConstructModuleCommand(theEnv,"defclass-module",DefclassData(theEnv)->DefclassConstruct));  }/*********************************************************************  NAME         : SuperclassPCommand  DESCRIPTION  : Determines if a class is a superclass of another  INPUTS       : None  RETURNS      : TRUE if class-1 is a superclass of class-2  SIDE EFFECTS : None  NOTES        : H/L Syntax : (superclassp <class-1> <class-2>) *********************************************************************/globle intBool SuperclassPCommand(  void *theEnv)  {   DEFCLASS *c1,*c2;      if (CheckTwoClasses(theEnv,"superclassp",&c1,&c2) == FALSE)     return(FALSE);   return(EnvSuperclassP(theEnv,(void *) c1,(void *) c2));  }/***************************************************  NAME         : EnvSuperclassP  DESCRIPTION  : Determines if the first class is                 a superclass of the other  INPUTS       : 1) First class                 2) Second class  RETURNS      : TRUE if first class is a                 superclass of the first,                 FALSE otherwise  SIDE EFFECTS : None  NOTES        : None ***************************************************/#if IBM_TBC#pragma argsused#endifgloble intBool EnvSuperclassP(  void *theEnv,  void *firstClass,  void *secondClass)  {#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif   return(HasSuperclass((DEFCLASS *) secondClass,(DEFCLASS *) firstClass));  }/*********************************************************************  NAME         : SubclassPCommand  DESCRIPTION  : Determines if a class is a subclass of another  INPUTS       : None  RETURNS      : TRUE if class-1 is a subclass of class-2  SIDE EFFECTS : None  NOTES        : H/L Syntax : (subclassp <class-1> <class-2>) *********************************************************************/globle intBool SubclassPCommand(  void *theEnv)  {   DEFCLASS *c1,*c2;      if (CheckTwoClasses(theEnv,"subclassp",&c1,&c2) == FALSE)     return(FALSE);   return(EnvSubclassP(theEnv,(void *) c1,(void *) c2));  }/***************************************************  NAME         : EnvSubclassP  DESCRIPTION  : Determines if the first class is                 a subclass of the other  INPUTS       : 1) First class                 2) Second class  RETURNS      : TRUE if first class is a                 subclass of the first,                 FALSE otherwise  SIDE EFFECTS : None  NOTES        : None ***************************************************/#if IBM_TBC#pragma argsused#endifgloble intBool EnvSubclassP(  void *theEnv,  void *firstClass,  void *secondClass)  {#if MAC_MCW || IBM_MCW || MAC_XCD#pragma unused(theEnv)#endif   return(HasSuperclass((DEFCLASS *) firstClass,(DEFCLASS *) secondClass));  }/*********************************************************************  NAME         : SlotExistPCommand  DESCRIPTION  : Determines if a slot is present in a class  INPUTS       : None  RETURNS      : TRUE if the slot exists, FALSE otherwise  SIDE EFFECTS : None  NOTES        : H/L Syntax : (slot-existp <class> <slot> [inherit]) *********************************************************************/globle int SlotExistPCommand(  void *theEnv)  {   DEFCLASS *cls;   SLOT_DESC *sd;   int inheritFlag = FALSE;   DATA_OBJECT dobj;      sd = CheckSlotExists(theEnv,"slot-existp",&cls,FALSE,TRUE);   if (sd == NULL)     return(FALSE);