cstrcpsr.c

clips源代码

  char *logicalName)
  {
   struct construct *currentPtr;
   int rv, ov;

   /*=================================*/
   /* Look for a valid construct name */
   /* (e.g. defrule, deffacts).       */
   /*=================================*/

   currentPtr = FindConstruct(theEnv,name);
   if (currentPtr == NULL) return(-1);

   /*==================================*/
   /* Prepare the parsing environment. */
   /*==================================*/

   ov = GetHaltExecution(theEnv);
   SetEvaluationError(theEnv,FALSE);
   SetHaltExecution(theEnv,FALSE);
   ClearParsedBindNames(theEnv);
   PushRtnBrkContexts(theEnv);
   ExpressionData(theEnv)->ReturnContext = FALSE;
   ExpressionData(theEnv)->BreakContext = FALSE;
   EvaluationData(theEnv)->CurrentEvaluationDepth++;

   /*=======================================*/
   /* Call the construct's parsing routine. */
   /*=======================================*/

   ConstructData(theEnv)->ParsingConstruct = TRUE;
   rv = (*currentPtr->parseFunction)(theEnv,logicalName);
   ConstructData(theEnv)->ParsingConstruct = FALSE;

   /*===============================*/
   /* Restore environment settings. */
   /*===============================*/

   EvaluationData(theEnv)->CurrentEvaluationDepth--;
   PopRtnBrkContexts(theEnv);

   ClearParsedBindNames(theEnv);
   SetPPBufferStatus(theEnv,OFF);
   SetHaltExecution(theEnv,ov);

   /*==============================*/
   /* Return the status of parsing */
   /* the construct.               */
   /*==============================*/

   return(rv);
  }

/*********************************************************/
/* GetConstructNameAndComment: Get the name and comment  */
/*   field of a construct. Returns name of the construct */
/*   if no errors are detected, otherwise returns NULL.  */
/*********************************************************/
#if IBM_TBC && (! DEBUGGING_FUNCTIONS)
#pragma argsused
#endif
globle SYMBOL_HN *GetConstructNameAndComment(
  void *theEnv,
  char *readSource,
  struct token *inputToken,
  char *constructName,
  void *(*findFunction)(void *,char *),
  int (*deleteFunction)(void *,void *),
  char *constructSymbol,
  int fullMessageCR,
  int getComment,
  int moduleNameAllowed)
  {
#if (MAC_MCW || IBM_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS)
#pragma unused(fullMessageCR)
#endif
   SYMBOL_HN *name, *moduleName;
   int redefining = FALSE;
   void *theConstruct;
   unsigned separatorPosition;
   struct defmodule *theModule;

   /*==========================*/
   /* Next token should be the */
   /* name of the construct.   */
   /*==========================*/

   GetToken(theEnv,readSource,inputToken);
   if (inputToken->type != SYMBOL)
     {
      PrintErrorID(theEnv,"CSTRCPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"Missing name for ");
      EnvPrintRouter(theEnv,WERROR,constructName);
      EnvPrintRouter(theEnv,WERROR," construct\n");
      return(NULL);
     }

   name = (SYMBOL_HN *) inputToken->value;

   /*===============================*/
   /* Determine the current module. */
   /*===============================*/

   separatorPosition = FindModuleSeparator(ValueToString(name));
   if (separatorPosition)
     {
      if (moduleNameAllowed == FALSE)
        {
         SyntaxErrorMessage(theEnv,"module specifier");
         return(NULL);
        }

      moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name));
      if (moduleName == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName));
         return(NULL);
        }

      EnvSetCurrentModule(theEnv,(void *) theModule);
      name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name));
      if (name == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }
     }

   /*=====================================================*/
   /* If the module was not specified, record the current */
   /* module name as part of the pretty-print form.       */
   /*=====================================================*/

   else
     {
      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
      if (moduleNameAllowed)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule));
         SavePPBuffer(theEnv,"::");
         SavePPBuffer(theEnv,ValueToString(name));
        }
     }

   /*==================================================================*/
   /* Check for import/export conflicts from the construct definition. */
   /*==================================================================*/

#if DEFMODULE_CONSTRUCT
   if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name)))
     {
      ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL);
      return(NULL);
     }
