genrccom.c

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

static VOID SaveDefgenerics(log)
  char *log;
  {
   SaveConstruct(log,DefgenericConstruct);
  }

/**********************************************************************
  NAME         : SaveDefmethods
  DESCRIPTION  : Outputs pretty-print forms of generic function methods
  INPUTS       : The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 **********************************************************************/
static VOID SaveDefmethods(log)
  char *log;
  {
   DoForAllConstructs(SaveDefmethodsForDefgeneric,DefgenericModuleIndex,
                      CLIPS_FALSE,(VOID *) log);
  }
  
/***************************************************
  NAME         : SaveDefmethodsForDefgeneric
  DESCRIPTION  : Save the pretty-print forms of
                 all methods for a generic function
                 to a file
  INPUTS       : 1) The defgeneric
                 2) The logical name of the output
  RETURNS      : Nothing useful
  SIDE EFFECTS : Methods written
  NOTES        : None
 ***************************************************/
static VOID SaveDefmethodsForDefgeneric(theDefgeneric,userBuffer)
  struct constructHeader *theDefgeneric;
  VOID *userBuffer;
  {
   DEFGENERIC *gfunc = (DEFGENERIC *) theDefgeneric;
   char *log = (char *) userBuffer;
   register unsigned i;
   
   for (i = 0 ; i < gfunc->mcnt ; i++)
     {
      if (gfunc->methods[i].ppForm != NULL)
        {
         PrintInChunks(log,gfunc->methods[i].ppForm);
         PrintCLIPS(log,"\n");
        }
     }
  }

/****************************************************
  NAME         : RemoveDefgenericMethod
  DESCRIPTION  : Removes a generic function method
                   from the array and removes the
                   generic too if its the last method
  INPUTS       : 1) The generic function
                 2) The array index of the method
  RETURNS      : Nothing useful
  SIDE EFFECTS : List adjusted
                 Nodes deallocated
  NOTES        : Assumes deletion is safe
 ****************************************************/
static VOID RemoveDefgenericMethod(gfunc,gi)
  DEFGENERIC *gfunc;
  int gi;
  {
   DEFMETHOD *narr;
   register int b,e;
   
   if (gfunc->methods[gi].system)
     {
      SetEvaluationError(CLIPS_TRUE);
      PrintErrorID("GENRCCOM",4,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Cannot remove implicit system function method for generic function ");
      PrintCLIPS(WERROR,GetDefgenericName((VOID *) gfunc));
      PrintCLIPS(WERROR,".\n");
      return;
     }
   DeleteMethodInfo(gfunc,&gfunc->methods[gi]);
   if (gfunc->mcnt == 1)
     {
      rm((VOID *) gfunc->methods,(int) sizeof(DEFMETHOD));
      gfunc->mcnt = 0;
      gfunc->methods = NULL;
     }
   else
     {
      gfunc->mcnt--;
      narr = (DEFMETHOD *) gm2((int) (sizeof(DEFMETHOD) * gfunc->mcnt));
      for (b = e = 0 ; b < gfunc->mcnt ; b++ , e++)
        {
         if (b == gi)
           e++;
         CopyMemory(DEFMETHOD,1,&narr[b],&gfunc->methods[e]);
        }
      rm((VOID *) gfunc->methods,(int) (sizeof(DEFMETHOD) * (gfunc->mcnt+1)));
      gfunc->methods = narr;
     }
  }

#endif
  
#if DEBUGGING_FUNCTIONS

/******************************************************
  NAME         : ListMethodsForGeneric
  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
  RETURNS      : The number of methods printed
  SIDE EFFECTS : None
  NOTES        : None
 ******************************************************/
static long ListMethodsForGeneric(logicalName,gfunc)
  char *logicalName;
  DEFGENERIC *gfunc;
  {
   int gi;
   char buf[256];

   for (gi = 0 ; gi < gfunc->mcnt ; gi++)
     {
      PrintCLIPS(logicalName,GetDefgenericName((VOID *) gfunc));
      PrintCLIPS(logicalName," #");
      PrintMethod(buf,255,&gfunc->methods[gi]);
      PrintCLIPS(logicalName,buf);
      PrintCLIPS(logicalName,"\n");
     }
   return((long) gfunc->mcnt);
  }

/******************************************************************
  NAME         : DefgenericWatchAccess
  DESCRIPTION  : Parses a list of generic names passed by
                 AddWatchItem() and sets the traces accordingly
  INPUTS       : 1) A code indicating which trace flag is to be set
                    Ignored
                 2) The value to which to set the trace flags
                 3) A list of expressions containing the names
                    of the generics for which to set traces
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Watch flags set in specified generics
  NOTES        : Accessory function for AddWatchItem()
 ******************************************************************/
#if IBM_TBC
#pragma argsused
#endif
static BOOLEAN DefgenericWatchAccess(code,newState,argExprs)
  int code,newState;
  EXPRESSION *argExprs;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(code)
#endif
   return(ConstructSetWatchAccess(DefgenericConstruct,newState,argExprs,
                                    GetDefgenericWatch,SetDefgenericWatch));
  }
  
