classpsr.c

clips源代码

      respond to pattern-matching
      ================================================================ */
   if (abstract && reactive)
     {
      PrintErrorID(theEnv,"CLASSPSR",1,FALSE);
      EnvPrintRouter(theEnv,WERROR,"An abstract class cannot be reactive.\n");
      DeletePackedClassLinks(theEnv,sclasses,TRUE);
      DeletePackedClassLinks(theEnv,preclist,TRUE);
      DeleteSlots(theEnv,slots);
      return(TRUE);
     }

#endif

   /* =======================================================
      If we're only checking syntax, don't add the
      successfully parsed defclass to the KB.
      ======================================================= */

   if (ConstructData(theEnv)->CheckSyntaxMode)
     {
      DeletePackedClassLinks(theEnv,sclasses,TRUE);
      DeletePackedClassLinks(theEnv,preclist,TRUE);
      DeleteSlots(theEnv,slots);
      return(FALSE);
     }

   cls = NewClass(theEnv,cname);
   cls->abstract = abstract;
#if DEFRULE_CONSTRUCT
   cls->reactive = reactive;
#endif
   cls->directSuperclasses.classCount = sclasses->classCount;
   cls->directSuperclasses.classArray = sclasses->classArray;

   /* =======================================================
      This is a hack to let functions which need to iterate
      over a class AND its superclasses to conveniently do so

      The real precedence list starts in position 1
      ======================================================= */
   preclist->classArray[0] = cls;
   cls->allSuperclasses.classCount = preclist->classCount;
   cls->allSuperclasses.classArray = preclist->classArray;
   rtn_struct(theEnv,packedClassLinks,sclasses);
   rtn_struct(theEnv,packedClassLinks,preclist);

   /* =================================
      Shove slots into contiguous array
      ================================= */
   if (slots != NULL)
     PackSlots(theEnv,cls,slots);
   AddClass(theEnv,cls);

   return(FALSE);
  }

/* =========================================
   *****************************************
          INTERNALLY VISIBLE FUNCTIONS
   =========================================
   ***************************************** */

/***********************************************************
  NAME         : ValidClassName
  DESCRIPTION  : Determines if a new class of the given
                 name can be defined in the current module
  INPUTS       : 1) The new class name
                 2) Buffer to hold class address
  RETURNS      : TRUE if OK, FALSE otherwise
  SIDE EFFECTS : Error message printed if not OK
  NOTES        : GetConstructNameAndComment() (called before
                 this function) ensures that the defclass
                 name does not conflict with one from
                 another module
 ***********************************************************/
static intBool ValidClassName(
  void *theEnv,
  char *theClassName,
  DEFCLASS **theDefclass)
  {
   *theDefclass = (DEFCLASS *) EnvFindDefclass(theEnv,theClassName);
   if (*theDefclass != NULL)
     {
      /* ===================================
         System classes (which are visible
         in all modules) cannot be redefined
         =================================== */
      if ((*theDefclass)->system)
        {
         PrintErrorID(theEnv,"CLASSPSR",2,FALSE);
         EnvPrintRouter(theEnv,WERROR,"Cannot redefine a predefined system class.\n");
         return(FALSE);
        }

      /* ===============================================
         A class in the current module can only be
         redefined if it is not in use, e.g., instances,
         generic function method restrictions, etc.
         =============================================== */
      if ((EnvIsDefclassDeletable(theEnv,(void *) *theDefclass) == FALSE) &&
          (! ConstructData(theEnv)->CheckSyntaxMode))
        {
         PrintErrorID(theEnv,"CLASSPSR",3,FALSE);
         EnvPrintRouter(theEnv,WERROR,EnvGetDefclassName(theEnv,(void *) *theDefclass));
         EnvPrintRouter(theEnv,WERROR," class cannot be redefined while\n");
         EnvPrintRouter(theEnv,WERROR,"    outstanding references to it still exist.\n");
         return(FALSE);
        }
     }
   return(TRUE);
  }

/***************************************************************
  NAME         : ParseSimpleQualifier
  DESCRIPTION  : Parses abstract/concrete role and
                 pattern-matching reactivity for class
  INPUTS       : 1) The input logical name
                 2) The name of the qualifier being parsed
                 3) The qualifier value indicating that the
                    qualifier should be false
                 4) The qualifier value indicating that the
                    qualifier should be TRUE
                 5) A pointer to a bitmap indicating
                    if the qualifier has already been parsed
                 6) A buffer to store the value of the qualifier
  RETURNS      : TRUE if all OK, FALSE otherwise
  SIDE EFFECTS : Bitmap and qualifier buffers set
                 Messages printed on errors
  NOTES        : None
 ***************************************************************/
