inscom.c

clips源代码

        return;
      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(temp));
      if ((theModule == NULL) ? (strcmp(DOToString(temp),"*") != 0) : FALSE)
        {
         ExpectedTypeError1(theEnv,"instance-address",1,"module name");
         SetEvaluationError(theEnv,TRUE);
         return;
        }
      if (theModule == NULL)
        {
         searchImports = TRUE;
         theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
        }
      else
        searchImports = FALSE;
      if (EnvArgTypeCheck(theEnv,"instance-address",2,INSTANCE_NAME,&temp)
             == FALSE)
        return;
      ins = FindInstanceInModule(theEnv,(SYMBOL_HN *) temp.value,theModule,
                                 ((struct defmodule *) EnvGetCurrentModule(theEnv)),searchImports);
      if (ins != NULL)
        {
         result->type = INSTANCE_ADDRESS;
         result->value = (void *) ins;
        }
      else
        NoInstanceError(theEnv,ValueToString(temp.value),"instance-address");
     }
   else if (EnvArgTypeCheck(theEnv,"instance-address",1,INSTANCE_OR_INSTANCE_NAME,&temp))
     {
      if (temp.type == INSTANCE_ADDRESS)
        {
         ins = (INSTANCE_TYPE *) temp.value;
         if (ins->garbage == 0)
           {
            result->type = INSTANCE_ADDRESS;
            result->value = temp.value;
           }
         else
           {
            StaleInstanceAddress(theEnv,"instance-address",0);
            SetEvaluationError(theEnv,TRUE);
           }
        }
      else
        {
         ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
         if (ins != NULL)
           {
            result->type = INSTANCE_ADDRESS;
            result->value = (void *) ins;
           }
         else
           NoInstanceError(theEnv,ValueToString(temp.value),"instance-address");
        }
     }
  }

/***************************************************************
  NAME         : InstanceNameCommand
  DESCRIPTION  : Gets the name of an INSTANCE
  INPUTS       : The address of the value buffer
  RETURNS      : The INSTANCE_NAME symbol
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (instance-name <instance>)
 ***************************************************************/
globle void InstanceNameCommand(
  void *theEnv,
  DATA_OBJECT *result)
  {
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   result->type = SYMBOL;
   result->value = EnvFalseSymbol(theEnv);
   if (EnvArgTypeCheck(theEnv,"instance-name",1,INSTANCE_OR_INSTANCE_NAME,&temp) == FALSE)
     return;
   if (temp.type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) temp.value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress(theEnv,"instance-name",0);
         SetEvaluationError(theEnv,TRUE);
         return;
        }
     }
   else
     {
      ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
      if (ins == NULL)
        {
         NoInstanceError(theEnv,ValueToString(temp.value),"instance-name");
         return;
        }
     }
   result->type = INSTANCE_NAME;
   result->value = (void *) ins->name;
  }

/**************************************************************
  NAME         : InstanceAddressPCommand
  DESCRIPTION  : Determines if a value is of type INSTANCE
  INPUTS       : None
  RETURNS      : TRUE if type INSTANCE_ADDRESS, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (instance-addressp <arg>)
 **************************************************************/
globle intBool InstanceAddressPCommand(
  void *theEnv)
  {
   DATA_OBJECT temp;

   EvaluateExpression(theEnv,GetFirstArgument(),&temp);
   return((GetType(temp) == INSTANCE_ADDRESS) ? TRUE : FALSE);
  }

/**************************************************************
  NAME         : InstanceNamePCommand
  DESCRIPTION  : Determines if a value is of type INSTANCE_NAME
  INPUTS       : None
  RETURNS      : TRUE if type INSTANCE_NAME, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (instance-namep <arg>)
 **************************************************************/
globle intBool InstanceNamePCommand(
  void *theEnv)
  {
   DATA_OBJECT temp;

   EvaluateExpression(theEnv,GetFirstArgument(),&temp);
   return((GetType(temp) == INSTANCE_NAME) ? TRUE : FALSE);
  }