/***********************************************************************
  NAME         : DefgenericWatchPrint
  DESCRIPTION  : Parses a list of generic names passed by
                 AddWatchItem() and displays the traces accordingly
  INPUTS       : 1) The logical name of the output
                 2) A code indicating which trace flag is to be examined
                    Ignored
                 3) A list of expressions containing the names
                    of the generics for which to examine traces
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Watch flags displayed for specified generics
  NOTES        : Accessory function for AddWatchItem()
 ***********************************************************************/
#if IBM_TBC
#pragma argsused
#endif
static BOOLEAN DefgenericWatchPrint(log,code,argExprs)
  char *log;
  int code;
  EXPRESSION *argExprs;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(code)
#endif
   return(ConstructPrintWatchAccess(DefgenericConstruct,log,argExprs,
                                    GetDefgenericWatch,SetDefgenericWatch));
  }
  
/******************************************************************
  NAME         : DefmethodWatchAccess
  DESCRIPTION  : Parses a list of methods passed by
                 AddWatchItem() and sets the traces accordingly
  INPUTS       : 1) A code indicating which trace flag is to be set
                    Ignored
                 2) The value to which to set the trace flags
                 3) A list of expressions containing the methods
                   for which to set traces
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Watch flags set in specified methods
  NOTES        : Accessory function for AddWatchItem()
 ******************************************************************/
#if IBM_TBC
#pragma argsused
#endif
static BOOLEAN DefmethodWatchAccess(code,newState,argExprs)
  int code,newState;
  EXPRESSION *argExprs;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(code)
#endif
   return(DefmethodWatchSupport(newState ? "watch" : "unwatch",NULL,
                                newState,NULL,SetDefmethodWatch,argExprs));
  }
  
/***********************************************************************
  NAME         : DefmethodWatchPrint
  DESCRIPTION  : Parses a list of methods passed by
                 AddWatchItem() and displays the traces accordingly
  INPUTS       : 1) The logical name of the output
                 2) A code indicating which trace flag is to be examined
                    Ignored
                 3) A list of expressions containing the methods for
                    which to examine traces
  RETURNS      : CLIPS_TRUE if all OK, CLIPS_FALSE otherwise
  SIDE EFFECTS : Watch flags displayed for specified methods
  NOTES        : Accessory function for AddWatchItem()
 ***********************************************************************/
#if IBM_TBC
#pragma argsused
#endif
static BOOLEAN DefmethodWatchPrint(log,code,argExprs)
  char *log;
  int code;
  EXPRESSION *argExprs;
  {
#if MAC_MPW || MAC_MCW
#pragma unused(code)
#endif
   return(DefmethodWatchSupport("list-watch-items",log,-1,
                                PrintMethodWatchFlag,NULL,argExprs));
  }

/*******************************************************
  NAME         : DefmethodWatchSupport
  DESCRIPTION  : Sets or displays methods specified
  INPUTS       : 1) The calling function name
                 2) The logical output name for displays
                    (can be NULL)
                 3) The new set state (can be -1)
                 4) The print function (can be NULL)
                 5) The trace function (can be NULL)
                 6) The methods expression list
  RETURNS      : CLIPS_TRUE if all OK,
                 CLIPS_FALSE otherwise
  SIDE EFFECTS : Method trace flags set or displayed
  NOTES        : None
 *******************************************************/
static BOOLEAN DefmethodWatchSupport(funcName,log,newState,printFunc,traceFunc,argExprs)
  char *funcName,*log;
  int newState;
#if ANSI_COMPILER
  VOID (*printFunc)(char *,VOID *,unsigned);
  VOID (*traceFunc)(int,VOID *,unsigned);
#else
  VOID (*printFunc)();
  VOID (*traceFunc)();
