insmngr.c

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

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

/*************************************************************/
/* Purpose:  Creation and Deletion of Instances Routines     */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#if INSTANCE_PATTERN_MATCHING
#include "network.h"
#include "drive.h"
#include "objrtmch.h"
#endif

#if LOGICAL_DEPENDENCIES
#include "lgcldpnd.h"
#endif

#include "classcom.h"
#include "classfun.h"
#include "clipsmem.h"
#include "extnfunc.h"
#include "insfun.h"
#include "modulutl.h"
#include "msgfun.h"
#include "prccode.h"
#include "router.h"
#include "utility.h"

#define _INSMNGR_SOURCE_
#include "insmngr.h"

#include "inscom.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */
#define MAKE_TRACE   "==>"
#define UNMAKE_TRACE "<=="

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */
   
/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static INSTANCE_TYPE *NewInstance(void);
static INSTANCE_TYPE *InstanceLocationInfo(DEFCLASS *,SYMBOL_HN *,INSTANCE_TYPE **,unsigned *);
static VOID InstallInstance(INSTANCE_TYPE *,int);
static VOID BuildDefaultSlots(BOOLEAN);
static int CoreInitializeInstance(INSTANCE_TYPE *,EXPRESSION *);
static int InsertSlotOverrides(INSTANCE_TYPE *,EXPRESSION *);
static VOID EvaluateClassDefaults(INSTANCE_TYPE *);

#if DEBUGGING_FUNCTIONS
static VOID PrintInstanceWatch(char *,INSTANCE_TYPE *);
#endif

#else

static INSTANCE_TYPE *NewInstance();
static INSTANCE_TYPE *InstanceLocationInfo();
static VOID InstallInstance();
static VOID BuildDefaultSlots();
static int CoreInitializeInstance();
static int InsertSlotOverrides();
static VOID EvaluateClassDefaults();

#if DEBUGGING_FUNCTIONS
static VOID PrintInstanceWatch();
#endif

#endif

/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle INSTANCE_TYPE *InstanceList = NULL;
globle unsigned long GlobalNumberOfInstances = 0L;

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
static INSTANCE_TYPE *CurrentInstance = NULL;
static INSTANCE_TYPE *InstanceListBottom = NULL;

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
   
/***********************************************************
  NAME         : InitializeInstanceCommand
  DESCRIPTION  : Initializes an instance of a class
  INPUTS       : The address of the result value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance intialized
  NOTES        : CLIPS Syntax:
                 (active-initialize-instance <instance-name>
                    <slot-override>*)
 ***********************************************************/
globle VOID InitializeInstanceCommand(result)
  DATA_OBJECT *result;
  {
   INSTANCE_TYPE *ins;
   
   SetpType(result,SYMBOL);
   SetpValue(result,CLIPSFalseSymbol);
   ins = CheckInstance("initialize-instance");
   if (ins == NULL)
     return;
   if (CoreInitializeInstance(ins,GetFirstArgument()->nextArg) == CLIPS_TRUE)
     {
      SetpType(result,INSTANCE_NAME);
      SetpValue(result,(VOID *) ins->name);
     }
  }
  
/****************************************************************
  NAME         : MakeInstanceCommand
  DESCRIPTION  : Creates and initializes an instance of a class
  INPUTS       : The address of the result value
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instance intialized
  NOTES        : CLIPS Syntax:
                 (active-make-instance <instance-name> of <class>
                    <slot-override>*)
 ****************************************************************/
