Example #1
0
globle intBool ConstructExported(
  void *theEnv,
  EXEC_STATUS,
  char *constructTypeStr,
  struct symbolHashNode *moduleName,
  struct symbolHashNode *findName)
  {
   struct symbolHashNode *constructType;
   struct defmodule *theModule;
   struct portItem *theExportList;
   
   constructType = FindSymbolHN(theEnv,execStatus,constructTypeStr);
   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,ValueToString(moduleName));
   
   if ((constructType == NULL) || (theModule == NULL) || (findName == NULL))
     { return(FALSE); }
   
   theExportList = theModule->exportList;
   while (theExportList != NULL)
     {
      if ((theExportList->constructType == NULL) ||
          (theExportList->constructType == constructType))
       {
        if ((theExportList->constructName == NULL) ||
            (theExportList->constructName == findName))
          { return TRUE; }
       }

      theExportList = theExportList->next;
     }

   return FALSE;
  }
Example #2
0
static void ClearDefrules(
  void *theEnv)
  {
   struct defmodule *theModule;

   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN");
   EnvFocus(theEnv,(void *) theModule);
  }
Example #3
0
static void ClearDefrules(
  void *theEnv,
  EXEC_STATUS)
  {
   struct defmodule *theModule;

   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,"MAIN");
   EnvFocus(theEnv,execStatus,(void *) theModule);
  }
Example #4
0
static void ResetDefrules(
  void *theEnv)
  {
   struct defmodule *theModule;
   
   DefruleData(theEnv)->CurrentEntityTimeTag = 0L;
   EnvClearFocusStack(theEnv);
   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN");
   EnvFocus(theEnv,(void *) theModule);
  }
Example #5
0
globle void GetFactListFunction(
  void *theEnv,
  DATA_OBJECT_PTR returnValue)
  {
   struct defmodule *theModule;
   DATA_OBJECT result;
   int numArgs;

   /*===========================================*/
   /* Determine if a module name was specified. */
   /*===========================================*/

   if ((numArgs = EnvArgCountCheck(theEnv,"get-fact-list",NO_MORE_THAN,1)) == -1)
     {
      EnvSetMultifieldErrorValue(theEnv,returnValue);
      return;
     }

   if (numArgs == 1)
     {
      EnvRtnUnknown(theEnv,1,&result);

      if (GetType(result) != SYMBOL)
        {
         EnvSetMultifieldErrorValue(theEnv,returnValue);
         ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name");
         return;
        }

      if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
        {
         if (strcmp("*",DOToString(result)) != 0)
           {
            EnvSetMultifieldErrorValue(theEnv,returnValue);
            ExpectedTypeError1(theEnv,"get-fact-list",1,"defmodule name");
            return;
           }

         theModule = NULL;
        }
     }
   else
     { theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv)); }

   /*=====================*/
   /* Get the constructs. */
   /*=====================*/

   EnvGetFactList(theEnv,returnValue,theModule);
  }
Example #6
0
globle struct defmodule *GetModuleName(
  void *theEnv,
  char *functionName,
  int whichArgument,
  int *error)
  {
   DATA_OBJECT result;
   struct defmodule *theModule;

   *error = FALSE;

   /*========================*/
   /* Retrieve the argument. */
   /*========================*/

   EnvRtnUnknown(theEnv,whichArgument,&result);

   /*=================================*/
   /* A module name must be a symbol. */
   /*=================================*/

   if (GetType(result) != SYMBOL)
     {
      ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
      *error = TRUE;
      return(NULL);
     }

   /*=======================================*/
   /* Check to see that the symbol actually */
   /* corresponds to a defined module.      */
   /*=======================================*/

   if ((theModule = (struct defmodule *) EnvFindDefmodule(theEnv,DOToString(result))) == NULL)
     {
      if (strcmp("*",DOToString(result)) != 0)
        {
         ExpectedTypeError1(theEnv,functionName,whichArgument,"defmodule name");
         *error = TRUE;
        }
      return(NULL);
     }

   /*=================================*/
   /* Return a pointer to the module. */
   /*=================================*/

   return(theModule);
  }
Example #7
0
globle void *SetCurrentModuleCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   struct defmodule *theModule;
   SYMBOL_HN *defaultReturn;

   /*=====================================================*/
   /* Check for the correct number and type of arguments. */
   /*=====================================================*/

   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
   if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));

   defaultReturn = (SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(((struct defmodule *) EnvGetCurrentModule(theEnv))->name));

   if (EnvArgCountCheck(theEnv,"set-current-module",EXACTLY,1) == -1)
     { return(defaultReturn); }

   if (EnvArgTypeCheck(theEnv,"set-current-module",1,SYMBOL,&argPtr) == FALSE)
     { return(defaultReturn); }

   argument = DOToString(argPtr);

   /*================================================*/
   /* Set the current module to the specified value. */
   /*================================================*/

   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument);

   if (theModule == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",argument);
      return(defaultReturn);
     }

   EnvSetCurrentModule(theEnv,(void *) theModule);

   /*================================*/
   /* Return the new current module. */
   /*================================*/

   return((SYMBOL_HN *) defaultReturn);
  }