#endif
  EXPRESSION *argExprs;
  {
   VOID *theGeneric;
   unsigned theMethod;
   int argIndex = 2;
   DATA_OBJECT genericName,methodIndex;
   struct defmodule *theModule;
   
   /* ==============================
      If no methods are specified,
      show the trace for all methods
      in all generics
      ============================== */
   if (argExprs == NULL)
     {
      SaveCurrentModule();
      theModule = (struct defmodule *) GetNextDefmodule(NULL);
      while (theModule != NULL)
        {
         SetCurrentModule((VOID *) theModule);
         if (traceFunc == NULL)
           {
            PrintCLIPS(log,GetDefmoduleName((VOID *) theModule));
            PrintCLIPS(log,":\n");
           }
         theGeneric = GetNextDefgeneric(NULL);
         while (theGeneric != NULL)
            {
             theMethod = GetNextDefmethod(theGeneric,0);
             while (theMethod != 0)
               {
                if (traceFunc != NULL)
                  (*traceFunc)(newState,theGeneric,theMethod);
                else
                  {
                   PrintCLIPS(log,"   ");
                   (*printFunc)(log,theGeneric,theMethod);
                  }
                theMethod = GetNextDefmethod(theGeneric,theMethod);
               }
             theGeneric = GetNextDefgeneric(theGeneric);
            }
         theModule = (struct defmodule *) GetNextDefmodule((VOID *) theModule);
        }
      RestoreCurrentModule();
      return(CLIPS_TRUE);
     }
     
   /* =========================================
      Set the traces for every method specified
      ========================================= */
   while (argExprs != NULL)
     {
      if (EvaluateExpression(argExprs,&genericName))
        return(CLIPS_FALSE);
      if ((genericName.type != SYMBOL) ? CLIPS_TRUE :
          ((theGeneric = (VOID *) 
              LookupDefgenericByMdlOrScope(DOToString(genericName))) == NULL))
        {
         ExpectedTypeError1(funcName,argIndex,"generic function name");
         return(CLIPS_FALSE);
        }
      if (GetNextArgument(argExprs) == NULL)
        theMethod = 0;
      else
        {
         argExprs = GetNextArgument(argExprs);
         argIndex++;
         if (EvaluateExpression(argExprs,&methodIndex))
           return(CLIPS_FALSE);
         if ((methodIndex.type != INTEGER) ? CLIPS_FALSE :
             ((DOToInteger(methodIndex) <= 0) ? CLIPS_FALSE :
              (FindMethodByIndex((DEFGENERIC *) theGeneric,theMethod) != -1)))
           theMethod = (unsigned) DOToInteger(methodIndex);
         else
           {
            ExpectedTypeError1(funcName,argIndex,"method index");
            return(CLIPS_FALSE);
           }
        }
      if (theMethod == 0)
        {
         theMethod = GetNextDefmethod(theGeneric,0);
         while (theMethod != 0)
           {
            if (traceFunc != NULL)
              (*traceFunc)(newState,theGeneric,theMethod);
            else
              (*printFunc)(log,theGeneric,theMethod);
            theMethod = GetNextDefmethod(theGeneric,theMethod);
           }
        }
      else
        {
         if (traceFunc != NULL)
           (*traceFunc)(newState,theGeneric,theMethod);
         else
           (*printFunc)(log,theGeneric,theMethod);
        }
      argExprs = GetNextArgument(argExprs);
      argIndex++;
     }
   return(CLIPS_TRUE);
  }

/***************************************************
  NAME         : PrintMethodWatchFlag
  DESCRIPTION  : Displays trace value for method
  INPUTS       : 1) The logical name of the output
                 2) The generic function
                 3) The method index
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
static VOID PrintMethodWatchFlag(log,theGeneric,theMethod)
  char *log;
  VOID *theGeneric;
  unsigned theMethod;
  {
   char buf[60];

   PrintCLIPS(log,GetDefgenericName(theGeneric));
   PrintCLIPS(log," ");
   GetDefmethodDescription(buf,59,theGeneric,theMethod);
   PrintCLIPS(log,buf);
   PrintCLIPS(log,GetDefmethodWatch(theGeneric,theMethod) ? " = on\n" : " = off\n");
  }
    
#endif

#if ! OBJECT_SYSTEM

/***************************************************
  NAME         : TypeCommand
  DESCRIPTION  : Works like "class" in COOL
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : None
  NOTES        : CLIPS Syntax: (type <primitive>)
 ***************************************************/
globle VOID TypeCommand(result)
  DATA_OBJECT *result;
  {
   EvaluateExpression(GetFirstArgument(),result);
   result->value = (VOID *) AddSymbol(TypeName(result->type));
   result->type = SYMBOL;
  }
  
#endif

#endif

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