/*****************************************************************
  NAME         : InstancePCommand
  DESCRIPTION  : Determines if a value is of type INSTANCE_ADDRESS
                   or INSTANCE_NAME
  INPUTS       : None
  RETURNS      : TRUE if type INSTANCE_NAME or INSTANCE_ADDRESS,
                     FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (instancep <arg>)
 *****************************************************************/
globle intBool InstancePCommand(
  void *theEnv)
  {
   DATA_OBJECT temp;

   EvaluateExpression(theEnv,GetFirstArgument(),&temp);
   if ((GetType(temp) == INSTANCE_NAME) || (GetType(temp) == INSTANCE_ADDRESS))
     return(TRUE);
   return(FALSE);
  }

/********************************************************
  NAME         : InstanceExistPCommand
  DESCRIPTION  : Determines if an instance exists
  INPUTS       : None
  RETURNS      : TRUE if instance exists, FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : H/L Syntax : (instance-existp <arg>)
 ********************************************************/
globle intBool InstanceExistPCommand(
  void *theEnv)
  {
   DATA_OBJECT temp;

   EvaluateExpression(theEnv,GetFirstArgument(),&temp);
   if (temp.type == INSTANCE_ADDRESS)
     return((((INSTANCE_TYPE *) temp.value)->garbage == 0) ? TRUE : FALSE);
   if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL))
     return((FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value) != NULL) ?
             TRUE : FALSE);
   ExpectedTypeError1(theEnv,"instance-existp",1,"instance name, instance address or symbol");
   SetEvaluationError(theEnv,TRUE);
   return(FALSE);
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

#if DEBUGGING_FUNCTIONS

/***************************************************
  NAME         : ListInstancesInModule
  DESCRIPTION  : List instances of specified
                 class(es) in a module
  INPUTS       : 1) Traversal id to avoid multiple
                    passes over same class
                 2) Logical name of output
                 3) The name of the class
                    (NULL for all classes)
                 4) Flag indicating whether to
                    include instances of subclasses
                 5) A flag indicating whether to
                    indent because of module name
  RETURNS      : The number of instances listed
  SIDE EFFECTS : Instances listed to logical output
  NOTES        : Assumes defclass scope flags
                 are up to date
 ***************************************************/
static long ListInstancesInModule(
  void *theEnv,
  int id,
  char *logicalName,
  char *className,
  intBool inheritFlag,
  intBool allModulesFlag)
  {
   void *theDefclass,*theInstance;
   long count = 0L;

   /* ===================================
      For the specified module, print out
      instances of all the classes
      =================================== */
   if (className == NULL)
     {
      /* ==============================================
         If instances are being listed for all modules,
         only list the instances of classes in this
         module (to avoid listing instances twice)
         ============================================== */
      if (allModulesFlag)
        {
         for (theDefclass = EnvGetNextDefclass(theEnv,NULL) ;
              theDefclass != NULL ;
              theDefclass = EnvGetNextDefclass(theEnv,theDefclass))
           count += TabulateInstances(theEnv,id,logicalName,
                        (DEFCLASS *) theDefclass,FALSE,allModulesFlag);
        }

      /* ===================================================
         If instances are only be listed for one module,
         list all instances visible to the module (including
         ones belonging to classes in other modules)
         =================================================== */
      else
        {
         theInstance = GetNextInstanceInScope(theEnv,NULL);
         while (theInstance != NULL)
           {
            if (GetHaltExecution(theEnv) == TRUE)
              { return(count); }

            count++;
            PrintInstanceNameAndClass(theEnv,logicalName,(INSTANCE_TYPE *) theInstance,TRUE);
            theInstance = GetNextInstanceInScope(theEnv,theInstance);
           }
        }
     }

   /* ===================================
      For the specified module, print out
      instances of the specified class
      =================================== */
   else
     {
      theDefclass = (void *) LookupDefclassAnywhere(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv)),className);
      if (theDefclass != NULL)
        {
         count += TabulateInstances(theEnv,id,logicalName,
                      (DEFCLASS *) theDefclass,inheritFlag,allModulesFlag);
        }
      else if (! allModulesFlag)
        ClassExistError(theEnv,"instances",className);
     }
   return(count);
  }

