inscom.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*              CLIPS Version 6.05  04/09/97           */
   /*                                                     */
   /*                INSTANCE COMMAND MODULE              */
   /*******************************************************/

/*************************************************************/
/* Purpose:  CLIPS Kernel Interface Commands for Instances   */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#include "argacces.h"
#include "classcom.h"
#include "classfun.h"
#include "clipsmem.h"
#include "exprnpsr.h"
#include "insfile.h"
#include "insfun.h"
#include "insmngr.h"
#include "insmoddp.h"
#include "insmult.h"
#include "inspsr.h"
#include "msgfun.h"
#include "router.h"
#include "strngrtr.h"
#include "utility.h"
#include "commline.h"

#define _INSCOM_SOURCE_
#include "inscom.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define ALL_QUALIFIER      "inherit"

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

#if DEBUGGING_FUNCTIONS
static long ListInstancesInModule(int,char *,char *,BOOLEAN,BOOLEAN);
static long TabulateInstances(int,char *,DEFCLASS *,BOOLEAN,BOOLEAN);
#endif

static VOID PrintInstance(char *,INSTANCE_TYPE *,char *);
static INSTANCE_SLOT *FindISlotByName(INSTANCE_TYPE *,char *);

#else

#if DEBUGGING_FUNCTIONS
static long ListInstancesInModule();
static long TabulateInstances();
#endif

static VOID PrintInstance();
static INSTANCE_SLOT *FindISlotByName();

#endif

/* =========================================
   *****************************************
       EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
   
globle INSTANCE_TYPE DummyInstance = { { &InstanceInfo }, NULL,NULL, 0, 1 };

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

/*********************************************************
  NAME         : SetupInstances
  DESCRIPTION  : Initializes instance Hash Table,
                   Function Parsers, and Data Structures
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
globle VOID SetupInstances()
  {
   InitializeInstanceTable();
   InstallPrimitive((struct entityRecord *) &InstanceInfo,INSTANCE_ADDRESS);
   
#if ! RUN_TIME

#if INSTANCE_PATTERN_MATCHING
   DefineFunction2("initialize-instance",'u',
                  PTIF InactiveInitializeInstance,"InactiveInitializeInstance",NULL);
   DefineFunction2("active-initialize-instance",'u',
                  PTIF InitializeInstanceCommand,"InitializeInstanceCommand",NULL);
   AddFunctionParser("active-initialize-instance",ParseInitializeInstance);
   
   DefineFunction2("make-instance",'u',PTIF InactiveMakeInstance,"InactiveMakeInstance",NULL);
   DefineFunction2("active-make-instance",'u',PTIF MakeInstanceCommand,"MakeInstanceCommand",NULL);
   AddFunctionParser("active-make-instance",ParseInitializeInstance);
   
#else
   DefineFunction2("initialize-instance",'u',
                  PTIF InitializeInstanceCommand,"InitializeInstanceCommand",NULL);
   DefineFunction2("make-instance",'u',PTIF MakeInstanceCommand,"MakeInstanceCommand",NULL);
#endif   
   AddFunctionParser("initialize-instance",ParseInitializeInstance);
   AddFunctionParser("make-instance",ParseInitializeInstance);

   DefineFunction2("init-slots",'u',PTIF InitSlotsCommand,"InitSlotsCommand","00");
   
   DefineFunction2("delete-instance",'b',PTIF DeleteInstanceCommand,
                   "DeleteInstanceCommand","00");
   DefineFunction2("unmake-instance",'b',PTIF UnmakeInstanceCommand,
                   "UnmakeInstanceCommand","1*e");

#if DEBUGGING_FUNCTIONS
   DefineFunction2("instances",'v',PTIF InstancesCommand,"InstancesCommand","*3w");
   DefineFunction2("ppinstance",'v',PTIF PPInstanceCommand,"PPInstanceCommand","00");
#endif

   DefineFunction2("symbol-to-instance-name",'u',
                  PTIF SymbolToInstanceName,"SymbolToInstanceName","11w");
   DefineFunction2("instance-name-to-symbol",'w',
                  PTIF InstanceNameToSymbol,"InstanceNameToSymbol","11p");
   DefineFunction2("instance-address",'u',PTIF InstanceAddressCommand,
                   "InstanceAddressCommand","12eep");
   DefineFunction2("instance-addressp",'b',PTIF InstanceAddressPCommand,
                   "InstanceAddressPCommand","11");
   DefineFunction2("instance-namep",'b',PTIF InstanceNamePCommand,
                   "InstanceNamePCommand","11");
   DefineFunction2("instance-name",'u',PTIF InstanceNameCommand,
                   "InstanceNameCommand","11e");
   DefineFunction2("instancep",'b',PTIF InstancePCommand,"InstancePCommand","11");
   DefineFunction2("instance-existp",'b',PTIF InstanceExistPCommand,
                   "InstanceExistPCommand","11e");
   DefineFunction2("class",'u',PTIF ClassCommand,"ClassCommand","11");
   
   SetupInstanceModDupCommands();
   SetupInstanceFileCommands();
   SetupInstanceMultifieldCommands();

#endif

   AddCleanupFunction("instances",CleanupInstances,0);
   AddResetFunction("instances",DestroyAllInstances,60);
  }

/*******************************************************************
  NAME         : DeleteInstance
  DESCRIPTION  : DIRECTLY removes a named instance from the
                   hash table and its class's
                   instance list
  INPUTS       : The instance address (NULL to delete all instances)
  RETURNS      : 1 if successful, 0 otherwise
  SIDE EFFECTS : Instance is deallocated
  NOTES        : C interface for deleting instances
 *******************************************************************/
