if (top->argList->type == DEFGLOBAL_PTR) return(top);#endif   if (top->argList->nextArg != NULL)     { theConstraint = ExpressionToConstraintRecord(theEnv,top->argList->nextArg); }   AddBindName(theEnv,variableName,theConstraint);   return(top);  }/********************************************//* ReturnParse: Parses the return function. *//********************************************/static struct expr *ReturnParse(  void *theEnv,  struct expr *top,  char *infile)  {   int error_flag = FALSE;   struct token theToken;   if (ExpressionData(theEnv)->svContexts->rtn == TRUE)     ExpressionData(theEnv)->ReturnContext = TRUE;   if (ExpressionData(theEnv)->ReturnContext == FALSE)     {      PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);      EnvPrintRouter(theEnv,WERROR,"The return function is not valid in this context.\n");      ReturnExpression(theEnv,top);      return(NULL);     }   ExpressionData(theEnv)->ReturnContext = FALSE;   SavePPBuffer(theEnv," ");   top->argList = ArgumentParse(theEnv,infile,&error_flag);   if (error_flag)     {      ReturnExpression(theEnv,top);      return(NULL);     }   else if (top->argList == NULL)     {      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,")");     }   else     {      SavePPBuffer(theEnv," ");      GetToken(theEnv,infile,&theToken);      if (theToken.type != RPAREN)        {         SyntaxErrorMessage(theEnv,"return function");         ReturnExpression(theEnv,top);         return(NULL);        }      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,")");     }   return(top);  }/**********************************************//* BreakParse:                                *//**********************************************/static struct expr *BreakParse(  void *theEnv,  struct expr *top,  char *infile)  {   struct token theToken;   if (ExpressionData(theEnv)->svContexts->brk == FALSE)     {      PrintErrorID(theEnv,"PRCDRPSR",2,TRUE);      EnvPrintRouter(theEnv,WERROR,"The break function not valid in this context.\n");      ReturnExpression(theEnv,top);      return(NULL);     }   SavePPBuffer(theEnv," ");   GetToken(theEnv,infile,&theToken);   if (theToken.type != RPAREN)     {      SyntaxErrorMessage(theEnv,"break function");      ReturnExpression(theEnv,top);      return(NULL);     }   PPBackup(theEnv);   PPBackup(theEnv);   SavePPBuffer(theEnv,")");   return(top);  }/**********************************************//* SwitchParse:                               *//**********************************************/static struct expr *SwitchParse(  void *theEnv,  struct expr *top,  char *infile)  {   struct token theToken;   EXPRESSION *theExp,*chk;   int default_count = 0;   /*============================*/   /* Process the switch value   */   /*============================*/   IncrementIndentDepth(theEnv,3);   SavePPBuffer(theEnv," ");   top->argList = theExp = ParseAtomOrExpression(theEnv,infile,NULL);   if (theExp == NULL)     goto SwitchParseError;   /*========================*/   /* Parse case statements. */   /*========================*/   GetToken(theEnv,infile,&theToken);   while (theToken.type != RPAREN)     {      PPBackup(theEnv);      PPCRAndIndent(theEnv);      SavePPBuffer(theEnv,theToken.printForm);      if (theToken.type != LPAREN)        goto SwitchParseErrorAndMessage;      GetToken(theEnv,infile,&theToken);      SavePPBuffer(theEnv," ");      if ((theToken.type == SYMBOL) &&          (strcmp(ValueToString(theToken.value),"case") == 0))        {         if (default_count != 0)           goto SwitchParseErrorAndMessage;         theExp->nextArg = ParseAtomOrExpression(theEnv,infile,NULL);         SavePPBuffer(theEnv," ");         if (theExp->nextArg == NULL)           goto SwitchParseError;         for (chk = top->argList->nextArg ; chk != theExp->nextArg ; chk = chk->nextArg)           {            if ((chk->type == theExp->nextArg->type) &&                (chk->value == theExp->nextArg->value) &&                IdenticalExpression(chk->argList,theExp->nextArg->argList))              {               PrintErrorID(theEnv,"PRCDRPSR",3,TRUE);               EnvPrintRouter(theEnv,WERROR,"Duplicate case found in switch function.\n");               goto SwitchParseError;              }           }         GetToken(theEnv,infile,&theToken);         if ((theToken.type != SYMBOL) ? TRUE :             (strcmp(ValueToString(theToken.value),"then") != 0))           goto SwitchParseErrorAndMessage;        }      else if ((theToken.type == SYMBOL) &&               (strcmp(ValueToString(theToken.value),"default") == 0))        {         if (default_count)           goto SwitchParseErrorAndMessage;         theExp->nextArg = GenConstant(theEnv,RVOID,NULL);         default_count = 1;        }      else        goto SwitchParseErrorAndMessage;      theExp = theExp->nextArg;      if (ExpressionData(theEnv)->svContexts->rtn == TRUE)        ExpressionData(theEnv)->ReturnContext = TRUE;      if (ExpressionData(theEnv)->svContexts->brk == TRUE)        ExpressionData(theEnv)->BreakContext = TRUE;      IncrementIndentDepth(theEnv,3);      PPCRAndIndent(theEnv);      theExp->nextArg = GroupActions(theEnv,infile,&theToken,TRUE,NULL,FALSE);      DecrementIndentDepth(theEnv,3);      ExpressionData(theEnv)->ReturnContext = FALSE;      ExpressionData(theEnv)->BreakContext = FALSE;      if (theExp->nextArg == NULL)        goto SwitchParseError;      theExp = theExp->nextArg;      PPBackup(theEnv);      PPBackup(theEnv);      SavePPBuffer(theEnv,theToken.printForm);      GetToken(theEnv,infile,&theToken);     }   DecrementIndentDepth(theEnv,3);   return(top);SwitchParseErrorAndMessage:   SyntaxErrorMessage(theEnv,"switch function");SwitchParseError:   ReturnExpression(theEnv,top);   DecrementIndentDepth(theEnv,3);   return(NULL);  }/********************************************************//* SearchParsedBindNames:                               *//********************************************************/globle int SearchParsedBindNames(  void *theEnv,  SYMBOL_HN *name_sought)  {   struct BindInfo *var_ptr;   int theIndex = 1;   var_ptr = ProcedureParserData(theEnv)->ListOfParsedBindNames;   while (var_ptr != NULL)     {      if (var_ptr->name == name_sought)        { return(theIndex); }      var_ptr = var_ptr->next;      theIndex++;     }   return(0);  }/********************************************************//* FindBindConstraints:                               *//********************************************************/globle struct constraintRecord *FindBindConstraints(  void *theEnv,  SYMBOL_HN *nameSought)  {   struct BindInfo *theVariable;   theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames;   while (theVariable != NULL)     {      if (theVariable->name == nameSought)        { return(theVariable->constraints); }      theVariable = theVariable->next;     }   return(NULL);  }/********************************************************//* CountParsedBindNames: Counts the number of variables *//*   names that have been bound using the bind function *//*   in the current context (e.g. the RHS of a rule).   *//********************************************************/globle int CountParsedBindNames(  void *theEnv)  {   struct BindInfo *theVariable;   int theIndex = 0;   theVariable = ProcedureParserData(theEnv)->ListOfParsedBindNames;   while (theVariable != NULL)     {      theVariable = theVariable->next;      theIndex++;     }   return(theIndex);  }/****************************************************************//* AddBindName: Adds a variable name used as the first argument *//*   of the bind function to the list of variable names parsed  *//*   within the current semantic context (e.g. RHS of a rule).  *//****************************************************************/static int AddBindName(  void *theEnv,  SYMBOL_HN *variableName,  CONSTRAINT_RECORD *theConstraint)  {   CONSTRAINT_RECORD *tmpConstraint;   struct BindInfo *currentBind, *lastBind;   int theIndex = 1;   /*=========================================================*/   /* Look for the variable name in the list of bind variable */   /* names already parsed. If it is found, then return the   */   /* index to the variable and union the new constraint      */   /* information with the old constraint information.        */   /*=========================================================*/   lastBind = NULL;   currentBind = ProcedureParserData(theEnv)->ListOfParsedBindNames;   while (currentBind != NULL)     {      if (currentBind->name == variableName)        {         if (theConstraint != NULL)           {            tmpConstraint = currentBind->constraints;            currentBind->constraints = UnionConstraints(theEnv,theConstraint,currentBind->constraints);            RemoveConstraint(theEnv,tmpConstraint);            RemoveConstraint(theEnv,theConstraint);           }         return(theIndex);        }      lastBind = currentBind;      currentBind = currentBind->next;      theIndex++;     }   /*===============================================================*/   /* If the variable name wasn't found, then add it to the list of */   /* variable names and store the constraint information with it.  */   /*===============================================================*/   currentBind = get_struct(theEnv,BindInfo);   currentBind->name = variableName;   currentBind->constraints = theConstraint;   currentBind->next = NULL;   if (lastBind == NULL) ProcedureParserData(theEnv)->ListOfParsedBindNames = currentBind;   else lastBind->next = currentBind;   return(theIndex);  }/********************************************************//* RemoveParsedBindName:                                     *//********************************************************/globle void RemoveParsedBindName(  void *theEnv,  struct symbolHashNode *bname)  {   struct BindInfo *prv,*tmp;   prv = NULL;   tmp = ProcedureParserData(theEnv)->ListOfParsedBindNames;   while ((tmp != NULL) ? (tmp->name != bname) : FALSE)     {      prv = tmp;      tmp = tmp->next;     }   if (tmp != NULL)     {      if (prv == NULL)        ProcedureParserData(theEnv)->ListOfParsedBindNames = tmp->next;      else        prv->next = tmp->next;      RemoveConstraint(theEnv,tmp->constraints);      rtn_struct(theEnv,BindInfo,tmp);     }  }#endif#endif