/******************************************************
  NAME         : TabulateInstances
  DESCRIPTION  : Displays all instances for a class
  INPUTS       : 1) The traversal id for the classes
                 2) The logical name of the output
                 3) The class address
                 4) A flag indicating whether to
                    print out instances of subclasses
                    or not.
                 5) A flag indicating whether to
                    indent because of module name
  RETURNS      : The number of instances (including
                    subclasses' instances)
  SIDE EFFECTS : None
  NOTES        : None
 ******************************************************/
static long TabulateInstances(
  void *theEnv,
  int id,
  char *logicalName,
  DEFCLASS *cls,
  intBool inheritFlag,
  intBool allModulesFlag)
  {
   INSTANCE_TYPE *ins;
   long i;
   long count = 0;

   if (TestTraversalID(cls->traversalRecord,id))
     return(0L);
   SetTraversalID(cls->traversalRecord,id);
   for (ins = cls->instanceList ; ins != NULL ; ins = ins->nxtClass)
     {
      if (EvaluationData(theEnv)->HaltExecution)
        return(count);
      if (allModulesFlag)
        EnvPrintRouter(theEnv,logicalName,"   ");
      PrintInstanceNameAndClass(theEnv,logicalName,ins,TRUE);
      count++;
     }
   if (inheritFlag)
     {
      for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
        {
         if (EvaluationData(theEnv)->HaltExecution)
           return(count);
         count += TabulateInstances(theEnv,id,logicalName,
                     cls->directSubclasses.classArray[i],inheritFlag,allModulesFlag);
        }
     }
   return(count);
  }

#endif

/***************************************************
  NAME         : PrintInstance
  DESCRIPTION  : Displays an instance's slots
  INPUTS       : 1) Logical name for output
                 2) Instance address
                 3) String used to separate
                    slot printouts
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Assumes instance is valid
 ***************************************************/
static void PrintInstance(
  void *theEnv,
  char *logicalName,
  INSTANCE_TYPE *ins,
  char *separator)
  {
   long i;
   register INSTANCE_SLOT *sp;

   PrintInstanceNameAndClass(theEnv,logicalName,ins,FALSE);
   for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
     {
      EnvPrintRouter(theEnv,logicalName,separator);
      sp = ins->slotAddresses[i];
      EnvPrintRouter(theEnv,logicalName,"(");
      EnvPrintRouter(theEnv,logicalName,ValueToString(sp->desc->slotName->name));
      if (sp->type != MULTIFIELD)
        {
         EnvPrintRouter(theEnv,logicalName," ");
         PrintAtom(theEnv,logicalName,(int) sp->type,sp->value);
        }
      else if (GetInstanceSlotLength(sp) != 0)
        {
         EnvPrintRouter(theEnv,logicalName," ");
         PrintMultifield(theEnv,logicalName,(MULTIFIELD_PTR) sp->value,0,
                         (long) (GetInstanceSlotLength(sp) - 1),FALSE);
        }
      EnvPrintRouter(theEnv,logicalName,")");
     }
  }

/***************************************************
  NAME         : FindISlotByName
  DESCRIPTION  : Looks up an instance slot by
                   instance name and slot name
  INPUTS       : 1) Instance address
                 2) Instance name-string
  RETURNS      : The instance slot address, NULL if
                   does not exist
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
static INSTANCE_SLOT *FindISlotByName(
  void *theEnv,
  INSTANCE_TYPE *ins,
  char *sname)
  {
   SYMBOL_HN *ssym;

   ssym = FindSymbolHN(theEnv,sname);
   if (ssym == NULL)
     return(NULL);
   return(FindInstanceSlot(theEnv,ins,ssym));
  }

#endif