globle long int StrCompareFunction(
void *theEnv)
{
int numArgs, length;
DATA_OBJECT arg1, arg2, arg3;
long returnValue;
/*=======================================================*/
/* Function str-compare expects either 2 or 3 arguments. */
/*=======================================================*/
if ((numArgs = EnvArgRangeCheck(theEnv,"str-compare",2,3)) == -1) return(0L);
/*=============================================================*/
/* The first two arguments should be of type symbol or string. */
/*=============================================================*/
if (EnvArgTypeCheck(theEnv,"str-compare",1,SYMBOL_OR_STRING,&arg1) == FALSE)
{ return(0L); }
if (EnvArgTypeCheck(theEnv,"str-compare",2,SYMBOL_OR_STRING,&arg2) == FALSE)
{ return(0L); }
/*===================================================*/
/* Compare the strings. Use the 3rd argument for the */
/* maximum length of comparison, if it is provided. */
/*===================================================*/
if (numArgs == 3)
{
if (EnvArgTypeCheck(theEnv,"str-compare",3,INTEGER,&arg3) == FALSE)
{ return(0L); }
length = CoerceToInteger(GetType(arg3),GetValue(arg3));
returnValue = strncmp(DOToString(arg1),DOToString(arg2),
(STD_SIZE) length);
}
else
{ returnValue = strcmp(DOToString(arg1),DOToString(arg2)); }
/*========================================================*/
/* Return Values are as follows: */
/* -1 is returned if <string-1> is less than <string-2>. */
/* 1 is return if <string-1> is greater than <string-2>. */
/* 0 is returned if <string-1> is equal to <string-2>. */
/*========================================================*/
if (returnValue < 0) returnValue = -1;
else if (returnValue > 0) returnValue = 1;
return(returnValue);
}
globle void PPFactFunction(
void *theEnv)
{
struct fact *theFact;
int numberOfArguments;
const char *logicalName = NULL; /* Avoids warning */
int ignoreDefaults = FALSE;
DATA_OBJECT theArg;
if ((numberOfArguments = EnvArgRangeCheck(theEnv,"ppfact",1,3)) == -1) return;
theFact = GetFactAddressOrIndexArgument(theEnv,"ppfact",1,TRUE);
if (theFact == NULL) return;
/*===============================================================*/
/* Determine the logical name to which the fact will be printed. */
/*===============================================================*/
if (numberOfArguments == 1)
{ logicalName = STDOUT; }
else
{
logicalName = GetLogicalName(theEnv,2,STDOUT);
if (logicalName == NULL)
{
IllegalLogicalNameMessage(theEnv,"ppfact");
EnvSetHaltExecution(theEnv,TRUE);
EnvSetEvaluationError(theEnv,TRUE);
return;
}
}
/*=========================================*/
/* Should slot values be printed if they */
/* are the same as the default slot value. */
/*=========================================*/
if (numberOfArguments == 3)
{
EnvRtnUnknown(theEnv,3,&theArg);
if ((theArg.value == EnvFalseSymbol(theEnv)) && (theArg.type == SYMBOL))
{ ignoreDefaults = FALSE; }
else
{ ignoreDefaults = TRUE; }
}
/*============================================================*/
/* Determine if any router recognizes the output destination. */
/*============================================================*/
if (strcmp(logicalName,"nil") == 0)
{ return; }
else if (QueryRouters(theEnv,logicalName) == FALSE)
{
UnrecognizedRouterMessage(theEnv,logicalName);
return;
}
EnvPPFact(theEnv,theFact,logicalName,ignoreDefaults);
}
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;
}