Example #8
0
globle int PPDefmodule(
  void *theEnv,
  char *defmoduleName,
  char *logicalName)
  {
   void *defmodulePtr;

   defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName);
   if (defmodulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName);
      return(FALSE);
     }

   if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(TRUE);
   PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr));
   return(TRUE);
  }
Example #9
0
bool PPDefmodule(
  void *theEnv,
  const char *defmoduleName,
  const char *logicalName)
  {
   void *defmodulePtr;

   defmodulePtr = EnvFindDefmodule(theEnv,defmoduleName);
   if (defmodulePtr == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",defmoduleName);
      return(false);
     }

   if (EnvGetDefmodulePPForm(theEnv,defmodulePtr) == NULL) return(true);
   PrintInChunks(theEnv,logicalName,EnvGetDefmodulePPForm(theEnv,defmodulePtr));
   return(true);
  }
Example #10
0
globle char *ExtractModuleAndConstructName(
  void *theEnv,
  EXEC_STATUS,
  char *theName)
  {
   unsigned separatorPosition;
   SYMBOL_HN *moduleName, *shortName;
   struct defmodule *theModule;

   /*========================*/
   /* Find the :: separator. */
   /*========================*/

   separatorPosition = FindModuleSeparator(theName);
   if (! separatorPosition) return(theName);

   /*==========================*/
   /* Extract the module name. */
   /*==========================*/

   moduleName = ExtractModuleName(theEnv,execStatus,separatorPosition,theName);
   if (moduleName == NULL) return(NULL);

   /*====================================*/
   /* Check to see if the module exists. */
   /*====================================*/

   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,ValueToString(moduleName));
   if (theModule == NULL) return(NULL);

   /*============================*/
   /* Change the current module. */
   /*============================*/

   EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);

   /*=============================*/
   /* Extract the construct name. */
   /*=============================*/

   shortName = ExtractConstructName(theEnv,execStatus,separatorPosition,theName);
   if (shortName == NULL) return(NULL);
   return(ValueToString(shortName));
  }
Example #11
0
static void ResetDefrules(
  void *theEnv,
  EXEC_STATUS)
  {
   struct defmodule *theModule;
   struct joinLink *theLink;
   struct partialMatch *notParent;
  
   DefruleData(theEnv,execStatus)->CurrentEntityTimeTag = 1L;
   EnvClearFocusStack(theEnv,execStatus);
   theModule = (struct defmodule *) EnvFindDefmodule(theEnv,execStatus,"MAIN");
   EnvFocus(theEnv,execStatus,(void *) theModule);
   
   for (theLink = DefruleData(theEnv,execStatus)->RightPrimeJoins;
        theLink != NULL;
        theLink = theLink->next)
     { PosEntryRetractAlpha(theEnv,execStatus,theLink->join->rightMemory->beta[0]); }

   for (theLink = DefruleData(theEnv,execStatus)->LeftPrimeJoins;
        theLink != NULL;
        theLink = theLink->next)
     { 
      if ((theLink->join->patternIsNegated || theLink->join->joinFromTheRight) && 
          (! theLink->join->patternIsExists))
        {
         notParent = theLink->join->leftMemory->beta[0];
         
         if (notParent->marker)
           { RemoveBlockedLink(notParent); }
           
         /*==========================================================*/
         /* Prevent any retractions from generating partial matches. */
         /*==========================================================*/
           
         notParent->marker = notParent;
         
         if (notParent->children != NULL)
           { PosEntryRetractBeta(theEnv,execStatus,notParent,notParent->children); }
           /*
         if (notParent->dependents != NULL) 
           { RemoveLogicalSupport(theEnv,execStatus,notParent); } */
        }
     }
  }
Example #12
0
globle int FocusCommand(
  void *theEnv)
  {
   DATA_OBJECT argPtr;
   char *argument;
   struct defmodule *theModule;
   int argCount, i;

   /*=====================================================*/
   /* Check for the correct number and type of arguments. */
   /*=====================================================*/

   if ((argCount = EnvArgCountCheck(theEnv,"focus",AT_LEAST,1)) == -1)
     { return(FALSE); }

   /*===========================================*/
   /* Focus on the specified defrule module(s). */
   /*===========================================*/

   for (i = argCount; i > 0; i--)
     {
      if (EnvArgTypeCheck(theEnv,"focus",i,SYMBOL,&argPtr) == FALSE)
        { return(FALSE); }

      argument = DOToString(argPtr);
      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,argument);

      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",argument);
         return(FALSE);
        }

      EnvFocus(theEnv,(void *) theModule);
     }

   /*===================================================*/
   /* Return TRUE to indicate success of focus command. */
   /*===================================================*/

   return(TRUE);
  }