static intBool ParseSimpleQualifier(
  void *theEnv,
  char *readSource,
  char *classQualifier,
  char *clearRelation,
  char *setRelation,
  intBool *alreadyTestedFlag,
  intBool *binaryFlag)
  {
   if (*alreadyTestedFlag)
     {
      PrintErrorID(theEnv,"CLASSPSR",4,FALSE);
      EnvPrintRouter(theEnv,WERROR,"Class ");
      EnvPrintRouter(theEnv,WERROR,classQualifier);
      EnvPrintRouter(theEnv,WERROR," already declared.\n");
      return(FALSE);
     }
   SavePPBuffer(theEnv," ");
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
     goto ParseSimpleQualifierError;
   if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),setRelation) == 0)
     *binaryFlag = TRUE;
   else if (strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),clearRelation) == 0)
     *binaryFlag = FALSE;
   else
     goto ParseSimpleQualifierError;
   GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
   if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
     goto ParseSimpleQualifierError;
   *alreadyTestedFlag = TRUE;
   return(TRUE);

ParseSimpleQualifierError:
   SyntaxErrorMessage(theEnv,"defclass");
   return(FALSE);
  }

/***************************************************
  NAME         : ReadUntilClosingParen
  DESCRIPTION  : Skips over tokens until a ')' is
                 encountered.
  INPUTS       : 1) The logical input source
                 2) A buffer for scanned tokens
  RETURNS      : TRUE if ')' read, FALSE
                 otherwise
  SIDE EFFECTS : Tokens read
  NOTES        : Expects first token after opening
                 paren has already been scanned
 ***************************************************/
static intBool ReadUntilClosingParen(
  void *theEnv,
  char *readSource,
  struct token *inputToken)
  {
   int cnt = 1,lparen_read = FALSE;

   do
     {
      if (lparen_read == FALSE)
        SavePPBuffer(theEnv," ");
      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type == STOP)
        {
         SyntaxErrorMessage(theEnv,"message-handler declaration");
         return(FALSE);
        }
      else if (inputToken->type == LPAREN)
        {
         lparen_read = TRUE;
         cnt++;
        }
      else if (inputToken->type == RPAREN)
        {
         cnt--;
         if (lparen_read == FALSE)
           {
            PPBackup(theEnv);
            PPBackup(theEnv);
            SavePPBuffer(theEnv,")");
           }
         lparen_read = FALSE;
        }
      else
        lparen_read = FALSE;
     }
   while (cnt > 0);

   return(TRUE);
  }

/*****************************************************************************
  NAME         : AddClass
  DESCRIPTION  : Determines the precedence list of the new class.
                 If it is valid, the routine checks to see if the class
                 already exists.  If it does not, all the subclass
                 links are made from the class's direct superclasses,
                 and the class is inserted in the hash table.  If it
                 does, all sublclasses are deleted. An error will occur
                 if any instances of the class (direct or indirect) exist.
                 If all checks out, the old definition is replaced by the new.
  INPUTS       : The new class description
  RETURNS      : Nothing useful
  SIDE EFFECTS : The class is deleted if there is an error.
  NOTES        : No change in the class graph state will occur
                 if there were any errors.
                 Assumes class is not busy!!!
 *****************************************************************************/
static void AddClass(
  void *theEnv,
  DEFCLASS *cls)
  {
   DEFCLASS *ctmp;
#if DEBUGGING_FUNCTIONS
   int oldTraceInstances = FALSE,
       oldTraceSlots = FALSE;
#endif

   /* ===============================================
      If class does not already exist, insert and
      form progeny links with all direct superclasses
      =============================================== */
   cls->hashTableIndex = HashClass(GetDefclassNamePointer((void *) cls));
   ctmp = (DEFCLASS *) EnvFindDefclass(theEnv,EnvGetDefclassName(theEnv,(void *) cls));

   if (ctmp != NULL)
     {
#if DEBUGGING_FUNCTIONS
      oldTraceInstances = ctmp->traceInstances;
      oldTraceSlots = ctmp->traceSlots;
#endif
      DeleteClassUAG(theEnv,ctmp);
     }
   PutClassInTable(theEnv,cls);

   BuildSubclassLinks(theEnv,cls);
   InstallClass(theEnv,cls,TRUE);
   AddConstructToModule((struct constructHeader *) cls);

   FormInstanceTemplate(theEnv,cls);
   FormSlotNameMap(theEnv,cls);

   AssignClassID(theEnv,cls);

#if DEBUGGING_FUNCTIONS
   if (cls->abstract)
     {
      cls->traceInstances = FALSE;
      cls->traceSlots = FALSE;
     }
   else
     {
      if (oldTraceInstances)
        cls->traceInstances = TRUE;
      if (oldTraceSlots)
        cls->traceSlots = TRUE;
     }
#endif

#if DEBUGGING_FUNCTIONS
   if (EnvGetConserveMemory(theEnv) == FALSE)
     SetDefclassPPForm((void *) cls,CopyPPBuffer(theEnv));
#endif

#if DEFMODULE_CONSTRUCT

   /* =========================================
      Create a bitmap indicating whether this
      class is in scope or not for every module
      ========================================= */
   CreateClassScopeMap(theEnv,cls);

#endif

   /* ==============================================
      Define get- and put- handlers for public slots
      ============================================== */
   CreatePublicSlotMessageHandlers(theEnv,cls);
  }