globle struct expr *Function0Parse(
void *theEnv,
char *logicalName)
{
struct token theToken;
struct expr *top;
/*=================================*/
/* All functions begin with a '('. */
/*=================================*/
GetToken(theEnv,logicalName,&theToken);
if (theToken.type != LPAREN)
{
SyntaxErrorMessage(theEnv,"function calls");
return(NULL);
}
/*=================================*/
/* Parse the rest of the function. */
/*=================================*/
top = Function1Parse(theEnv,logicalName);
return(top);
}
globle struct expr *ArgumentParse(
void *theEnv,
char *logicalName,
int *errorFlag)
{
struct expr *top;
struct token theToken;
/*===============*/
/* Grab a token. */
/*===============*/
GetToken(theEnv,logicalName,&theToken);
/*============================*/
/* ')' counts as no argument. */
/*============================*/
if (theToken.type == RPAREN)
{ return(NULL); }
/*================================*/
/* Parse constants and variables. */
/*================================*/
if ((theToken.type == SF_VARIABLE) || (theToken.type == MF_VARIABLE) ||
(theToken.type == SYMBOL) || (theToken.type == STRING) ||
#if DEFGLOBAL_CONSTRUCT
(theToken.type == GBL_VARIABLE) ||
(theToken.type == MF_GBL_VARIABLE) ||
#endif
#if OBJECT_SYSTEM
(theToken.type == INSTANCE_NAME) ||
#endif
(theToken.type == FLOAT) || (theToken.type == INTEGER))
{ return(GenConstant(theEnv,theToken.type,theToken.value)); }
/*======================*/
/* Parse function call. */
/*======================*/
if (theToken.type != LPAREN)
{
PrintErrorID(theEnv,"EXPRNPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression.\n");
*errorFlag = TRUE;
return(NULL);
}
top = Function1Parse(theEnv,logicalName);
if (top == NULL) *errorFlag = TRUE;
return(top);
}
globle struct expr *ParseAtomOrExpression(
void *theEnv,
char *logicalName,
struct token *useToken)
{
struct token theToken, *thisToken;
struct expr *rv;
if (useToken == NULL)
{
thisToken = &theToken;
GetToken(theEnv,logicalName,thisToken);
}
else thisToken = useToken;
if ((thisToken->type == SYMBOL) || (thisToken->type == STRING) ||
(thisToken->type == INTEGER) || (thisToken->type == FLOAT) ||
#if OBJECT_SYSTEM
(thisToken->type == INSTANCE_NAME) ||
#endif
#if DEFGLOBAL_CONSTRUCT
(thisToken->type == GBL_VARIABLE) ||
(thisToken->type == MF_GBL_VARIABLE) ||
#endif
(thisToken->type == SF_VARIABLE) || (thisToken->type == MF_VARIABLE))
{ rv = GenConstant(theEnv,thisToken->type,thisToken->value); }
else if (thisToken->type == LPAREN)
{
rv = Function1Parse(theEnv,logicalName);
if (rv == NULL) return(NULL);
}
else
{
PrintErrorID(theEnv,"EXPRNPSR",2,TRUE);
EnvPrintRouter(theEnv,WERROR,"Expected a constant, variable, or expression.\n");
return(NULL);
}
return(rv);
}
globle struct expr *GetAssertArgument(
char *logicalName,
struct token *theToken,
int *error,
int endType,
int constantsOnly,
int *printError)
{
struct expr *nextField;
/*=================================================*/
/* Read in the first token of the slot's value. If */
/* the end delimiter is encountered, then return. */
/*=================================================*/
*printError = TRUE;
GetToken(logicalName,theToken);
if (theToken->type == endType) return(NULL);
/*=============================================================*/
/* If an equal sign of left parenthesis was parsed, then parse */
/* a function which is to be evaluated to determine the slot's */
/* value. The equal sign corresponds to the return value */
/* constraint which can be used in LHS fact patterns. The */
/* equal sign is no longer necessary on either the LHS or RHS */
/* of a rule to indicate that a function is being evaluated to */
/* determine its value either for assignment or pattern */
/* matching. */
/*=============================================================*/
if ((theToken->type == SYMBOL) ?
(strcmp(ValueToString(theToken->value),"=") == 0) :
(theToken->type == LPAREN))
{
if (constantsOnly)
{
*error = TRUE;
return(NULL);
}
#if ! RUN_TIME
if (theToken->type == LPAREN) nextField = Function1Parse(logicalName);
else nextField = Function0Parse(logicalName);
if (nextField == NULL)
#endif
{
*printError = FALSE;
*error = TRUE;
}
#if ! RUN_TIME
else
{
theToken->type= RPAREN;
theToken->value = (void *) AddSymbol(")");
theToken->printForm = ")";
}
#endif
return(nextField);
}
/*==================================================*/
/* Constants are always allowed as RHS slot values. */
/*==================================================*/
if ((theToken->type == SYMBOL) || (theToken->type == STRING) ||
#if OBJECT_SYSTEM
(theToken->type == INSTANCE_NAME) ||
#endif
(theToken->type == FLOAT) || (theToken->type == INTEGER))
{ return(GenConstant(theToken->type,theToken->value)); }
/*========================================*/
/* Variables are also allowed as RHS slot */
/* values under some circumstances. */
/*========================================*/
if ((theToken->type == SF_VARIABLE) ||
#if DEFGLOBAL_CONSTRUCT
(theToken->type == GBL_VARIABLE) ||
(theToken->type == MF_GBL_VARIABLE) ||
#endif
(theToken->type == MF_VARIABLE))
{
if (constantsOnly)
{
*error = TRUE;
return(NULL);
}
return(GenConstant(theToken->type,theToken->value));
}
/*==========================================================*/
/* If none of the other cases have been satisfied, then the */
/* token parsed is not appropriate for a RHS slot value. */
/*==========================================================*/
*error = TRUE;
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);
}
}