Example #13
0
static struct activation *NextActivationToFire(
  void *theEnv)
  {
   struct activation *theActivation;
   struct defmodule *theModule;

   /*====================================*/
   /* If there is no current focus, then */
   /* focus on the MAIN module.          */
   /*====================================*/

   if (EngineData(theEnv)->CurrentFocus == NULL)
     {
      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN");
      EnvFocus(theEnv,theModule);
     }

   /*===========================================================*/
   /* Determine the top activation on the agenda of the current */
   /* focus. If the current focus has no activations on its     */
   /* agenda, then pop the focus off the focus stack until      */
   /* a focus that has an activation on its agenda is found.    */
   /*===========================================================*/

   theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda;
   while ((theActivation == NULL) && (EngineData(theEnv)->CurrentFocus != NULL))
     {
      if (EngineData(theEnv)->CurrentFocus != NULL) EnvPopFocus(theEnv);
      if (EngineData(theEnv)->CurrentFocus != NULL) theActivation = EngineData(theEnv)->CurrentFocus->theDefruleModule->agenda;
     }

   /*=========================================*/
   /* Return the next activation to be fired. */
   /*=========================================*/

   return(theActivation);
  }
Example #14
0
static int ParseImportSpec(
  void *theEnv,
  char *readSource,
  struct token *theToken,
  struct defmodule *newModule)
  {
   struct defmodule *theModule;
   struct portItem *thePort, *oldImportSpec;
   int found, count;

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   SavePPBuffer(theEnv," ");

   GetToken(theEnv,readSource,theToken);

   if (theToken->type != SYMBOL)
     {
      SyntaxErrorMessage(theEnv,"defmodule import specification");
      return(TRUE);
     }

   /*=====================================*/
   /* Verify the existence of the module. */
   /*=====================================*/

   if ((theModule = (struct defmodule *)
                    EnvFindDefmodule(theEnv,ValueToString(theToken->value))) == NULL)
     {
      CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken->value));
      return(TRUE);
     }

   /*========================================*/
   /* If the specified module doesn't export */
   /* any constructs, then the import        */
   /* specification is meaningless.          */
   /*========================================*/

   if (theModule->exportList == NULL)
     {
      NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),NULL,NULL);
      return(TRUE);
     }

   /*==============================================*/
   /* Parse the remaining portion of the import    */
   /* specification and return if an error occurs. */
   /*==============================================*/

   oldImportSpec = newModule->importList;
   if (ParseExportSpec(theEnv,readSource,theToken,newModule,theModule)) return(TRUE);

   /*========================================================*/
   /* If the ?NONE keyword was used with the import spec,    */
   /* then no constructs were actually imported and the      */
   /* import spec does not need to be checked for conflicts. */
   /*========================================================*/

   if (newModule->importList == oldImportSpec) return(FALSE);

   /*======================================================*/
   /* Check to see if the construct being imported can be  */
   /* by the specified module. This check exported doesn't */
   /* guarantee that a specific named construct actually   */
   /* exists. It just checks that it could be exported if  */
   /* it does exists.                                      */
   /*======================================================*/

   if (newModule->importList->constructType != NULL)
     {
      /*=============================*/
      /* Look for the construct in   */
      /* the module that exports it. */
      /*=============================*/

      found = FALSE;
      for (thePort = theModule->exportList;
           (thePort != NULL) && (! found);
           thePort = thePort->next)
        {
         if (thePort->constructType == NULL) found = TRUE;
         else if (thePort->constructType == newModule->importList->constructType)
           {
            if (newModule->importList->constructName == NULL) found = TRUE;
            else if (thePort->constructName == NULL) found = TRUE;
            else if (thePort->constructName == newModule->importList->constructName)
              { found = TRUE; }
           }
        }

      /*=======================================*/
      /* If it's not exported by the specified */
      /* module, print an error message.       */
      /*=======================================*/

      if (! found)
        {
         if (newModule->importList->constructName == NULL)
           {
            NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                    ValueToString(newModule->importList->constructType),
                                    NULL);
           }
         else
           {
            NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                    ValueToString(newModule->importList->constructType),
                                    ValueToString(newModule->importList->constructName));
           }
         return(TRUE);
        }
     }

   /*======================================================*/
   /* Verify that specific named constructs actually exist */
   /* and can be seen from the module importing them.      */
   /*======================================================*/

   SaveCurrentModule(theEnv);
   EnvSetCurrentModule(theEnv,(void *) newModule);

   for (thePort = newModule->importList;
        thePort != NULL;
        thePort = thePort->next)
     {
      if ((thePort->constructType == NULL) || (thePort->constructName == NULL))
        { continue; }

      theModule = (struct defmodule *)
                  EnvFindDefmodule(theEnv,ValueToString(thePort->moduleName));
      EnvSetCurrentModule(theEnv,theModule);
      if (FindImportedConstruct(theEnv,ValueToString(thePort->constructType),NULL,
                                ValueToString(thePort->constructName),&count,
                                TRUE,FALSE) == NULL)
        {
         NotExportedErrorMessage(theEnv,EnvGetDefmoduleName(theEnv,theModule),
                                 ValueToString(thePort->constructType),
                                 ValueToString(thePort->constructName));
         RestoreCurrentModule(theEnv);
         return(TRUE);
        }
     }

   RestoreCurrentModule(theEnv);

   /*===============================================*/
   /* The import list has been successfully parsed. */
   /*===============================================*/

   return(FALSE);
  }
