classinf.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.05  04/09/97          */
   /*                                                     */
   /*        CLASS INFO PROGRAMMATIC ACCESS MODULE        */
   /*******************************************************/

/**************************************************************/
/* Purpose: Class Information Interface Support Routines      */
/*                                                            */
/* Principal Programmer(s):                                   */
/*      Brian L. Donnell                                      */
/*                                                            */
/* Contributing Programmer(s):                                */
/*                                                            */
/* Revision History:                                          */
/*                                                            */
/**************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#ifndef _CLIPS_STDIO_
#define _CLIPS_STDIO_
#include <stdio.h>
#endif

#if ANSI_COMPILER
#include <string.h>
#endif

#include "argacces.h"
#include "classcom.h"
#include "classexm.h"
#include "classfun.h"
#include "classini.h"
#include "clipsmem.h"
#include "insfun.h"
#include "msgfun.h"
#include "multifld.h"
#include "prntutil.h"

#define _CLASSINF_SOURCE_
#include "classinf.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static VOID SlotInfoSupportFunction(DATA_OBJECT *,char *,VOID (*)(VOID *,char *,DATA_OBJECT *));
static int CountSubclasses(DEFCLASS *,int,int);
static int StoreSubclasses(VOID *,int,DEFCLASS *,int,int);
static SLOT_DESC *SlotInfoSlot(DATA_OBJECT *,DEFCLASS *,char *,char *);

#else

static VOID SlotInfoSupportFunction();
static int CountSubclasses();
static int StoreSubclasses();
static SLOT_DESC *SlotInfoSlot();

#endif

/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */

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

/*********************************************************************
  NAME         : ClassAbstractPCommand
  DESCRIPTION  : Determines if direct instances of a class can be made
  INPUTS       : None
  RETURNS      : CLIPS_TRUE (1) if class is abstract, CLIPS_FALSE (0) if concrete
  SIDE EFFECTS : None
  NOTES        : Syntax: (class-abstractp <class>)
 *********************************************************************/
