insfun.c

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

        }
      else
        {
         sp->value = CreateMultifield2(1L);
         SetMFType(sp->value,1,(short) val->type);
         SetMFValue(sp->value,1,val->value);
        }
      MultifieldInstall(sp->value);
      SetpType(setVal,MULTIFIELD);
      SetpValue(setVal,sp->value);
      SetpDOBegin(setVal,1);
      SetpDOEnd(setVal,GetMFLength(sp->value));
     }
   /* ================================================== 
      6.05 Bug fix - any slot set directly or indirectly
      by a slot override or other side-effect during an
      instance initialization should not have its
      default value set
      ================================================== */
   sp->override = WithinInit;
   
#if DEBUGGING_FUNCTIONS
   if (ins->cls->traceSlots)
     {
      if (sp->desc->shared)
        PrintCLIPS(WTRACE,"::= shared slot ");
      else
        PrintCLIPS(WTRACE,"::= local slot ");
      PrintCLIPS(WTRACE,ValueToString(sp->desc->slotName->name));
      PrintCLIPS(WTRACE," in instance ");
      PrintCLIPS(WTRACE,ValueToString(ins->name));
      PrintCLIPS(WTRACE," <- ");
      if (sp->type != MULTIFIELD)
        PrintAtom(WTRACE,(int) sp->type,sp->value);
      else
        PrintMultifield(WTRACE,(MULTIFIELD_PTR) sp->value,0,
                        GetInstanceSlotLength(sp) - 1,CLIPS_TRUE);
      PrintCLIPS(WTRACE,"\n");
     }
#endif
   ChangesToInstances = CLIPS_TRUE;
   
#if INSTANCE_PATTERN_MATCHING
   if (ins->cls->reactive && sp->desc->reactive)
     {
      /* ============================================
         If we have changed a shared slot, we need to
         perform a Rete update for every instance
         which contains this slot
         ============================================ */
      if (sp->desc->shared)
        {
         sharedTraversalID = GetTraversalID();
         if (sharedTraversalID != -1)
           {
            NetworkModifyForSharedSlot(sharedTraversalID,sp->desc->cls,sp->desc);
            ReleaseTraversalID();
           }
         else
           {
            PrintErrorID("INSFUN",6,CLIPS_FALSE);
            PrintCLIPS(WERROR,"Unable to pattern-match on shared slot ");
            PrintCLIPS(WERROR,ValueToString(sp->desc->slotName->name));
            PrintCLIPS(WERROR," in class ");
            PrintCLIPS(WERROR,GetDefclassName((VOID *) sp->desc->cls));
            PrintCLIPS(WERROR,".\n");
           }
        }
      else
        ObjectNetworkAction(OBJECT_MODIFY,(VOID *) ins,(int) sp->desc->slotName->id);
     }
#endif

   return(CLIPS_TRUE);
  }

/*******************************************************************
  NAME         : ValidSlotValue
  DESCRIPTION  : Determines if a value is appropriate
                   for a slot-value
  INPUTS       : 1) The value buffer
                 2) Slot descriptor
                 3) Instance for which slot is being checked
                    (can be NULL)
                 4) Buffer holding printout of the offending command
                    (if NULL assumes message-handler is executing
                     and calls PrintHandler for CurrentCore instead)
  RETURNS      : CLIPS_TRUE if value is OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Sets EvaluationError if slot is not OK
  NOTES        : Examines all fields of a multi-field
 *******************************************************************/