Example #15
0
globle int ParseDefmodule(
  void *theEnv,
  char *readSource)
  {
   SYMBOL_HN *defmoduleName;
   struct defmodule *newDefmodule;
   struct token inputToken;
   int i;
   struct moduleItem *theItem;
   struct portItem *portSpecs, *nextSpec;
   struct defmoduleItemHeader *theHeader;
   struct callFunctionItem *defineFunctions;
   struct defmodule *redefiningMainModule = NULL;
   int parseError;
   struct portItem *oldImportList = NULL, *oldExportList = NULL;
   short overwrite = FALSE;

   /*================================================*/
   /* Flush the buffer which stores the pretty print */
   /* representation for a module.  Add the already  */
   /* parsed keyword defmodule to this buffer.       */
   /*================================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defmodule ");

   /*===============================*/
   /* Modules cannot be loaded when */
   /* a binary load is in effect.   */
   /*===============================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defmodule");
      return(TRUE);
     }
#endif

   /*=====================================================*/
   /* Parse the name and comment fields of the defmodule. */
   /* Remove the defmodule if it already exists.          */
   /*=====================================================*/

   defmoduleName = GetConstructNameAndComment(theEnv,readSource,&inputToken,"defmodule",
                                              EnvFindDefmodule,DeleteDefmodule,"+",
                                              TRUE,TRUE,FALSE);
   if (defmoduleName == NULL) { return(TRUE); }

   if (strcmp(ValueToString(defmoduleName),"MAIN") == 0)
     { redefiningMainModule = (struct defmodule *) EnvFindDefmodule(theEnv,"MAIN"); }

   /*==============================================*/
   /* Create the defmodule structure if necessary. */
   /*==============================================*/

   if (redefiningMainModule == NULL)
     {
      newDefmodule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(defmoduleName));
      if (newDefmodule)
        { overwrite = TRUE; }
      else
        {
         newDefmodule = get_struct(theEnv,defmodule);
         newDefmodule->name = defmoduleName;
         newDefmodule->usrData = NULL;
         newDefmodule->next = NULL;
        }
     }
   else
     {
      overwrite = TRUE;
      newDefmodule = redefiningMainModule;
     }

   if (overwrite)
     {
      oldImportList = newDefmodule->importList;
      oldExportList = newDefmodule->exportList;
     }

   newDefmodule->importList = NULL;
   newDefmodule->exportList = NULL;

   /*===================================*/
   /* Finish parsing the defmodule (its */
   /* import/export specifications).    */
   /*===================================*/

   parseError = ParsePortSpecifications(theEnv,readSource,&inputToken,newDefmodule);

   /*====================================*/
   /* Check for import/export conflicts. */
   /*====================================*/

   if (! parseError) parseError = FindMultiImportConflict(theEnv,newDefmodule);

   /*======================================================*/
   /* If an error occured in parsing or an import conflict */
   /* was detected, abort the definition of the defmodule. */
   /* If we're only checking syntax, then we want to exit  */
   /* at this point as well.                               */
   /*======================================================*/

   if (parseError || ConstructData(theEnv)->CheckSyntaxMode)
     {
      while (newDefmodule->importList != NULL)
        {
         nextSpec = newDefmodule->importList->next;
         rtn_struct(theEnv,portItem,newDefmodule->importList);
         newDefmodule->importList = nextSpec;
        }

      while (newDefmodule->exportList != NULL)
        {
         nextSpec = newDefmodule->exportList->next;
         rtn_struct(theEnv,portItem,newDefmodule->exportList);
         newDefmodule->exportList = nextSpec;
        }

      if ((redefiningMainModule == NULL) && (! overwrite))
        { rtn_struct(theEnv,defmodule,newDefmodule); }

      if (overwrite)
        {
         newDefmodule->importList = oldImportList;
         newDefmodule->exportList = oldExportList;
        }

      if (parseError) return(TRUE);
      return(FALSE);
     }

   /*===============================================*/
   /* Increment the symbol table counts for symbols */
   /* used in the defmodule data structures.        */
   /*===============================================*/

   if (redefiningMainModule == NULL)
     { IncrementSymbolCount(newDefmodule->name); }
   else
     {
      if ((newDefmodule->importList != NULL) ||
          (newDefmodule->exportList != NULL))
        { DefmoduleData(theEnv)->MainModuleRedefinable = FALSE; }
     }

   for (portSpecs = newDefmodule->importList; portSpecs != NULL; portSpecs = portSpecs->next)
     {
      if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
      if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
      if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
     }

   for (portSpecs = newDefmodule->exportList; portSpecs != NULL; portSpecs = portSpecs->next)
     {
      if (portSpecs->moduleName != NULL) IncrementSymbolCount(portSpecs->moduleName);
      if (portSpecs->constructType != NULL) IncrementSymbolCount(portSpecs->constructType);
      if (portSpecs->constructName != NULL) IncrementSymbolCount(portSpecs->constructName);
     }

   /*====================================================*/
   /* Allocate storage for the module's construct lists. */
   /*====================================================*/

   if (redefiningMainModule != NULL) { /* Do nothing */ }
   else if (DefmoduleData(theEnv)->NumberOfModuleItems == 0) newDefmodule->itemsArray = NULL;
   else
     {
      newDefmodule->itemsArray = (struct defmoduleItemHeader **) gm2(theEnv,sizeof(void *) * DefmoduleData(theEnv)->NumberOfModuleItems);
      for (i = 0, theItem = DefmoduleData(theEnv)->ListOfModuleItems;
           (i < DefmoduleData(theEnv)->NumberOfModuleItems) && (theItem != NULL);
           i++, theItem = theItem->next)
        {
         if (theItem->allocateFunction == NULL)
           { newDefmodule->itemsArray[i] = NULL; }
         else
           {
            newDefmodule->itemsArray[i] = (struct defmoduleItemHeader *)
                                          (*theItem->allocateFunction)(theEnv);
            theHeader = (struct defmoduleItemHeader *) newDefmodule->itemsArray[i];
            theHeader->theModule = newDefmodule;
            theHeader->firstItem = NULL;
            theHeader->lastItem = NULL;
           }
        }
     }

   /*=======================================*/
   /* Save the pretty print representation. */
   /*=======================================*/

   SavePPBuffer(theEnv,"\n");

   if (EnvGetConserveMemory(theEnv) == TRUE)
     { newDefmodule->ppForm = NULL; }
   else
     { newDefmodule->ppForm = CopyPPBuffer(theEnv); }

   /*==============================================*/
   /* Add the defmodule to the list of defmodules. */
   /*==============================================*/

   if (redefiningMainModule == NULL)
     {
      if (DefmoduleData(theEnv)->LastDefmodule == NULL) DefmoduleData(theEnv)->ListOfDefmodules = newDefmodule;
      else DefmoduleData(theEnv)->LastDefmodule->next = newDefmodule;
      DefmoduleData(theEnv)->LastDefmodule = newDefmodule;
      newDefmodule->bsaveID = DefmoduleData(theEnv)->NumberOfDefmodules++;
     }

   EnvSetCurrentModule(theEnv,(void *) newDefmodule);

   /*=========================================*/
   /* Call any functions required by other    */
   /* constructs when a new module is defined */
   /*=========================================*/

   for (defineFunctions = DefmoduleData(theEnv)->AfterModuleDefinedFunctions;
        defineFunctions != NULL;
        defineFunctions = defineFunctions->next)
     { (* (void (*)(void *)) defineFunctions->func)(theEnv); }

   /*===============================================*/
   /* Defmodule successfully parsed with no errors. */
   /*===============================================*/

   return(FALSE);
  }
