inherpsr.c

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

   /*******************************************************/
   /*      "C" Language Integrated Production System      */
   /*                                                     */
   /*               CLIPS Version 6.05  04/09/97          */
   /*                                                     */
   /*             MULTIPLE INHERITANCE PARSER MODULE      */
   /*******************************************************/

/**************************************************************/
/* Purpose: Parsing Routines for Multiple Inheritance         */
/*                                                            */
/* Principal Programmer(s):                                   */
/*      Brian L. Donnell                                      */
/*                                                            */
/* Contributing Programmer(s):                                */
/*                                                            */
/* Revision History:                                          */
/*                                                            */
/**************************************************************/
   
/* =========================================
   *****************************************
               EXTERNAL DEFINITIONS
   =========================================
   ***************************************** */
#include "setup.h"

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

#include "classcom.h"
#include "classfun.h"
#include "clipsmem.h"
#include "modulutl.h"
#include "router.h"
#include "scanner.h"

#define _INHERPSR_SOURCE_
#include "inherpsr.h"

extern struct token ObjectParseToken;

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

/* =========================================
   *****************************************
               MACROS AND TYPES
   =========================================
   ***************************************** */
typedef struct partialOrder PARTIAL_ORDER;
typedef struct successor SUCCESSOR;

struct partialOrder
  {
   DEFCLASS *cls;
   unsigned pre;
   SUCCESSOR *suc;
   struct partialOrder *nxt;
  };
 
struct successor
  {
   PARTIAL_ORDER *po;
   struct successor *nxt;
  };
  
/* =========================================
   *****************************************
      INTERNALLY VISIBLE FUNCTION HEADERS
   =========================================
   ***************************************** */
#if ANSI_COMPILER

static PARTIAL_ORDER *InitializePartialOrderTable(PARTIAL_ORDER *,PACKED_CLASS_LINKS *);
static VOID RecordPartialOrders(PARTIAL_ORDER *,DEFCLASS *,PACKED_CLASS_LINKS *,unsigned);
static PARTIAL_ORDER *FindPartialOrder(PARTIAL_ORDER *,DEFCLASS *);
static VOID PrintPartialOrderLoop(PARTIAL_ORDER *);
static VOID PrintClassLinks(char *,char *,CLASS_LINK *);

#else

static PARTIAL_ORDER *InitializePartialOrderTable();
static VOID RecordPartialOrders();
static PARTIAL_ORDER *FindPartialOrder();
static VOID PrintPartialOrderLoop();
static VOID PrintClassLinks();

#endif

/* =========================================
   *****************************************
      EXTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */

/* =========================================
   *****************************************
      INTERNALLY VISIBLE GLOBAL VARIABLES
   =========================================
   ***************************************** */
    
/* =========================================
   *****************************************
          EXTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/**************************************************************
  NAME         : ParseSuperclasses
  DESCRIPTION  : Parses the (is-a <superclass>+) portion of
                 the (defclass ...) construct and returns
                 a list of direct superclasses.  The
                 class "standard-class" is the precedence list 
                 for classes with no direct superclasses.
                 The final precedence list (not calculated here)
                 will have the class in question first followed
                 by the merged precedence lists of its direct
                 superclasses.
  INPUTS       : 1) The logical name of the input source
                 2) The symbolic name of the new class
  RETURNS      : The address of the superclass list
                  or NULL if there was an error
  SIDE EFFECTS : None
  NOTES        : Assumes "(defclass <name> [<comment>] (" 
                 has already been scanned.
                 
                 All superclasses must be defined before
                 their subclasses.  Duplicates in the (is-a
                 ...) list are are not allowed (a class may only
                 inherits from a superclass once).
                 
                 This routine also checks the class-precedence
                 lists of each of the direct superclasses for
                 an occurrence of the new class - i.e. cycles!
                 This can only happen when a class is redefined
                 (a new class cannot have an unspecified
                 superclass).
                 
                 This routine allocates the space for the list
 ***************************************************************/