globle int ValidSlotValue(val,sd,ins,theCommand)
  DATA_OBJECT *val;
  SLOT_DESC *sd;
  INSTANCE_TYPE *ins;
  char *theCommand;
  {
   register int violationCode;
   
   /* ===================================
      Special NoParamValue means to reset
      slot to default value
      =================================== */
   if (GetpValue(val) == NoParamValue)
     return(CLIPS_TRUE);
   if ((sd->multiple == 0) && (val->type == MULTIFIELD) &&
                              (GetpDOLength(val) != 1))
     {
      PrintErrorID("INSFUN",7,CLIPS_FALSE);
      PrintDataObject(WERROR,val);
      PrintCLIPS(WERROR," illegal for single-field ");
      PrintSlot(WERROR,sd,ins,theCommand);
      PrintCLIPS(WERROR,".\n");
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }
   if (val->type == RVOID)
     {
      PrintErrorID("INSFUN",8,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Void function illegal value for ");
      PrintSlot(WERROR,sd,ins,theCommand);
      PrintCLIPS(WERROR,".\n");
      SetEvaluationError(CLIPS_TRUE);
      return(CLIPS_FALSE);
     }
   if (GetDynamicConstraintChecking())
     {
      violationCode = ConstraintCheckDataObject(val,sd->constraint);
      if (violationCode != NO_VIOLATION)
        {
         PrintErrorID("CSTRNCHK",1,CLIPS_FALSE);
         if ((GetpType(val) == MULTIFIELD) && (sd->multiple == 0))
           PrintAtom(WERROR,GetMFType(GetpValue(val),GetpDOBegin(val)),
                            GetMFValue(GetpValue(val),GetpDOEnd(val)));
         else
           PrintDataObject(WERROR,val);
         PrintCLIPS(WERROR," for ");
         PrintSlot(WERROR,sd,ins,theCommand);
         ConstraintViolationErrorMessage(NULL,NULL,0,0,NULL,0,
                                         violationCode,sd->constraint,CLIPS_FALSE);
         SetEvaluationError(CLIPS_TRUE);
         return(CLIPS_FALSE);
        }
     }
   return(CLIPS_TRUE);
  }
  
/********************************************************
  NAME         : CheckInstance
  DESCRIPTION  : Checks to see if the first argument to
                 a function is a valid instance
  INPUTS       : Name of the calling function
  RETURNS      : The address of the instance
  SIDE EFFECTS : EvaluationError set and messages printed
                 on errors
  NOTES        : Used by Initialize and ModifyInstance
 ********************************************************/
globle INSTANCE_TYPE *CheckInstance(func)
  char *func;
  {
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;
   
   EvaluateExpression(GetFirstArgument(),&temp);
   if (temp.type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) temp.value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress(func);
         SetEvaluationError(CLIPS_TRUE);
         return(NULL);
        }
     }
   else if ((temp.type == INSTANCE_NAME) || 
            (temp.type == SYMBOL))
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) temp.value);
      if (ins == NULL)
        {
         NoInstanceError(ValueToString(temp.value),func);
         return(NULL);
        }
     }
   else
     {
      PrintErrorID("INSFUN",1,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Expected a valid instance in function ");
      PrintCLIPS(WERROR,func);
      PrintCLIPS(WERROR,".\n");
      SetEvaluationError(CLIPS_TRUE);
      return(NULL);
     }
   return(ins);
  }
   
