genrccom.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.05  04/09/97          */
   /*                                                     */
   /*                                                     */
   /*******************************************************/

/*************************************************************/
/* Purpose: CLIPS Generic Functions Interface Routines       */
/*                                                           */
/* Principal Programmer(s):                                  */
/*      Brian L. Donnell                                     */
/*                                                           */
/* Contributing Programmer(s):                               */
/*                                                           */
/* Revision History:                                         */
/*                                                           */
/*************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

#if DEFGENERIC_CONSTRUCT

#if ANSI_COMPILER
#include <string.h>
#endif

#if DEFRULE_CONSTRUCT
#include "network.h"
#endif

#if BLOAD || BLOAD_AND_BSAVE
#include "bload.h"
#endif

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
#include "genrcbin.h"
#endif

#if CONSTRUCT_COMPILER
#include "genrccmp.h"
#endif

#if (! BLOAD_ONLY) && (! RUN_TIME)
#include "constrct.h"
#include "genrcpsr.h"
#endif

#if OBJECT_SYSTEM
#include "classcom.h"
#include "inscom.h"
#endif

#if DEBUGGING_FUNCTIONS
#include "watch.h"
#endif

#include "argacces.h"
#include "clipsmem.h"
#include "cstrcpsr.h"
#include "extnfunc.h"
#include "genrcexe.h"
#include "modulpsr.h"
#include "multifld.h"
#include "router.h"

#define _GENRCCOM_SOURCE_
#include "genrccom.h"

/* =========================================
   *****************************************
                   CONSTANTS
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */
   
/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static VOID PrintGenericCall(char *,VOID *);
static BOOLEAN EvaluateGenericCall(VOID *,DATA_OBJECT *);
static VOID DecrementGenericBusyCount(VOID *);
static VOID IncrementGenericBusyCount(VOID *);

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

static VOID SaveDefgenerics(char *);
static VOID SaveDefmethods(char *);
static VOID SaveDefmethodsForDefgeneric(struct constructHeader *,VOID *);
static VOID RemoveDefgenericMethod(DEFGENERIC *,int);

#endif

#if DEBUGGING_FUNCTIONS
static long ListMethodsForGeneric(char *,DEFGENERIC *);
static BOOLEAN DefgenericWatchAccess(int,int,EXPRESSION *);
static BOOLEAN DefgenericWatchPrint(char *,int,EXPRESSION *);
static BOOLEAN DefmethodWatchAccess(int,int,EXPRESSION *);
static BOOLEAN DefmethodWatchPrint(char *,int,EXPRESSION *);
static BOOLEAN DefmethodWatchSupport(char *,char *,int,
                                     VOID (*)(char *,VOID *,unsigned),
                                     VOID (*)(int,VOID *,unsigned),EXPRESSION *);
static VOID PrintMethodWatchFlag(char *,VOID *,unsigned);
#endif

#else

static VOID PrintGenericCall();
static BOOLEAN EvaluateGenericCall();
static VOID DecrementGenericBusyCount();
static VOID IncrementGenericBusyCount();

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

static VOID SaveDefgenerics();
static VOID SaveDefmethods();
static VOID SaveDefmethodsForDefgeneric();
static VOID RemoveDefgenericMethod();

#endif

#if DEBUGGING_FUNCTIONS
static long ListMethodsForGeneric();
static BOOLEAN DefgenericWatchAccess();
static BOOLEAN DefgenericWatchPrint();
static BOOLEAN DefmethodWatchAccess();
static BOOLEAN DefmethodWatchPrint();
static BOOLEAN DefmethodWatchSupport();
static VOID PrintMethodWatchFlag();
#endif

#endif
      
/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
globle struct construct *DefgenericConstruct;
globle int DefgenericModuleIndex;

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */

static ENTITY_RECORD GenericEntityRecord =
                     { GCALL,0,0,1,
                       PrintGenericCall,PrintGenericCall,
                       NULL,EvaluateGenericCall,NULL,
                       DecrementGenericBusyCount,IncrementGenericBusyCount,
                       NULL,NULL,NULL,NULL };

/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */
   
/***********************************************************
  NAME         : SetupGenericFunctions
  DESCRIPTION  : Initializes all generic function
                   data structures, constructs and functions
  INPUTS       : None
  RETURNS      : Nothing useful
  SIDE EFFECTS : Generic function CLIPS functions set up
  NOTES        : None
 ***********************************************************/
