insfun.c

来自「clips源代码」· C语言 代码 · 共 1,328 行 · 第 1/4 页

#if DEBUGGING_FUNCTIONS
   if (ins->cls->traceSlots)
     {
      if (sp->desc->shared)
        EnvPrintRouter(theEnv,WTRACE,"::= shared slot ");
      else
        EnvPrintRouter(theEnv,WTRACE,"::= local slot ");
      EnvPrintRouter(theEnv,WTRACE,ValueToString(sp->desc->slotName->name));
      EnvPrintRouter(theEnv,WTRACE," in instance ");
      EnvPrintRouter(theEnv,WTRACE,ValueToString(ins->name));
      EnvPrintRouter(theEnv,WTRACE," <- ");
      if (sp->type != MULTIFIELD)
        PrintAtom(theEnv,WTRACE,(int) sp->type,sp->value);
      else
        PrintMultifield(theEnv,WTRACE,(MULTIFIELD_PTR) sp->value,0,
                        (long) (GetInstanceSlotLength(sp) - 1),TRUE);
      EnvPrintRouter(theEnv,WTRACE,"\n");
     }
#endif
   InstanceData(theEnv)->ChangesToInstances = TRUE;

#if DEFRULE_CONSTRUCT
   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(theEnv);
         if (sharedTraversalID != -1)
           {
            NetworkModifyForSharedSlot(theEnv,sharedTraversalID,sp->desc->cls,sp->desc);
            ReleaseTraversalID(theEnv);
           }
         else
           {
            PrintErrorID(theEnv,"INSFUN",6,FALSE);
            EnvPrintRouter(theEnv,WERROR,"Unable to pattern-match on shared slot ");
            EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
            EnvPrintRouter(theEnv,WERROR," in class ");
            EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) sp->desc->cls));
            EnvPrintRouter(theEnv,WERROR,".\n");
           }
        }
      else
        ObjectNetworkAction(theEnv,OBJECT_MODIFY,(INSTANCE_TYPE *) ins,(int) sp->desc->slotName->id);
     }
