genrccom.c

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

   return(gfunc->methods[mi].ppForm);
  }

/***************************************************
  NAME         : ListDefgenericsCommand
  DESCRIPTION  : Displays all defgeneric names
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric names printed
  NOTES        : CLIPS Interface
 ***************************************************/
globle VOID ListDefgenericsCommand()
  {
   ListConstructCommand("list-defgenerics",DefgenericConstruct);
  }

/***************************************************
  NAME         : ListDefgenerics
  DESCRIPTION  : Displays all defgeneric names
  INPUTS       : 1) The logical name of the output
                 2) The module
  RETURNS      : Nothing useful
  SIDE EFFECTS : Defgeneric names printed
  NOTES        : C Interface
 ***************************************************/
globle VOID ListDefgenerics(logicalName,theModule)
  char *logicalName;
  struct defmodule *theModule;
  {
   ListConstruct(DefgenericConstruct,logicalName,theModule);
  }

/******************************************************
  NAME         : ListDefmethods
  DESCRIPTION  : Lists a brief description of methods
                   for a particular generic function
  INPUTS       : 1) The logical name of the output
                 2) Generic function to list methods for
                    (NULL means list all methods)
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ******************************************************/
globle VOID ListDefmethods(logicalName,vptr)
  char *logicalName;
  VOID *vptr;
  {
   DEFGENERIC *gfunc;
   long count;
   
   if (vptr != NULL)
     count = ListMethodsForGeneric(logicalName,(DEFGENERIC *) vptr);
   else
     {
      count = 0L;
      for (gfunc = (DEFGENERIC *) GetNextDefgeneric(NULL) ;
           gfunc != NULL ;
           gfunc = (DEFGENERIC *) GetNextDefgeneric((VOID *) gfunc))
        {
         count += ListMethodsForGeneric(logicalName,gfunc);
         if (GetNextDefgeneric((VOID *) gfunc) != NULL)
           PrintCLIPS(logicalName,"\n");
        }
     }
   PrintTally(logicalName,count,"method","methods");
  }

#endif

/***************************************************************
  NAME         : GetDefgenericListFunction
  DESCRIPTION  : Groups all defgeneric names into
                 a multifield list
  INPUTS       : A data object buffer to hold
                 the multifield result
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : CLIPS Syntax: (get-defgeneric-list [<module>])
 ***************************************************************/
globle VOID GetDefgenericListFunction(returnValue)
  DATA_OBJECT*returnValue;
  {
   GetConstructListFunction("get-defgeneric-list",returnValue,DefgenericConstruct);
  }

/***************************************************************
  NAME         : GetDefgenericList
  DESCRIPTION  : Groups all defgeneric names into
                 a multifield list
  INPUTS       : 1) A data object buffer to hold
                    the multifield result
                 2) The module from which to obtain defgenerics
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield allocated and filled
  NOTES        : External C access
 ***************************************************************/
globle VOID GetDefgenericList(returnValue,theModule)
  DATA_OBJECT *returnValue;
  struct defmodule *theModule;
  {
   GetConstructList(returnValue,DefgenericConstruct,theModule);
  }
  
/***********************************************************
  NAME         : GetDefmethodListCommand
  DESCRIPTION  : Groups indices of all methdos for a generic
                 function into a multifield variable
                 (NULL means get methods for all generics)
  INPUTS       : A data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield set to list of method indices
  NOTES        : None
 ***********************************************************/
globle VOID GetDefmethodListCommand(returnValue)
  DATA_OBJECT_PTR returnValue;
  {
   DATA_OBJECT temp;
   DEFGENERIC *gfunc;
   
   if (RtnArgCount() == 0)
     GetDefmethodList(NULL,returnValue);
   else
     {
      if (ArgTypeCheck("get-defmethod-list",1,SYMBOL,&temp) == CLIPS_FALSE)
        {
         SetMultifieldErrorValue(returnValue);
         return;
        }
      gfunc = CheckGenericExists("get-defmethod-list",DOToString(temp));
      if (gfunc != NULL)
        GetDefmethodList((VOID *) gfunc,returnValue);
      else
        SetMultifieldErrorValue(returnValue);
     }
  }
  
/***********************************************************
  NAME         : GetDefmethodList
  DESCRIPTION  : Groups indices of all methdos for a generic
                 function into a multifield variable
                 (NULL means get methods for all generics)
  INPUTS       : 1) A pointer to a generic function
                 2) A data object buffer
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield set to list of method indices
  NOTES        : None
 ***********************************************************/