globle VOID SetupGenericFunctions()
  {
   InstallPrimitive(&GenericEntityRecord,GCALL);

   DefgenericModuleIndex = 
                RegisterModuleItem("defgeneric",
#if (! RUN_TIME)
                                    AllocateDefgenericModule,FreeDefgenericModule,
#else
                                    NULL,NULL,
#endif
#if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
                                    BloadDefgenericModuleReference,
#else
                                    NULL,
#endif
#if CONSTRUCT_COMPILER && (! RUN_TIME)
                                    DefgenericCModuleReference,
#else
                                    NULL,
#endif
                                    FindDefgeneric);

   DefgenericConstruct =  AddConstruct("defgeneric","defgenerics",
#if (! BLOAD_ONLY) && (! RUN_TIME)
                                       ParseDefgeneric,
#else
                                       NULL,
#endif
                                       FindDefgeneric,
                                       GetConstructNamePointer,GetConstructPPForm,
                                       GetConstructModuleItem,GetNextDefgeneric,
                                       SetNextConstruct,IsDefgenericDeletable,
                                       Undefgeneric,
#if (! BLOAD_ONLY) && (! RUN_TIME)
                                       RemoveDefgeneric
#else
                                       NULL
#endif
                                       );

#if ! RUN_TIME
   AddClearReadyFunction("defgeneric",ClearDefgenericsReady,0);

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   SetupGenericsBload();
#endif

#if CONSTRUCT_COMPILER
   SetupGenericsCompiler();
#endif

#if ! BLOAD_ONLY
#if DEFMODULE_CONSTRUCT
   AddPortConstructItem("defgeneric",SYMBOL);
#endif
   AddConstruct("defmethod","defmethods",ParseDefmethod,
                NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL);
   
  /* ================================================================
     Make sure defmethods are cleared last, for other constructs may
       be using them and need to be cleared first
       
     Need to be cleared in two stages so that mutually dependent
       constructs (like classes) can be cleared
     ================================================================ */
   AddSaveFunction("defgeneric",SaveDefgenerics,1000);
   AddSaveFunction("defmethod",SaveDefmethods,-1000);
   DefineFunction2("undefgeneric",'v',PTIF UndefgenericCommand,"UndefgenericCommand","11w");
   DefineFunction2("undefmethod",'v',PTIF UndefmethodCommand,"UndefmethodCommand","22*wg");
#endif

#if IMPERATIVE_METHODS
   DefineFunction2("call-next-method",'u',PTIF CallNextMethod,"CallNextMethod","00");
   FuncSeqOvlFlags("call-next-method",CLIPS_TRUE,CLIPS_FALSE);
   DefineFunction2("call-specific-method",'u',PTIF CallSpecificMethod,
                   "CallSpecificMethod","2**wi");
   FuncSeqOvlFlags("call-specific-method",CLIPS_TRUE,CLIPS_FALSE);
   DefineFunction2("override-next-method",'u',PTIF OverrideNextMethod,
                   "OverrideNextMethod",NULL);
   FuncSeqOvlFlags("override-next-method",CLIPS_TRUE,CLIPS_FALSE);
   DefineFunction2("next-methodp",'b',PTIF NextMethodP,"NextMethodP","00");
   FuncSeqOvlFlags("next-methodp",CLIPS_TRUE,CLIPS_FALSE);
#endif
   DefineFunction2("(gnrc-current-arg)",'u',PTIF GetGenericCurrentArgument,
                   "GetGenericCurrentArgument",NULL);

#if DEBUGGING_FUNCTIONS
   DefineFunction2("ppdefgeneric",'v',PTIF PPDefgenericCommand,"PPDefgenericCommand","11w");
   DefineFunction2("list-defgenerics",'v',PTIF ListDefgenericsCommand,"ListDefgenericsCommand","01");
   DefineFunction2("ppdefmethod",'v',PTIF PPDefmethodCommand,"PPDefmethodCommand","22*wi");
   DefineFunction2("list-defmethods",'v',PTIF ListDefmethodsCommand,"ListDefmethodsCommand","01w");
   DefineFunction2("preview-generic",'v',PTIF PreviewGeneric,"PreviewGeneric","1**w");
#endif
   
   DefineFunction2("get-defgeneric-list",'m',PTIF GetDefgenericListFunction,
                   "GetDefgenericListFunction","01");
   DefineFunction2("get-defmethod-list",'m',PTIF GetDefmethodListCommand,
                   "GetDefmethodListCommand","01w");
   DefineFunction2("get-method-restrictions",'m',PTIF GetMethodRestrictionsCommand,
                   "GetMethodRestrictionsCommand","22iw");
   DefineFunction2("defgeneric-module",'w',PTIF GetDefgenericModuleCommand,
                   "GetDefgenericModuleCommand","11w");

#if OBJECT_SYSTEM
   DefineFunction2("type",'u',PTIF ClassCommand,"ClassCommand","11");
#else
   DefineFunction2("type",'u',PTIF TypeCommand,"TypeCommand","11");
#endif

#endif

#if DEBUGGING_FUNCTIONS
   AddWatchItem("generic-functions",0,&WatchGenerics,34,
                DefgenericWatchAccess,DefgenericWatchPrint);
   AddWatchItem("methods",0,&WatchMethods,33,
                DefmethodWatchAccess,DefmethodWatchPrint);
#endif
  }
  
