inscom.c

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

   CloseStringSource(router);
   
   if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
       (CurrentExpression == NULL))
     { PeriodicCleanup(CLIPS_TRUE,CLIPS_FALSE); } 

   if ((result.type == SYMBOL) && (result.value == CLIPSFalseSymbol))
     return(NULL);
     
   return((VOID *) FindInstanceBySymbol((SYMBOL_HN *) result.value));
  }

/***************************************************************
  NAME         : CreateRawInstance
  DESCRIPTION  : Creates an empty of instance of the specified
                   class.  No slot-overrides or class defaults
                   are applied.
  INPUTS       : 1) Address of class
                 2) Name of the new instance
  RETURNS      : The instance address if instance created,
                    NULL otherwise
  SIDE EFFECTS : Old instance of same name deleted (if possible)
  NOTES        : None
 ***************************************************************/
globle VOID *CreateRawInstance(cptr,iname)
  VOID *cptr;
  char *iname;
  {
   return((VOID *) BuildInstance(AddSymbol(iname),(DEFCLASS *) cptr,CLIPS_FALSE));
  }
  
/***************************************************************************
  NAME         : FindInstance
  DESCRIPTION  : Looks up a specified instance in the instance hash table
  INPUTS       : Name-string of the instance
  RETURNS      : The address of the found instance, NULL otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************************************/
globle VOID *FindInstance(theModule,iname,searchImports)
  VOID *theModule;
  char *iname;
  BOOLEAN searchImports;
  {
   SYMBOL_HN *isym;
   
   isym = FindSymbol(iname);
   if (isym == NULL)
     return(NULL);
   if (theModule == NULL)
     theModule = (VOID *) GetCurrentModule();
   return((VOID *) FindInstanceInModule(isym,(struct defmodule *) theModule,
                                        ((struct defmodule *) GetCurrentModule()),searchImports));
  }

/***************************************************************************
  NAME         : ValidInstanceAddress
  DESCRIPTION  : Determines if an instance address is still valid
  INPUTS       : Instance address
  RETURNS      : 1 if the address is still valid, 0 otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************************************/
globle int ValidInstanceAddress(iptr)
  VOID *iptr;
  {
   return((((INSTANCE_TYPE *) iptr)->garbage == 0) ? 1 : 0);
  }
  
/***************************************************
  NAME         : DirectGetSlot
  DESCRIPTION  : Gets a slot value
  INPUTS       : 1) Instance address
                 2) Slot name
                 3) Caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID DirectGetSlot(ins,sname,result)
  VOID *ins;
  char *sname;
  DATA_OBJECT *result;
  {
   INSTANCE_SLOT *sp;

   if (((INSTANCE_TYPE *) ins)->garbage == 1)
     {
      SetEvaluationError(CLIPS_TRUE);
      result->type = SYMBOL;
      result->value = CLIPSFalseSymbol;
      return;
     }
   sp = FindISlotByName((INSTANCE_TYPE *) ins,sname);
   if (sp == NULL)
     {
      SetEvaluationError(CLIPS_TRUE);
      result->type = SYMBOL;
      result->value = CLIPSFalseSymbol;
      return;
     }
   result->type = sp->type;
   result->value = sp->value;
   if (sp->type == MULTIFIELD)
     {
      result->begin = 0;
      result->end = GetInstanceSlotLength(sp) - 1;
     }
   PropagateReturnValue(result);
  }

/*********************************************************
  NAME         : DirectPutSlot
  DESCRIPTION  : Gets a slot value
  INPUTS       : 1) Instance address
                 2) Slot name
                 3) Caller's new value buffer
  RETURNS      : CLIPS_TRUE if put successful, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 *********************************************************/
globle int DirectPutSlot(ins,sname,val)
  VOID *ins;
  char *sname;
  DATA_OBJECT *val;
  {
   INSTANCE_SLOT *sp;
   DATA_OBJECT junk;
   
   if ((((INSTANCE_TYPE *) ins)->garbage == 1) || (val == NULL))
     {
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }
   sp = FindISlotByName((INSTANCE_TYPE *) ins,sname);
   if (sp == NULL)
     {
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }
     
   if (PutSlotValue((INSTANCE_TYPE *) ins,sp,val,&junk,"external put"))
     {
      if ((CurrentEvaluationDepth == 0) && (! EvaluatingTopLevelCommand) &&
          (CurrentExpression == NULL))
        { PeriodicCleanup(CLIPS_TRUE,CLIPS_FALSE); } 
      return(CLIPS_TRUE);
     }
   return(CLIPS_FALSE);
  }