Example #16
0
globle void EnvReset(
  void *theEnv)
  {
   struct callFunctionItem *resetPtr;

   /*=====================================*/
   /* The reset command can't be executed */
   /* while a reset is in progress.       */
   /*=====================================*/

   if (ConstructData(theEnv)->ResetInProgress) return;

   ConstructData(theEnv)->ResetInProgress = TRUE;
   ConstructData(theEnv)->ResetReadyInProgress = TRUE;

   /*================================================*/
   /* If the reset is performed from the top level   */
   /* command prompt, reset the halt execution flag. */
   /*================================================*/

   if (UtilityData(theEnv)->CurrentGarbageFrame->topLevel) SetHaltExecution(theEnv,FALSE);

   /*=======================================================*/
   /* Call the before reset function to determine if the    */
   /* reset should continue. [Used by the some of the       */
   /* windowed interfaces to query the user whether a       */
   /* reset should proceed with activations on the agenda.] */
   /*=======================================================*/

   if ((ConstructData(theEnv)->BeforeResetFunction != NULL) ? 
       ((*ConstructData(theEnv)->BeforeResetFunction)(theEnv) == FALSE) :
                                       FALSE)
     {
      ConstructData(theEnv)->ResetReadyInProgress = FALSE;
      ConstructData(theEnv)->ResetInProgress = FALSE;
      return;
     }
   ConstructData(theEnv)->ResetReadyInProgress = FALSE;

   /*===========================*/
   /* Call each reset function. */
   /*===========================*/

   for (resetPtr = ConstructData(theEnv)->ListOfResetFunctions;
        (resetPtr != NULL) && (GetHaltExecution(theEnv) == FALSE);
        resetPtr = resetPtr->next)
     { 
      if (resetPtr->environmentAware)
        { (*resetPtr->func)(theEnv); }
      else            
        { (* (void (*)(void)) resetPtr->func)(); }
     }

   /*============================================*/
   /* Set the current module to the MAIN module. */
   /*============================================*/

   EnvSetCurrentModule(theEnv,(void *) EnvFindDefmodule(theEnv,"MAIN"));

   /*===========================================*/
   /* Perform periodic cleanup if the reset was */
   /* issued from an embedded controller.       */
   /*===========================================*/

   if ((UtilityData(theEnv)->CurrentGarbageFrame->topLevel) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
       (EvaluationData(theEnv)->CurrentExpression == NULL) && (UtilityData(theEnv)->GarbageCollectionLocks == 0))
     {
      CleanCurrentGarbageFrame(theEnv,NULL);
      CallPeriodicTasks(theEnv);
     }

   /*===================================*/
   /* A reset is no longer in progress. */
   /*===================================*/

   ConstructData(theEnv)->ResetInProgress = FALSE;
  }
