genrcexe.c

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

             (temp.value == CLIPSFalseSymbol))
           return(CLIPS_FALSE);
        }
      if (k != meth->restrictionCount-1)
        k++;
     }
   return(CLIPS_TRUE);
  }
 
#if IMPERATIVE_METHODS

/***************************************************
  NAME         : NextMethodP
  DESCRIPTION  : Determines if a shadowed generic
                   function method is available for
                   execution
  INPUTS       : None
  RETURNS      : CLIPS_TRUE if there is a method available,
                   CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax: (next-methodp)
 ***************************************************/
globle int NextMethodP()
  {
   register DEFMETHOD *meth;
   
   if (CurrentMethod == NULL)
     return(CLIPS_FALSE);
   meth = FindApplicableMethod(CurrentGeneric,CurrentMethod);
   if (meth != NULL)
     {
      meth->busy--;
      return(CLIPS_TRUE);
     }
   return(CLIPS_FALSE);
  }
  
/****************************************************
  NAME         : CallNextMethod
  DESCRIPTION  : Executes the next available method
                   in the core for a generic function
  INPUTS       : Caller's buffer for the result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Side effects of execution of shadow
                 EvaluationError set if no method
                   is available to execute.
  NOTES        : CLIPS Syntax: (call-next-method)
 ****************************************************/