#endif

   /*========================================================*/
   /* Remove the construct if it is already in the knowledge */
   /* base and we're not just checking syntax.               */
   /*========================================================*/

   if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      theConstruct = (*findFunction)(theEnv,ValueToString(name));
      if (theConstruct != NULL)
        {
         redefining = TRUE;
         if (deleteFunction != NULL)
           {
            if ((*deleteFunction)(theEnv,theConstruct) == FALSE)
              {
               PrintErrorID(theEnv,"CSTRCPSR",4,TRUE);
               EnvPrintRouter(theEnv,WERROR,"Cannot redefine ");
               EnvPrintRouter(theEnv,WERROR,constructName);
               EnvPrintRouter(theEnv,WERROR," ");
               EnvPrintRouter(theEnv,WERROR,ValueToString(name));
               EnvPrintRouter(theEnv,WERROR," while it is in use.\n");
               return(NULL);
              }
           }
        }
     }

   /*=============================================*/
   /* If compilations are being watched, indicate */
   /* that a construct is being compiled.         */
   /*=============================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) &&
       GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      if (redefining) 
        {
         PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
         EnvPrintRouter(theEnv,WDIALOG,"Redefining ");
        }
      else EnvPrintRouter(theEnv,WDIALOG,"Defining ");

      EnvPrintRouter(theEnv,WDIALOG,constructName);
      EnvPrintRouter(theEnv,WDIALOG,": ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(name));

      if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n");
      else EnvPrintRouter(theEnv,WDIALOG," ");
     }
   else
#endif
     {
      if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
        { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); }
     }

   /*===============================*/
   /* Get the comment if it exists. */
   /*===============================*/

   GetToken(theEnv,readSource,inputToken);
   if ((inputToken->type == STRING) && getComment)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,inputToken->printForm);
      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type != RPAREN)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,"\n   ");
         SavePPBuffer(theEnv,inputToken->printForm);
        }
     }
   else if (inputToken->type != RPAREN)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,"\n   ");
      SavePPBuffer(theEnv,inputToken->printForm);
     }

   /*===================================*/
   /* Return the name of the construct. */
   /*===================================*/

   return(name);
  }

/****************************************/
/* RemoveConstructFromModule: Removes a */
/*   construct from its module's list   */
/****************************************/
globle void RemoveConstructFromModule(
  void *theEnv,
  struct constructHeader *theConstruct)
  {
   struct constructHeader *lastConstruct,*currentConstruct;

   /*==============================*/
   /* Find the specified construct */
   /* in the module's list.        */
   /*==============================*/

   lastConstruct = NULL;
   currentConstruct = theConstruct->whichModule->firstItem;
   while (currentConstruct != theConstruct)
     {
      lastConstruct = currentConstruct;
      currentConstruct = currentConstruct->next;
     }

   /*========================================*/
   /* If it wasn't there, something's wrong. */
   /*========================================*/

   if (currentConstruct == NULL)
     {
      SystemError(theEnv,"CSTRCPSR",1);
      EnvExitRouter(theEnv,EXIT_FAILURE);
     }

   /*==========================*/
   /* Remove it from the list. */
   /*==========================*/

   if (lastConstruct == NULL)
     { theConstruct->whichModule->firstItem = theConstruct->next; }
   else
     { lastConstruct->next = theConstruct->next; }

   /*=================================================*/
   /* Update the pointer to the last item in the list */
   /* if the construct just deleted was at the end.   */
   /*=================================================*/

   if (theConstruct == theConstruct->whichModule->lastItem)
     { theConstruct->whichModule->lastItem = lastConstruct; }
  }

/******************************************************/
/* ImportExportConflictMessage: Generic error message */
/*   for an import/export module conflict detected    */
/*   when a construct is being defined.               */
/******************************************************/
globle void ImportExportConflictMessage(
  void *theEnv,
  char *constructName,
  char *itemName,
  char *causedByConstruct,
  char *causedByName)
  {
   PrintErrorID(theEnv,"CSTRCPSR",3,TRUE);
   EnvPrintRouter(theEnv,WERROR,"Cannot define ");
   EnvPrintRouter(theEnv,WERROR,constructName);
   EnvPrintRouter(theEnv,WERROR," ");
   EnvPrintRouter(theEnv,WERROR,itemName);
   EnvPrintRouter(theEnv,WERROR," because of an import/export conflict");

   if (causedByConstruct == NULL) EnvPrintRouter(theEnv,WERROR,".\n");
   else
     {
      EnvPrintRouter(theEnv,WERROR," caused by the ");
      EnvPrintRouter(theEnv,WERROR,causedByConstruct);
      EnvPrintRouter(theEnv,WERROR," ");
      EnvPrintRouter(theEnv,WERROR,causedByName);
      EnvPrintRouter(theEnv,WERROR,".\n");
     }
  }

#endif /* (! RUN_TIME) && (! BLOAD_ONLY) */