Example #17
0
globle void FactsCommand(
  void *theEnv)
  {
   int argumentCount;
   long long start = UNSPECIFIED, end = UNSPECIFIED, max = UNSPECIFIED;
   struct defmodule *theModule;
   DATA_OBJECT theValue;
   int argOffset;

   /*=========================================================*/
   /* Determine the number of arguments to the facts command. */
   /*=========================================================*/

   if ((argumentCount = EnvArgCountCheck(theEnv,(char*)"facts",NO_MORE_THAN,4)) == -1) return;

   /*==================================*/
   /* The default module for the facts */
   /* command is the current module.   */
   /*==================================*/

   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));

   /*==========================================*/
   /* If no arguments were specified, then use */
   /* the default values to list the facts.    */
   /*==========================================*/

   if (argumentCount == 0)
     {
      EnvFacts(theEnv,WDISPLAY,theModule,start,end,max);
      return;
     }

   /*========================================================*/
   /* Since there are one or more arguments, see if a module */
   /* or start index was specified as the first argument.    */
   /*========================================================*/

   EnvRtnUnknown(theEnv,1,&theValue);

   /*===============================================*/
   /* If the first argument is a symbol, then check */
   /* to see that a valid module was specified.     */
   /*===============================================*/

   if (theValue.type == SYMBOL)
     {
      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theValue.value));
      if ((theModule == NULL) && (strcmp(ValueToString(theValue.value),"*") != 0))
        {
         SetEvaluationError(theEnv,TRUE);
         CantFindItemErrorMessage(theEnv,(char*)"defmodule",ValueToString(theValue.value));
         return;
        }

      if ((start = GetFactsArgument(theEnv,2,argumentCount)) == INVALID) return;

      argOffset = 1;
     }

   /*================================================*/
   /* Otherwise if the first argument is an integer, */
   /* check to see that a valid index was specified. */
   /*================================================*/

   else if (theValue.type == INTEGER)
     {
      start = DOToLong(theValue);
      if (start < 0)
        {
         ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number");
         SetHaltExecution(theEnv,TRUE);
         SetEvaluationError(theEnv,TRUE);
         return;
        }
      argOffset = 0;
     }

   /*==========================================*/
   /* Otherwise the first argument is invalid. */
   /*==========================================*/

   else
     {
      ExpectedTypeError1(theEnv,(char*)"facts",1,(char*)"symbol or positive number");
      SetHaltExecution(theEnv,TRUE);
      SetEvaluationError(theEnv,TRUE);
      return;
     }

   /*==========================*/
   /* Get the other arguments. */
   /*==========================*/

   if ((end = GetFactsArgument(theEnv,2 + argOffset,argumentCount)) == INVALID) return;
   if ((max = GetFactsArgument(theEnv,3 + argOffset,argumentCount)) == INVALID) return;

   /*=================*/
   /* List the facts. */
   /*=================*/

   EnvFacts(theEnv,WDISPLAY,theModule,start,end,max);
  }
Example #18
0
globle intBool ParseDefglobal(
  void *theEnv,
  char *readSource)
  {
   int defglobalError = FALSE;
#if (MAC_MCW || IBM_MCW) && (RUN_TIME || BLOAD_ONLY)
#pragma unused(theEnv,readSource)
#endif

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

   struct token theToken;
   int tokenRead = TRUE;
   struct defmodule *theModule;

   /*=====================================*/
   /* Pretty print buffer initialization. */
   /*=====================================*/

   SetPPBufferStatus(theEnv,ON);
   FlushPPBuffer(theEnv);
   SetIndentDepth(theEnv,3);
   SavePPBuffer(theEnv,"(defglobal ");

   /*=================================================*/
   /* Individual defglobal constructs can't be parsed */
   /* while a binary load is in effect.               */
   /*=================================================*/

#if BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE
   if ((Bloaded(theEnv) == TRUE) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      CannotLoadWithBloadMessage(theEnv,"defglobal");
      return(TRUE);
     }
#endif

   /*===========================*/
   /* Look for the module name. */
   /*===========================*/

   GetToken(theEnv,readSource,&theToken);
   if (theToken.type == SYMBOL)
     {
      /*=================================================*/
      /* The optional module name can't contain a module */
      /* separator like other constructs. For example,   */
      /* (defrule X::foo is OK for rules, but the right  */
      /* syntax for defglobals is (defglobal X ?*foo*.   */
      /*=================================================*/

      tokenRead = FALSE;
      if (FindModuleSeparator(ValueToString(theToken.value)))
        {
         SyntaxErrorMessage(theEnv,"defglobal");
         return(TRUE);
        }

      /*=================================*/
      /* Determine if the module exists. */
      /*=================================*/

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(theToken.value));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(theToken.value));
         return(TRUE);
        }

      /*=========================================*/
      /* If the module name was OK, then set the */
      /* current module to the specified module. */
      /*=========================================*/

      SavePPBuffer(theEnv," ");
      EnvSetCurrentModule(theEnv,(void *) theModule);
     }

   /*===========================================*/
   /* If the module name wasn't specified, then */
   /* use the current module's name in the      */
   /* defglobal's pretty print representation.  */
   /*===========================================*/

   else
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,theToken.printForm);
     }

   /*======================*/
   /* Parse the variables. */
   /*======================*/

   while (GetVariableDefinition(theEnv,readSource,&defglobalError,tokenRead,&theToken))
     {
      tokenRead = FALSE;

      FlushPPBuffer(theEnv);
      SavePPBuffer(theEnv,"(defglobal ");
      SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,((struct defmodule *) EnvGetCurrentModule(theEnv))));
      SavePPBuffer(theEnv," ");
     }