globle BOOLEAN DeleteInstance(iptr)
  VOID *iptr;
  {
   INSTANCE_TYPE *ins,*itmp;
   int success = 1;
   
   if (iptr != NULL)
     return(QuashInstance((INSTANCE_TYPE *) iptr));
   ins = InstanceList;
   while (ins != NULL)
     {
      itmp = ins;
      ins = ins->nxtList;
      if (QuashInstance((INSTANCE_TYPE *) itmp) == 0)
        success = 0;
     }
   
   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(CLIPS_TRUE,CLIPS_FALSE); } 

   return(success);
  }
  
/*******************************************************************
  NAME         : UnmakeInstance
  DESCRIPTION  : Removes a named instance via message-passing
  INPUTS       : The instance address (NULL to delete all instances)
  RETURNS      : 1 if successful, 0 otherwise
  SIDE EFFECTS : Instance is deallocated
  NOTES        : C interface for deleting instances
 *******************************************************************/
globle BOOLEAN UnmakeInstance(iptr)
  VOID *iptr;
  {
   INSTANCE_TYPE *ins;
   int success = 1,svmaintain;
   
   svmaintain = MaintainGarbageInstances;
   MaintainGarbageInstances = CLIPS_TRUE;
   ins = (INSTANCE_TYPE *) iptr;
   if (ins != NULL)
     {
      if (ins->garbage)
        success = 0;
      else
        {
         DirectMessage(DELETE_SYMBOL,ins,NULL,NULL);
         if (ins->garbage == 0)
           success = 0;
        }
     }
   else
     {
      ins = InstanceList;
      while (ins != NULL)
        {
         DirectMessage(DELETE_SYMBOL,ins,NULL,NULL);
         if (ins->garbage == 0)
           success = 0;
         ins = ins->nxtList;
         while ((ins != NULL) ? ins->garbage : CLIPS_FALSE)
           ins = ins->nxtList;
        }
     }
   MaintainGarbageInstances = svmaintain;
   CleanupInstances();
   
   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(CLIPS_TRUE,CLIPS_FALSE); } 

   return(success);
  }
  
#if DEBUGGING_FUNCTIONS

/*******************************************************************
  NAME         : InstancesCommand
  DESCRIPTION  : Lists all instances associated
                   with a particular class
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS syntax : (instances [<class-name> [inherit]])
 *******************************************************************/
globle VOID InstancesCommand()
  {
   int argno, inheritFlag = CLIPS_FALSE;
   VOID *theDefmodule = (VOID *) GetCurrentModule();
   char *className = NULL;
   DATA_OBJECT temp;

   argno = RtnArgCount();
   if (argno > 0)
     {
      if (ArgTypeCheck("instances",1,SYMBOL,&temp) == CLIPS_FALSE)
        return;
      theDefmodule = FindDefmodule(DOToString(temp));
      if ((theDefmodule != NULL) ? CLIPS_FALSE :
          (strcmp(DOToString(temp),"*") != 0))
        {
         SetEvaluationError(CLIPS_TRUE);
         ExpectedTypeError1("instances",1,"defmodule name");
         return;
        }
      if (argno > 1)
        {
         if (ArgTypeCheck("instances",2,SYMBOL,&temp) == CLIPS_FALSE)
           return;
         className = DOToString(temp);
         if (LookupDefclassAnywhere((struct defmodule *) theDefmodule,className) == NULL)
           {
            if (strcmp(className,"*") == 0)
              className = NULL;
            else
              {
               ClassExistError("instances",className);
                 return;
              }
           }
         if (argno > 2)
           {
            if (ArgTypeCheck("instances",3,SYMBOL,&temp) == CLIPS_FALSE)
              return;
            if (strcmp(DOToString(temp),ALL_QUALIFIER) != 0)
              {
               SetEvaluationError(CLIPS_TRUE);
               ExpectedTypeError1("instances",3,"keyword \"inherit\"");
               return;
              }
            inheritFlag = CLIPS_TRUE;
           }
        }
     }
   Instances(WDISPLAY,theDefmodule,className,inheritFlag);
  }
  
