insfun.c

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

  DESCRIPTION  : Looks up a specified instance in the instance hash table
  INPUTS       : The CLIPS symbol for the name of the instance
  RETURNS      : The address of the found instance, NULL otherwise
  SIDE EFFECTS : None
  NOTES        : An instance is searched for by name first in the
                 current module - then in imported modules according
                 to the order given in the current module's definition
 ***************************************************************************/
globle INSTANCE_TYPE *FindInstanceBySymbol(moduleAndInstanceName)
  SYMBOL_HN *moduleAndInstanceName;
  {
   int modulePosition,searchImports;
   SYMBOL_HN *moduleName,*instanceName;
   struct defmodule *currentModule,*theModule;
   
   currentModule = ((struct defmodule *) GetCurrentModule());
   
   /* =======================================
      Instance names of the form [<name>] are
      searched for only in the current module
      ======================================= */
   modulePosition = FindModuleSeparator(ValueToString(moduleAndInstanceName));
   if (modulePosition == CLIPS_FALSE)
     {
      theModule = currentModule;
      instanceName = moduleAndInstanceName;
      searchImports = CLIPS_FALSE;
     }
     
   /* =========================================
      Instance names of the form [::<name>] are
      searched for in the current module and
      imported modules in the definition order
      ========================================= */
   else if (modulePosition == 1)
     {
      theModule = currentModule;
      instanceName = ExtractConstructName(modulePosition,ValueToString(moduleAndInstanceName));
      searchImports = CLIPS_TRUE;
     }
   
   /* =============================================
      Instance names of the form [<module>::<name>]
      are searched for in the specified module
      ============================================= */
   else
     {
      moduleName = ExtractModuleName(modulePosition,ValueToString(moduleAndInstanceName));
      theModule = (struct defmodule *) FindDefmodule(ValueToString(moduleName));
      instanceName = ExtractConstructName(modulePosition,ValueToString(moduleAndInstanceName));
      if (theModule == NULL)
        return(NULL);
      searchImports = CLIPS_FALSE;
     }
   return(FindInstanceInModule(instanceName,theModule,currentModule,searchImports));
  }

/***************************************************
  NAME         : FindInstanceInModule
  DESCRIPTION  : Finds an instance of the given name
                 in the given module in scope of
                 the given current module
                 (will also search imported modules
                  if specified)
  INPUTS       : 1) The instance name (no module)
                 2) The module to search
                 3) The currently active module
                 4) A flag indicating whether
                    to search imported modules of
                    given module as well
  RETURNS      : The instance (NULL if none found)
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle INSTANCE_TYPE *FindInstanceInModule(instanceName,theModule,currentModule,searchImports)
  SYMBOL_HN *instanceName;
  struct defmodule *theModule,*currentModule;
  BOOLEAN searchImports;
  {
   INSTANCE_TYPE *startInstance,*ins;
  
   /* ===============================
      Find the first instance of the
      correct name in the hash chain
      =============================== */
   startInstance = InstanceTable[HashInstance(instanceName)];
   while (startInstance != NULL)
     {
      if (startInstance->name == instanceName)
        break;
      startInstance = startInstance->nxtHash;
     }
   if (startInstance == NULL)
     return(NULL);
   
   /* ===========================================
      Look for the instance in the specified
      module - if the class of the found instance
      is in scope of the current module, we have
      found the instance
      =========================================== */
   for (ins = startInstance ;
        (ins != NULL) ? (ins->name == startInstance->name) : CLIPS_FALSE ;
        ins = ins->nxtHash)
     if ((ins->cls->header.whichModule->theModule == theModule) &&
          DefclassInScope(ins->cls,currentModule))
       return(ins);
     
   /* ================================
      For ::<name> formats, we need to
      search imported modules too
      ================================ */
   if (searchImports == CLIPS_FALSE)
     return(NULL);
   MarkModulesAsUnvisited();
   return(FindImportedInstance(theModule,currentModule,startInstance));
  }

