insmngr.c

clips源代码

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*              CLIPS Version 6.24  05/17/06           */
   /*                                                     */
   /*            INSTANCE PRIMITIVE SUPPORT MODULE        */
   /*******************************************************/

/*************************************************************/
/* Purpose:  Creation and Deletion of Instances Routines     */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/*                                                           */
/* Revision History:                                         */
/*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
/*                                                           */
/*      6.24: Removed LOGICAL_DEPENDENCIES compilation flag. */
/*                                                           */
/*            Converted INSTANCE_PATTERN_MATCHING to         */
/*            DEFRULE_CONSTRUCT.                             */
/*                                                           */
/*            Renamed BOOLEAN macro type to intBool.         */
/*                                                           */
/*************************************************************/

/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if OBJECT_SYSTEM

#if DEFRULE_CONSTRUCT
#include "network.h"
#include "drive.h"
#include "objrtmch.h"
#include "lgcldpnd.h"
#endif

#include "classcom.h"
#include "classfun.h"
#include "engine.h"
#include "envrnmnt.h"
#include "memalloc.h"
#include "extnfunc.h"
#include "insfun.h"
#include "modulutl.h"
#include "msgcom.h"
#include "msgfun.h"
#include "prccode.h"
#include "router.h"
#include "sysdep.h"
#include "utility.h"

#define _INSMNGR_SOURCE_
#include "insmngr.h"

#include "inscom.h"
#include "watch.h"

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

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

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

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

/* =========================================
   *****************************************
          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        : H/L Syntax:
                 (active-initialize-instance <instance-name>
                    <slot-override>*)
 ***********************************************************/
globle void InitializeInstanceCommand(
  void *theEnv,
  DATA_OBJECT *result)
  {
   INSTANCE_TYPE *ins;

   SetpType(result,SYMBOL);
   SetpValue(result,EnvFalseSymbol(theEnv));
   ins = CheckInstance(theEnv,"initialize-instance");
   if (ins == NULL)
     return;
   if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg) == 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        : H/L Syntax:
                 (active-make-instance <instance-name> of <class>
                    <slot-override>*)
 ****************************************************************/