globle int ClassAbstractPCommand()
  {
   DATA_OBJECT tmp;
   DEFCLASS *cls;
   
   if (ArgTypeCheck("class-abstractp",1,SYMBOL,&tmp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   cls = LookupDefclassByMdlOrScope(DOToString(tmp));
   if (cls == NULL)
     {
      ClassExistError("class-abstractp",ValueToString(tmp.value));
      return(CLIPS_FALSE);
     }
   return(ClassAbstractP((VOID *) cls));
  }

#if INSTANCE_PATTERN_MATCHING

/*****************************************************************
  NAME         : ClassReactivePCommand
  DESCRIPTION  : Determines if instances of a class can match rule
                 patterns
  INPUTS       : None
  RETURNS      : CLIPS_TRUE (1) if class is reactive, CLIPS_FALSE (0) 
                 if non-reactive
  SIDE EFFECTS : None
  NOTES        : Syntax: (class-reactivep <class>)
 *****************************************************************/
globle int ClassReactivePCommand()
  {
   DATA_OBJECT tmp;
   DEFCLASS *cls;
   
   if (ArgTypeCheck("class-reactivep",1,SYMBOL,&tmp) == CLIPS_FALSE)
     return(CLIPS_FALSE);
   cls = LookupDefclassByMdlOrScope(DOToString(tmp));
   if (cls == NULL)
     {
      ClassExistError("class-reactivep",ValueToString(tmp.value));
      return(CLIPS_FALSE);
     }
   return(ClassReactiveP((VOID *) cls));
  }

#endif 

/***********************************************************
  NAME         : ClassInfoFnxArgs
  DESCRIPTION  : Examines arguments for:
                   class-slots, get-defmessage-handler-list,
                   class-superclasses and class-subclasses
  INPUTS       : 1) Name of function
                 2) A buffer to hold a flag indicating if
                    the inherit keyword was specified
  RETURNS      : Pointer to the class on success,
                   NULL on errors 
  SIDE EFFECTS : inhp flag set
                 error flag set
  NOTES        : None
 ***********************************************************/
globle VOID *ClassInfoFnxArgs(fnx,inhp)
  char *fnx;
  int *inhp;
  {
   VOID *clsptr;
   DATA_OBJECT tmp;

   *inhp = 0;
   if (RtnArgCount() == 0)
     {
      ExpectedCountError(fnx,AT_LEAST,1);
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   if (ArgTypeCheck(fnx,1,SYMBOL,&tmp) == CLIPS_FALSE)
     return(NULL);
   clsptr = (VOID *) LookupDefclassByMdlOrScope(DOToString(tmp));
   if (clsptr == NULL)
     {
      ClassExistError(fnx,ValueToString(tmp.value));
      return(NULL);
     }
   if (RtnArgCount() == 2)
     {
      if (ArgTypeCheck(fnx,2,SYMBOL,&tmp) == CLIPS_FALSE)
        return(NULL);
      if (strcmp(ValueToString(tmp.value),"inherit") == 0)
        *inhp = 1;
      else
        {
         SyntaxErrorMessage(fnx);
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
     }
   return(clsptr);
  }

/********************************************************************
  NAME         : ClassSlotsCommand
  DESCRIPTION  : Groups slot info for a class into a multifield value
                   for dynamic perusal
  INPUTS       : Data object buffer to hold the slots of the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates a multifield storing the names of
                    the slots of the class
  NOTES        : Syntax: (class-slots <class> [inherit])
 ********************************************************************/
globle VOID ClassSlotsCommand(result)
  DATA_OBJECT *result;
  {
   int inhp;
   VOID *clsptr;
   
   clsptr = ClassInfoFnxArgs("class-slots",&inhp);
   if (clsptr == NULL)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   ClassSlots(clsptr,result,inhp);
  }
  
/************************************************************************
  NAME         : ClassSuperclassesCommand
  DESCRIPTION  : Groups superclasses for a class into a multifield value
                   for dynamic perusal
  INPUTS       : Data object buffer to hold the superclasses of the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates a multifield storing the names of
                    the superclasses of the class
  NOTES        : Syntax: (class-superclasses <class> [inherit])
 ************************************************************************/
globle VOID ClassSuperclassesCommand(result)
  DATA_OBJECT *result;
  {
   int inhp;
   VOID *clsptr;
   
   clsptr = ClassInfoFnxArgs("class-superclasses",&inhp);
   if (clsptr == NULL)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   ClassSuperclasses(clsptr,result,inhp);
  }
  
/************************************************************************
  NAME         : ClassSubclassesCommand
  DESCRIPTION  : Groups subclasses for a class into a multifield value
                   for dynamic perusal
  INPUTS       : Data object buffer to hold the subclasses of the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates a multifield storing the names of
                    the subclasses of the class
  NOTES        : Syntax: (class-subclasses <class> [inherit])
 ************************************************************************/
globle VOID ClassSubclassesCommand(result)
  DATA_OBJECT *result;
  {
   int inhp;
   VOID *clsptr;
   
   clsptr = ClassInfoFnxArgs("class-subclasses",&inhp);
   if (clsptr == NULL)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   ClassSubclasses(clsptr,result,inhp);
  }
  
/***********************************************************************
  NAME         : GetDefmessageHandlersListCmd
  DESCRIPTION  : Groups message-handlers for a class into a multifield
                   value for dynamic perusal
  INPUTS       : Data object buffer to hold the handlers of the class
  RETURNS      : Nothing useful
  SIDE EFFECTS : Creates a multifield storing the names of
                    the message-handlers of the class
  NOTES        : Syntax: (get-defmessage-handler-list <class> [inherit])
 ***********************************************************************/
globle VOID GetDefmessageHandlersListCmd(result)
  DATA_OBJECT *result;
  {
   int inhp;
   VOID *clsptr;
   
   if (RtnArgCount () == 0)
      GetDefmessageHandlerList(NULL,result,0);
   else
     {
      clsptr = ClassInfoFnxArgs("get-defmessage-handler-list",&inhp);
      if (clsptr == NULL)
        {
         SetMultifieldErrorValue(result);
         return;
        }
      GetDefmessageHandlerList(clsptr,result,inhp);
     }
  }
  
/*********************************
 Slot Information Access Functions
 *********************************/
globle VOID SlotFacetsCommand(result)
  DATA_OBJECT *result;
  {
   SlotInfoSupportFunction(result,"slot-facets",SlotFacets);
  }

globle VOID SlotSourcesCommand(result)
  DATA_OBJECT *result;
  {
   SlotInfoSupportFunction(result,"slot-sources",SlotSources);
  }
  
globle VOID SlotTypesCommand(result)
  DATA_OBJECT *result;
  {
   SlotInfoSupportFunction(result,"slot-types",SlotTypes);
  }
  
globle VOID SlotAllowedValuesCommand(result)
  DATA_OBJECT *result;
  {
   SlotInfoSupportFunction(result,"slot-allowed-values",SlotAllowedValues);
  }
  
globle VOID SlotRangeCommand(result)
  DATA_OBJECT *result;
  {
   SlotInfoSupportFunction(result,"slot-range",SlotRange);
  }