/********************************************************************
  NAME         : FindInstanceSlot
  DESCRIPTION  : Finds an instance slot by name
  INPUTS       : 1) The address of the instance
                 2) The CLIPS symbolic name of the slot
  RETURNS      : The address of the slot, NULL if not found
  SIDE EFFECTS : None
  NOTES        : None
 ********************************************************************/
globle INSTANCE_SLOT *FindInstanceSlot(ins,sname)
  INSTANCE_TYPE *ins;
  SYMBOL_HN *sname;
  {
   register int i;
   
   i = FindInstanceTemplateSlot(ins->cls,sname);
   return((i != -1) ? ins->slotAddresses[i] : NULL);
  }
  
/********************************************************************
  NAME         : FindInstanceTemplateSlot
  DESCRIPTION  : Performs a search on an class's instance
                   template slot array to find a slot by name
  INPUTS       : 1) The address of the class
                 2) The CLIPS symbolic name of the slot
  RETURNS      : The index of the slot, -1 if not found
  SIDE EFFECTS : None
  NOTES        : The slot's unique id is used as index into
                 the slot map array.
 ********************************************************************/
globle int FindInstanceTemplateSlot(cls,sname)
  DEFCLASS *cls;
  SYMBOL_HN *sname;
  {
   int sid;
   
   sid = FindSlotNameID(sname);
   if (sid == -1)
     return(-1);
   if (sid > cls->maxSlotNameID)
     return(-1);
   return((int) cls->slotNameMap[sid] - 1);
  }

/***********************************************************
  NAME         : EvaluateAndStoreInDataObject
  DESCRIPTION  : Evaluates slot-value expressions
                   and stores the result in a CLIPS
                   Kernel data object
  INPUTS       : 1) Flag indicating if multifields are OK
                 2) The value-expression
                 3) The data object structure
  RETURNS      : CLIPS_FALSE on errors, CLIPS_TRUE otherwise
  SIDE EFFECTS : Segment allocated for storing
                 multifield values
  NOTES        : None
 ***********************************************************/
globle int EvaluateAndStoreInDataObject(mfp,exp,val)
  int mfp;
  EXPRESSION *exp;
  DATA_OBJECT *val;
  {   
   val->type = MULTIFIELD;
   val->begin = 0;
   val->end = -1;
   if (exp == NULL)
     {
      val->value = CreateMultifield(0L);
      return(CLIPS_TRUE);
     }
   if ((mfp == 0) && (exp->nextArg == NULL))
     EvaluateExpression(exp,val);
   else
     StoreInMultifield(val,exp,CLIPS_TRUE);
   return(EvaluationError ? CLIPS_FALSE : CLIPS_TRUE);
  }
  
/*******************************************************
  NAME         : PutSlotValue
  DESCRIPTION  : Evaluates new slot-expression and
                   stores it as a multifield
                   variable for the slot.
  INPUTS       : 1) The address of the instance
                    (NULL if no trace-messages desired)
                 2) The address of the slot
                 3) The address of the value
                 4) DATA_OBJECT_PTR to store the
                    set value
                 5) The command doing the put-
  RETURNS      : CLIPS_FALSE on errors, or CLIPS_TRUE
  SIDE EFFECTS : Old value deleted and new one allocated
                 Old value symbols deinstalled
                 New value symbols installed
  NOTES        : None
 *******************************************************/
globle int PutSlotValue(ins,sp,val,setVal,theCommand)
  INSTANCE_TYPE *ins;
  INSTANCE_SLOT *sp;
  DATA_OBJECT *val,*setVal;
  char *theCommand;
  {
   if (ValidSlotValue(val,sp->desc,ins,theCommand) == CLIPS_FALSE)
     {
      SetpType(setVal,SYMBOL);
      SetpValue(setVal,CLIPSFalseSymbol);
      return(CLIPS_FALSE);
     }
   return(DirectPutSlotValue(ins,sp,val,setVal));
  }
  