#endif

   return(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      : TRUE if value is OK, FALSE otherwise
  SIDE EFFECTS : Sets EvaluationError if slot is not OK
  NOTES        : Examines all fields of a multi-field
 *******************************************************************/
globle int ValidSlotValue(
  void *theEnv,
  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) == ProceduralPrimitiveData(theEnv)->NoParamValue)
     return(TRUE);
   if ((sd->multiple == 0) && (val->type == MULTIFIELD) &&
                              (GetpDOLength(val) != 1))
     {
      PrintErrorID(theEnv,"INSFUN",7,FALSE);
      PrintDataObject(theEnv,WERROR,val);
      EnvPrintRouter(theEnv,WERROR," illegal for single-field ");
      PrintSlot(theEnv,WERROR,sd,ins,theCommand);
      EnvPrintRouter(theEnv,WERROR,".\n");
      SetEvaluationError(theEnv,TRUE);
      return(FALSE);
     }
   if (val->type == RVOID)
     {
      PrintErrorID(theEnv,"INSFUN",8,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Void function illegal value for ");
      PrintSlot(theEnv,WERROR,sd,ins,theCommand);
      EnvPrintRouter(theEnv,WERROR,".\n");
      SetEvaluationError(theEnv,TRUE);
      return(FALSE);
     }
   if (EnvGetDynamicConstraintChecking(theEnv))
     {
      violationCode = ConstraintCheckDataObject(theEnv,val,sd->constraint);
      if (violationCode != NO_VIOLATION)
        {
         PrintErrorID(theEnv,"CSTRNCHK",1,FALSE);
         if ((GetpType(val) == MULTIFIELD) && (sd->multiple == 0))
           PrintAtom(theEnv,WERROR,GetMFType(GetpValue(val),GetpDOBegin(val)),
                            GetMFValue(GetpValue(val),GetpDOEnd(val)));
         else
           PrintDataObject(theEnv,WERROR,val);
         EnvPrintRouter(theEnv,WERROR," for ");
         PrintSlot(theEnv,WERROR,sd,ins,theCommand);
         ConstraintViolationErrorMessage(theEnv,NULL,NULL,0,0,NULL,0,
                                         violationCode,sd->constraint,FALSE);
         SetEvaluationError(theEnv,TRUE);
         return(FALSE);
        }
     }
   return(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(
  void *theEnv,
  char *func)
  {
   INSTANCE_TYPE *ins;
   DATA_OBJECT temp;

   EvaluateExpression(theEnv,GetFirstArgument(),&temp);
   if (temp.type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) temp.value;
      if (ins->garbage == 1)
        {
         StaleInstanceAddress(theEnv,func,0);
         SetEvaluationError(theEnv,TRUE);
         return(NULL);
        }
     }
   else if ((temp.type == INSTANCE_NAME) ||
            (temp.type == SYMBOL))
     {
      ins = FindInstanceBySymbol(theEnv,(SYMBOL_HN *) temp.value);
      if (ins == NULL)
        {
         NoInstanceError(theEnv,ValueToString(temp.value),func);
         return(NULL);
        }
     }
   else
     {
      PrintErrorID(theEnv,"INSFUN",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Expected a valid instance in function ");
      EnvPrintRouter(theEnv,WERROR,func);
      EnvPrintRouter(theEnv,WERROR,".\n");
      SetEvaluationError(theEnv,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(
  void *theEnv,
  char *iname,
  char *func)
  {
   PrintErrorID(theEnv,"INSFUN",2,FALSE);
   EnvPrintRouter(theEnv,WERROR,"No such instance ");
   EnvPrintRouter(theEnv,WERROR,iname);
   EnvPrintRouter(theEnv,WERROR," in function ");
   EnvPrintRouter(theEnv,WERROR,func);
   EnvPrintRouter(theEnv,WERROR,".\n");
   SetEvaluationError(theEnv,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(
  void *theEnv,
  char *func,
  int whichArg)
  {
   PrintErrorID(theEnv,"INSFUN",4,FALSE);
   EnvPrintRouter(theEnv,WERROR,"Invalid instance-address in function ");
   EnvPrintRouter(theEnv,WERROR,func);
   if (whichArg > 0)
     {
      EnvPrintRouter(theEnv,WERROR,", argument #");
      PrintLongInteger(theEnv,WERROR,(long long) whichArg);
     }
   EnvPrintRouter(theEnv,WERROR,".\n");
  }

/**********************************************************************
  NAME         : EnvGetInstancesChanged
  DESCRIPTION  : Returns whether instances have changed
                   (any were added/deleted or slot values were changed)
                   since last time flag was set to FALSE
  INPUTS       : None
  RETURNS      : The instances-changed flag
  SIDE EFFECTS : None
  NOTES        : Used by interfaces to update instance windows
 **********************************************************************/
globle int EnvGetInstancesChanged(
  void *theEnv)
  {
   return(InstanceData(theEnv)->ChangesToInstances);
  }

/*******************************************************
  NAME         : EnvSetInstancesChanged
  DESCRIPTION  : Sets instances-changed flag (see above)
  INPUTS       : The value (TRUE or FALSE)
  RETURNS      : Nothing useful
  SIDE EFFECTS : The flag is set
  NOTES        : None
 *******************************************************/
globle void EnvSetInstancesChanged(
  void *theEnv,
  int changed)
  {
   InstanceData(theEnv)->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(
  void *theEnv,
  char *logName,
  SLOT_DESC *sd,
  INSTANCE_TYPE *ins,
  char *theCommand)
  {
   EnvPrintRouter(theEnv,logName,"slot ");
   EnvPrintRouter(theEnv,logName,ValueToString(sd->slotName->name));
   if (ins != NULL)
     {
      EnvPrintRouter(theEnv,logName," of instance [");
      EnvPrintRouter(theEnv,logName,ValueToString(ins->name));
      EnvPrintRouter(theEnv,logName,"]");
     }
   else if (sd->cls != NULL)
     {
      EnvPrintRouter(theEnv,logName," of class ");
      EnvPrintRouter(theEnv,logName,EnvGetDefclassName(theEnv,(void *) sd->cls));
     }
   EnvPrintRouter(theEnv,logName," found in ");
   if (theCommand != NULL)
     EnvPrintRouter(theEnv,logName,theCommand);
   else
     PrintHandler(theEnv,logName,MessageHandlerData(theEnv)->CurrentCore->hnd,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(
  void *theEnv,
  char *logicalName,
  INSTANCE_TYPE *theInstance,
  intBool linefeedFlag)
  {
   EnvPrintRouter(theEnv,logicalName,"[");
   EnvPrintRouter(theEnv,logicalName,EnvGetInstanceName(theEnv,(void *) theInstance));
   EnvPrintRouter(theEnv,logicalName,"] of ");
   PrintClassName(theEnv,logicalName,theInstance->cls,linefeedFlag);
  }
  
/***************************************************
  NAME         : PrintInstanceName
  DESCRIPTION  : Used by the rule system commands
                 such as (matches) and (agenda)
                 to print out the name of an instance
  INPUTS       : 1) The logical output name
                 2) A pointer to the instance
  RETURNS      : Nothing useful
  SIDE EFFECTS : Name of instance printed
  NOTES        : None