globle struct expr *Function1Parse(
void *theEnv,
char *logicalName)
{
struct token theToken;
struct expr *top;
/*========================*/
/* Get the function name. */
/*========================*/
GetToken(theEnv,logicalName,&theToken);
if (theToken.type != SYMBOL)
{
PrintErrorID(theEnv,"EXPRNPSR",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"A function name must be a symbol\n");
return(NULL);
}
/*=================================*/
/* Parse the rest of the function. */
/*=================================*/
top = Function2Parse(theEnv,logicalName,ValueToString(theToken.value));
return(top);
}
globle int CheckSyntax(
char *theString,
DATA_OBJECT_PTR returnValue)
{
char *name;
struct token theToken;
struct expr *top;
short rv;
/*==============================*/
/* Set the default return value */
/* (TRUE for problems found). */
/*==============================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,TrueSymbol);
/*===========================================*/
/* Create a string source router so that the */
/* string can be used as an input source. */
/*===========================================*/
if (OpenStringSource("check-syntax",theString,0) == 0)
{ return(TRUE); }
/*=================================*/
/* Only expressions and constructs */
/* can have their syntax checked. */
/*=================================*/
GetToken("check-syntax",&theToken);
if (theToken.type != LPAREN)
{
CloseStringSource("check-syntax");
SetpValue(returnValue,AddSymbol("MISSING-LEFT-PARENTHESIS"));
return(TRUE);
}
/*========================================*/
/* The next token should be the construct */
/* type or function name. */
/*========================================*/
GetToken("check-syntax",&theToken);
if (theToken.type != SYMBOL)
{
CloseStringSource("check-syntax");
SetpValue(returnValue,AddSymbol("EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS"));
return(TRUE);
}
name = ValueToString(theToken.value);
/*==============================================*/
/* Set up a router to capture the error output. */
/*==============================================*/
AddRouter("error-capture",40,
FindErrorCapture, PrintErrorCapture,
NULL, NULL, NULL);
/*================================*/
/* Determine if it's a construct. */
/*================================*/
if (FindConstruct(name))
{
CheckSyntaxMode = TRUE;
rv = (short) ParseConstruct(name,"check-syntax");
GetToken("check-syntax",&theToken);
CheckSyntaxMode = FALSE;
if (rv)
{
PrintRouter(WERROR,"\nERROR:\n");
PrintInChunks(WERROR,GetPPBuffer());
PrintRouter(WERROR,"\n");
}
DestroyPPBuffer();
CloseStringSource("check-syntax");
if ((rv != FALSE) || (WarningString != NULL))
{
SetErrorCaptureValues(returnValue);
DeactivateErrorCapture();
return(TRUE);
}
if (theToken.type != STOP)
{
SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
DeactivateErrorCapture();
return(TRUE);
}
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,FalseSymbol);
DeactivateErrorCapture();
return(FALSE);
}
/*=======================*/
/* Parse the expression. */
/*=======================*/
top = Function2Parse("check-syntax",name);
GetToken("check-syntax",&theToken);
ClearParsedBindNames();
CloseStringSource("check-syntax");
if (top == NULL)
{
SetErrorCaptureValues(returnValue);
DeactivateErrorCapture();
return(TRUE);
}
if (theToken.type != STOP)
{
SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
DeactivateErrorCapture();
ReturnExpression(top);
return(TRUE);
}
DeactivateErrorCapture();
ReturnExpression(top);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,FalseSymbol);
return(FALSE);
}
bool RouteCommand(
void *theEnv,
const char *command,
bool printResult)
{
DATA_OBJECT result;
struct expr *top;
const char *commandName;
struct token theToken;
int danglingConstructs;
if (command == NULL)
{ return(0); }
/*========================================*/
/* Open a string input source and get the */
/* first token from that source. */
/*========================================*/
OpenStringSource(theEnv,"command",command,0);
GetToken(theEnv,"command",&theToken);
/*=====================*/
/* Evaluate constants. */
/*=====================*/
if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
(theToken.type == FLOAT) || (theToken.type == INTEGER) ||
(theToken.type == INSTANCE_NAME))
{
CloseStringSource(theEnv,"command");
if (printResult)
{
PrintAtom(theEnv,STDOUT,theToken.type,theToken.value);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return(1);
}
/*=====================*/
/* Evaluate variables. */
/*=====================*/
if ((theToken.type == GBL_VARIABLE) ||
(theToken.type == SF_VARIABLE) ||
(theToken.type == MF_VARIABLE))
{
CloseStringSource(theEnv,"command");
top = GenConstant(theEnv,theToken.type,theToken.value);
EvaluateExpression(theEnv,top,&result);
rtn_struct(theEnv,expr,top);
if (printResult)
{
PrintDataObject(theEnv,STDOUT,&result);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return(1);
}
/*========================================================*/
/* If the next token isn't the beginning left parenthesis */
/* of a command or construct, then whatever was entered */
/* cannot be evaluated at the command prompt. */
/*========================================================*/
if (theToken.type != LPAREN)
{
PrintErrorID(theEnv,"COMMLINE",1,false);
EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or variable\n");
CloseStringSource(theEnv,"command");
return(0);
}
/*===========================================================*/
/* The next token must be a function name or construct type. */
/*===========================================================*/
GetToken(theEnv,"command",&theToken);
if (theToken.type != SYMBOL)
{
PrintErrorID(theEnv,"COMMLINE",2,false);
EnvPrintRouter(theEnv,WERROR,"Expected a command.\n");
CloseStringSource(theEnv,"command");
return(0);
}
commandName = ValueToString(theToken.value);
/*======================*/
/* Evaluate constructs. */
/*======================*/
#if (! RUN_TIME) && (! BLOAD_ONLY)
{
int errorFlag;
errorFlag = ParseConstruct(theEnv,commandName,"command");
if (errorFlag != -1)
{
CloseStringSource(theEnv,"command");
if (errorFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
}
DestroyPPBuffer(theEnv);
if (errorFlag) return 0;
else return 1;
}
}
#endif
/*========================*/
/* Parse a function call. */
/*========================*/
danglingConstructs = ConstructData(theEnv)->DanglingConstructs;
CommandLineData(theEnv)->ParsingTopLevelCommand = true;
top = Function2Parse(theEnv,"command",commandName);
CommandLineData(theEnv)->ParsingTopLevelCommand = false;
ClearParsedBindNames(theEnv);
/*================================*/
/* Close the string input source. */
/*================================*/
CloseStringSource(theEnv,"command");
/*=========================*/
/* Evaluate function call. */
/*=========================*/
if (top == NULL)
{
ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
return false;
}
ExpressionInstall(theEnv,top);
CommandLineData(theEnv)->EvaluatingTopLevelCommand = true;
CommandLineData(theEnv)->CurrentCommand = top;
EvaluateExpression(theEnv,top,&result);
CommandLineData(theEnv)->CurrentCommand = NULL;
CommandLineData(theEnv)->EvaluatingTopLevelCommand = false;
ExpressionDeinstall(theEnv,top);
ReturnExpression(theEnv,top);
ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
/*=================================================*/
/* Print the return value of the function/command. */
/*=================================================*/
if ((result.type != RVOID) && printResult)
{
PrintDataObject(theEnv,STDOUT,&result);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return true;
}
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,1L));
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,1L));
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,1L));
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;
}
SavePPBuffer(theEnv," ");
}
}
if (CheckArgumentAgainstRestriction(theEnv,parse->argList->nextArg,(int) 'i'))
goto LoopForCountParseError;
/*====================================*/
/* 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
goto LoopForCountParseError;
/*=====================================*/
/* Process the loop-for-count actions. */
/*=====================================*/
if (ExpressionData(theEnv)->svContexts->rtn == TRUE)
ExpressionData(theEnv)->ReturnContext = TRUE;
ExpressionData(theEnv)->BreakContext = TRUE;
oldBindList = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
parse->argList->nextArg->nextArg =
GroupActions(theEnv,infile,&theToken,read_first_paren,NULL,FALSE);
if (parse->argList->nextArg->nextArg == NULL)
{
SetParsedBindNames(theEnv,oldBindList);
ReturnExpression(theEnv,parse);
return(NULL);
}
newBindList = GetParsedBindNames(theEnv);
prev = NULL;
while (newBindList != NULL)
{
if ((loopVar == NULL) ? FALSE :
(strcmp(ValueToString(newBindList->name),ValueToString(loopVar)) == 0))
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
PrintErrorID(theEnv,"PRCDRPSR",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"Cannot rebind loop variable in function loop-for-count.\n");
ReturnExpression(theEnv,parse);
return(NULL);
}
prev = newBindList;
newBindList = newBindList->next;
}
if (prev == NULL)
SetParsedBindNames(theEnv,oldBindList);
else
prev->next = oldBindList;
if (loopVar != NULL)
ReplaceLoopCountVars(theEnv,loopVar,parse->argList->nextArg->nextArg,0);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,theToken.printForm);
/*================================================================*/
/* Check for the closing right parenthesis of the loop-for-count. */
/*================================================================*/
if (theToken.type != RPAREN)
{
SyntaxErrorMessage(theEnv,"loop-for-count function");
ReturnExpression(theEnv,parse);
return(NULL);
}
DecrementIndentDepth(theEnv,3);
return(parse);
LoopForCountParseError:
SyntaxErrorMessage(theEnv,"loop-for-count function");
ReturnExpression(theEnv,parse);
return(NULL);
}
globle struct expr *GroupActions(
void *theEnv,
char *logicalName,
struct token *theToken,
int readFirstToken,
char *endWord,
int functionNameParsed)
{
struct expr *top, *nextOne, *lastOne = NULL;
/*=============================*/
/* Create the enclosing progn. */
/*=============================*/
top = GenConstant(theEnv,FCALL,FindFunction(theEnv,"progn"));
/*========================================================*/
/* Continue until all appropriate commands are processed. */
/*========================================================*/
while (TRUE)
{
/*================================================*/
/* Skip reading in the token if this is the first */
/* pass and the initial token was already read */
/* before calling this function. */
/*================================================*/
if (readFirstToken)
{ GetToken(theEnv,logicalName,theToken); }
else
{ readFirstToken = TRUE; }
/*=================================================*/
/* Look to see if a symbol has terminated the list */
/* of actions (such as "else" in an if function). */
/*=================================================*/
if ((theToken->type == SYMBOL) &&
(endWord != NULL) &&
(! functionNameParsed))
{
if (strcmp(ValueToString(theToken->value),endWord) == 0)
{ return(top); }
}
/*====================================*/
/* Process a function if the function */
/* name has already been read. */
/*====================================*/
if (functionNameParsed)
{
nextOne = Function2Parse(theEnv,logicalName,ValueToString(theToken->value));
functionNameParsed = FALSE;
}
/*========================================*/
/* Process a constant or global variable. */
/*========================================*/
else if ((theToken->type == SYMBOL) || (theToken->type == STRING) ||
(theToken->type == INTEGER) || (theToken->type == FLOAT) ||
#if DEFGLOBAL_CONSTRUCT
(theToken->type == GBL_VARIABLE) ||
(theToken->type == MF_GBL_VARIABLE) ||
#endif
#if OBJECT_SYSTEM
(theToken->type == INSTANCE_NAME) ||
#endif
(theToken->type == SF_VARIABLE) || (theToken->type == MF_VARIABLE))
{ nextOne = GenConstant(theEnv,theToken->type,theToken->value); }
/*=============================*/
/* Otherwise parse a function. */
/*=============================*/
else if (theToken->type == LPAREN)
{ nextOne = Function1Parse(theEnv,logicalName); }
/*======================================*/
/* Otherwise replace sequence expansion */
/* variables and return the expression. */
/*======================================*/
else
{
if (ReplaceSequenceExpansionOps(theEnv,top,NULL,
FindFunction(theEnv,"(expansion-call)"),
FindFunction(theEnv,"expand$")))
{
ReturnExpression(theEnv,top);
return(NULL);
}
return(top);
}
/*===========================*/
/* Add the new action to the */
/* list of progn arguments. */
/*===========================*/
if (nextOne == NULL)
{
theToken->type = UNKNOWN_VALUE;
ReturnExpression(theEnv,top);
return(NULL);
}
if (lastOne == NULL)
{ top->argList = nextOne; }
else
{ lastOne->nextArg = nextOne; }
lastOne = nextOne;
PPCRAndIndent(theEnv);
}
}