/*******************************************************
  NAME         : DirectPutSlotValue
  DESCRIPTION  : Evaluates new slot-expression and
                   stores it as a multifield
                   variable for the slot.
  INPUTS       : 1) The address of the instance
                    (NULL if no trace-messages desired)
                 2) The address of the slot
                 3) The address of the value
                 4) DATA_OBJECT_PTR to store the
                    set value
  RETURNS      : CLIPS_FALSE on errors, or CLIPS_TRUE
  SIDE EFFECTS : Old value deleted and new one allocated
                 Old value symbols deinstalled
                 New value symbols installed
  NOTES        : None
 *******************************************************/
globle int DirectPutSlotValue(ins,sp,val,setVal)
  INSTANCE_TYPE *ins;
  INSTANCE_SLOT *sp;
  DATA_OBJECT *val,*setVal;
  {
   register long i,j; /* 6.04 Bug Fix */
#if INSTANCE_PATTERN_MATCHING
   int sharedTraversalID;
   INSTANCE_SLOT *bsp,**spaddr;
#endif
   DATA_OBJECT tmpVal;
   
   SetpType(setVal,SYMBOL);
   SetpValue(setVal,CLIPSFalseSymbol);
   if (val == NULL)
     {
      CLIPSSystemError("INSFUN",1);
      ExitCLIPS(2);
     }
   else if (GetpValue(val) == NoParamValue)
     {
      if (sp->desc->dynamicDefault)
        {
         val = &tmpVal;
         if (!EvaluateAndStoreInDataObject(sp->desc->multiple,
                                           (EXPRESSION *) sp->desc->defaultValue,val))
           return(CLIPS_FALSE);
        }
      else
        val = sp->desc->defaultValue;
     } 
#if INSTANCE_PATTERN_MATCHING
   if (JoinOperationInProgress && sp->desc->reactive &&
       (ins->cls->reactive || sp->desc->shared))
     {
      PrintErrorID("INSFUN",5,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot modify reactive instance slots while\n");
      PrintCLIPS(WERROR,"  pattern-matching is in process.\n");
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }

   /* =============================================
      If we are about to change a slot of an object
      which is a basis for a firing rule, we need
      to make sure that slot is copied first
      ============================================= */
   if (ins->basisSlots != NULL)
     {
      spaddr = &ins->slotAddresses[ins->cls->slotNameMap[sp->desc->slotName->id] - 1];
      bsp = ins->basisSlots + (spaddr - ins->slotAddresses);
      if (bsp->value == NULL)
        {
         bsp->type = sp->type;
         bsp->value = sp->value;
         if (sp->desc->multiple)
           MultifieldInstall((MULTIFIELD_PTR) bsp->value);
         else
           AtomInstall((int) bsp->type,bsp->value);
        }
     }
        
#endif
   if (sp->desc->multiple == 0)
     {
      AtomDeinstall((int) sp->type,sp->value);
      
      /* ======================================
         Assumed that multfield already checked
         to be of cardinality 1
         ====================================== */
      if (GetpType(val) == MULTIFIELD)
        {
         sp->type = GetMFType(GetpValue(val),GetpDOBegin(val));
         sp->value = GetMFValue(GetpValue(val),GetpDOBegin(val));
        }
      else
        {
         sp->type = val->type;
         sp->value = val->value;
        }
      AtomInstall((int) sp->type,sp->value);
      SetpType(setVal,sp->type);
      SetpValue(setVal,sp->value);
     }
   else
     {
      MultifieldDeinstall((MULTIFIELD_PTR) sp->value);
      AddToMultifieldList((MULTIFIELD_PTR) sp->value);
      sp->type = MULTIFIELD;
      if (val->type == MULTIFIELD)
        {
         sp->value = CreateMultifield2(GetpDOLength(val));
         for (i = 1 , j = GetpDOBegin(val) ; i <= GetpDOLength(val) ; i++ , j++)
           {
            SetMFType(sp->value,i,GetMFType(val->value,j));
            SetMFValue(sp->value,i,GetMFValue(val->value,j));
           }