globle VOID CallNextMethod(result)
  DATA_OBJECT *result;
  {
   DEFMETHOD *oldMethod;

   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   if (HaltExecution)
     return;
   oldMethod = CurrentMethod;
   if (CurrentMethod != NULL)
     CurrentMethod = FindApplicableMethod(CurrentGeneric,CurrentMethod);
   if (CurrentMethod == NULL)
     {
      CurrentMethod = oldMethod;
      PrintErrorID("GENRCEXE",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Shadowed methods not applicable in current context.\n");
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   
#if DEBUGGING_FUNCTIONS
   if (CurrentMethod->trace)
     WatchMethod(BEGIN_TRACE);
#endif
   if (CurrentMethod->system)
     {
      EXPRESSION fcall;
      
      fcall.type = FCALL;
      fcall.value = CurrentMethod->actions->value;
      fcall.nextArg = NULL;
      fcall.argList = GetProcParamExpressions();
      EvaluateExpression(&fcall,result);
     }
   else
     EvaluateProcActions(CurrentGeneric->header.whichModule->theModule,
                         CurrentMethod->actions,CurrentMethod->localVarCount,
                         result,UnboundMethodErr);
   CurrentMethod->busy--;
#if DEBUGGING_FUNCTIONS
   if (CurrentMethod->trace)
     WatchMethod(END_TRACE);
#endif
   CurrentMethod = oldMethod;
   ReturnFlag = CLIPS_FALSE;
  }
  
/**************************************************************************
  NAME         : CallSpecificMethod
  DESCRIPTION  : Allows a specific method to be called without regards to
                   higher precedence methods which might also be applicable
                   However, shadowed methods can still be called.
  INPUTS       : A data object buffer to hold the method evaluation result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Side-effects of method applicability tests and the
                 evaluation of methods
  NOTES        : CLIPS Syntax: (call-specific-method
                                <generic-function> <method-index> <args>)
 **************************************************************************/
globle VOID CallSpecificMethod(result)
  DATA_OBJECT *result;
  {
   DATA_OBJECT temp;
   DEFGENERIC *gfunc;
   int mi;
   
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   if (ArgTypeCheck("call-specific-method",1,SYMBOL,&temp) == CLIPS_FALSE)
     return;
   gfunc = CheckGenericExists("call-specific-method",DOToString(temp));
   if (gfunc == NULL)
     return;
   if (ArgTypeCheck("call-specific-method",2,INTEGER,&temp) == CLIPS_FALSE)
     return;
   mi = CheckMethodExists("call-specific-method",gfunc,DOToInteger(temp));
   if (mi == -1)
     return;
   gfunc->methods[mi].busy++;
   GenericDispatch(gfunc,NULL,&gfunc->methods[mi],
                   GetFirstArgument()->nextArg->nextArg,result);
   gfunc->methods[mi].busy--;
  }

/***********************************************************************
  NAME         : OverrideNextMethod
  DESCRIPTION  : Changes the arguments to shadowed methods, thus the set
                 of applicable methods to this call may change
  INPUTS       : A buffer to hold the result of the call
  RETURNS      : Nothing useful
  SIDE EFFECTS : Any of evaluating method restrictions and bodies
  NOTES        : CLIPS Syntax: (override-next-method <args>)
 ***********************************************************************/
globle VOID OverrideNextMethod(result)
  DATA_OBJECT *result;
  {
   result->type = SYMBOL;
   result->value = CLIPSFalseSymbol;
   if (HaltExecution)
     return;
   if (CurrentMethod == NULL)
     {
      PrintErrorID("GENRCEXE",2,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Shadowed methods not applicable in current context.\n");
      SetEvaluationError(CLIPS_TRUE);
      return;
     }
   GenericDispatch(CurrentGeneric,CurrentMethod,NULL,
                   GetFirstArgument(),result);
  }

#endif /* IMPERATIVE_METHODS */

/***********************************************************
  NAME         : GetGenericCurrentArgument
  DESCRIPTION  : Returns the value of the generic function
                   argument being tested in the method
                   applicability determination process
  INPUTS       : A data-object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Data-object set
  NOTES        : Useful for queries in wildcard restrictions
 ***********************************************************/
globle VOID GetGenericCurrentArgument(result)
  DATA_OBJECT *result;
  {
   result->type = GenericCurrentArgument->type;
   result->value = GenericCurrentArgument->value;
   result->begin = GenericCurrentArgument->begin;
   result->end = GenericCurrentArgument->end;
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
     
/************************************************************
  NAME         : FindApplicableMethod
  DESCRIPTION  : Finds the first/next applicable
                   method for a generic function call
  INPUTS       : 1) The generic function pointer
                 2) The address of the current method
                    (NULL to find the first)
  RETURNS      : The address of the first/next
                   applicable method (NULL on errors)
  SIDE EFFECTS : Any from evaluating query restrictions
                 Methoid busy count incremented if applicable
  NOTES        : None
 ************************************************************/
static DEFMETHOD *FindApplicableMethod(gfunc,meth)
  DEFGENERIC *gfunc;
  DEFMETHOD *meth;
  {
   if (meth != NULL)
     meth++;
   else
     meth = gfunc->methods;
   for ( ; meth < &gfunc->methods[gfunc->mcnt] ; meth++)
     {
      meth->busy++;
      if (IsMethodApplicable(meth))
        return(meth);
      meth->busy--;
     }
   return(NULL);
  }
 
#if DEBUGGING_FUNCTIONS

/**********************************************************************
  NAME         : WatchGeneric
  DESCRIPTION  : Prints out a trace of the beginning or end
                   of the execution of a generic function
  INPUTS       : A string to indicate beginning or end of execution
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Uses the globals CurrentGeneric, ProcParamArraySize and 
                   ProcParamArray for other trace info
 **********************************************************************/
static VOID WatchGeneric(tstring)
  char *tstring;
  {
   PrintCLIPS(WTRACE,"GNC ");
   PrintCLIPS(WTRACE,tstring);
   PrintCLIPS(WTRACE," ");
   if (CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) GetCurrentModule()))
     {
      PrintCLIPS(WTRACE,GetDefmoduleName((VOID *) 
                        CurrentGeneric->header.whichModule->theModule));
      PrintCLIPS(WTRACE,"::");
     }
   PrintCLIPS(WTRACE,ValueToString((VOID *) CurrentGeneric->header.name));
   PrintCLIPS(WTRACE," ");
   PrintCLIPS(WTRACE," ED:");
   PrintLongInteger(WTRACE,(long) CurrentEvaluationDepth);
   PrintProcParamArray(WTRACE);
  }
 
/**********************************************************************
  NAME         : WatchMethod
  DESCRIPTION  : Prints out a trace of the beginning or end
                   of the execution of a generic function
                   method
  INPUTS       : A string to indicate beginning or end of execution
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : Uses the globals CurrentGeneric, CurrentMethod,
                   ProcParamArraySize and ProcParamArray for 
                   other trace info
 **********************************************************************/
static VOID WatchMethod(tstring)
  char *tstring;
  {
   PrintCLIPS(WTRACE,"MTH ");
   PrintCLIPS(WTRACE,tstring);
   PrintCLIPS(WTRACE," ");
   if (CurrentGeneric->header.whichModule->theModule != ((struct defmodule *) GetCurrentModule()))
     {
      PrintCLIPS(WTRACE,GetDefmoduleName((VOID *) 
                        CurrentGeneric->header.whichModule->theModule));
      PrintCLIPS(WTRACE,"::");
     }
   PrintCLIPS(WTRACE,ValueToString((VOID *) CurrentGeneric->header.name));
   PrintCLIPS(WTRACE,":#");
   if (CurrentMethod->system)
     PrintCLIPS(WTRACE,"SYS");
   PrintLongInteger(WTRACE,(long) CurrentMethod->index);
   PrintCLIPS(WTRACE," ");
   PrintCLIPS(WTRACE," ED:");
   PrintLongInteger(WTRACE,(long) CurrentEvaluationDepth);
   PrintProcParamArray(WTRACE);
  }
 
#endif

#if OBJECT_SYSTEM

/***************************************************
  NAME         : DetermineRestrictionClass
  DESCRIPTION  : Finds the class of an argument in
                   the ProcParamArray
  INPUTS       : The argument data object
  RETURNS      : The class address, NULL if error
  SIDE EFFECTS : EvaluationError set on errors
  NOTES        : None
 ***************************************************/
static DEFCLASS *DetermineRestrictionClass(dobj)
  DATA_OBJECT *dobj;
  {
   INSTANCE_TYPE *ins;
   DEFCLASS *cls;
   
   if (dobj->type == INSTANCE_NAME)
     {
      ins = FindInstanceBySymbol((SYMBOL_HN *) dobj->value);
      cls = (ins != NULL) ? ins->cls : NULL;
     }
   else if (dobj->type == INSTANCE_ADDRESS)
     {
      ins = (INSTANCE_TYPE *) dobj->value;
      cls = (ins->garbage == 0) ? ins->cls : NULL;
     }
   else
     return(PrimitiveClassMap[dobj->type]);
   if (cls == NULL)
     {
      SetEvaluationError(CLIPS_TRUE);
      PrintErrorID("GENRCEXE",3,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Unable to determine class of ");
      PrintDataObject(WERROR,dobj);
      PrintCLIPS(WERROR," in generic function ");
      PrintCLIPS(WERROR,GetDefgenericName((VOID *) CurrentGeneric));
      PrintCLIPS(WERROR,".\n");
     }
   return(cls);
  }
  
#endif
 
#endif

/***************************************************
  NAME         : 
  DESCRIPTION  : 
  INPUTS       : 
  RETURNS      : 
  SIDE EFFECTS : 
  NOTES        : 
 ***************************************************/