#endif

   /*==================================*/
   /* Return the parsing error status. */
   /*==================================*/

   return(defglobalError);
  }
Example #19
0
static void *SearchImportedConstructModules(
  void *theEnv,
  EXEC_STATUS,
  struct symbolHashNode *constructType,
  struct defmodule *matchModule,
  struct moduleItem *theModuleItem,
  struct symbolHashNode *findName,
  int *count,
  int searchCurrent,
  struct defmodule *notYetDefinedInModule)
  {
   struct defmodule *theModule;
   struct portItem *theImportList, *theExportList;
   void *rv, *arv = NULL;
   int searchModule, exported;
   struct defmodule *currentModule;

   /*=========================================*/
   /* Start the search in the current module. */
   /* If the current module has already been  */
   /* visited, then return.                   */
   /*=========================================*/

   currentModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus));
   if (currentModule->visitedFlag) return(NULL);

   /*=======================================================*/
   /* The searchCurrent flag indicates whether the current  */
   /* module should be included in the search. In addition, */
   /* if matchModule is non-NULL, the current module will   */
   /* only be searched if it is the specific module from    */
   /* which we want the construct imported.                 */
   /*=======================================================*/

   if ((searchCurrent) &&
       ((matchModule == NULL) || (currentModule == matchModule)))
     {
      /*===============================================*/
      /* Look for the construct in the current module. */
      /*===============================================*/

      rv = (*theModuleItem->findFunction)(theEnv,execStatus,ValueToString(findName));

      /*========================================================*/
      /* If we're in the process of defining the construct in   */
      /* the module we're searching then go ahead and increment */
      /* the count indicating the number of modules in which    */
      /* the construct was found.                               */
      /*========================================================*/

      if (notYetDefinedInModule == currentModule)
        {
         (*count)++;
         arv = rv;
        }

      /*=========================================================*/
      /* Otherwise, if the construct is in the specified module, */
      /* increment the count only if the construct actually      */
      /* belongs to the module. [Some constructs, like the COOL  */
      /* system classes, can be found in any module, but they    */
      /* actually belong to the MAIN module.]                    */
      /*=========================================================*/

      else if (rv != NULL)
        {
         if (((struct constructHeader *) rv)->whichModule->theModule == currentModule)
           { (*count)++; }
         arv = rv;
        }
     }

   /*=====================================*/
   /* Mark the current module as visited. */
   /*=====================================*/

   currentModule->visitedFlag = TRUE;

   /*===================================*/
   /* Search through all of the modules */
   /* imported by the current module.   */
   /*===================================*/

   theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv,execStatus));
   theImportList = theModule->importList;

   while (theImportList != NULL)
     {
      /*===================================================*/
      /* Determine if the module should be searched (based */
      /* upon whether the entire module, all constructs of */
      /* a specific type, or specifically named constructs */
      /* are imported).                                    */
      /*===================================================*/

      searchModule = FALSE;
      if ((theImportList->constructType == NULL) ||
          (theImportList->constructType == constructType))
        {
         if ((theImportList->constructName == NULL) ||
             (theImportList->constructName == findName))
           { searchModule = TRUE; }
        }

      /*=================================*/
      /* Determine if the module exists. */
      /*=================================*/

      if (searchModule)
        {
         theModule = (struct defmodule *)
                     EnvFindDefmodule(theEnv,execStatus,ValueToString(theImportList->moduleName));
         if (theModule == NULL) searchModule = FALSE;
        }

      /*=======================================================*/
      /* Determine if the construct is exported by the module. */
      /*=======================================================*/

      if (searchModule)
        {
         exported = FALSE;
         theExportList = theModule->exportList;
         while ((theExportList != NULL) && (! exported))
           {
            if ((theExportList->constructType == NULL) ||
                (theExportList->constructType == constructType))
              {
               if ((theExportList->constructName == NULL) ||
                   (theExportList->constructName == findName))
                 { exported = TRUE; }
               }

            theExportList = theExportList->next;
           }

         if (! exported) searchModule = FALSE;
        }

      /*=================================*/
      /* Search in the specified module. */
      /*=================================*/

      if (searchModule)
        {
         EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
         if ((rv = SearchImportedConstructModules(theEnv,execStatus,constructType,matchModule,
                                                  theModuleItem,findName,
                                                  count,TRUE,
                                                  notYetDefinedInModule)) != NULL)
           { arv = rv; }
        }

      /*====================================*/
      /* Move on to the next imported item. */
      /*====================================*/

      theImportList = theImportList->next;
     }

   /*=========================*/
   /* Return a pointer to the */
   /* last construct found.   */
   /*=========================*/

   return(arv);
  }
