globle void BindFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT *theBind, *lastBind;
int found = FALSE,
unbindVar = FALSE;
SYMBOL_HN *variableName = NULL;
#if DEFGLOBAL_CONSTRUCT
struct defglobal *theGlobal = NULL;
#endif
/*===============================================*/
/* Determine the name of the variable to be set. */
/*===============================================*/
#if DEFGLOBAL_CONSTRUCT
if (GetFirstArgument()->type == DEFGLOBAL_PTR)
{ theGlobal = (struct defglobal *) GetFirstArgument()->value; }
else
#endif
{
EvaluateExpression(theEnv,GetFirstArgument(),returnValue);
variableName = (SYMBOL_HN *) DOPToPointer(returnValue);
}
/*===========================================*/
/* Determine the new value for the variable. */
/*===========================================*/
if (GetFirstArgument()->nextArg == NULL)
{ unbindVar = TRUE; }
else if (GetFirstArgument()->nextArg->nextArg == NULL)
{ EvaluateExpression(theEnv,GetFirstArgument()->nextArg,returnValue); }
else
{ StoreInMultifield(theEnv,returnValue,GetFirstArgument()->nextArg,TRUE); }
/*==================================*/
/* Bind a defglobal if appropriate. */
/*==================================*/
#if DEFGLOBAL_CONSTRUCT
if (theGlobal != NULL)
{
QSetDefglobalValue(theEnv,theGlobal,returnValue,unbindVar);
return;
}
#endif
/*===============================================*/
/* Search for the variable in the list of binds. */
/*===============================================*/
theBind = ProcedureFunctionData(theEnv)->BindList;
lastBind = NULL;
while ((theBind != NULL) && (found == FALSE))
{
if (theBind->supplementalInfo == (void *) variableName)
{ found = TRUE; }
else
{
lastBind = theBind;
theBind = theBind->next;
}
}
/*========================================================*/
/* If variable was not in the list of binds, then add it. */
/* Make sure that this operation preserves the bind list */
/* as a stack. */
/*========================================================*/
if (found == FALSE)
{
if (unbindVar == FALSE)
{
theBind = get_struct(theEnv,dataObject);
theBind->supplementalInfo = (void *) variableName;
IncrementSymbolCount(variableName);
theBind->next = NULL;
if (lastBind == NULL)
{ ProcedureFunctionData(theEnv)->BindList = theBind; }
else
{ lastBind->next = theBind; }
}
else
{
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
}
else
{ ValueDeinstall(theEnv,theBind); }
/*================================*/
/* Set the value of the variable. */
/*================================*/
if (unbindVar == FALSE)
{
theBind->type = returnValue->type;
theBind->value = returnValue->value;
theBind->begin = returnValue->begin;
theBind->end = returnValue->end;
ValueInstall(theEnv,returnValue);
}
else
{
if (lastBind == NULL) ProcedureFunctionData(theEnv)->BindList = theBind->next;
else lastBind->next = theBind->next;
DecrementSymbolCount(theEnv,(struct symbolHashNode *) theBind->supplementalInfo);
rtn_struct(theEnv,dataObject,theBind);
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
}
}
/*********************************************************************
NAME : CheckMultifieldSlotModify
DESCRIPTION : For the functions slot-replace$, insert, & delete
as well as direct-slot-replace$, insert, & delete
this function gets the slot, index, and optional
field-value for these functions
INPUTS : 1) A code indicating the type of operation
INSERT (0) : Requires one index
REPLACE (1) : Requires two indices
DELETE_OP (2) : Requires two indices
2) Function name-string
3) Instance address
4) Argument expression chain
5) Caller's buffer for index (or beginning of range)
6) Caller's buffer for end of range
(can be NULL for INSERT)
7) Caller's new-field value buffer
(can be NULL for DELETE_OP)
RETURNS : The address of the instance-slot,
NULL on errors
SIDE EFFECTS : Caller's index buffer set
Caller's new-field value buffer set (if not NULL)
Will allocate an ephemeral segment to store more
than 1 new field value
EvaluationError set on errors
NOTES : Assume the argument chain is at least 2
expressions deep - slot, index, and optional values
*********************************************************************/
static INSTANCE_SLOT *CheckMultifieldSlotModify(
void *theEnv,
int code,
char *func,
INSTANCE_TYPE *ins,
EXPRESSION *args,
int *rb,
int *re,
DATA_OBJECT *newval)
{
DATA_OBJECT temp;
INSTANCE_SLOT *sp;
int start;
start = (args == GetFirstArgument()) ? 1 : 2;
EvaluationData(theEnv)->EvaluationError = FALSE;
EvaluateExpression(theEnv,args,&temp);
if (temp.type != SYMBOL)
{
ExpectedTypeError1(theEnv,func,start,"symbol");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
sp = FindInstanceSlot(theEnv,ins,(SYMBOL_HN *) temp.value);
if (sp == NULL)
{
SlotExistError(theEnv,ValueToString(temp.value),func);
return(NULL);
}
if (sp->desc->multiple == 0)
{
PrintErrorID(theEnv,"INSMULT",1,FALSE);
EnvPrintRouter(theEnv,WERROR,"Function ");
EnvPrintRouter(theEnv,WERROR,func);
EnvPrintRouter(theEnv,WERROR," cannot be used on single-field slot ");
EnvPrintRouter(theEnv,WERROR,ValueToString(sp->desc->slotName->name));
EnvPrintRouter(theEnv,WERROR," in instance ");
EnvPrintRouter(theEnv,WERROR,ValueToString(ins->name));
EnvPrintRouter(theEnv,WERROR,".\n");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
EvaluateExpression(theEnv,args->nextArg,&temp);
if (temp.type != INTEGER)
{
ExpectedTypeError1(theEnv,func,start+1,"integer");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
args = args->nextArg->nextArg;
*rb = ValueToInteger(temp.value);
if ((code == REPLACE) || (code == DELETE_OP))
{
EvaluateExpression(theEnv,args,&temp);
if (temp.type != INTEGER)
{
ExpectedTypeError1(theEnv,func,start+2,"integer");
SetEvaluationError(theEnv,TRUE);
return(NULL);
}
*re = ValueToInteger(temp.value);
args = args->nextArg;
}
if ((code == INSERT) || (code == REPLACE))
{
if (EvaluateAndStoreInDataObject(theEnv,1,args,newval) == FALSE)
return(NULL);
}
return(sp);
}
globle void IfFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
int numArgs;
struct expr *theExpr;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if ((EvaluationData(theEnv)->CurrentExpression->argList == NULL) ||
(EvaluationData(theEnv)->CurrentExpression->argList->nextArg == NULL))
{
EnvArgRangeCheck(theEnv,"if",2,3);
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg == NULL)
{ numArgs = 2; }
else if (EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg->nextArg == NULL)
{ numArgs = 3; }
else
{
EnvArgRangeCheck(theEnv,"if",2,3);
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
/*=========================*/
/* Evaluate the condition. */
/*=========================*/
EvaluateExpression(theEnv,EvaluationData(theEnv)->CurrentExpression->argList,returnValue);
if ((ProcedureFunctionData(theEnv)->BreakFlag == TRUE) || (ProcedureFunctionData(theEnv)->ReturnFlag == TRUE))
{
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
/*=========================================*/
/* If the condition evaluated to FALSE and */
/* an "else" portion exists, evaluate it */
/* and return the value. */
/*=========================================*/
if ((returnValue->value == EnvFalseSymbol(theEnv)) &&
(returnValue->type == SYMBOL) &&
(numArgs == 3))
{
theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg->nextArg;
switch (theExpr->type)
{
case INTEGER:
case FLOAT:
case SYMBOL:
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
case INSTANCE_ADDRESS:
#endif
case EXTERNAL_ADDRESS:
returnValue->type = theExpr->type;
returnValue->value = theExpr->value;
break;
default:
EvaluateExpression(theEnv,theExpr,returnValue);
break;
}
return;
}
/*===================================================*/
/* Otherwise if the symbol evaluated to a non-FALSE */
/* value, evaluate the "then" portion and return it. */
/*===================================================*/
else if ((returnValue->value != EnvFalseSymbol(theEnv)) ||
(returnValue->type != SYMBOL))
{
theExpr = EvaluationData(theEnv)->CurrentExpression->argList->nextArg;
switch (theExpr->type)
{
case INTEGER:
case FLOAT:
case SYMBOL:
case STRING:
#if OBJECT_SYSTEM
case INSTANCE_NAME:
case INSTANCE_ADDRESS:
#endif
case EXTERNAL_ADDRESS:
returnValue->type = theExpr->type;
returnValue->value = theExpr->value;
break;
default:
EvaluateExpression(theEnv,theExpr,returnValue);
break;
}
return;
}
/*=========================================*/
/* Return FALSE if the condition evaluated */
/* to FALSE and there is no "else" portion */
/* of the if statement. */
/*=========================================*/
returnValue->type = SYMBOL;
returnValue->value = EnvFalseSymbol(theEnv);
return;
}
globle void QSetDefglobalValue(
void *theEnv,
struct defglobal *theGlobal,
DATA_OBJECT_PTR vPtr,
int resetVar)
{
/*====================================================*/
/* If the new value passed for the defglobal is NULL, */
/* then reset the defglobal to the initial value it */
/* had when it was defined. */
/*====================================================*/
if (resetVar)
{
EvaluateExpression(theEnv,theGlobal->initial,vPtr);
if (EvaluationData(theEnv)->EvaluationError)
{
vPtr->type = SYMBOL;
vPtr->value = EnvFalseSymbol(theEnv);
}
}
/*==========================================*/
/* If globals are being watch, then display */
/* the change to the global variable. */
/*==========================================*/
#if DEBUGGING_FUNCTIONS
if (theGlobal->watch)
{
EnvPrintRouter(theEnv,WTRACE,":== ?*");
EnvPrintRouter(theEnv,WTRACE,ValueToString(theGlobal->header.name));
EnvPrintRouter(theEnv,WTRACE,"* ==> ");
PrintDataObject(theEnv,WTRACE,vPtr);
EnvPrintRouter(theEnv,WTRACE," <== ");
PrintDataObject(theEnv,WTRACE,&theGlobal->current);
EnvPrintRouter(theEnv,WTRACE,"\n");
}
#endif
/*==============================================*/
/* Remove the old value of the global variable. */
/*==============================================*/
ValueDeinstall(theEnv,&theGlobal->current);
if (theGlobal->current.type == MULTIFIELD)
{ ReturnMultifield(theEnv,(struct multifield *) theGlobal->current.value); }
/*===========================================*/
/* Set the new value of the global variable. */
/*===========================================*/
theGlobal->current.type = vPtr->type;
if (vPtr->type != MULTIFIELD) theGlobal->current.value = vPtr->value;
else DuplicateMultifield(theEnv,&theGlobal->current,vPtr);
ValueInstall(theEnv,&theGlobal->current);
/*===========================================*/
/* Set the variable indicating that a change */
/* has been made to a global variable. */
/*===========================================*/
DefglobalData(theEnv)->ChangeToGlobals = TRUE;
if ((EvaluationData(theEnv)->CurrentEvaluationDepth == 0) && (! CommandLineData(theEnv)->EvaluatingTopLevelCommand) &&
(EvaluationData(theEnv)->CurrentExpression == NULL))
{ PeriodicCleanup(theEnv,TRUE,FALSE); }
}
globle struct expr *ParseDefault(
void *theEnv,
const char *readSource,
int multifield,
int dynamic,
int evalStatic,
int *noneSpecified,
int *deriveSpecified,
int *error)
{
struct expr *defaultList = NULL, *lastDefault = NULL;
struct expr *newItem, *tmpItem;
struct token theToken;
DATA_OBJECT theValue;
CONSTRAINT_RECORD *rv;
int specialVarCode;
*noneSpecified = FALSE;
*deriveSpecified = FALSE;
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&theToken);
/*===================================================*/
/* Read the items contained in the default attribute */
/* until a closing right parenthesis is encountered. */
/*===================================================*/
while (theToken.type != RPAREN)
{
/*========================================*/
/* Get the next item in the default list. */
/*========================================*/
newItem = ParseAtomOrExpression(theEnv,readSource,&theToken);
if (newItem == NULL)
{
ReturnExpression(theEnv,defaultList);
*error = TRUE;
return(NULL);
}
/*===========================================================*/
/* Check for invalid variable usage. With the expection of */
/* ?NONE for the default attribute, local variables may not */
/* be used within the default or default-dynamic attributes. */
/*===========================================================*/
if ((newItem->type == SF_VARIABLE) || (newItem->type == MF_VARIABLE))
{
if (strcmp(ValueToString(newItem->value),"NONE") == 0)
{ specialVarCode = 0; }
else if (strcmp(ValueToString(newItem->value),"DERIVE") == 0)
{ specialVarCode = 1; }
else
{ specialVarCode = -1; }
if ((dynamic) ||
(newItem->type == MF_VARIABLE) ||
(specialVarCode == -1) ||
((specialVarCode != -1) && (defaultList != NULL)))
{
if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute");
else SyntaxErrorMessage(theEnv,"default attribute");
ReturnExpression(theEnv,newItem);
ReturnExpression(theEnv,defaultList);
*error = TRUE;
return(NULL);
}
ReturnExpression(theEnv,newItem);
/*============================================*/
/* Check for the closing right parenthesis of */
/* the default or default dynamic attribute. */
/*============================================*/
GetToken(theEnv,readSource,&theToken);
if (theToken.type != RPAREN)
{
if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute");
else SyntaxErrorMessage(theEnv,"default attribute");
PPBackup(theEnv);
SavePPBuffer(theEnv," ");
SavePPBuffer(theEnv,theToken.printForm);
*error = TRUE;
}
if (specialVarCode == 0)
*noneSpecified = TRUE;
else
*deriveSpecified = TRUE;
return(NULL);
}
/*====================================================*/
/* Look to see if any variables have been used within */
/* expressions contained within the default list. */
/*====================================================*/
if (ExpressionContainsVariables(newItem,FALSE) == TRUE)
{
ReturnExpression(theEnv,defaultList);
ReturnExpression(theEnv,newItem);
*error = TRUE;
if (dynamic) SyntaxErrorMessage(theEnv,"default-dynamic attribute");
else SyntaxErrorMessage(theEnv,"default attribute");
return(NULL);
}
/*============================================*/
/* Add the default value to the default list. */
/*============================================*/
if (lastDefault == NULL)
{ defaultList = newItem; }
else
{ lastDefault->nextArg = newItem; }
lastDefault = newItem;
/*=======================================*/
/* Begin parsing the next default value. */
/*=======================================*/
SavePPBuffer(theEnv," ");
GetToken(theEnv,readSource,&theToken);
}
/*=====================================*/
/* Fix up pretty print representation. */
/*=====================================*/
PPBackup(theEnv);
PPBackup(theEnv);
SavePPBuffer(theEnv,")");
/*=========================================*/
/* A single field slot's default attribute */
/* must contain a single value. */
/*=========================================*/
if (multifield == FALSE)
{
if (defaultList == NULL)
{ *error = TRUE; }
else if (defaultList->nextArg != NULL)
{ *error = TRUE; }
else
{
rv = ExpressionToConstraintRecord(theEnv,defaultList);
rv->multifieldsAllowed = FALSE;
if (UnmatchableConstraint(rv)) *error = TRUE;
RemoveConstraint(theEnv,rv);
}
if (*error)
{
PrintErrorID(theEnv,"DEFAULT",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"The default value for a single field slot must be a single field value\n");
ReturnExpression(theEnv,defaultList);
return(NULL);
}
}
/*=======================================================*/
/* If the dynamic-default attribute is not being parsed, */
/* evaluate the expressions to make the default value. */
/*=======================================================*/
if (dynamic || (! evalStatic) || (defaultList == NULL)) return(defaultList);
tmpItem = defaultList;
newItem = defaultList;
defaultList = NULL;
while (newItem != NULL)
{
SetEvaluationError(theEnv,FALSE);
if (EvaluateExpression(theEnv,newItem,&theValue)) *error = TRUE;
if ((theValue.type == MULTIFIELD) &&
(multifield == FALSE) &&
(*error == FALSE))
{
PrintErrorID(theEnv,"DEFAULT",1,TRUE);
EnvPrintRouter(theEnv,WERROR,"The default value for a single field slot must be a single field value\n");
*error = TRUE;
}
if (*error)
{
ReturnExpression(theEnv,tmpItem);
ReturnExpression(theEnv,defaultList);
*error = TRUE;
return(NULL);
}
lastDefault = ConvertValueToExpression(theEnv,&theValue);
defaultList = AppendExpressions(defaultList,lastDefault);
newItem = newItem->nextArg;
}
ReturnExpression(theEnv,tmpItem);
/*==========================*/
/* Return the default list. */
/*==========================*/
return(defaultList);
}
globle void RetractCommand(
void *theEnv)
{
long long factIndex;
struct fact *ptr;
struct expr *theArgument;
DATA_OBJECT theResult;
int argNumber;
/*================================*/
/* Iterate through each argument. */
/*================================*/
for (theArgument = GetFirstArgument(), argNumber = 1;
theArgument != NULL;
theArgument = GetNextArgument(theArgument), argNumber++)
{
/*========================*/
/* Evaluate the argument. */
/*========================*/
EvaluateExpression(theEnv,theArgument,&theResult);
/*===============================================*/
/* If the argument evaluates to an integer, then */
/* it's assumed to be the fact index of the fact */
/* to be retracted. */
/*===============================================*/
if (theResult.type == INTEGER)
{
/*==========================================*/
/* A fact index must be a positive integer. */
/*==========================================*/
factIndex = ValueToLong(theResult.value);
if (factIndex < 0)
{
ExpectedTypeError1(theEnv,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *");
return;
}
/*================================================*/
/* See if a fact with the specified index exists. */
/*================================================*/
ptr = FindIndexedFact(theEnv,factIndex);
/*=====================================*/
/* If the fact exists then retract it, */
/* otherwise print an error message. */
/*=====================================*/
if (ptr != NULL)
{ EnvRetract(theEnv,(void *) ptr); }
else
{
char tempBuffer[20];
gensprintf(tempBuffer,"f-%lld",factIndex);
CantFindItemErrorMessage(theEnv,(char*)"fact",tempBuffer);
}
}
/*===============================================*/
/* Otherwise if the argument evaluates to a fact */
/* address, we can directly retract it. */
/*===============================================*/
else if (theResult.type == FACT_ADDRESS)
{ EnvRetract(theEnv,theResult.value); }
/*============================================*/
/* Otherwise if the argument evaluates to the */
/* symbol *, then all facts are retracted. */
/*============================================*/
else if ((theResult.type == SYMBOL) ?
(strcmp(ValueToString(theResult.value),"*") == 0) : FALSE)
{
RemoveAllFacts(theEnv);
return;
}
/*============================================*/
/* Otherwise the argument has evaluated to an */
/* illegal value for the retract command. */
/*============================================*/
else
{
ExpectedTypeError1(theEnv,(char*)"retract",argNumber,(char*)"fact-address, fact-index, or the symbol *");
SetEvaluationError(theEnv,TRUE);
}
}
}
globle void AssertCommand(
void *theEnv,
DATA_OBJECT_PTR rv)
{
struct deftemplate *theDeftemplate;
struct field *theField;
DATA_OBJECT theValue;
struct expr *theExpression;
struct templateSlot *slotPtr;
struct fact *newFact;
int error = FALSE;
int i;
struct fact *theFact;
/*===================================================*/
/* Set the default return value to the symbol FALSE. */
/*===================================================*/
SetpType(rv,SYMBOL);
SetpValue(rv,EnvFalseSymbol(theEnv));
/*================================*/
/* Get the deftemplate associated */
/* with the fact being asserted. */
/*================================*/
theExpression = GetFirstArgument();
theDeftemplate = (struct deftemplate *) theExpression->value;
/*=======================================*/
/* Create the fact and store the name of */
/* the deftemplate as the 1st field. */
/*=======================================*/
if (theDeftemplate->implied == FALSE)
{
newFact = CreateFactBySize(theEnv,theDeftemplate->numberOfSlots);
slotPtr = theDeftemplate->slotList;
}
else
{
newFact = CreateFactBySize(theEnv,1);
if (theExpression->nextArg == NULL)
{
newFact->theProposition.theFields[0].type = MULTIFIELD;
newFact->theProposition.theFields[0].value = CreateMultifield2(theEnv,0L);
}
slotPtr = NULL;
}
newFact->whichDeftemplate = theDeftemplate;
/*===================================================*/
/* Evaluate the expression associated with each slot */
/* and store the result in the appropriate slot of */
/* the newly created fact. */
/*===================================================*/
theField = newFact->theProposition.theFields;
for (theExpression = theExpression->nextArg, i = 0;
theExpression != NULL;
theExpression = theExpression->nextArg, i++)
{
/*===================================================*/
/* Evaluate the expression to be stored in the slot. */
/*===================================================*/
EvaluateExpression(theEnv,theExpression,&theValue);
/*============================================================*/
/* A multifield value can't be stored in a single field slot. */
/*============================================================*/
if ((slotPtr != NULL) ?
(slotPtr->multislot == FALSE) && (theValue.type == MULTIFIELD) :
FALSE)
{
MultiIntoSingleFieldSlotError(theEnv,slotPtr,theDeftemplate);
theValue.type = SYMBOL;
theValue.value = EnvFalseSymbol(theEnv);
error = TRUE;
}
/*==============================*/
/* Store the value in the slot. */
/*==============================*/
theField[i].type = theValue.type;
theField[i].value = theValue.value;
/*========================================*/
/* Get the information for the next slot. */
/*========================================*/
if (slotPtr != NULL) slotPtr = slotPtr->next;
}
/*============================================*/
/* If an error occured while generating the */
/* fact's slot values, then abort the assert. */
/*============================================*/
if (error)
{
ReturnFact(theEnv,newFact);
return;
}
/*================================*/
/* Add the fact to the fact-list. */
/*================================*/
theFact = (struct fact *) EnvAssert(theEnv,(void *) newFact);
/*========================================*/
/* The asserted fact is the return value. */
/*========================================*/
if (theFact != NULL)
{
SetpType(rv,FACT_ADDRESS);
SetpValue(rv,(void *) theFact);
}
return;
}
static DATA_OBJECT_PTR GetSaveFactsDeftemplateNames(
void *theEnv,
struct expr *theList,
int saveCode,
int *count,
int *error)
{
struct expr *tempList;
DATA_OBJECT_PTR theDOArray;
int i, tempCount;
struct deftemplate *theDeftemplate = NULL;
/*=============================*/
/* Initialize the error state. */
/*=============================*/
*error = FALSE;
/*=====================================================*/
/* If no deftemplate names were specified as arguments */
/* then the deftemplate name list is empty. */
/*=====================================================*/
if (theList == NULL)
{
*count = 0;
return(NULL);
}
/*======================================*/
/* Determine the number of deftemplate */
/* names to be stored in the name list. */
/*======================================*/
for (tempList = theList, *count = 0;
tempList != NULL;
tempList = tempList->nextArg, (*count)++)
{ /* Do Nothing */ }
/*=========================================*/
/* Allocate the storage for the name list. */
/*=========================================*/
theDOArray = (DATA_OBJECT_PTR) gm3(theEnv,(long) sizeof(DATA_OBJECT) * *count);
/*=====================================*/
/* Loop through each of the arguments. */
/*=====================================*/
for (tempList = theList, i = 0;
i < *count;
tempList = tempList->nextArg, i++)
{
/*========================*/
/* Evaluate the argument. */
/*========================*/
EvaluateExpression(theEnv,tempList,&theDOArray[i]);
if (EvaluationData(theEnv)->EvaluationError)
{
*error = TRUE;
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
/*======================================*/
/* A deftemplate name must be a symbol. */
/*======================================*/
if (theDOArray[i].type != SYMBOL)
{
*error = TRUE;
ExpectedTypeError1(theEnv,(char*)"save-facts",3+i,(char*)"symbol");
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
/*===================================================*/
/* Find the deftemplate. For a local save, look only */
/* in the current module. For a visible save, look */
/* in all visible modules. */
/*===================================================*/
if (saveCode == LOCAL_SAVE)
{
theDeftemplate = (struct deftemplate *)
EnvFindDeftemplate(theEnv,ValueToString(theDOArray[i].value));
if (theDeftemplate == NULL)
{
*error = TRUE;
ExpectedTypeError1(theEnv,(char*)"save-facts",3+i,(char*)"local deftemplate name");
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
}
else if (saveCode == VISIBLE_SAVE)
{
theDeftemplate = (struct deftemplate *)
FindImportedConstruct(theEnv,(char*)"deftemplate",NULL,
ValueToString(theDOArray[i].value),
&tempCount,TRUE,NULL);
if (theDeftemplate == NULL)
{
*error = TRUE;
ExpectedTypeError1(theEnv,(char*)"save-facts",3+i,(char*)"visible deftemplate name");
rm3(theEnv,theDOArray,(long) sizeof(DATA_OBJECT) * *count);
return(NULL);
}
}
/*==================================*/
/* Add a pointer to the deftemplate */
/* to the array being created. */
/*==================================*/
theDOArray[i].type = DEFTEMPLATE_PTR;
theDOArray[i].value = (void *) theDeftemplate;
}
/*===================================*/
/* Return the array of deftemplates. */
/*===================================*/
return(theDOArray);
}