/***************************************************
  NAME         : GetInstanceName
  DESCRIPTION  : Returns name of instance
  INPUTS       : Pointer to instance
  RETURNS      : Name of instance
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle char *GetInstanceName(iptr)
  VOID *iptr;
  {
   if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     return(NULL);
   return(ValueToString(((INSTANCE_TYPE *) iptr)->name));
  }
  
/***************************************************
  NAME         : GetInstanceClass
  DESCRIPTION  : Returns class of instance
  INPUTS       : Pointer to instance
  RETURNS      : Pointer to class of instance
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID *GetInstanceClass(iptr)
  VOID *iptr;
  {
   if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     return(NULL);
   return((VOID *) ((INSTANCE_TYPE *) iptr)->cls);
  }
  
/***************************************************
  NAME         : GetGlobalNumberOfInstances
  DESCRIPTION  : Returns the total number of
                   instances in all modules
  INPUTS       : None
  RETURNS      : The instance count
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle unsigned long GetGlobalNumberOfInstances()
  {
   return(GlobalNumberOfInstances);
  }
  
/***************************************************
  NAME         : GetNextInstance
  DESCRIPTION  : Returns next instance in list
                 (or first instance in list)
  INPUTS       : Pointer to previous instance
                 (or NULL to get first instance)
  RETURNS      : The next instance or first instance
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID *GetNextInstance(iptr)
  VOID *iptr;
  {
   if (iptr == NULL)
     return((VOID *) InstanceList);
   if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     return(NULL);
   return((VOID *) ((INSTANCE_TYPE *) iptr)->nxtList);
  }

/***************************************************
  NAME         : GetNextInstanceInScope
  DESCRIPTION  : Returns next instance in list
                 (or first instance in list)
                 which class is in scope
  INPUTS       : Pointer to previous instance
                 (or NULL to get first instance)
  RETURNS      : The next instance or first instance
                 which class is in scope of the
                 current module
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID *GetNextInstanceInScope(iptr)
  VOID *iptr;
  {
   INSTANCE_TYPE *ins = (INSTANCE_TYPE *) iptr;
   
   if (ins == NULL)
     ins = InstanceList;
   else if (ins->garbage)
     return(NULL);
   else
     ins = ins->nxtList;
   while (ins != NULL)
     {
      if (DefclassInScope(ins->cls,NULL))
        return((VOID *) ins);
      ins = ins->nxtList;
     }
   return(NULL);
  }

/***************************************************
  NAME         : GetNextInstanceInClass
  DESCRIPTION  : Finds next instance of class
                 (or first instance of class)
  INPUTS       : 1) Class address
                 2) Instance address
                    (NULL to get first instance)
  RETURNS      : The next or first class instance
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID *GetNextInstanceInClass(cptr,iptr)
  VOID *cptr,*iptr;
  {
   if (iptr == NULL)
     return((VOID *) ((DEFCLASS *) cptr)->instanceList);
   if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     return(NULL);
   return((VOID *) ((INSTANCE_TYPE *) iptr)->nxtClass);
  }

/***************************************************
  NAME         : GetInstancePPForm
  DESCRIPTION  : Writes slot names and values to
                  caller's buffer
  INPUTS       : 1) Caller's buffer
                 2) Size of buffer (not including
                    space for terminating '\0')
                 3) Instance address
  RETURNS      : Nothing useful
  SIDE EFFECTS : Caller's buffer written
  NOTES        : None
 ***************************************************/
globle VOID GetInstancePPForm(buf,buflen,iptr)
  char *buf;
  int buflen;
  VOID *iptr;
  {
   char *pbuf = "***InstancePPForm***";
   
   if (((INSTANCE_TYPE *) iptr)->garbage == 1)
     return;
   if (OpenStringDestination(pbuf,buf,buflen+1) == 0)
     return;
   PrintInstance(pbuf,(INSTANCE_TYPE *) iptr," ");
   CloseStringDestination(pbuf);
  }

/*********************************************************
  NAME         : ClassCommand
  DESCRIPTION  : Returns the class of an instance
  INPUTS       : Caller's result buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (class <object>)
                 Can also be called by (type <object>)
                   if you have generic functions installed
 *********************************************************/