Example #20
0
globle struct expr *Function2Parse(
  void *theEnv,
  char *logicalName,
  char *name)
  {
   struct FunctionDefinition *theFunction;
   struct expr *top;
   int moduleSpecified = FALSE;
   unsigned position;
   struct symbolHashNode *moduleName = NULL, *constructName = NULL;
#if DEFGENERIC_CONSTRUCT
   void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
   void *dptr;
#endif

   /*=========================================================*/
   /* Module specification cannot be used in a function call. */
   /*=========================================================*/

   if ((position = FindModuleSeparator(name)) != FALSE)
     { 
      moduleName = ExtractModuleName(theEnv,position,name);
      constructName = ExtractConstructName(theEnv,position,name);
      moduleSpecified = TRUE; 
     }

   /*================================*/
   /* Has the function been defined? */
   /*================================*/

   theFunction = FindFunction(theEnv,name);

#if DEFGENERIC_CONSTRUCT
   if (moduleSpecified)
     { 
      if (ConstructExported(theEnv,(char*)"defgeneric",moduleName,constructName) ||
          EnvGetCurrentModule(theEnv) == EnvFindDefmodule(theEnv,ValueToString(moduleName)))
        { gfunc = (void *) EnvFindDefgeneric(theEnv,name); }
      else
        { gfunc = NULL; }
     }
   else
     { gfunc = (void *) LookupDefgenericInScope(theEnv,name); }
#endif

#if DEFFUNCTION_CONSTRUCT
   if ((theFunction == NULL)
#if DEFGENERIC_CONSTRUCT
        && (gfunc == NULL)
#endif
     )
     if (moduleSpecified)
       { 
        if (ConstructExported(theEnv,(char*)"deffunction",moduleName,constructName) ||
            EnvGetCurrentModule(theEnv) == EnvFindDefmodule(theEnv,ValueToString(moduleName)))
          { dptr = (void *) EnvFindDeffunction(theEnv,name); }
        else
          { dptr = NULL; }
       }
     else
       { dptr = (void *) LookupDeffunctionInScope(theEnv,name); }
   else
     dptr = NULL;
#endif

   /*=============================*/
   /* Define top level structure. */
   /*=============================*/

#if DEFFUNCTION_CONSTRUCT
   if (dptr != NULL)
     top = GenConstant(theEnv,PCALL,dptr);
   else
#endif
#if DEFGENERIC_CONSTRUCT
   if (gfunc != NULL)
     top = GenConstant(theEnv,GCALL,gfunc);
   else
#endif
   if (theFunction != NULL)
     top = GenConstant(theEnv,FCALL,theFunction);
   else
     {
      PrintErrorID(theEnv,(char*)"EXPRNPSR",3,TRUE);
      EnvPrintRouter(theEnv,WERROR,(char*)"Missing function declaration for ");
      EnvPrintRouter(theEnv,WERROR,name);
      EnvPrintRouter(theEnv,WERROR,(char*)".\n");
      return(NULL);
     }

   /*=======================================================*/
   /* Check to see if function has its own parsing routine. */
   /*=======================================================*/

   PushRtnBrkContexts(theEnv);
   ExpressionData(theEnv)->ReturnContext = FALSE;
   ExpressionData(theEnv)->BreakContext = FALSE;

#if DEFGENERIC_CONSTRUCT || DEFFUNCTION_CONSTRUCT
   if (top->type == FCALL)
#endif
     {
      if (theFunction->parser != NULL)
        {
         top = (*theFunction->parser)(theEnv,top,logicalName);
         PopRtnBrkContexts(theEnv);
         if (top == NULL) return(NULL);
         if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,(char*)"(expansion-call)"),
                                         FindFunction(theEnv,(char*)"expand$")))
           {
            ReturnExpression(theEnv,top);
            return(NULL);
           }
         return(top);
        }
     }

   /*========================================*/
   /* Default parsing routine for functions. */
   /*========================================*/

   top = CollectArguments(theEnv,top,logicalName);
   PopRtnBrkContexts(theEnv);
   if (top == NULL) return(NULL);

   if (ReplaceSequenceExpansionOps(theEnv,top->argList,top,FindFunction(theEnv,(char*)"(expansion-call)"),
                                    FindFunction(theEnv,(char*)"expand$")))
     {
      ReturnExpression(theEnv,top);
      return(NULL);
     }

   /*============================================================*/
   /* If the function call uses the sequence expansion operator, */
   /* its arguments cannot be checked until runtime.             */
   /*============================================================*/

   if (top->value == (void *) FindFunction(theEnv,(char*)"(expansion-call)"))
     { return(top); }

   /*============================*/
   /* Check for argument errors. */
   /*============================*/

   if ((top->type == FCALL) && EnvGetStaticConstraintChecking(theEnv))
     {
      if (CheckExpressionAgainstRestrictions(theEnv,top,theFunction->restrictions,name))
        {
         ReturnExpression(theEnv,top);
         return(NULL);
        }
     }

#if DEFFUNCTION_CONSTRUCT
   else if (top->type == PCALL)
     {
      if (CheckDeffunctionCall(theEnv,top->value,CountArguments(top->argList)) == FALSE)
        {
         ReturnExpression(theEnv,top);
         return(NULL);
        }
     }
#endif

   /*========================*/
   /* Return the expression. */
   /*========================*/

   return(top);
  }
Example #21
0
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 || WIN_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);
  }