globle VOID GetDefmethodList(vgfunc,returnValue)
  VOID *vgfunc;
  DATA_OBJECT_PTR returnValue;
  {
   DEFGENERIC *gfunc,*svg,*svnxt;
   int i,j;
   long count; /* 6.04 Bug Fix */
   MULTIFIELD_PTR theList;
   
   if (vgfunc != NULL)
     {
      gfunc = (DEFGENERIC *) vgfunc;
      svnxt = (DEFGENERIC *) GetNextDefgeneric(vgfunc);
      SetNextDefgeneric(vgfunc,NULL);
     }
   else
     {
      gfunc = (DEFGENERIC *) GetNextDefgeneric(NULL);
      svnxt = (gfunc != NULL) ? (DEFGENERIC *) GetNextDefgeneric((VOID *) gfunc) : NULL;
     }
   count = 0;
   for (svg = gfunc ;
        gfunc != NULL ;
        gfunc = (DEFGENERIC *) GetNextDefgeneric((VOID *) gfunc))
     count += (int) gfunc->mcnt;
   count *= 2;
   SetpType(returnValue,MULTIFIELD);
   SetpDOBegin(returnValue,1);
   SetpDOEnd(returnValue,count);
   theList = (MULTIFIELD_PTR) CreateMultifield(count);
   SetpValue(returnValue,theList);
   for (gfunc = svg , i = 1 ;
        gfunc != NULL ;
        gfunc = (DEFGENERIC *) GetNextDefgeneric((VOID *) gfunc))
     {
      for (j = 0 ; j < gfunc->mcnt ; j++)
        {
         SetMFType(theList,i,SYMBOL);
         SetMFValue(theList,i++,GetDefgenericNamePointer((VOID *) gfunc));
         SetMFType(theList,i,INTEGER);
         SetMFValue(theList,i++,AddLong((long) gfunc->methods[j].index));
        }
     }
   if (svg != NULL)
     SetNextDefgeneric((VOID *) svg,(VOID *) svnxt);
  }

/***********************************************************************************
  NAME         : GetMethodRestrictionsCommand
  DESCRIPTION  : Stores restrictions of a method in multifield
  INPUTS       : A data object buffer to hold a multifield
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield created (length zero on errors)
  NOTES        : Syntax: (get-method-restrictions <generic-function> <method-index>)
 ***********************************************************************************/
globle VOID GetMethodRestrictionsCommand(result)
  DATA_OBJECT *result;
  {
   DATA_OBJECT temp;
   DEFGENERIC *gfunc;
   
   if (ArgTypeCheck("get-method-restrictions",1,SYMBOL,&temp) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   gfunc = CheckGenericExists("get-method-restrictions",DOToString(temp));
   if (gfunc == NULL)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   if (ArgTypeCheck("get-method-restrictions",2,INTEGER,&temp) == CLIPS_FALSE)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   if (CheckMethodExists("get-method-restrictions",gfunc,DOToInteger(temp)) == -1)
     {
      SetMultifieldErrorValue(result);
      return;
     }
   GetMethodRestrictions((VOID *) gfunc,(unsigned) DOToInteger(temp),result);
  }
  
/***********************************************************************
  NAME         : GetMethodRestrictions
  DESCRIPTION  : Stores restrictions of a method in multifield
  INPUTS       : 1) Pointer to the generic function
                 2) The method index
                 3) A data object buffer to hold a multifield
  RETURNS      : Nothing useful
  SIDE EFFECTS : Multifield created (length zero on errors)
  NOTES        : The restrictions are stored in the multifield
                 in the following format:
                 
                 <min-number-of-arguments>
                 <max-number-of-arguments> (-1 if wildcard allowed)
                 <restriction-count>
                 <index of 1st restriction>
                       .
                       .
                 <index of nth restriction>
                 <restriction 1>
                     <query TRUE/FALSE>
                     <number-of-classes>
                     <class 1>
                        .
                        .
                     <class n>
                    .
                    .
                    .
                  <restriction n>
                  
                  Thus, for the method
                  (defmethod foo ((?a NUMBER SYMBOL) (?b (= 1 1)) $?c))
                  (get-method-restrictions foo 1) would yield
                  
                  (2 -1 3 7 11 13 FALSE 2 NUMBER SYMBOL TRUE 0 FALSE 0)
 ***********************************************************************/
globle VOID GetMethodRestrictions(vgfunc,mi,result)
  VOID *vgfunc;
  unsigned mi;
  DATA_OBJECT *result;
  {
   register int i,j;
   register DEFMETHOD *meth;
   register RESTRICTION *rptr;
   int count,roffset,rindex;
   MULTIFIELD_PTR theList;
   
   meth = ((DEFGENERIC *) vgfunc)->methods + FindMethodByIndex((DEFGENERIC *) vgfunc,mi);
   count = 3;
   for (i = 0 ; i < meth->restrictionCount ; i++)
     count += meth->restrictions[i].tcnt + 3;
   theList = (MULTIFIELD_PTR) CreateMultifield(count);
   SetpType(result,MULTIFIELD);
   SetpValue(result,theList);
   SetpDOBegin(result,1);
   SetpDOEnd(result,count);
   SetMFType(theList,1,INTEGER);
   SetMFValue(theList,1,AddLong((long) meth->minRestrictions));
   SetMFType(theList,2,INTEGER);
   SetMFValue(theList,2,AddLong((long) meth->maxRestrictions));
   SetMFType(theList,3,INTEGER);
   SetMFValue(theList,3,AddLong((long) meth->restrictionCount));
   roffset = 3 + meth->restrictionCount + 1;
   rindex = 4;
   for (i = 0 ; i < meth->restrictionCount ; i++)
     {
      rptr = meth->restrictions + i;
      SetMFType(theList,rindex,INTEGER);
      SetMFValue(theList,rindex++,AddLong((long) roffset));
      SetMFType(theList,roffset,SYMBOL);
      SetMFValue(theList,roffset++,(rptr->query != NULL) ? CLIPSTrueSymbol : CLIPSFalseSymbol);
      SetMFType(theList,roffset,INTEGER);
      SetMFValue(theList,roffset++,AddLong((long) rptr->tcnt));
      for (j = 0 ; j < rptr->tcnt ; j++)
        {
         SetMFType(theList,roffset,SYMBOL);
#if OBJECT_SYSTEM
         SetMFValue(theList,roffset++,AddSymbol(GetDefclassName(rptr->types[j])));
#else
         SetMFValue(theList,roffset++,AddSymbol(TypeName(ValueToInteger(rptr->types[j]))));
#endif
        }
     }
  }
  
/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***************************************************
  NAME         : PrintGenericCall
  DESCRIPTION  : PrintExpression() support function
                 for generic function calls
  INPUTS       : 1) The output logical name
                 2) The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : Call expression printed
  NOTES        : None
 ***************************************************/