/********************************************************
  NAME         : PPInstanceCommand
  DESCRIPTION  : Displays the current slot-values
                   of an instance
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS syntax : (ppinstance <instance>)
 ********************************************************/
globle VOID PPInstanceCommand()
  {
   INSTANCE_TYPE *ins;

   if (CheckCurrentMessage("ppinstance",CLIPS_TRUE) == CLIPS_FALSE)
     return;
   ins = GetActiveInstance();
   if (ins->garbage == 1)
     return;
   PrintInstance(WDISPLAY,ins,"\n");
   PrintCLIPS(WDISPLAY,"\n");
  }

/***************************************************************
  NAME         : Instances
  DESCRIPTION  : Lists instances of classes
  INPUTS       : 1) The logical name for the output
                 2) Address of the module (NULL for all classes)
                 3) Name of the class
                    (NULL for all classes in specified module)
                 4) A flag indicating whether to print instances
                    of subclasses or not
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 **************************************************************/
globle VOID Instances(logicalName,theVModule,className,inheritFlag)
  char *logicalName;
  VOID *theVModule;
  char *className;
  int inheritFlag;
  {
   int id;
   struct defmodule *theModule;
   long count = 0L;
   
   /* ===========================================
      Grab a traversal id to avoid printing out
      instances twice due to multiple inheritance
      =========================================== */
  if ((id = GetTraversalID()) == -1)
    return;
  SaveCurrentModule();
     
   /* ====================================
      For all modules, print out instances
      of specified class(es)
      ==================================== */
   if (theVModule == NULL)
     {
      theModule = (struct defmodule *) GetNextDefmodule(NULL);
      while (theModule != NULL)
        {
         PrintCLIPS(logicalName,GetDefmoduleName((VOID *) theModule));
         PrintCLIPS(logicalName,":\n");
         SetCurrentModule((VOID *) theModule);
         count += ListInstancesInModule(id,logicalName,className,inheritFlag,CLIPS_TRUE);
         theModule = (struct defmodule *) GetNextDefmodule((VOID *) theModule);
        }
     }
   
   /* ====================================
      For the specified module, print out
      instances of the specified class(es)
      ==================================== */
   else
     {
      SetCurrentModule((VOID *) theVModule);
      count = ListInstancesInModule(id,logicalName,className,inheritFlag,CLIPS_FALSE);
     }
     
   RestoreCurrentModule();
   ReleaseTraversalID();
   if (HaltExecution == CLIPS_FALSE)
     PrintTally(logicalName,count,"instance","instances");
  }  

#endif

/*********************************************************
  NAME         : MakeInstance
  DESCRIPTION  : C Interface for creating and
                   initializing a class instance
  INPUTS       : The make-instance call string,
                    e.g. "([bill] of man (age 34))"
  RETURNS      : The instance address if instance created,
                    NULL otherwise
  SIDE EFFECTS : Creates the instance and returns
                    the result in caller's buffer
  NOTES        : None
 *********************************************************/
globle VOID *MakeInstance(mkstr)
  char *mkstr;
  {
   char *router = "***MKINS***";
   struct token tkn;
   EXPRESSION *top;
   DATA_OBJECT result;

   result.type = SYMBOL;
   result.value = CLIPSFalseSymbol;
   if (OpenStringSource(router,mkstr,0) == 0)
     return(NULL);
   GetToken(router,&tkn);
   if (tkn.type == LPAREN)
     {
      top = GenConstant(FCALL,(VOID *) FindFunction("make-instance"));
      if (ParseSimpleInstance(top,router) != NULL)
        {
         GetToken(router,&tkn);
         if (tkn.type == STOP)
           EvaluateExpression(top,&result);
         else
           SyntaxErrorMessage("instance definition");
         ReturnExpression(top);      
        }
     }
   else
     SyntaxErrorMessage("instance definition");