globle long EnvRtnLong(
void *theEnv,
int argumentPosition)
{
int count = 1;
DATA_OBJECT result;
struct expr *argPtr;
/*=====================================================*/
/* Find the appropriate argument in the argument list. */
/*=====================================================*/
for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
(argPtr != NULL) && (count < argumentPosition);
argPtr = argPtr->nextArg)
{ count++; }
if (argPtr == NULL)
{
NonexistantError(theEnv,"RtnLong",
ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
argumentPosition);
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(1L);
}
/*======================================*/
/* Return the value of the nth argument */
/* if it is a float or integer. */
/*======================================*/
EvaluateExpression(theEnv,argPtr,&result);
if (result.type == FLOAT)
{ return((long) ValueToDouble(result.value)); }
else if (result.type == INTEGER)
{ return(ValueToLong(result.value)); }
/*======================================================*/
/* Generate an error if the argument is the wrong type. */
/*======================================================*/
ExpectedTypeError3(theEnv,"RtnLong",
ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
argumentPosition,"number");
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(1L);
}
globle DATA_OBJECT_PTR EnvRtnUnknown(
void *theEnv,
int argumentPosition,
DATA_OBJECT_PTR returnValue)
{
int count = 1;
struct expr *argPtr;
/*=====================================================*/
/* Find the appropriate argument in the argument list. */
/*=====================================================*/
for (argPtr = EvaluationData(theEnv)->CurrentExpression->argList;
(argPtr != NULL) && (count < argumentPosition);
argPtr = argPtr->nextArg)
{ count++; }
if (argPtr == NULL)
{
NonexistantError(theEnv,"RtnUnknown",
ValueToString(ExpressionFunctionCallName(EvaluationData(theEnv)->CurrentExpression)),
argumentPosition);
SetHaltExecution(theEnv,TRUE);
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
/*=======================================*/
/* Return the value of the nth argument. */
/*=======================================*/
EvaluateExpression(theEnv,argPtr,returnValue);
return(returnValue);
}
/*************************************************************
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);
}
globle void PrintExpression(
char *fileid,
struct expr *theExpression)
{
struct expr *oldExpression;
if (theExpression == NULL)
{ return; }
while (theExpression != NULL)
{
switch (theExpression->type)
{
case SF_VARIABLE:
case GBL_VARIABLE:
PrintRouter(fileid,"?");
PrintRouter(fileid,ValueToString(theExpression->value));
break;
case MF_VARIABLE:
case MF_GBL_VARIABLE:
PrintRouter(fileid,"$?");
PrintRouter(fileid,ValueToString(theExpression->value));
break;
case FCALL:
PrintRouter(fileid,"(");
PrintRouter(fileid,ValueToString(ExpressionFunctionCallName(theExpression)));
if (theExpression->argList != NULL) { PrintRouter(fileid," "); }
PrintExpression(fileid,theExpression->argList);
PrintRouter(fileid,")");
break;
default:
oldExpression = CurrentExpression;
CurrentExpression = theExpression;
PrintAtom(fileid,theExpression->type,theExpression->value);
CurrentExpression = oldExpression;
break;
}
theExpression = theExpression->nextArg;
if (theExpression != NULL) PrintRouter(fileid," ");
}
return;
}
/*************************************************************
NAME : ParseQueryActionExpression
DESCRIPTION : Parses the action-expression for a query
INPUTS : 1) The top node of the query expression
2) The logical name of the input
3) List of query parameters
RETURNS : TRUE if all OK, FALSE otherwise
SIDE EFFECTS : Entire query-expression deleted on errors
Nodes allocated for new expression
Action shoved in front of template-restrictions
and in back of test-expression on query
argument list
NOTES : Expects top != NULL && top->argList != NULL
*************************************************************/
static int ParseQueryActionExpression(
void *theEnv,
EXPRESSION *top,
const char *readSource,
EXPRESSION *factQuerySetVars,
struct token *queryInputToken)
{
EXPRESSION *qaction,*tmpFactSetVars;
struct BindInfo *oldBindList,*newBindList,*prev;
oldBindList = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
ExpressionData(theEnv)->BreakContext = TRUE;
ExpressionData(theEnv)->ReturnContext = ExpressionData(theEnv)->svContexts->rtn;
qaction = GroupActions(theEnv,readSource,queryInputToken,TRUE,NULL,FALSE);
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,queryInputToken->printForm);
ExpressionData(theEnv)->BreakContext = FALSE;
if (qaction == NULL)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
SyntaxErrorMessage(theEnv,"fact-set query function");
ReturnExpression(theEnv,top);
return(FALSE);
}
qaction->nextArg = top->argList->nextArg;
top->argList->nextArg = qaction;
newBindList = GetParsedBindNames(theEnv);
prev = NULL;
while (newBindList != NULL)
{
tmpFactSetVars = factQuerySetVars;
while (tmpFactSetVars != NULL)
{
if (tmpFactSetVars->value == (void *) newBindList->name)
{
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBindList);
PrintErrorID(theEnv,"FACTQPSR",3,FALSE);
EnvPrintRouter(theEnv,WERROR,"Cannot rebind fact-set member variable ");
EnvPrintRouter(theEnv,WERROR,ValueToString(tmpFactSetVars->value));
EnvPrintRouter(theEnv,WERROR," in function ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ExpressionFunctionCallName(top)));
EnvPrintRouter(theEnv,WERROR,".\n");
ReturnExpression(theEnv,top);
return(FALSE);
}
tmpFactSetVars = tmpFactSetVars->nextArg;
}
prev = newBindList;
newBindList = newBindList->next;
}
if (prev == NULL)
{ SetParsedBindNames(theEnv,oldBindList); }
else
{ prev->next = oldBindList; }
return(TRUE);
}
/***************************************************************
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);
}