globle PACKED_CLASS_LINKS *ParseSuperclasses(readSource,newClassName)
  char *readSource;
  SYMBOL_HN *newClassName;
  {
   CLASS_LINK *clink = NULL,*cbot = NULL,*ctmp;
   DEFCLASS *sclass;
   PACKED_CLASS_LINKS *plinks;
   
   if (GetType(ObjectParseToken) != LPAREN)
     {
      SyntaxErrorMessage("defclass inheritance");
      return(NULL);
     }
   GetToken(readSource,&ObjectParseToken);
   if ((GetType(ObjectParseToken) != SYMBOL) ? CLIPS_TRUE :
       (ObjectParseToken.value != (VOID *) ISA_SYMBOL)) 
     {
      SyntaxErrorMessage("defclass inheritance");
      return(NULL);
     }
   SavePPBuffer(" ");
   GetToken(readSource,&ObjectParseToken);
   while (GetType(ObjectParseToken) != RPAREN)
     {
      if (GetType(ObjectParseToken) != SYMBOL)
        {
         SyntaxErrorMessage("defclass");
         goto SuperclassParseError;
        }
      if (FindModuleSeparator(ValueToString(newClassName)))
        {
         IllegalModuleSpecifierMessage();
         goto SuperclassParseError;
        }
      if (GetValue(ObjectParseToken) == (VOID *) newClassName)
        {
         PrintErrorID("INHERPSR",1,CLIPS_FALSE);
         PrintCLIPS(WERROR,"A class may not have itself as a superclass.\n");
         goto SuperclassParseError;
        }
      for (ctmp = clink ; ctmp != NULL ; ctmp = ctmp->nxt)
        {
         if (GetValue(ObjectParseToken) == (VOID *) ctmp->cls->header.name)
           {
            PrintErrorID("INHERPSR",2,CLIPS_FALSE);
            PrintCLIPS(WERROR,"A class may inherit from a superclass only once.\n");
            goto SuperclassParseError;
           }
        }
      sclass = LookupDefclassInScope(ValueToString(GetValue(ObjectParseToken)));  
      if (sclass == NULL)
        { 
         PrintErrorID("INHERPSR",3,CLIPS_FALSE);
         PrintCLIPS(WERROR,"A class must be defined after all its superclasses.\n");
         goto SuperclassParseError;
        }
      if ((sclass == PrimitiveClassMap[INSTANCE_NAME]) ||
          (sclass == PrimitiveClassMap[INSTANCE_ADDRESS]) ||
          (sclass == PrimitiveClassMap[INSTANCE_NAME]->directSuperclasses.classArray[0]))
        {
         PrintErrorID("INHERPSR",6,CLIPS_FALSE);
         PrintCLIPS(WERROR,"A user-defined class cannot be a subclass of ");
         PrintCLIPS(WERROR,GetDefclassName((VOID *) sclass));
         PrintCLIPS(WERROR,".\n");
         goto SuperclassParseError;
        }
      ctmp = get_struct(classLink);
      ctmp->cls = sclass;
      if (clink == NULL)
        clink = ctmp;
      else
        cbot->nxt = ctmp;
      ctmp->nxt = NULL;
      cbot = ctmp;          
     
      SavePPBuffer(" ");
      GetToken(readSource,&ObjectParseToken);
     }
   if (clink == NULL)
     {
      PrintErrorID("INHERPSR",4,CLIPS_FALSE);
      PrintCLIPS(WERROR,"Must have at least one superclass.\n");
      return(NULL);
     }
   PPBackup();
   PPBackup();
   SavePPBuffer(")");
   plinks = get_struct(packedClassLinks);
   PackClassLinks(plinks,clink);
   return(plinks);

SuperclassParseError:
   DeleteClassLinks(clink);
   return(NULL);
  }
  
/***************************************************************************
  NAME         : FindPrecedenceList
  DESCRIPTION  : A complete class precedence list is obtained from the
                 list of direct superclasses as follows :
                 
                 Each class and its direct superclasses are recursively
                 entered in order to a list called the partial order table.
                 A class is only entered once.  The order reflects a pre-order
                 depth-first traversal of the classes, and this order will be
                 followed as closely as possible to preserve the "family"
                 heuristic when constructing the class precedence list.
                 
                 Attached to each node is a count indicating the number of
                 classes which must precede this class and a list of classes
                 which must succeed this class (attached via the suc field and
                 linked via nxt fields).  These predecessor counts
                 and successor lists indicate the partial orderings given
                 by the rules of multiple inheritance for the classes:
                 1) a class must precede all its superclasses, and 2) a
                 class determines the precedence of its immediate superclasses.
                 
                 For example, the following class definitions
                 
                 (defclass A (is-a USER))
                 (defclass B (is-a USER))
                 (defclass C (is-a A B))
                 
                 would give the following partial orders:
                 
                 C < A          by Rule 1
                 C < B          by Rule 1
                 A < B          by Rule 2
                 B < USER       by Rule 1
                 A < USER       by Rule 1
                 USER < OBJECT  by Rule 1
                 
                 In turn, these partial orders would be recorded in a
                 sequence table:
                 
                                     C     A      USER    OBJECT    B
                 Predecessor Count   0     1       2        1       2
                 Successor List     A,B  B,USER  OBJECT   <NIL>    USER
                 
                 To generate a precedence list for C, we pick the first
                 class with a predecessor count of 0, append it to the
                 precedence list, and decrement the counts of all its
                 successors.  We continue scanning for a 0 from where
                 we left off.  If we ever scan completely through the
                 table without finding a 0, then we know there is an
                 error.