inscom.c

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

 *****************************************************************/
globle VOID SymbolToInstanceName(result)
  DATA_OBJECT *result;
  {
   if (ArgTypeCheck("symbol-to-instance-name",1,SYMBOL,result) == CLIPS_FALSE)
     {
      SetpType(result,SYMBOL);
      SetpValue(result,CLIPSFalseSymbol);
      return;
     }
   SetpType(result,INSTANCE_NAME);
  }
  
/*****************************************************************
  NAME         : InstanceNameToSymbol
  DESCRIPTION  : Converts a symbol from type INSTANCE_NAME
                   to type SYMBOL
  INPUTS       : None
  RETURNS      : Symbol FALSE on errors - or converted instance name
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (instance-name-to-symbol <iname>)
 *****************************************************************/
globle VOID *InstanceNameToSymbol()
  {
   DATA_OBJECT result;
   
   if (ArgTypeCheck("instance-name-to-symbol",1,INSTANCE_NAME,&result) == CLIPS_FALSE)
     return(CLIPSFalseSymbol);
   return(result.value);
  }
  
/*********************************************************************************
  NAME         : InstanceAddressCommand
  DESCRIPTION  : Returns the address of an instance
  INPUTS       : The address of the value buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Stores instance address in caller's buffer
  NOTES        : CLIPS Syntax : (instance-address [<module-name>] <instance-name>)
 *********************************************************************************/