globle void MakeInstanceCommand(
  void *theEnv,
  DATA_OBJECT *result)
  {
   SYMBOL_HN *iname;
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   DEFCLASS *cls;

   SetpType(result,SYMBOL);
   SetpValue(result,EnvFalseSymbol(theEnv));
   EvaluateExpression(theEnv,GetFirstArgument(),&temp);
   if ((GetType(temp) != SYMBOL) &&
       (GetType(temp) != INSTANCE_NAME))
     {
      PrintErrorID(theEnv,"INSMNGR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Expected a valid name for new instance.\n");
      SetEvaluationError(theEnv,TRUE);
      return;
     }
   iname = (SYMBOL_HN *) GetValue(temp);

   if (GetFirstArgument()->nextArg->type == DEFCLASS_PTR)
     cls = (DEFCLASS *) GetFirstArgument()->nextArg->value;
   else
     {
      EvaluateExpression(theEnv,GetFirstArgument()->nextArg,&temp);
      if (GetType(temp) != SYMBOL)
        {
         PrintErrorID(theEnv,"INSMNGR",2,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Expected a valid class name for new instance.\n");
         SetEvaluationError(theEnv,TRUE);
         return;
        }
      cls = LookupDefclassInScope(theEnv,DOToString(temp));
      if (cls == NULL)
        {
         ClassExistError(theEnv,ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
                         DOToString(temp));
         SetEvaluationError(theEnv,TRUE);
         return;
        }
     }

   ins = BuildInstance(theEnv,iname,cls,TRUE);
   if (ins == NULL)
     return;
     
   if (CoreInitializeInstance(theEnv,ins,GetFirstArgument()->nextArg->nextArg) == TRUE)
     {
      result->type = INSTANCE_NAME;
      result->value = (void *) GetFullInstanceName(theEnv,ins);
     }
   else
     QuashInstance(theEnv,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(
  void *theEnv,
  INSTANCE_TYPE *ins)
  {
   char *moduleName,*buffer;
   size_t bufsz;
   SYMBOL_HN *iname;

   if (ins == &InstanceData(theEnv)->DummyInstance)
     return((SYMBOL_HN *) EnvAddSymbol(theEnv,"Dummy Instance"));
   if (ins->garbage)
     return(ins->name);
   if (ins->cls->header.whichModule->theModule == ((struct defmodule *) EnvGetCurrentModule(theEnv)))
     return(ins->name);
   moduleName = EnvGetDefmoduleName(theEnv,(void *) ins->cls->header.whichModule->theModule);
   bufsz = (sizeof(char) * (strlen(moduleName) +
                                  strlen(ValueToString(ins->name)) + 3));
   buffer = (char *) gm2(theEnv,bufsz);
   gensprintf(buffer,"%s::%s",moduleName,ValueToString(ins->name));
   iname = (SYMBOL_HN *) EnvAddSymbol(theEnv,buffer);
   rm(theEnv,(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(
  void *theEnv,
  SYMBOL_HN *iname,
  DEFCLASS *cls,
  intBool initMessage)
  {
   INSTANCE_TYPE *ins,*iprv;
   unsigned hashTableIndex;
   unsigned modulePosition;
   SYMBOL_HN *moduleName;
   DATA_OBJECT temp;

#if DEFRULE_CONSTRUCT
   if (EngineData(theEnv)->JoinOperationInProgress && cls->reactive)
     {
      PrintErrorID(theEnv,"INSMNGR",10,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Cannot create instances of reactive classes while\n");
      EnvPrintRouter(theEnv,WERROR,"  pattern-matching is in process.\n");
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }
#endif
   if (cls->abstract)
     {
      PrintErrorID(theEnv,"INSMNGR",3,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Cannot create instances of abstract class ");
      EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) cls));
      EnvPrintRouter(theEnv,WERROR,".\n");
      SetEvaluationError(theEnv,TRUE);
      return(NULL);
     }
   modulePosition = FindModuleSeparator(ValueToString(iname));
   if (modulePosition)
     {
      moduleName = ExtractModuleName(theEnv,modulePosition,ValueToString(iname));
      if ((moduleName == NULL) ||
          (moduleName != cls->header.whichModule->theModule->name))
        {
         PrintErrorID(theEnv,"INSMNGR",11,TRUE);
         EnvPrintRouter(theEnv,WERROR,"Invalid module specifier in new instance name.\n");
         SetEvaluationError(theEnv,TRUE);
         return(NULL);
        }
      iname = ExtractConstructName(theEnv,modulePosition,ValueToString(iname));
     }
   ins = InstanceLocationInfo(theEnv,cls,iname,&iprv,&hashTableIndex);
   if (ins != NULL)
     {
      if (ins->installed == 0)
        {
         PrintErrorID(theEnv,"INSMNGR",4,FALSE);
         EnvPrintRouter(theEnv,WERROR,"The instance ");
         EnvPrintRouter(theEnv,WERROR,ValueToString(iname));
         EnvPrintRouter(theEnv,WERROR," has a slot-value which depends on the instance definition.\n");
         SetEvaluationError(theEnv,TRUE);
         return(NULL);
        }
      ins->busy++;
      IncrementSymbolCount(iname);
      if (ins->garbage == 0)
        {
         if (InstanceData(theEnv)->MkInsMsgPass)
           DirectMessage(theEnv,MessageHandlerData(theEnv)->DELETE_SYMBOL,ins,NULL,NULL);
         else
           QuashInstance(theEnv,ins);
        }
      ins->busy--;
      DecrementSymbolCount(theEnv,iname);
      if (ins->garbage == 0)
        {
         PrintErrorID(theEnv,"INSMNGR",5,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Unable to delete old instance ");
         EnvPrintRouter(theEnv,WERROR,ValueToString(iname));
         EnvPrintRouter(theEnv,WERROR,".\n");
         SetEvaluationError(theEnv,TRUE);
         return(NULL);
        }
     }

   /* =============================================================
      Create the base instance from the defaults of the inheritance
      precedence list
      ============================================================= */
   InstanceData(theEnv)->CurrentInstance = NewInstance(theEnv);

#if DEFRULE_CONSTRUCT
   /* ==============================================
      Add this new instance as a dependent to
      any currently active basis - if the partial
      match was deleted, abort the instance creation
      ============================================== */
   if (AddLogicalDependencies(theEnv,(struct patternEntity *) InstanceData(theEnv)->CurrentInstance,FALSE)
        == FALSE)
     {
      rtn_struct(theEnv,instance,InstanceData(theEnv)->CurrentInstance);
      InstanceData(theEnv)->CurrentInstance = NULL;
      return(NULL);
     }
#endif

   InstanceData(theEnv)->CurrentInstance->name = iname;
   InstanceData(theEnv)->CurrentInstance->cls = cls;
   BuildDefaultSlots(theEnv,initMessage);

   /* ============================================================
      Put the instance in the instance hash table and put it on its
        class's instance list
      ============================================================ */
   InstanceData(theEnv)->CurrentInstance->hashTableIndex = hashTableIndex;
   if (iprv == NULL)
     {
      InstanceData(theEnv)->CurrentInstance->nxtHash = InstanceData(theEnv)->InstanceTable[hashTableIndex];