/*************************************************************
NAME : ParseQueryTestExpression
DESCRIPTION : Parses the test-expression for a query
INPUTS : 1) The top node of the query expression
2) The logical name of the input
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : Entire query-expression deleted on errors
Nodes allocated for new expression
Test shoved in front of class-restrictions on
query argument list
NOTES : Expects top != NULL
*************************************************************/
static int ParseQueryTestExpression(
void *theEnv,
EXPRESSION *top,
const char *readSource)
{
EXPRESSION *qtest;
int error;
struct BindInfo *oldBindList;
error = FALSE;
oldBindList = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
qtest = ArgumentParse(theEnv,readSource,&error);
if (error == TRUE)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
ReturnExpression(theEnv,top);
return(FALSE);
}
if (qtest == NULL)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
SyntaxErrorMessage(theEnv,"fact-set query function");
ReturnExpression(theEnv,top);
return(FALSE);
}
qtest->nextArg = top->argList;
top->argList = qtest;
if (ParsedBindNamesEmpty(theEnv) == FALSE)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
PrintErrorID(theEnv,"FACTQPSR",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Binds are not allowed in fact-set query in function ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
EnvPrintRouter(theEnv,WERROR,".\n");
ReturnExpression(theEnv,top);
return(FALSE);
}
SetParsedBindNames(theEnv,oldBindList);
return(TRUE);
}
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);
}
/********************************************************************************
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);
}
globle struct expr *CollectArguments(
void *theEnv,
struct expr *top,
char *logicalName)
{
int errorFlag;
struct expr *lastOne, *nextOne;
/*========================================*/
/* Default parsing routine for functions. */
/*========================================*/
lastOne = NULL;
while (TRUE)
{
SavePPBuffer(theEnv," ");
errorFlag = FALSE;
nextOne = ArgumentParse(theEnv,logicalName,&errorFlag);
if (errorFlag == TRUE)
{
ReturnExpression(theEnv,top);
return(NULL);
}
if (nextOne == NULL)
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
return(top);
}
if (lastOne == NULL)
{ top->argList = nextOne; }
else
{ lastOne->nextArg = nextOne; }
lastOne = nextOne;
}
}
/********************************************************************************
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);
}
/*************************************************************************************
NAME : ParseInitializeInstance
DESCRIPTION : Parses initialize-instance and make-instance function
calls into an EXPRESSION form that
can later be evaluated with EvaluateExpression(theEnv,)
INPUTS : 1) The address of the top node of the expression
containing the initialize-instance function call
2) The logical name of the input source
RETURNS : The address of the modified expression, or NULL
if there is an error
SIDE EFFECTS : The expression is enhanced to include all
aspects of the initialize-instance call
(slot-overrides etc.)
The "top" expression is deleted on errors.
NOTES : This function parses a initialize-instance call into
an expression of the following form :
(initialize-instance <instance-name> <slot-override>*)
where <slot-override> ::= (<slot-name> <expression>+)
goes to -->
initialize-instance
|
V
<instance or name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(make-instance <instance> of <class> <slot-override>*)
goes to -->
make-instance
|
V
<instance-name>-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(make-instance of <class> <slot-override>*)
goes to -->
make-instance
|
V
(gensym*)-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(modify-instance <instance> <slot-override>*)
goes to -->
modify-instance
|
V
<instance or name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
(duplicate-instance <instance> [to <new-name>] <slot-override>*)
goes to -->
duplicate-instance
|
V
<instance or name>-><new-name>-><slot-name>-><dummy-node>...
OR |
(gensym*) V
<value-expression>...
*************************************************************************************/
globle EXPRESSION *ParseInitializeInstance(
void *theEnv,
EXPRESSION *top,
const char *readSource)
{
int error,fcalltype,readclass;
if ((top->value == (void *) FindFunction(theEnv,"make-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-make-instance")))
fcalltype = MAKE_TYPE;
else if ((top->value == (void *) FindFunction(theEnv,"initialize-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-initialize-instance")))
fcalltype = INITIALIZE_TYPE;
else if ((top->value == (void *) FindFunction(theEnv,"modify-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-modify-instance")) ||
(top->value == (void *) FindFunction(theEnv,"message-modify-instance")) ||
(top->value == (void *) FindFunction(theEnv,"active-message-modify-instance")))
fcalltype = MODIFY_TYPE;
else
fcalltype = DUPLICATE_TYPE;
IncrementIndentDepth(theEnv,3);
error = FALSE;
if (top->type == UNKNOWN_VALUE)
top->type = FCALL;
else
SavePPBuffer(theEnv," ");
top->argList = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseInitializeInstanceError;
else if (top->argList == NULL)
{
SyntaxErrorMessage(theEnv,"instance");
goto ParseInitializeInstanceError;
}
SavePPBuffer(theEnv," ");
if (fcalltype == MAKE_TYPE)
{
/* ======================================
Handle the case of anonymous instances
where the name was not specified
====================================== */
if ((top->argList->type != SYMBOL) ? FALSE :
(strcmp(ValueToString(top->argList->value),CLASS_RLN) == 0))
{
top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
if (error == TRUE)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage(theEnv,"instance class");
goto ParseInitializeInstanceError;
}
if ((top->argList->nextArg->type != SYMBOL) ? TRUE :
(strcmp(ValueToString(top->argList->nextArg->value),CLASS_RLN) != 0))
{
top->argList->type = FCALL;
top->argList->value = (void *) FindFunction(theEnv,"gensym*");
readclass = FALSE;
}
else
readclass = TRUE;
}
else
{
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0))
{
SyntaxErrorMessage(theEnv,"make-instance");
goto ParseInitializeInstanceError;
}
SavePPBuffer(theEnv," ");
readclass = TRUE;
}
if (readclass)
{
top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage(theEnv,"instance class");
goto ParseInitializeInstanceError;
}
}
/* ==============================================
If the class name is a constant, go ahead and
look it up now and replace it with the pointer
============================================== */
if (ReplaceClassNameWithReference(theEnv,top->argList->nextArg) == FALSE)
goto ParseInitializeInstanceError;
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
top->argList->nextArg->nextArg =
ParseSlotOverrides(theEnv,readSource,&error);
}
else
{
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (fcalltype == DUPLICATE_TYPE)
{
if ((DefclassData(theEnv)->ObjectParseToken.type != SYMBOL) ? FALSE :
(strcmp(DOToString(DefclassData(theEnv)->ObjectParseToken),DUPLICATE_NAME_REF) == 0))
{
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,DefclassData(theEnv)->ObjectParseToken.printForm);
SavePPBuffer(theEnv," ");
top->argList->nextArg = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseInitializeInstanceError;
if (top->argList->nextArg == NULL)
{
SyntaxErrorMessage(theEnv,"instance name");
goto ParseInitializeInstanceError;
}
PPCRAndIndent(theEnv);
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
else
top->argList->nextArg = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"gensym*"));
top->argList->nextArg->nextArg = ParseSlotOverrides(theEnv,readSource,&error);
}
else
top->argList->nextArg = ParseSlotOverrides(theEnv,readSource,&error);
}
if (error)
goto ParseInitializeInstanceError;
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
SyntaxErrorMessage(theEnv,"slot-override");
goto ParseInitializeInstanceError;
}
DecrementIndentDepth(theEnv,3);
return(top);
ParseInitializeInstanceError:
SetEvaluationError(theEnv,TRUE);
ReturnExpression(theEnv,top);
DecrementIndentDepth(theEnv,3);
return(NULL);
}
/***************************************************************
NAME : ParseQueryRestrictions
DESCRIPTION : Parses the template restrictions for a query
INPUTS : 1) The top node of the query expression
2) The logical name of the input
3) Caller's token buffer
RETURNS : The fact-variable expressions
SIDE EFFECTS : Entire query expression deleted on errors
Nodes allocated for restrictions and fact
variable expressions
Template restrictions attached to query-expression
as arguments
NOTES : Expects top != NULL
***************************************************************/
static EXPRESSION *ParseQueryRestrictions(
void *theEnv,
EXPRESSION *top,
const char *readSource,
struct token *queryInputToken)
{
EXPRESSION *factQuerySetVars = NULL,*lastFactQuerySetVars = NULL,
*templateExp = NULL,*lastTemplateExp,
*tmp,*lastOne = NULL;
int error = FALSE;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != LPAREN)
{ goto ParseQueryRestrictionsError1; }
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != LPAREN)
{ goto ParseQueryRestrictionsError1; }
while (queryInputToken->type == LPAREN)
{
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != SF_VARIABLE)
{ goto ParseQueryRestrictionsError1; }
tmp = factQuerySetVars;
while (tmp != NULL)
{
if (tmp->value == queryInputToken->value)
{
PrintErrorID(theEnv,"FACTQPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Duplicate fact member variable name in function ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
EnvPrintRouter(theEnv,WERROR,".\n");
goto ParseQueryRestrictionsError2;
}
tmp = tmp->nextArg;
}
tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value);
if (factQuerySetVars == NULL)
{ factQuerySetVars = tmp; }
else
{ lastFactQuerySetVars->nextArg = tmp; }
lastFactQuerySetVars = tmp;
SavePPBuffer(theEnv," ");
templateExp = ArgumentParse(theEnv,readSource,&error);
if (error)
{ goto ParseQueryRestrictionsError2; }
if (templateExp == NULL)
{ goto ParseQueryRestrictionsError1; }
if (ReplaceTemplateNameWithReference(theEnv,templateExp) == FALSE)
{ goto ParseQueryRestrictionsError2; }
lastTemplateExp = templateExp;
SavePPBuffer(theEnv," ");
while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL)
{
if (ReplaceTemplateNameWithReference(theEnv,tmp) == FALSE)
goto ParseQueryRestrictionsError2;
lastTemplateExp->nextArg = tmp;
lastTemplateExp = tmp;
SavePPBuffer(theEnv," ");
}
if (error)
{ goto ParseQueryRestrictionsError2; }
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
tmp = GenConstant(theEnv,SYMBOL,(void *) FactQueryData(theEnv)->QUERY_DELIMETER_SYMBOL);
lastTemplateExp->nextArg = tmp;
lastTemplateExp = tmp;
if (top->argList == NULL)
{ top->argList = templateExp; }
else
{ lastOne->nextArg = templateExp; }
lastOne = lastTemplateExp;
templateExp = NULL;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,queryInputToken);
}
if (queryInputToken->type != RPAREN)
{ goto ParseQueryRestrictionsError1; }
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
return(factQuerySetVars);
ParseQueryRestrictionsError1:
SyntaxErrorMessage(theEnv,"fact-set query function");
ParseQueryRestrictionsError2:
ReturnExpression(theEnv,templateExp);
ReturnExpression(theEnv,top);
ReturnExpression(theEnv,factQuerySetVars);
return(NULL);
}
/***************************************************************
NAME : ParseQueryRestrictions
DESCRIPTION : Parses the class restrictions for a query
INPUTS : 1) The top node of the query expression
2) The logical name of the input
3) Caller's token buffer
RETURNS : The instance-variable expressions
SIDE EFFECTS : Entire query expression deleted on errors
Nodes allocated for restrictions and instance
variable expressions
Class restrictions attached to query-expression
as arguments
NOTES : Expects top != NULL
***************************************************************/
static EXPRESSION *ParseQueryRestrictions(
void *theEnv,
EXPRESSION *top,
char *readSource,
struct token *queryInputToken)
{
EXPRESSION *insQuerySetVars = NULL,*lastInsQuerySetVars = NULL,
*classExp = NULL,*lastClassExp,
*tmp,*lastOne = NULL;
int error = FALSE;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != LPAREN)
goto ParseQueryRestrictionsError1;
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != LPAREN)
goto ParseQueryRestrictionsError1;
while (queryInputToken->type == LPAREN)
{
GetToken(theEnv,readSource,queryInputToken);
if (queryInputToken->type != SF_VARIABLE)
goto ParseQueryRestrictionsError1;
tmp = insQuerySetVars;
while (tmp != NULL)
{
if (tmp->value == queryInputToken->value)
{
PrintErrorID(theEnv,"INSQYPSR",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Duplicate instance member variable name in function ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
EnvPrintRouter(theEnv,WERROR,".\n");
goto ParseQueryRestrictionsError2;
}
tmp = tmp->nextArg;
}
tmp = GenConstant(theEnv,SF_VARIABLE,queryInputToken->value);
if (insQuerySetVars == NULL)
insQuerySetVars = tmp;
else
lastInsQuerySetVars->nextArg = tmp;
lastInsQuerySetVars = tmp;
SavePPBuffer(theEnv," ");
classExp = ArgumentParse(theEnv,readSource,&error);
if (error)
goto ParseQueryRestrictionsError2;
if (classExp == NULL)
goto ParseQueryRestrictionsError1;
if (ReplaceClassNameWithReference(theEnv,classExp) == FALSE)
goto ParseQueryRestrictionsError2;
lastClassExp = classExp;
SavePPBuffer(theEnv," ");
while ((tmp = ArgumentParse(theEnv,readSource,&error)) != NULL)
{
if (ReplaceClassNameWithReference(theEnv,tmp) == FALSE)
goto ParseQueryRestrictionsError2;
lastClassExp->nextArg = tmp;
lastClassExp = tmp;
SavePPBuffer(theEnv," ");
}
if (error)
goto ParseQueryRestrictionsError2;
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
tmp = GenConstant(theEnv,SYMBOL,(void *) InstanceQueryData(theEnv)->QUERY_DELIMETER_SYMBOL);
lastClassExp->nextArg = tmp;
lastClassExp = tmp;
if (top->argList == NULL)
top->argList = classExp;
else
lastOne->nextArg = classExp;
lastOne = lastClassExp;
classExp = NULL;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,queryInputToken);
}
if (queryInputToken->type != RPAREN)
goto ParseQueryRestrictionsError1;
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
return(insQuerySetVars);
ParseQueryRestrictionsError1:
SyntaxErrorMessage(theEnv,"instance-set query function");
ParseQueryRestrictionsError2:
ReturnExpression(theEnv,classExp);
ReturnExpression(theEnv,top);
ReturnExpression(theEnv,insQuerySetVars);
return(NULL);
}