/***************************************************
  NAME         : NoInstanceError
  DESCRIPTION  : Prints out an appropriate error
                  message when an instance cannot be
                  found for a function
  INPUTS       : 1) The instance name
                 2) The function name
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID NoInstanceError(iname,func)
  char *iname,*func;
  {
   PrintErrorID("INSFUN",2,CLIPS_FALSE);
   PrintCLIPS(WERROR,"No such instance ");
   PrintCLIPS(WERROR,iname);
   PrintCLIPS(WERROR," in function ");
   PrintCLIPS(WERROR,func);
   PrintCLIPS(WERROR,".\n");
   SetEvaluationError(CLIPS_TRUE);
  }
  
/***************************************************
  NAME         : SlotExistError
  DESCRIPTION  : Prints out an appropriate error
                  message when a slot cannot be
                  found for a function
  INPUTS       : 1) The slot name
                 2) The function name
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID SlotExistError(sname,func)
  char *sname,*func;
  {
   PrintErrorID("INSFUN",3,CLIPS_FALSE);
   PrintCLIPS(WERROR,"No such slot ");
   PrintCLIPS(WERROR,sname);
   PrintCLIPS(WERROR," in function ");
   PrintCLIPS(WERROR,func);
   PrintCLIPS(WERROR,".\n");
   SetEvaluationError(CLIPS_TRUE);
  }
  
/***************************************************
  NAME         : StaleInstanceAddress
  DESCRIPTION  : Prints out an appropriate error
                  message when an instance address
                  is no longer valid
  INPUTS       : The function name
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID StaleInstanceAddress(func)
  char *func;
  {
   PrintErrorID("INSFUN",4,CLIPS_FALSE);
   PrintCLIPS(WERROR,"Invalid instance-address in function ");
   PrintCLIPS(WERROR,func);
   PrintCLIPS(WERROR,".\n");
  }
  
/**********************************************************************
  NAME         : GetInstancesChanged
  DESCRIPTION  : Returns whether instances have changed 
                   (any were added/deleted or slot values were changed)
                   since last time flag was set to CLIPS_FALSE
  INPUTS       : None
  RETURNS      : The instances-changed flag
  SIDE EFFECTS : None
  NOTES        : Used by interfaces to update instance windows
 **********************************************************************/
globle int GetInstancesChanged()
  {
   return(ChangesToInstances);
  }
  
/*******************************************************
  NAME         : SetInstancesChanged
  DESCRIPTION  : Sets instances-changed flag (see above)
  INPUTS       : The value (CLIPS_TRUE or CLIPS_FALSE)
  RETURNS      : Nothing useful
  SIDE EFFECTS : The flag is set
  NOTES        : None
 *******************************************************/
globle VOID SetInstancesChanged(changed)
  int changed;
  {
   ChangesToInstances = changed;
  }
    
/*******************************************************************
  NAME         : PrintSlot
  DESCRIPTION  : Displays the name and origin of a slot
  INPUTS       : 1) The logical output name
                 2) The slot descriptor
                 3) The instance source (can be NULL)
                 4) Buffer holding printout of the offending command
                    (if NULL assumes message-handler is executing
                     and calls PrintHandler for CurrentCore instead)
  RETURNS      : Nothing useful
  SIDE EFFECTS : Message printed
  NOTES        : None
 *******************************************************************/
globle VOID PrintSlot(log,sd,ins,theCommand)
  char *log;
  SLOT_DESC *sd;
  INSTANCE_TYPE *ins;
  char *theCommand;
  {
   PrintCLIPS(log,"slot ");
   PrintCLIPS(log,ValueToString(sd->slotName->name));
   if (ins != NULL)
     {
      PrintCLIPS(log," of instance [");
      PrintCLIPS(log,ValueToString(ins->name));
      PrintCLIPS(log,"]");
     }
   else if (sd->cls != NULL)
     {
      PrintCLIPS(log," of class ");
      PrintCLIPS(log,GetDefclassName((VOID *) sd->cls));
     }
   PrintCLIPS(log," found in ");
   if (theCommand != NULL)
     PrintCLIPS(log,theCommand); 
   else
     PrintHandler(log,CurrentCore->hnd,CLIPS_FALSE);
  }
  
/*****************************************************
  NAME         : PrintInstanceNameAndClass
  DESCRIPTION  : Displays an instance's name and class
  INPUTS       : 1) Logical name of output
                 2) The instance
                 3) Flag indicating whether to
                    print carriage-return at end
  RETURNS      : Nothing useful
  SIDE EFFECTS : Instnace name and class printed
  NOTES        : None
 *****************************************************/
globle VOID PrintInstanceNameAndClass(logicalName,theInstance,linefeedFlag)
  char *logicalName;
  INSTANCE_TYPE *theInstance;