/*******************************************************/   /*      "C" Language Integrated Production System      */   /*                                                     */   /*             CLIPS Version 6.24  06/05/06            */   /*                                                     */   /*          PROCEDURAL FUNCTIONS PARSER MODULE         */   /*******************************************************//*************************************************************//* Purpose:                                                  *//*                                                           *//* Principal Programmer(s):                                  *//*      Gary D. Riley                                        *//*      Brian L. Donnell                                     *//*                                                           *//* Contributing Programmer(s):                               *//*                                                           *//* Revision History:                                         *//*      6.23: Changed name of variable exp to theExp         *//*            because of Unix compiler warnings of shadowed  *//*            definitions.                                   *//*                                                           *//*      6.24: Renamed BOOLEAN macro type to intBool.         *//*                                                           *//*************************************************************/#define _PRCDRPSR_SOURCE_#include <stdio.h>#define _STDIO_INCLUDED_#include "setup.h"#include "argacces.h"#include "constrnt.h"#include "cstrnchk.h"#include "cstrnops.h"#include "cstrnutl.h"#include "envrnmnt.h"#include "exprnpsr.h"#include "memalloc.h"#include "modulutl.h"#include "multifld.h"#include "router.h"#include "scanner.h"#include "utility.h"#include "prcdrpsr.h"#if DEFGLOBAL_CONSTRUCT#include "globldef.h"#include "globlpsr.h"#endif#if ! RUN_TIME#define PRCDRPSR_DATA 12struct procedureParserData  {    struct BindInfo *ListOfParsedBindNames;  };#define ProcedureParserData(theEnv) ((struct procedureParserData *) GetEnvironmentData(theEnv,PRCDRPSR_DATA))#endif/***************************************//* LOCAL INTERNAL FUNCTION DEFINITIONS *//***************************************/#if (! RUN_TIME) && (! BLOAD_ONLY)   static struct expr            *WhileParse(void *,struct expr *,char *);   static struct expr            *LoopForCountParse(void *,struct expr *,char *);   static void                    ReplaceLoopCountVars(void *,SYMBOL_HN *,EXPRESSION *,int);   static struct expr            *IfParse(void *,struct expr *,char *);   static struct expr            *PrognParse(void *,struct expr *,char *);   static struct expr            *BindParse(void *,struct expr *,char *);   static int                     AddBindName(void *,struct symbolHashNode *,CONSTRAINT_RECORD *);   static struct expr            *ReturnParse(void *,struct expr *,char *);   static struct expr            *BreakParse(void *,struct expr *,char *);   static struct expr            *SwitchParse(void *,struct expr *,char *);   static void                    DeallocateProceduralFunctionData(void *);#endif#if ! RUN_TIME/*******************************************//* ProceduralFunctionParsers        *//*******************************************/globle void ProceduralFunctionParsers(  void *theEnv)  {   AllocateEnvironmentData(theEnv,PRCDRPSR_DATA,sizeof(struct procedureParserData),DeallocateProceduralFunctionData);#if (! BLOAD_ONLY)   AddFunctionParser(theEnv,"bind",BindParse);   AddFunctionParser(theEnv,"progn",PrognParse);   AddFunctionParser(theEnv,"if",IfParse);   AddFunctionParser(theEnv,"while",WhileParse);   AddFunctionParser(theEnv,"loop-for-count",LoopForCountParse);   AddFunctionParser(theEnv,"return",ReturnParse);   AddFunctionParser(theEnv,"break",BreakParse);   AddFunctionParser(theEnv,"switch",SwitchParse);#endif  }/*************************************************************//* DeallocateProceduralFunctionData: Deallocates environment *//*    data for procedural functions.                         *//*************************************************************/static void DeallocateProceduralFunctionData(  void *theEnv)  {    struct BindInfo *temp_bind;   while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL)     {      temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next;      rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames);      ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind;     }  }/********************************************************//* GetParsedBindNames:                                      *//********************************************************/globle struct BindInfo *GetParsedBindNames(  void *theEnv)  {   return(ProcedureParserData(theEnv)->ListOfParsedBindNames);  }/********************************************************//* SetParsedBindNames:                                      *//********************************************************/globle void SetParsedBindNames(  void *theEnv,  struct BindInfo *newValue)  {   ProcedureParserData(theEnv)->ListOfParsedBindNames = newValue;  }/********************************************************//* ClearParsedBindNames:                                     *//********************************************************/globle void ClearParsedBindNames(  void *theEnv)  {   struct BindInfo *temp_bind;   while (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL)     {      temp_bind = ProcedureParserData(theEnv)->ListOfParsedBindNames->next;      RemoveConstraint(theEnv,ProcedureParserData(theEnv)->ListOfParsedBindNames->constraints);      rtn_struct(theEnv,BindInfo,ProcedureParserData(theEnv)->ListOfParsedBindNames);      ProcedureParserData(theEnv)->ListOfParsedBindNames = temp_bind;     }  }/********************************************************//* ParsedBindNamesEmpty:                                     *//********************************************************/globle intBool ParsedBindNamesEmpty(  void *theEnv)  {   if (ProcedureParserData(theEnv)->ListOfParsedBindNames != NULL) return(FALSE);   return(TRUE);  }#if (! BLOAD_ONLY)/*********************************************************//* WhileParse: purpose is to parse the while statement.  *//*   The parse of the statement is the return value.     *//*   Syntax: (while <expression> do <action>+)           *//*********************************************************/static struct expr *WhileParse(  void *theEnv,  struct expr *parse,  char *infile)  {   struct token theToken;   int read_first_paren;   /*===============================*/   /* Process the while expression. */   /*===============================*/   SavePPBuffer(theEnv," ");   parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);   if (parse->argList == NULL)     {      ReturnExpression(theEnv,parse);      return(NULL);     }   /*====================================*/   /* Process the do keyword if present. */   /*====================================*/   GetToken(theEnv,infile,&theToken);   if ((theToken.type == SYMBOL) && (strcmp(ValueToString(theToken.value),"do") == 0))     {      read_first_paren = TRUE;      PPBackup(theEnv);      SavePPBuffer(theEnv," ");      SavePPBuffer(theEnv,theToken.printForm);      IncrementIndentDepth(theEnv,3);      PPCRAndIndent(theEnv);     }   else if (theToken.type == LPAREN)     {      read_first_paren = FALSE;      PPBackup(theEnv);      IncrementIndentDepth(theEnv,3);      PPCRAndIndent(theEnv);      SavePPBuffer(theEnv,theToken.printForm);     }   else     {      SyntaxErrorMessage(theEnv,"while function");      ReturnExpression(theEnv,parse);      return(NULL);     }   /*============================*/   /* Process the while actions. */   /*============================*/   if (ExpressionData(theEnv)->svContexts->rtn == TRUE)     ExpressionData(theEnv)->ReturnContext = TRUE;   ExpressionData(theEnv)->BreakContext = TRUE;   parse->argList->nextArg = GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);   if (parse->argList->nextArg == NULL)     {      ReturnExpression(theEnv,parse);      return(NULL);     }   PPBackup(theEnv);   PPBackup(theEnv);   SavePPBuffer(theEnv,theToken.printForm);   /*=======================================================*/   /* Check for the closing right parenthesis of the while. */   /*=======================================================*/   if (theToken.type != RPAREN)     {      SyntaxErrorMessage(theEnv,"while function");      ReturnExpression(theEnv,parse);      return(NULL);     }   DecrementIndentDepth(theEnv,3);   return(parse);  }/******************************************************************************************//* LoopForCountParse: purpose is to parse the loop-for-count statement.                   *//*   The parse of the statement is the return value.                                      *//*   Syntax: (loop-for-count <range> [do] <action>+)                                      *//*           <range> ::= (<sf-var> [<start-integer-expression>] <end-integer-expression>) *//******************************************************************************************/static struct expr *LoopForCountParse(  void *theEnv,  struct expr *parse,  char *infile)  {   struct token theToken;   SYMBOL_HN *loopVar = NULL;   EXPRESSION *tmpexp;   int read_first_paren;   struct BindInfo *oldBindList,*newBindList,*prev;   /*======================================*/   /* Process the loop counter expression. */   /*======================================*/   SavePPBuffer(theEnv," ");   GetToken(theEnv,infile,&theToken);   /* ==========================================      Simple form: loop-for-count <end> [do] ...      ========================================== */   if (theToken.type != LPAREN)     {      parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));      parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);      if (parse->argList->nextArg == NULL)        {         ReturnExpression(theEnv,parse);         return(NULL);        }     }   else     {      GetToken(theEnv,infile,&theToken);      if (theToken.type != SF_VARIABLE)        {         if (theToken.type != SYMBOL)           goto LoopForCountParseError;         parse->argList = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));         parse->argList->nextArg = Function2Parse(theEnv,infile,ValueToString(theToken.value));         if (parse->argList->nextArg == NULL)           {            ReturnExpression(theEnv,parse);            return(NULL);           }        }      /* =============================================================         Complex form: loop-for-count (<var> [<start>] <end>) [do] ...         ============================================================= */      else        {         loopVar = (SYMBOL_HN *) theToken.value;         SavePPBuffer(theEnv," ");         parse->argList = ParseAtomOrExpression(theEnv,infile,NULL);         if (parse->argList == NULL)           {            ReturnExpression(theEnv,parse);            return(NULL);           }         if (CheckArgumentAgainstRestriction(theEnv,parse->argList,(int) 'i'))           goto LoopForCountParseError;         SavePPBuffer(theEnv," ");         GetToken(theEnv,infile,&theToken);         if (theToken.type == RPAREN)           {            PPBackup(theEnv);            PPBackup(theEnv);            SavePPBuffer(theEnv,theToken.printForm);            tmpexp = GenConstant(theEnv,INTEGER,EnvAddLong(theEnv,1LL));            tmpexp->nextArg = parse->argList;            parse->argList = tmpexp;           }         else          {            parse->argList->nextArg = ParseAtomOrExpression(theEnv,infile,&theToken);            if (parse->argList->nextArg == NULL)              {               ReturnExpression(theEnv,parse);               return(NULL);              }            GetToken(theEnv,infile,&theToken);            if (theToken.type != RPAREN)              goto LoopForCountParseError;           }