/*************************************************************************************
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 : ParseSimpleInstance
DESCRIPTION : Parses instances from file for load-instances
into an EXPRESSION forms that
can later be evaluated with EvaluateExpression(theEnv,)
INPUTS : 1) The address of the top node of the expression
containing the make-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 make-instance call
(slot-overrides etc.)
The "top" expression is deleted on errors.
NOTES : The name, class, values etc. must be constants.
This function parses a make-instance call into
an expression of the following form :
(make-instance <instance> of <class> <slot-override>*)
where <slot-override> ::= (<slot-name> <expression>+)
goes to -->
make-instance
|
V
<instance-name>-><class-name>-><slot-name>-><dummy-node>...
|
V
<value-expression>...
****************************************************************************/
globle EXPRESSION *ParseSimpleInstance(
void *theEnv,
EXPRESSION *top,
const char *readSource)
{
EXPRESSION *theExp,*vals = NULL,*vbot,*tval;
unsigned short type;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != INSTANCE_NAME) &&
(GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL))
goto MakeInstanceError;
if ((GetType(DefclassData(theEnv)->ObjectParseToken) == SYMBOL) &&
(strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) == 0))
{
top->argList = GenConstant(theEnv,FCALL,
(void *) FindFunction(theEnv,"gensym*"));
}
else
{
top->argList = GenConstant(theEnv,INSTANCE_NAME,
(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(CLASS_RLN,DOToString(DefclassData(theEnv)->ObjectParseToken)) != 0))
goto MakeInstanceError;
}
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
goto MakeInstanceError;
top->argList->nextArg =
GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
theExp = top->argList->nextArg;
if (ReplaceClassNameWithReference(theEnv,theExp) == FALSE)
goto MakeInstanceError;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
while (GetType(DefclassData(theEnv)->ObjectParseToken) == LPAREN)
{
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL)
goto SlotOverrideError;
theExp->nextArg = GenConstant(theEnv,SYMBOL,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
theExp->nextArg->nextArg = GenConstant(theEnv,SYMBOL,EnvTrueSymbol(theEnv));
theExp = theExp->nextArg->nextArg;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
vbot = NULL;
while (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
{
type = GetType(DefclassData(theEnv)->ObjectParseToken);
if (type == LPAREN)
{
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if ((GetType(DefclassData(theEnv)->ObjectParseToken) != SYMBOL) ? TRUE :
(strcmp(ValueToString(DefclassData(theEnv)->ObjectParseToken.value),"create$") != 0))
goto SlotOverrideError;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
goto SlotOverrideError;
tval = GenConstant(theEnv,FCALL,(void *) FindFunction(theEnv,"create$"));
}
else
{
if ((type != SYMBOL) && (type != STRING) &&
(type != FLOAT) && (type != INTEGER) && (type != INSTANCE_NAME))
goto SlotOverrideError;
tval = GenConstant(theEnv,type,(void *) GetValue(DefclassData(theEnv)->ObjectParseToken));
}
if (vals == NULL)
vals = tval;
else
vbot->nextArg = tval;
vbot = tval;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
}
theExp->argList = vals;
GetToken(theEnv,readSource,&DefclassData(theEnv)->ObjectParseToken);
vals = NULL;
}
if (GetType(DefclassData(theEnv)->ObjectParseToken) != RPAREN)
goto SlotOverrideError;
return(top);
MakeInstanceError:
SyntaxErrorMessage(theEnv,"make-instance");
SetEvaluationError(theEnv,TRUE);
ReturnExpression(theEnv,top);
return(NULL);
SlotOverrideError:
SyntaxErrorMessage(theEnv,"slot-override");
SetEvaluationError(theEnv,TRUE);
ReturnExpression(theEnv,top);
ReturnExpression(theEnv,vals);
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);
}