globle VOID InstanceAddressCommand(result)
  DATA_OBJECT *result;
  {
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   struct defmodule *theModule;
   int searchImports;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   if (RtnArgCount() > 1)
     {
      if (ArgTypeCheck("instance-address",1,SYMBOL,&temp) == CLIPS_FALSE)
        return;
      theModule = (struct defmodule *) FindDefmodule(DOToString(temp));
      if ((theModule == NULL) ? (strcmp(DOToString(temp),"*") != 0) : CLIPS_FALSE)
        {
         ExpectedTypeError1("instance-address",1,"module name");
         SetEvaluationError(CLIPS_TRUE);
         return;
        }
      if (theModule == NULL)
        {
         searchImports = CLIPS_TRUE;
         theModule = ((struct defmodule *) GetCurrentModule());
        }
      else
        searchImports = CLIPS_FALSE;
      if (ArgTypeCheck("instance-address",2,INSTANCE_NAME,&temp)
             == CLIPS_FALSE)
        return;
      ins = FindInstanceInModule((SYMBOL_HN *) temp.value,theModule,
                                 ((struct defmodule *) GetCurrentModule()),searchImports);
      if (ins != NULL)
        {
         result->type = INSTANCE_ADDRESS;
         result->value = (VOID *) ins;
        }
      else
        NoInstanceError(ValueToString(temp.value),"instance-address");
     }
   else if (ArgTypeCheck("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("instance-address");
            SetEvaluationError(CLIPS_TRUE);
           }
        }
      else
        {
         ins = FindInstanceBySymbol((SYMBOL_HN *) temp.value);
         if (ins != NULL)
           {
            result->type = INSTANCE_ADDRESS;
            result->value = (VOID *) ins;
           }
         else
           NoInstanceError(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        : CLIPS Syntax : (instance-name <instance>)
 ***************************************************************/
globle VOID InstanceNameCommand(result)
  DATA_OBJECT *result;
  {
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   if (ArgTypeCheck("instance-name",1,INSTANCE_OR_INSTANCE_NAME,&temp) == CLIPS_FALSE)
     return;
   if (temp.type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) temp.value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress("instance-name");
         SetEvaluationError(CLIPS_TRUE);
         return;
        }
     }
   else
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) temp.value);
      if (ins == NULL)
        {
         NoInstanceError(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      : CLIPS_TRUE if type INSTANCE_ADDRESS, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (instance-addressp <arg>)
 **************************************************************/
globle BOOLEAN InstanceAddressPCommand()
  {
   DATA_OBJECT temp;

   EvaluateExpression(GetFirstArgument(),&temp);
   return((GetType(temp) == INSTANCE_ADDRESS) ? CLIPS_TRUE : CLIPS_FALSE);
  }
  
/**************************************************************
  NAME         : InstanceNamePCommand
  DESCRIPTION  : Determines if a value is of type INSTANCE_NAME
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if type INSTANCE_NAME, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (instance-namep <arg>)
 **************************************************************/
globle BOOLEAN InstanceNamePCommand()
  {
   DATA_OBJECT temp;

   EvaluateExpression(GetFirstArgument(),&temp);
   return((GetType(temp) == INSTANCE_NAME) ? CLIPS_TRUE : CLIPS_FALSE);
  }
  
/*****************************************************************
  NAME         : InstancePCommand
  DESCRIPTION  : Determines if a value is of type INSTANCE_ADDRESS
                   or INSTANCE_NAME
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if type INSTANCE_NAME or INSTANCE_ADDRESS,
                     CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (instancep <arg>)
 *****************************************************************/
globle BOOLEAN InstancePCommand()
  {
   DATA_OBJECT temp;

   EvaluateExpression(GetFirstArgument(),&temp);
   if ((GetType(temp) == INSTANCE_NAME) || (GetType(temp) == INSTANCE_ADDRESS))
     return(CLIPS_TRUE);
   return(CLIPS_FALSE);
  }
  
/********************************************************
  NAME         : InstanceExistPCommand
  DESCRIPTION  : Determines if an instance exists
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if instance exists, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (instance-existp <arg>)
 ********************************************************/
globle BOOLEAN InstanceExistPCommand()
  {
   DATA_OBJECT temp;

   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type == INSTANCE_ADDRESS)
     return((((INSTANCE_TYPE *) temp.value)->garbage == 0) ? CLIPS_TRUE : CLIPS_FALSE);
   if ((temp.type == INSTANCE_NAME) || (temp.type == SYMBOL))
     return((FindInstanceBySymbol((SYMBOL_HN *) temp.value) != NULL) ? 
             CLIPS_TRUE : CLIPS_FALSE);
   ExpectedTypeError1("instance-existp",1,"instance name, instance address or symbol");
   SetEvaluationError(CLIPS_TRUE);
   return(CLIPS_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(id,logicalName,className,inheritFlag,allModulesFlag)
  int id;
  char *logicalName,*className;
  BOOLEAN inheritFlag,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 = GetNextDefclass(NULL) ;
              theDefclass != NULL ;
              theDefclass = GetNextDefclass(theDefclass))
           count += TabulateInstances(id,logicalName,
                        (DEFCLASS *) theDefclass,CLIPS_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(NULL);
         while (theInstance != NULL)
           {
            count++;
            PrintInstanceNameAndClass(logicalName,(INSTANCE_TYPE *) theInstance,CLIPS_TRUE);
            theInstance = GetNextInstanceInScope(theInstance);
           }
        }
     }
        
   /* ===================================
      For the specified module, print out
      instances of the specified class
      =================================== */
   else
     {
      theDefclass = (VOID *) LookupDefclassAnywhere(((struct defmodule *) GetCurrentModule()),className);
      if (theDefclass != NULL)
        {
         count += TabulateInstances(id,logicalName,
                      (DEFCLASS *) theDefclass,inheritFlag,allModulesFlag);
        }
      else if (! allModulesFlag)
        ClassExistError("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(id,logicalName,cls,inheritFlag,allModulesFlag)
  int id;
  char *logicalName;
  DEFCLASS *cls;
  BOOLEAN inheritFlag,allModulesFlag;
  {
   INSTANCE_TYPE *ins;
   register unsigned 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 (HaltExecution)
        return(count);
      if (allModulesFlag)
        PrintCLIPS(logicalName,"   ");
      PrintInstanceNameAndClass(logicalName,ins,CLIPS_TRUE);
      count++;
     }
   if (inheritFlag)
     {
      for (i = 0 ; i < cls->directSubclasses.classCount ; i++)
        {
         if (HaltExecution)
           return(count);
         count += TabulateInstances(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(logicalName,ins,separator)
  char *logicalName;
  INSTANCE_TYPE *ins;
  char *separator;
  {
   register int i;
   register INSTANCE_SLOT *sp;
   
   PrintInstanceNameAndClass(logicalName,ins,CLIPS_FALSE);
   for (i = 0 ; i < ins->cls->instanceSlotCount ; i++)
     {
      PrintCLIPS(logicalName,separator);
      sp = ins->slotAddresses[i];
      PrintCLIPS(logicalName,"(");
      PrintCLIPS(logicalName,ValueToString(sp->desc->slotName->name));
      if (sp->type != MULTIFIELD)
        {
         PrintCLIPS(logicalName," ");
         PrintAtom(logicalName,(int) sp->type,sp->value);
        }
      else if (GetInstanceSlotLength(sp) != 0)
        {
         PrintCLIPS(logicalName," ");
         PrintMultifield(logicalName,(MULTIFIELD_PTR) sp->value,0,
                         GetInstanceSlotLength(sp) - 1,CLIPS_FALSE);
        }
      PrintCLIPS(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(ins,sname)
  INSTANCE_TYPE *ins;
  char *sname;
  {
   SYMBOL_HN *ssym;
   
   ssym = FindSymbol(sname);
   if (ssym == NULL)
     return(NULL);
   return(FindInstanceSlot(ins,ssym));
  }
  
#endif
 
/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/