#if IBM_TBC && (! DEVELOPER)
#pragma argsused
#endif
static VOID PrintGenericCall(log,value)
  char *log;
  VOID *value;
  {
#if DEVELOPER
   PrintCLIPS(log,"(");
   PrintCLIPS(log,GetDefgenericName(value));
   if (GetFirstArgument() != NULL)
     {
      PrintCLIPS(log," ");
      PrintExpression(log,GetFirstArgument());
     }
   PrintCLIPS(log,")");
#else
#if MAC_MPW || MAC_MCW
#pragma unused(log)
#pragma unused(value)
#endif
#endif
  }

/*******************************************************
  NAME         : EvaluateGenericCall
  DESCRIPTION  : Primitive support function for
                 calling a generic function
  INPUTS       : 1) The generic function
                 2) A data object buffer to hold
                    the evaluation result
  RETURNS      : CLIPS_FALSE if the generic function
                 returns the symbol FALSE,
                 CLIPS_TRUE otherwise
  SIDE EFFECTS : Data obejct buffer set and any
                 side-effects of calling the generic
  NOTES        : None
 *******************************************************/
static BOOLEAN EvaluateGenericCall(value,result)
  VOID *value;
  DATA_OBJECT *result;
  {
   GenericDispatch((DEFGENERIC *) value,NULL,NULL,GetFirstArgument(),result);
   if ((GetpType(result) == SYMBOL) &&
       (GetpValue(result) == CLIPSFalseSymbol))
     return(CLIPS_FALSE);
   return(CLIPS_TRUE);
  }

/***************************************************
  NAME         : DecrementGenericBusyCount
  DESCRIPTION  : Lowers the busy count of a
                 generic function construct
  INPUTS       : The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : Busy count decremented if a clear
                 is not in progress (see comment)
  NOTES        : None
 ***************************************************/
static VOID DecrementGenericBusyCount(value)
  VOID *value;
  {
   /* ==============================================
      The generics to which expressions in other
      constructs may refer may already have been
      deleted - thus, it is important not to modify
      the busy flag during a clear.
      ============================================== */
   if (! ClearInProgress)
     ((DEFGENERIC *) value)->busy--;
  }

/***************************************************
  NAME         : IncrementGenericBusyCount
  DESCRIPTION  : Raises the busy count of a
                 generic function construct
  INPUTS       : The generic function
  RETURNS      : Nothing useful
  SIDE EFFECTS : Busy count incremented
  NOTES        : None
 ***************************************************/
static VOID IncrementGenericBusyCount(value)
  VOID *value;
  {
   ((DEFGENERIC *) value)->busy++;
  }

#if (! BLOAD_ONLY) && (! RUN_TIME)

/**********************************************************************
  NAME         : SaveDefgenerics
  DESCRIPTION  : Outputs pretty-print forms of generic function headers
  INPUTS       : The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 **********************************************************************/