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; }