/***************************************************
  NAME         : FindDefgeneric
  DESCRIPTION  : Searches for a generic
  INPUTS       : The name of the generic
                 (possibly including a module name)
  RETURNS      : Pointer to the generic if
                 found, otherwise NULL
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle VOID *FindDefgeneric(genericModuleAndName)
  char *genericModuleAndName;
  {
   return(FindNamedConstruct(genericModuleAndName,DefgenericConstruct));
  }

/***************************************************
  NAME         : LookupDefgenericByMdlOrScope
  DESCRIPTION  : Finds a defgeneric anywhere (if
                 module is specified) or in current
                 or imported modules
  INPUTS       : The defgeneric name
  RETURNS      : The defgeneric (NULL if not found)
  SIDE EFFECTS : Error message printed on
                  ambiguous references
  NOTES        : None
 ***************************************************/
globle DEFGENERIC *LookupDefgenericByMdlOrScope(defgenericName)
  char *defgenericName;
  {
   return((DEFGENERIC *) LookupConstruct(DefgenericConstruct,defgenericName,CLIPS_TRUE));
  }
  
/***************************************************
  NAME         : LookupDefgenericInScope
  DESCRIPTION  : Finds a defgeneric in current or
                   imported modules (module
                   specifier is not allowed)
  INPUTS       : The defgeneric name
  RETURNS      : The defgeneric (NULL if not found)
  SIDE EFFECTS : Error message printed on
                  ambiguous references
  NOTES        : None
 ***************************************************/
globle DEFGENERIC *LookupDefgenericInScope(defgenericName)
  char *defgenericName;
  {
   return((DEFGENERIC *) LookupConstruct(DefgenericConstruct,defgenericName,CLIPS_FALSE));
  }
      
/***********************************************************
  NAME         : GetNextDefgeneric
  DESCRIPTION  : Finds first or next generic function
  INPUTS       : The address of the current generic function
  RETURNS      : The address of the next generic function
                   (NULL if none)
  SIDE EFFECTS : None
  NOTES        : If ptr == NULL, the first generic function
                    is returned.
 ***********************************************************/
globle VOID *GetNextDefgeneric(ptr)
  VOID *ptr;
  {
   return((VOID *) GetNextConstructItem((struct constructHeader *) ptr,DefgenericModuleIndex));
  }
  
/***********************************************************
  NAME         : GetNextDefmethod
  DESCRIPTION  : Find the next method for a generic function
  INPUTS       : 1) The generic function address
                 2) The index of the current method
  RETURNS      : The index of the next method
                    (0 if none)
  SIDE EFFECTS : None
  NOTES        : If index == 0, the index of the first
                   method is returned
 ***********************************************************/
globle unsigned GetNextDefmethod(ptr,index)
  VOID *ptr;
  unsigned index;
  {
   DEFGENERIC *gfunc;
   int mi;
   
   gfunc = (DEFGENERIC *) ptr;
   if (index == 0)
     {
      if (gfunc->methods != NULL)
        return(gfunc->methods[0].index);  
      return(0);
     }
   mi = FindMethodByIndex(gfunc,index);
   if ((mi+1) == gfunc->mcnt)
     return(0);
   return(gfunc->methods[mi+1].index);
  }
  
/***************************************************
  NAME         : IsDefgenericDeletable
  DESCRIPTION  : Determines if a generic function
                   can be deleted
  INPUTS       : Address of the generic function
  RETURNS      : CLIPS_TRUE if deletable, CLIPS_FALSE otherwise
  SIDE EFFECTS : None
  NOTES        : None
 ***************************************************/
globle int IsDefgenericDeletable(ptr)
  VOID *ptr;
  {
#if (MAC_MPW || MAC_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(ptr)
#endif

#if BLOAD_ONLY || RUN_TIME
   return(CLIPS_FALSE);
#else
#if BLOAD || BLOAD_AND_BSAVE
   if (Bloaded())
     return(CLIPS_FALSE);
#endif
   return ((((DEFGENERIC *) ptr)->busy == 0) ? CLIPS_TRUE : CLIPS_FALSE);
#endif
  }

/***************************************************
  NAME         : IsDefmethodDeletable