/****************************************************************************
NAME : SlotReferenceVar
DESCRIPTION : Replaces direct slot references in handler body
with special function calls to reference active instance
at run-time
The slot in in the class bound at parse-time is always
referenced (early binding).
Slot references of the form ?self:<name> directly reference
ProcParamArray[0] (the message object - ?self) to
find the specified slot at run-time
INPUTS : 1) Variable expression
2) The class of the handler being parsed
RETURNS : 0 if not recognized, 1 if so, -1 on errors
SIDE EFFECTS : Handler body SF_VARIABLE and MF_VARIABLE replaced with
direct slot access function
NOTES : Objects are allowed to directly access their own slots
without sending a message to themselves. Since the object
is "within the boundary of its internals", this does not
violate the encapsulation principle of OOP.
****************************************************************************/
static int SlotReferenceVar(
void *theEnv,
EXPRESSION *varexp,
void *userBuffer)
{
struct token itkn;
int oldpp;
SLOT_DESC *sd;
if ((varexp->type != SF_VARIABLE) && (varexp->type != MF_VARIABLE))
return(0);
if ((strncmp(ValueToString(varexp->value),SELF_STRING,SELF_LEN) == 0) ?
(ValueToString(varexp->value)[SELF_LEN] == SELF_SLOT_REF) : FALSE)
{
OpenStringSource(theEnv,"hnd-var",ValueToString(varexp->value) + SELF_LEN + 1,0);
oldpp = GetPPBufferStatus(theEnv);
SetPPBufferStatus(theEnv,OFF);
GetToken(theEnv,"hnd-var",&itkn);
SetPPBufferStatus(theEnv,oldpp);
CloseStringSource(theEnv,"hnd-var");
if (itkn.type != STOP)
{
sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value,
FALSE,NULL);
if (sd == NULL)
return(-1);
GenHandlerSlotReference(theEnv,varexp,HANDLER_GET,sd);
return(1);
}
}
return(0);
}
/*************************************************************************
NAME : ReplaceSlotReference
DESCRIPTION : Replaces instance-set query function variable
references of the form: <instance-variable>:<slot-name>
with function calls to get these instance-slots at run
time
INPUTS : 1) The instance-set variable list
2) The expression containing the variable
3) The address of the instance slot access function
4) Nesting depth of query functions
RETURNS : Nothing useful
SIDE EFFECTS : If the variable is a slot reference, then it is replaced
with the appropriate function-call.
NOTES : None
*************************************************************************/
static void ReplaceSlotReference(
void *theEnv,
EXEC_STATUS,
EXPRESSION *vlist,
EXPRESSION *theExp,
struct FunctionDefinition *func,
int ndepth)
{
size_t len;
int posn,oldpp;
size_t i;
register char *str;
EXPRESSION *eptr;
struct token itkn;
str = ValueToString(theExp->value);
len = strlen(str);
if (len < 3)
return;
for (i = len-2 ; i >= 1 ; i--)
{
if ((str[i] == INSTANCE_SLOT_REF) ? (i >= 1) : FALSE)
{
eptr = vlist;
posn = 0;
while (eptr && ((i != strlen(ValueToString(eptr->value))) ||
strncmp(ValueToString(eptr->value),str,
(STD_SIZE) i)))
{
eptr = eptr->nextArg;
posn++;
}
if (eptr != NULL)
{
OpenStringSource(theEnv,execStatus,"query-var",str+i+1,0);
oldpp = GetPPBufferStatus(theEnv,execStatus);
SetPPBufferStatus(theEnv,execStatus,OFF);
GetToken(theEnv,execStatus,"query-var",&itkn);
SetPPBufferStatus(theEnv,execStatus,oldpp);
CloseStringSource(theEnv,execStatus,"query-var");
theExp->type = FCALL;
theExp->value = (void *) func;
theExp->argList = GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) ndepth));
theExp->argList->nextArg =
GenConstant(theEnv,execStatus,INTEGER,(void *) EnvAddLong(theEnv,execStatus,(long long) posn));
theExp->argList->nextArg->nextArg = GenConstant(theEnv,execStatus,itkn.type,itkn.value);
break;
}
}
}
}
globle intBool EnvLoadFactsFromString(
void *theEnv,
char *theString,
int theMax)
{
char * theStrRouter = (char*)"*** load-facts-from-string ***";
struct token theToken;
struct expr *testPtr;
DATA_OBJECT rv;
/*==========================*/
/* Initialize string router */
/*==========================*/
if ((theMax == -1) ? (!OpenStringSource(theEnv,theStrRouter,theString,0)) :
(!OpenTextSource(theEnv,theStrRouter,theString,0,(unsigned) theMax)))
return(FALSE);
/*=================*/
/* Load the facts. */
/*=================*/
theToken.type = LPAREN;
while (theToken.type != STOP)
{
testPtr = StandardLoadFact(theEnv,theStrRouter,&theToken);
if (testPtr == NULL) theToken.type = STOP;
else EvaluateExpression(theEnv,testPtr,&rv);
ReturnExpression(theEnv,testPtr);
}
/*=================*/
/* Close router. */
/*=================*/
CloseStringSource(theEnv,theStrRouter);
/*================================================*/
/* Return TRUE if no error occurred while loading */
/* the facts, otherwise return FALSE. */
/*================================================*/
if (EvaluationData(theEnv)->EvaluationError) return(FALSE);
return(TRUE);
}
globle void StringToField(
void *theEnv,
char *theString,
DATA_OBJECT *returnValue)
{
struct token theToken;
/*====================================*/
/* Open the string as an input source */
/* and retrieve the first value. */
/*====================================*/
OpenStringSource(theEnv,"string-to-field-str",theString,0);
GetToken(theEnv,"string-to-field-str",&theToken);
CloseStringSource(theEnv,"string-to-field-str");
/*====================================================*/
/* Copy the token to the return value data structure. */
/*====================================================*/
returnValue->type = theToken.type;
if ((theToken.type == FLOAT) || (theToken.type == STRING) ||
#if OBJECT_SYSTEM
(theToken.type == INSTANCE_NAME) ||
#endif
(theToken.type == SYMBOL) || (theToken.type == INTEGER))
{ returnValue->value = theToken.value; }
else if (theToken.type == STOP)
{
returnValue->type = SYMBOL;
returnValue->value = (void *) EnvAddSymbol(theEnv,"EOF");
}
else if (theToken.type == UNKNOWN_VALUE)
{
returnValue->type = STRING;
returnValue->value = (void *) EnvAddSymbol(theEnv,"*** ERROR ***");
}
else
{
returnValue->type = STRING;
returnValue->value = (void *) EnvAddSymbol(theEnv,theToken.printForm);
}
}
/****************************************************************************
NAME : BindSlotReference
DESCRIPTION : Replaces direct slot binds in handler body with special
function calls to reference active instance at run-time
The slot in in the class bound at parse-time is always
referenced (early binding).
Slot references of the form ?self:<name> directly reference
ProcParamArray[0] (the message object - ?self) to
find the specified slot at run-time
INPUTS : 1) Variable expression
2) The class for the message-handler being parsed
RETURNS : 0 if not recognized, 1 if so, -1 on errors
SIDE EFFECTS : Handler body "bind" call replaced with direct slot access
function
NOTES : Objects are allowed to directly access their own slots
without sending a message to themselves. Since the object
is "within the boundary of its internals", this does not
violate the encapsulation principle of OOP.
****************************************************************************/
static int BindSlotReference(
void *theEnv,
EXPRESSION *bindExp,
void *userBuffer)
{
char *bindName;
struct token itkn;
int oldpp;
SLOT_DESC *sd;
EXPRESSION *saveExp;
bindName = ValueToString(bindExp->argList->value);
if (strcmp(bindName,SELF_STRING) == 0)
{
PrintErrorID(theEnv,"MSGPSR",5,FALSE);
EnvPrintRouter(theEnv,WERROR,"Active instance parameter cannot be changed.\n");
return(-1);
}
if ((strncmp(bindName,SELF_STRING,SELF_LEN) == 0) ?
(bindName[SELF_LEN] == SELF_SLOT_REF) : FALSE)
{
OpenStringSource(theEnv,"hnd-var",bindName + SELF_LEN + 1,0);
oldpp = GetPPBufferStatus(theEnv);
SetPPBufferStatus(theEnv,OFF);
GetToken(theEnv,"hnd-var",&itkn);
SetPPBufferStatus(theEnv,oldpp);
CloseStringSource(theEnv,"hnd-var");
if (itkn.type != STOP)
{
saveExp = bindExp->argList->nextArg;
sd = CheckSlotReference(theEnv,(DEFCLASS *) userBuffer,itkn.type,itkn.value,
TRUE,saveExp);
if (sd == NULL)
return(-1);
GenHandlerSlotReference(theEnv,bindExp,HANDLER_PUT,sd);
bindExp->argList->nextArg = NULL;
ReturnExpression(theEnv,bindExp->argList);
bindExp->argList = saveExp;
return(1);
}
}
return(0);
}
bool OpenStringBatch(
Environment *theEnv,
const char *stringName,
const char *theString,
bool placeAtEnd)
{
if (OpenStringSource(theEnv,stringName,theString,0) == false)
{ return false; }
if (FileCommandData(theEnv)->TopOfBatchList == NULL)
{
AddRouter(theEnv,"batch", 20,
QueryBatchCallback,NULL,
ReadBatchCallback,UnreadBatchCallback,
ExitBatchCallback,NULL);
}
AddBatch(theEnv,placeAtEnd,NULL,stringName,STRING_BATCH,theString,NULL);
return true;
}
globle int OpenStringBatch(
void *theEnv,
char *stringName,
char *theString,
int placeAtEnd)
{
if (OpenStringSource(theEnv,stringName,theString,0) == 0)
{ return(0); }
if (FileCommandData(theEnv)->TopOfBatchList == NULL)
{
EnvAddRouter(theEnv,"batch", 20,
FindBatch, NULL,
GetcBatch, UngetcBatch,
ExitBatch);
}
AddBatch(theEnv,placeAtEnd,(void *) stringName,STRING_BATCH,theString);
return(1);
}
globle struct fact *StringToFact(
char *str)
{
struct token theToken;
struct fact *factPtr;
int numberOfFields = 0, whichField;
struct expr *assertArgs, *tempPtr;
int error = FALSE;
DATA_OBJECT theResult;
/*=========================================*/
/* Open a string router and parse the fact */
/* using the router as an input source. */
/*=========================================*/
OpenStringSource("assert_str",str,0);
assertArgs = GetRHSPattern("assert_str",&theToken,
&error,FALSE,TRUE,
TRUE,RPAREN);
CloseStringSource("assert_str");
/*===========================================*/
/* Check for errors or the use of variables. */
/*===========================================*/
if (error)
{
ReturnExpression(assertArgs);
return(NULL);
}
if (ExpressionContainsVariables(assertArgs,FALSE))
{
LocalVariableErrorMessage("the assert-string function");
SetEvaluationError(TRUE);
ReturnExpression(assertArgs);
return(NULL);
}
/*=======================================================*/
/* Count the number of fields needed for the fact and */
/* create a fact data structure of the appropriate size. */
/*=======================================================*/
for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
{ numberOfFields++; }
factPtr = (struct fact *) CreateFactBySize(numberOfFields);
factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value;
/*=============================================*/
/* Copy the fields to the fact data structure. */
/*=============================================*/
whichField = 0;
for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
{
EvaluateExpression(tempPtr,&theResult);
factPtr->theProposition.theFields[whichField].type = (short) theResult.type;
factPtr->theProposition.theFields[whichField].value = theResult.value;
whichField++;
}
ReturnExpression(assertArgs);
/*==================*/
/* Return the fact. */
/*==================*/
return(factPtr);
}
globle int CheckSyntax(
char *theString,
DATA_OBJECT_PTR returnValue)
{
char *name;
struct token theToken;
struct expr *top;
short rv;
/*==============================*/
/* Set the default return value */
/* (TRUE for problems found). */
/*==============================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,TrueSymbol);
/*===========================================*/
/* Create a string source router so that the */
/* string can be used as an input source. */
/*===========================================*/
if (OpenStringSource("check-syntax",theString,0) == 0)
{ return(TRUE); }
/*=================================*/
/* Only expressions and constructs */
/* can have their syntax checked. */
/*=================================*/
GetToken("check-syntax",&theToken);
if (theToken.type != LPAREN)
{
CloseStringSource("check-syntax");
SetpValue(returnValue,AddSymbol("MISSING-LEFT-PARENTHESIS"));
return(TRUE);
}
/*========================================*/
/* The next token should be the construct */
/* type or function name. */
/*========================================*/
GetToken("check-syntax",&theToken);
if (theToken.type != SYMBOL)
{
CloseStringSource("check-syntax");
SetpValue(returnValue,AddSymbol("EXPECTED-SYMBOL-AFTER-LEFT-PARENTHESIS"));
return(TRUE);
}
name = ValueToString(theToken.value);
/*==============================================*/
/* Set up a router to capture the error output. */
/*==============================================*/
AddRouter("error-capture",40,
FindErrorCapture, PrintErrorCapture,
NULL, NULL, NULL);
/*================================*/
/* Determine if it's a construct. */
/*================================*/
if (FindConstruct(name))
{
CheckSyntaxMode = TRUE;
rv = (short) ParseConstruct(name,"check-syntax");
GetToken("check-syntax",&theToken);
CheckSyntaxMode = FALSE;
if (rv)
{
PrintRouter(WERROR,"\nERROR:\n");
PrintInChunks(WERROR,GetPPBuffer());
PrintRouter(WERROR,"\n");
}
DestroyPPBuffer();
CloseStringSource("check-syntax");
if ((rv != FALSE) || (WarningString != NULL))
{
SetErrorCaptureValues(returnValue);
DeactivateErrorCapture();
return(TRUE);
}
if (theToken.type != STOP)
{
SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
DeactivateErrorCapture();
return(TRUE);
}
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,FalseSymbol);
DeactivateErrorCapture();
return(FALSE);
}
/*=======================*/
/* Parse the expression. */
/*=======================*/
top = Function2Parse("check-syntax",name);
GetToken("check-syntax",&theToken);
ClearParsedBindNames();
CloseStringSource("check-syntax");
if (top == NULL)
{
SetErrorCaptureValues(returnValue);
DeactivateErrorCapture();
return(TRUE);
}
if (theToken.type != STOP)
{
SetpValue(returnValue,AddSymbol("EXTRANEOUS-INPUT-AFTER-LAST-PARENTHESIS"));
DeactivateErrorCapture();
ReturnExpression(top);
return(TRUE);
}
DeactivateErrorCapture();
ReturnExpression(top);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,FalseSymbol);
return(FALSE);
}
bool RouteCommand(
void *theEnv,
const char *command,
bool printResult)
{
DATA_OBJECT result;
struct expr *top;
const char *commandName;
struct token theToken;
int danglingConstructs;
if (command == NULL)
{ return(0); }
/*========================================*/
/* Open a string input source and get the */
/* first token from that source. */
/*========================================*/
OpenStringSource(theEnv,"command",command,0);
GetToken(theEnv,"command",&theToken);
/*=====================*/
/* Evaluate constants. */
/*=====================*/
if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
(theToken.type == FLOAT) || (theToken.type == INTEGER) ||
(theToken.type == INSTANCE_NAME))
{
CloseStringSource(theEnv,"command");
if (printResult)
{
PrintAtom(theEnv,STDOUT,theToken.type,theToken.value);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return(1);
}
/*=====================*/
/* Evaluate variables. */
/*=====================*/
if ((theToken.type == GBL_VARIABLE) ||
(theToken.type == SF_VARIABLE) ||
(theToken.type == MF_VARIABLE))
{
CloseStringSource(theEnv,"command");
top = GenConstant(theEnv,theToken.type,theToken.value);
EvaluateExpression(theEnv,top,&result);
rtn_struct(theEnv,expr,top);
if (printResult)
{
PrintDataObject(theEnv,STDOUT,&result);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return(1);
}
/*========================================================*/
/* If the next token isn't the beginning left parenthesis */
/* of a command or construct, then whatever was entered */
/* cannot be evaluated at the command prompt. */
/*========================================================*/
if (theToken.type != LPAREN)
{
PrintErrorID(theEnv,"COMMLINE",1,false);
EnvPrintRouter(theEnv,WERROR,"Expected a '(', constant, or variable\n");
CloseStringSource(theEnv,"command");
return(0);
}
/*===========================================================*/
/* The next token must be a function name or construct type. */
/*===========================================================*/
GetToken(theEnv,"command",&theToken);
if (theToken.type != SYMBOL)
{
PrintErrorID(theEnv,"COMMLINE",2,false);
EnvPrintRouter(theEnv,WERROR,"Expected a command.\n");
CloseStringSource(theEnv,"command");
return(0);
}
commandName = ValueToString(theToken.value);
/*======================*/
/* Evaluate constructs. */
/*======================*/
#if (! RUN_TIME) && (! BLOAD_ONLY)
{
int errorFlag;
errorFlag = ParseConstruct(theEnv,commandName,"command");
if (errorFlag != -1)
{
CloseStringSource(theEnv,"command");
if (errorFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
}
DestroyPPBuffer(theEnv);
if (errorFlag) return 0;
else return 1;
}
}
#endif
/*========================*/
/* Parse a function call. */
/*========================*/
danglingConstructs = ConstructData(theEnv)->DanglingConstructs;
CommandLineData(theEnv)->ParsingTopLevelCommand = true;
top = Function2Parse(theEnv,"command",commandName);
CommandLineData(theEnv)->ParsingTopLevelCommand = false;
ClearParsedBindNames(theEnv);
/*================================*/
/* Close the string input source. */
/*================================*/
CloseStringSource(theEnv,"command");
/*=========================*/
/* Evaluate function call. */
/*=========================*/
if (top == NULL)
{
ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
return false;
}
ExpressionInstall(theEnv,top);
CommandLineData(theEnv)->EvaluatingTopLevelCommand = true;
CommandLineData(theEnv)->CurrentCommand = top;
EvaluateExpression(theEnv,top,&result);
CommandLineData(theEnv)->CurrentCommand = NULL;
CommandLineData(theEnv)->EvaluatingTopLevelCommand = false;
ExpressionDeinstall(theEnv,top);
ReturnExpression(theEnv,top);
ConstructData(theEnv)->DanglingConstructs = danglingConstructs;
/*=================================================*/
/* Print the return value of the function/command. */
/*=================================================*/
if ((result.type != RVOID) && printResult)
{
PrintDataObject(theEnv,STDOUT,&result);
EnvPrintRouter(theEnv,STDOUT,"\n");
}
return true;
}
globle int EnvBuild(
void *theEnv,
char *theString)
{
char *constructType;
struct token theToken;
int errorFlag;
/*====================================================*/
/* No additions during defrule join network activity. */
/*====================================================*/
#if DEFRULE_CONSTRUCT
if (EngineData(theEnv)->JoinOperationInProgress) return(FALSE);
#endif
/*===========================================*/
/* Create a string source router so that the */
/* string can be used as an input source. */
/*===========================================*/
if (OpenStringSource(theEnv,"build",theString,0) == 0)
{ return(FALSE); }
/*================================*/
/* The first token of a construct */
/* must be a left parenthesis. */
/*================================*/
GetToken(theEnv,"build",&theToken);
if (theToken.type != LPAREN)
{
CloseStringSource(theEnv,"build");
return(FALSE);
}
/*==============================================*/
/* The next token should be the construct type. */
/*==============================================*/
GetToken(theEnv,"build",&theToken);
if (theToken.type != SYMBOL)
{
CloseStringSource(theEnv,"build");
return(FALSE);
}
constructType = ValueToString(theToken.value);
/*======================*/
/* Parse the construct. */
/*======================*/
errorFlag = ParseConstruct(theEnv,constructType,"build");
/*=================================*/
/* Close the string source router. */
/*=================================*/
CloseStringSource(theEnv,"build");
/*=========================================*/
/* If an error occured while parsing the */
/* construct, then print an error message. */
/*=========================================*/
if (errorFlag == 1)
{
EnvPrintRouter(theEnv,WERROR,"\nERROR:\n");
PrintInChunks(theEnv,WERROR,GetPPBuffer(theEnv));
EnvPrintRouter(theEnv,WERROR,"\n");
}
DestroyPPBuffer(theEnv);
/*===============================================*/
/* Return TRUE if the construct was successfully */
/* parsed, otherwise return FALSE. */
/*===============================================*/
if (errorFlag == 0) return(TRUE);
return(FALSE);
}
globle int EnvEval(
void *theEnv,
char *theString,
DATA_OBJECT_PTR returnValue)
{
struct expr *top;
int ov;
static int depth = 0;
char logicalNameBuffer[20];
struct BindInfo *oldBinds;
/*======================================================*/
/* Evaluate the string. Create a different logical name */
/* for use each time the eval function is called. */
/*======================================================*/
depth++;
sprintf(logicalNameBuffer,"Eval-%d",depth);
if (OpenStringSource(theEnv,logicalNameBuffer,theString,0) == 0)
{
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
depth--;
return(FALSE);
}
/*================================================*/
/* Save the current parsing state before routines */
/* are called to parse the eval string. */
/*================================================*/
ov = GetPPBufferStatus(theEnv);
SetPPBufferStatus(theEnv,FALSE);
oldBinds = GetParsedBindNames(theEnv);
SetParsedBindNames(theEnv,NULL);
/*========================================================*/
/* Parse the string argument passed to the eval function. */
/*========================================================*/
top = ParseAtomOrExpression(theEnv,logicalNameBuffer,NULL);
/*============================*/
/* Restore the parsing state. */
/*============================*/
SetPPBufferStatus(theEnv,ov);
ClearParsedBindNames(theEnv);
SetParsedBindNames(theEnv,oldBinds);
/*===========================================*/
/* Return if an error occured while parsing. */
/*===========================================*/
if (top == NULL)
{
SetEvaluationError(theEnv,TRUE);
CloseStringSource(theEnv,logicalNameBuffer);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
depth--;
return(FALSE);
}
/*==============================================*/
/* The sequence expansion operator must be used */
/* within the argument list of a function call. */
/*==============================================*/
if ((top->type == MF_GBL_VARIABLE) || (top->type == MF_VARIABLE))
{
PrintErrorID(theEnv,"MISCFUN",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"expand$ must be used in the argument list of a function call.\n");
SetEvaluationError(theEnv,TRUE);
CloseStringSource(theEnv,logicalNameBuffer);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
ReturnExpression(theEnv,top);
depth--;
return(FALSE);
}
/*=======================================*/
/* The expression to be evaluated cannot */
/* contain any local variables. */
/*=======================================*/
if (ExpressionContainsVariables(top,FALSE))
{
PrintErrorID(theEnv,"STRNGFUN",2,FALSE);
EnvPrintRouter(theEnv,WERROR,"Some variables could not be accessed by the eval function.\n");
SetEvaluationError(theEnv,TRUE);
CloseStringSource(theEnv,logicalNameBuffer);
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,EnvFalseSymbol(theEnv));
ReturnExpression(theEnv,top);
depth--;
return(FALSE);
}
/*====================================*/
/* Evaluate the expression and return */
/* the memory used to parse it. */
/*====================================*/
ExpressionInstall(theEnv,top);
EvaluateExpression(theEnv,top,returnValue);
ExpressionDeinstall(theEnv,top);
depth--;
ReturnExpression(theEnv,top);
CloseStringSource(theEnv,logicalNameBuffer);
if (GetEvaluationError(theEnv)) return(FALSE);
return(TRUE);
}
globle struct multifield *StringToMultifield(
void *theEnv,
const char *theString)
{
struct token theToken;
struct multifield *theSegment;
struct field *theFields;
unsigned long numberOfFields = 0;
struct expr *topAtom = NULL, *lastAtom = NULL, *theAtom;
/*====================================================*/
/* Open the string as an input source and read in the */
/* list of values to be stored in the multifield. */
/*====================================================*/
OpenStringSource(theEnv,"multifield-str",theString,0);
GetToken(theEnv,"multifield-str",&theToken);
while (theToken.type != STOP)
{
if ((theToken.type == SYMBOL) || (theToken.type == STRING) ||
(theToken.type == FLOAT) || (theToken.type == INTEGER) ||
(theToken.type == INSTANCE_NAME))
{ theAtom = GenConstant(theEnv,theToken.type,theToken.value); }
else
{ theAtom = GenConstant(theEnv,STRING,EnvAddSymbol(theEnv,theToken.printForm)); }
numberOfFields++;
if (topAtom == NULL) topAtom = theAtom;
else lastAtom->nextArg = theAtom;
lastAtom = theAtom;
GetToken(theEnv,"multifield-str",&theToken);
}
CloseStringSource(theEnv,"multifield-str");
/*====================================================================*/
/* Create a multifield of the appropriate size for the values parsed. */
/*====================================================================*/
theSegment = (struct multifield *) EnvCreateMultifield(theEnv,numberOfFields);
theFields = theSegment->theFields;
/*====================================*/
/* Copy the values to the multifield. */
/*====================================*/
theAtom = topAtom;
numberOfFields = 0;
while (theAtom != NULL)
{
theFields[numberOfFields].type = theAtom->type;
theFields[numberOfFields].value = theAtom->value;
numberOfFields++;
theAtom = theAtom->nextArg;
}
/*===========================*/
/* Return the parsed values. */
/*===========================*/
ReturnExpression(theEnv,topAtom);
/*============================*/
/* Return the new multifield. */
/*============================*/
return(theSegment);
}
globle EXPRESSION *ParseConstantArguments(
void *theEnv,
char *argstr,
int *error)
{
EXPRESSION *top = NULL,*bot = NULL,*tmp;
char *router = "***FNXARGS***";
struct token tkn;
*error = FALSE;
if (argstr == NULL) return(NULL);
/*=====================================*/
/* Open the string as an input source. */
/*=====================================*/
if (OpenStringSource(theEnv,router,argstr,0) == 0)
{
PrintErrorID(theEnv,"EXPRNPSR",6,FALSE);
EnvPrintRouter(theEnv,WERROR,"Cannot read arguments for external call.\n");
*error = TRUE;
return(NULL);
}
/*======================*/
/* Parse the constants. */
/*======================*/
GetToken(theEnv,router,&tkn);
while (tkn.type != STOP)
{
if ((tkn.type != SYMBOL) && (tkn.type != STRING) &&
(tkn.type != FLOAT) && (tkn.type != INTEGER) &&
(tkn.type != INSTANCE_NAME))
{
PrintErrorID(theEnv,"EXPRNPSR",7,FALSE);
EnvPrintRouter(theEnv,WERROR,"Only constant arguments allowed for external function call.\n");
ReturnExpression(theEnv,top);
*error = TRUE;
CloseStringSource(theEnv,router);
return(NULL);
}
tmp = GenConstant(theEnv,tkn.type,tkn.value);
if (top == NULL)
top = tmp;
else
bot->nextArg = tmp;
bot = tmp;
GetToken(theEnv,router,&tkn);
}
/*================================*/
/* Close the string input source. */
/*================================*/
CloseStringSource(theEnv,router);
/*=======================*/
/* Return the arguments. */
/*=======================*/
return(top);
}
globle struct fact *StringToFact(
char *str)
{
struct token theToken;
struct fact *factPtr;
int numberOfFields = 0, whichField;
struct expr *assertArgs, *tempPtr;
int error = FALSE;
DATA_OBJECT theResult;
/*=========================================*/
/* Open a string router and parse the fact */
/* using the router as an input source. */
/*=========================================*/
OpenStringSource("assert_str",str,0);
assertArgs = GetRHSPattern("assert_str",&theToken,
&error,FALSE,TRUE,
TRUE,RPAREN);
CloseStringSource("assert_str");
#if CERTAINTY_FACTORS
/* GetRHSPattern called above may have left a token
in the lookahead Token (theUnToken) -- see GetRHSPattern and
Scanner.c -- clear it since we are closing the string source
and it should not be read when next token requested
NOTE: this may not be needed now that am not unGetting STOP tokens?
*/
ClearTheUnToken();
#endif
/*===========================================*/
/* Check for errors or the use of variables. */
/*===========================================*/
if (error)
{
ReturnExpression(assertArgs);
return(NULL);
}
if (ExpressionContainsVariables(assertArgs,FALSE))
{
LocalVariableErrorMessage("the assert-string function");
SetEvaluationError(TRUE);
ReturnExpression(assertArgs);
return(NULL);
}
/*=======================================================*/
/* Count the number of fields needed for the fact and */
/* create a fact data structure of the appropriate size. */
/*=======================================================*/
for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
{ numberOfFields++; }
factPtr = (struct fact *) CreateFactBySize(numberOfFields);
factPtr->whichDeftemplate = (struct deftemplate *) assertArgs->value;
#if CERTAINTY_FACTORS
/* get the CF from the argList of the DEFTEMPLATE_PTR expr struct currently
pointed at be assertArgs
*/
if (assertArgs->argList == NULL)
factPtr->factCF = 1.0;
else
{
EvaluateExpression(assertArgs->argList,&theResult);
if (theResult.type != FLOAT && theResult.type != INTEGER)
{
cfNonNumberError();
factPtr->factCF = 1.0;
}
else
factPtr->factCF = (theResult.type == FLOAT) ?
ValueToDouble(theResult.value) :
(double)ValueToLong(theResult.value);
}
#endif
/*=============================================*/
/* Copy the fields to the fact data structure. */
/*=============================================*/
ExpressionInstall(assertArgs); /* DR0836 */
whichField = 0;
for (tempPtr = assertArgs->nextArg; tempPtr != NULL; tempPtr = tempPtr->nextArg)
{
#if FUZZY_DEFTEMPLATES /* 03-07-96 */
/* NOTE: a fuzzy fact should have been parsed to give a single constant arg
of type FUZZY_VALUE
*/
#endif
EvaluateExpression(tempPtr,&theResult);
factPtr->theProposition.theFields[whichField].type = (short) theResult.type;
factPtr->theProposition.theFields[whichField].value = theResult.value;
whichField++;
}
ExpressionDeinstall(assertArgs); /* DR0836 */
ReturnExpression(assertArgs);
/*==================*/
/* Return the fact. */
/*==================*/
return(factPtr);
}
