/********************************************************************************
NAME : ParseSlotOverrides
DESCRIPTION : Forms expressions for slot-overrides
INPUTS : 1) The logical name of the input
2) Caller's buffer for error flkag
RETURNS : Address override expressions, NULL
if none or error.
SIDE EFFECTS : Slot-expression built
Caller's error flag set
NOTES : <slot-override> ::= (<slot-name> <value>*)*
goes to
<slot-name> --> <dummy-node> --> <slot-name> --> <dummy-node>...
|
V
<value-expression> --> <value-expression> --> ...
Assumes first token has already been scanned
********************************************************************************/
globle EXPRESSION *ParseSlotOverrides(
void *theEnv,
const char *readSource,
int *error)
{
EXPRESSION *top = NULL,*bot = NULL,*theExp;
EXPRESSION *theExpNext;
while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
{
*error = FALSE;
theExp = ArgumentParse(theEnv,readSource,error);
if (*error == TRUE)
{
ReturnExpression(theEnv,top);
return(NULL);
}
else if (theExp == NULL)
{
SyntaxErrorMessage(theEnv,"slot-override");
*error = TRUE;
ReturnExpression(theEnv,top);
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
theExpNext = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv));
if (CollectArguments(theEnv,theExpNext,readSource) == NULL)
{
*error = TRUE;
ReturnExpression(theEnv,top);
ReturnExpression(theEnv,theExp);
return(NULL);
}
theExp->nextArg = theExpNext;
if (top == NULL)
top = theExp;
else
bot->nextArg = theExp;
bot = theExp->nextArg;
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
return(top);
}
/********************************************************************************
NAME : ParseSlotOverrides
DESCRIPTION : Forms expressions for slot-overrides
INPUTS : 1) The logical name of the input
2) Caller's buffer for error flkag
RETURNS : Address override expressions, NULL
if none or error.
SIDE EFFECTS : Slot-expression built
Caller's error flag set
NOTES : <slot-override> ::= (<slot-name> <value>*)*
goes to
<slot-name> --> <dummy-node> --> <slot-name> --> <dummy-node>...
|
V
<value-expression> --> <value-expression> --> ...
Assumes first token has already been scanned
********************************************************************************/
globle EXPRESSION *ParseSlotOverrides(
char *readSource,
int *error)
{
EXPRESSION *top = NULL,*bot = NULL,*exp;
while (GetType(ObjectParseToken) == LPAREN)
{
*error = FALSE;
exp = ArgumentParse(readSource,error);
if (*error == TRUE)
{
ReturnExpression(top);
return(NULL);
}
else if (exp == NULL)
{
SyntaxErrorMessage("slot-override");
*error = TRUE;
ReturnExpression(top);
SetEvaluationError(TRUE);
return(NULL);
}
exp->nextArg = GenConstant(SYMBOL,TrueSymbol);
if (CollectArguments(exp->nextArg,readSource) == NULL)
{
*error = TRUE;
ReturnExpression(top);
return(NULL);
}
if (top == NULL)
top = exp;
else
bot->nextArg = exp;
bot = exp->nextArg;
PPCRAndIndent();
GetToken(readSource,&ObjectParseToken);
}
PPBackup();
PPBackup();
SavePPBuffer(ObjectParseToken.print_rep);
return(top);
}
static struct expr *BindParse(
void *theEnv,
struct expr *top,
char *infile)
{
struct token theToken;
SYMBOL_HN *variableName;
struct expr *texp;
CONSTRAINT_RECORD *theConstraint = NULL;
#if DEFGLOBAL_CONSTRUCT
struct defglobal *theGlobal;
int count;
#endif
SavePPBuffer(theEnv," ");
/*=============================================*/
/* Next token must be the name of the variable */
/* to be bound. */
/*=============================================*/
GetToken(theEnv,infile,&theToken);
if ((theToken.type != SF_VARIABLE) && (theToken.type != GBL_VARIABLE))
{
if ((theToken.type != MF_VARIABLE) || ExpressionData(theEnv)->SequenceOpMode)
{
SyntaxErrorMessage(theEnv,"bind function");
ReturnExpression(theEnv,top);
return(NULL);
}
}
/*==============================*/
/* Process the bind expression. */
/*==============================*/
top->argList = GenConstant(theEnv,SYMBOL,theToken.value);
variableName = (SYMBOL_HN *) theToken.value;
#if DEFGLOBAL_CONSTRUCT
if ((theToken.type == GBL_VARIABLE) ?
((theGlobal = (struct defglobal *)
FindImportedConstruct(theEnv,"defglobal",NULL,ValueToString(variableName),
&count,TRUE,FALSE)) != NULL) :
FALSE)
{
top->argList->type = DEFGLOBAL_PTR;
top->argList->value = (void *) theGlobal;
}
else if (theToken.type == GBL_VARIABLE)
{
GlobalReferenceErrorMessage(theEnv,ValueToString(variableName));
ReturnExpression(theEnv,top);
return(NULL);
}
#endif
texp = get_struct(theEnv,expr);
texp->argList = texp->nextArg = NULL;
if (CollectArguments(theEnv,texp,infile) == NULL)
{
ReturnExpression(theEnv,top);
return(NULL);
}
top->argList->nextArg = texp->argList;
rtn_struct(theEnv,expr,texp);
#if DEFGLOBAL_CONSTRUCT
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);
}
globle struct expr *Function2Parse(
void *theEnv,
char *logicalName,
char *name)
{
struct FunctionDefinition *theFunction;
struct expr *top;
#if DEFGENERIC_CONSTRUCT
void *gfunc;
#endif
#if DEFFUNCTION_CONSTRUCT
void *dptr;
#endif
/*=========================================================*/
/* Module specification cannot be used in a function call. */
/*=========================================================*/
if (FindModuleSeparator(name))
{
IllegalModuleSpecifierMessage(theEnv);
return(NULL);
}
/*================================*/
/* Has the function been defined? */
/*================================*/
theFunction = FindFunction(theEnv,name);
#if DEFGENERIC_CONSTRUCT
gfunc = (void *) LookupDefgenericInScope(theEnv,name);
#endif
#if DEFFUNCTION_CONSTRUCT
if ((theFunction == NULL)
#if DEFGENERIC_CONSTRUCT
&& (gfunc == NULL)
#endif
)
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,"EXPRNPSR",3,TRUE);
EnvPrintRouter(theEnv,WERROR,"Missing function declaration for ");
EnvPrintRouter(theEnv,WERROR,name);
EnvPrintRouter(theEnv,WERROR,".\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,"(expansion-call)"),
FindFunction(theEnv,"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,"(expansion-call)"),
FindFunction(theEnv,"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,"(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);
}