globle VOID MakeInstanceCommand(result)
  DATA_OBJECT *result;
  {
   SYMBOL_HN *iname;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   DEFCLASS *cls;
   
   SetpType(result,SYMBOL);
   SetpValue(result,CLIPSFalseSymbol);
   EvaluateExpression(GetFirstArgument(),&temp);
   if ((GetType(temp) != SYMBOL) && 
       (GetType(temp) != INSTANCE_NAME))
     {
      PrintErrorID("INSMNGR",1,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Expected a valid name for new instance.\n");
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   iname = (SYMBOL_HN *) GetValue(temp);
   if (GetFirstArgument()->nextArg->type == DEFCLASS_PTR)
     cls = (DEFCLASS *) GetFirstArgument()->nextArg->value;
   else
     {
      EvaluateExpression(GetFirstArgument()->nextArg,&temp);
      if (GetType(temp) != SYMBOL)
        {
         PrintErrorID("INSMNGR",2,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Expected a valid class name for new instance.\n");
         SetEvaluationError(CLIPS_TRUE);
         return;
        }
      cls = LookupDefclassInScope(DOToString(temp));
      if (cls == NULL)
        {
         ClassExistError(ValueToString(ExpressionFunctionCallName(CurrentExpression)),
                         DOToString(temp));
         SetEvaluationError(CLIPS_TRUE);
         return;
        }
     }
     
   ins = BuildInstance(iname,cls,CLIPS_TRUE);
   if (ins == NULL)
     return;
   if (CoreInitializeInstance(ins,GetFirstArgument()->nextArg->nextArg) == CLIPS_TRUE)
     {
      result->type = INSTANCE_NAME;
      result->value = (VOID *) GetFullInstanceName(ins);
     }
   else
     QuashInstance(ins);
  }

/***************************************************
  NAME         : GetFullInstanceName
  DESCRIPTION  : If this function is called while
                 the current module is other than
                 the one in which the instance
                 resides, then the module name is
                 prepended to the instance name.
                 Otherwise - the base name only is
                 returned.
  INPUTS       : The instance
  RETURNS      : The instance name symbol (with
                 module name and :: prepended)
  SIDE EFFECTS : Temporary buffer allocated possibly
                 and new symbol created
  NOTES        : Used to differentiate between
                 instances of the same name in
                 different modules
 ***************************************************/
globle SYMBOL_HN *GetFullInstanceName(ins)
  INSTANCE_TYPE *ins;
  {
   char *moduleName,*buffer;
   int bufsz;
   SYMBOL_HN *iname;
   
   if (ins == &DummyInstance)
     return((SYMBOL_HN *) AddSymbol("Dummy Instance"));
   if (ins->garbage)
     return(ins->name);
   if (ins->cls->header.whichModule->theModule == ((struct defmodule *) GetCurrentModule()))
     return(ins->name);
   moduleName = GetDefmoduleName((VOID *) ins->cls->header.whichModule->theModule);
   bufsz = (int) (sizeof(char) * (strlen(moduleName) + 
                                  strlen(ValueToString(ins->name)) + 3));
   buffer = (char *) gm2(bufsz);
   sprintf(buffer,"%s::%s",moduleName,ValueToString(ins->name));
   iname = (SYMBOL_HN *) AddSymbol(buffer);
   rm((VOID *) buffer,bufsz);
   return(iname);
  }

/***************************************************
  NAME         : BuildInstance
  DESCRIPTION  : Creates an uninitialized instance
  INPUTS       : 1) Name of the instance
                 2) Class pointer
                 3) Flag indicating whether init
                    message will be called for
                    this instance or not
  RETURNS      : The address of the new instance,
                   NULL on errors (or when a
                   a logical basis in a rule was
                   deleted int the same RHS in
                   which the instance creation
                   occurred)
  SIDE EFFECTS : Old definition (if any) is deleted
  NOTES        : None
 ***************************************************/
globle INSTANCE_TYPE *BuildInstance(iname,cls,initMessage)
  SYMBOL_HN *iname;
  DEFCLASS *cls;
  BOOLEAN initMessage;
  {
   INSTANCE_TYPE *ins,*iprv;
   unsigned hashTableIndex;
   int modulePosition;
   SYMBOL_HN *moduleName;
   
#if INSTANCE_PATTERN_MATCHING
   if (JoinOperationInProgress && cls->reactive)
     {
      PrintErrorID("INSMNGR",10,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot create instances of reactive classes while\n");
      PrintCLIPS(WERROR,"  pattern-matching is in process.\n");
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
#endif
   if (cls->abstract)
     {
      PrintErrorID("INSMNGR",3,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot create instances of abstract class ");
      PrintCLIPS(WERROR,GetDefclassName((VOID *) cls));
      PrintCLIPS(WERROR,".\n");
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   modulePosition = FindModuleSeparator(ValueToString(iname));
   if (modulePosition)
     {
      moduleName = ExtractModuleName(modulePosition,ValueToString(iname));
      if ((moduleName == NULL) ||
          (moduleName != cls->header.whichModule->theModule->name))
        {
         PrintErrorID("INSMNGR",11,CLIPS_TRUE);
         PrintCLIPS(WERROR,"Invalid module specifier in new instance name.\n");
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
      iname = ExtractConstructName(modulePosition,ValueToString(iname));
     }
   ins = InstanceLocationInfo(cls,iname,&iprv,&hashTableIndex);
   if (ins != NULL)
     {
      if (ins->installed == 0)
        {
         PrintErrorID("INSMNGR",4,CLIPS_FALSE);
         PrintCLIPS(WERROR,"The instance ");
         PrintCLIPS(WERROR,ValueToString(iname));
         PrintCLIPS(WERROR," has a slot-value which depends on the instance definition.\n");
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
      ins->busy++;
      IncrementSymbolCount(iname);
      if (ins->garbage == 0)
        {
         if (MkInsMsgPass)
           DirectMessage(DELETE_SYMBOL,ins,NULL,NULL);
         else
           QuashInstance(ins);
        }
      ins->busy--;
      DecrementSymbolCount(iname);
      if (ins->garbage == 0)
        {
         PrintErrorID("INSMNGR",5,CLIPS_FALSE);
         PrintCLIPS(WERROR,"Unable to delete old instance ");
         PrintCLIPS(WERROR,ValueToString(iname));
         PrintCLIPS(WERROR,".\n");
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
     }
     
   /* ============================================================= 
      Create the base instance from the defaults of the inheritance
      precedence list
      ============================================================= */
   CurrentInstance = NewInstance();
   
#if LOGICAL_DEPENDENCIES
   /* ==============================================
      Add this new instance as a dependent to
      any currently active basis - if the partial
      match was deleted, abort the instance creation
      ============================================== */
   if (AddLogicalDependencies((struct patternEntity *) CurrentInstance,CLIPS_FALSE)
        == CLIPS_FALSE)
     {
      rtn_struct(instance,CurrentInstance);
      CurrentInstance = NULL;