globle VOID ClassCommand(result)
  DATA_OBJECT *result;
  {
   INSTANCE_TYPE *ins;
   char *func;
   DATA_OBJECT temp;
   
   func = ValueToString(((struct FunctionDefinition *)
                       CurrentExpression->value)->callFunctionName);
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) temp.value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress(func);
         SetEvaluationError(CLIPS_TRUE);
         return;
        }
      result->value = (VOID *) GetDefclassNamePointer((VOID *) ins->cls);
     }
   else if (temp.type == INSTANCE_NAME)
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) temp.value);
      if (ins == NULL)
        {
         NoInstanceError(ValueToString(temp.value),func);
         return;
        }
      result->value = (VOID *) GetDefclassNamePointer((VOID *) ins->cls);
     }
   else
     {
      switch (temp.type)
        {
         case INTEGER          :
         case FLOAT            :
         case SYMBOL           :
         case STRING           :
         case MULTIFIELD       : 
         case EXTERNAL_ADDRESS :
         case FACT_ADDRESS     : 
                          result->value = (VOID *) 
                                           GetDefclassNamePointer((VOID *) 
                                            PrimitiveClassMap[temp.type]);
                         return;
         default       : PrintErrorID("INSCOM",1,CLIPS_FALSE);
                         PrintCLIPS(WERROR,"Undefined type in function ");
                         PrintCLIPS(WERROR,func);
                         PrintCLIPS(WERROR,".\n");
                         SetEvaluationError(CLIPS_TRUE);
        }
     }
  }

/******************************************************
  NAME         : DeleteInstanceCommand
  DESCRIPTION  : Removes a named instance from the
                   hash table and its class's
                   instance list
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if successful,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : Instance is deallocated
  NOTES        : This is an internal function that
                   only be called by a handler
 ******************************************************/
globle BOOLEAN DeleteInstanceCommand()
  {
   if (CheckCurrentMessage("delete-instance",CLIPS_TRUE))
     return(QuashInstance(GetActiveInstance()));
   return(CLIPS_FALSE);
  }
  
/********************************************************************
  NAME         : UnmakeInstanceCommand
  DESCRIPTION  : Uses message-passing to delete the
                   specified instance
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if successful, CLIPS_FALSE otherwise
  SIDE EFFECTS : Instance is deallocated
  NOTES        : Syntax: (unmake-instance <instance-expression>+ | *)
 ********************************************************************/
globle BOOLEAN UnmakeInstanceCommand()
  {
   EXPRESSION *theArgument;
   DATA_OBJECT theResult;
   INSTANCE_TYPE *ins;
   int argNumber = 1,rtn = CLIPS_TRUE;

   theArgument = GetFirstArgument();
   while (theArgument != NULL)
     {
      EvaluateExpression(theArgument,&theResult);
      if ((theResult.type == INSTANCE_NAME) || (theResult.type == SYMBOL))
        {
         ins = FindInstanceBySymbol((SYMBOL_HN *) theResult.value);
         if ((ins == NULL) ? (strcmp(DOToString(theResult),"*") != 0) : CLIPS_FALSE)
           {
            NoInstanceError(DOToString(theResult),"unmake-instance");
            return(CLIPS_FALSE);
           }
         }
      else if (theResult.type == INSTANCE_ADDRESS)
        {
         ins = (INSTANCE_TYPE *) theResult.value;
         if (ins->garbage)
           {
            StaleInstanceAddress("unmake-instance");
            SetEvaluationError(CLIPS_TRUE);
            return(CLIPS_FALSE);
           }
        }
      else
        {
         ExpectedTypeError1("retract",argNumber,"instance-address, instance-name, or the symbol *");
         SetEvaluationError(CLIPS_TRUE);
         return(CLIPS_FALSE);
        }
      if (UnmakeInstance(ins) == CLIPS_FALSE)
        rtn = CLIPS_FALSE;
      if (ins == NULL)
        return(rtn);
      argNumber++;
      theArgument = GetNextArgument(theArgument);
     }
   return(rtn);
  }

/*****************************************************************
  NAME         : SymbolToInstanceName
  DESCRIPTION  : Converts a symbol from type SYMBOL
                   to type INSTANCE_NAME
  INPUTS       : The address of the value buffer
  RETURNS      : The new INSTANCE_NAME symbol
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax : (symbol-to-instance-name <symbol>)