globle long int IntegerFunction(
void *theEnv)
{
DATA_OBJECT valstruct;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"integer",EXACTLY,1) == -1) return(0L);
/*================================================================*/
/* Check for the correct type of argument. Note that ArgTypeCheck */
/* will convert floats to integers when an integer is requested */
/* (which is the purpose of the integer function). */
/*================================================================*/
if (EnvArgTypeCheck(theEnv,"integer",1,INTEGER,&valstruct) == FALSE) return(0L);
/*===================================================*/
/* Return the numeric value converted to an integer. */
/*===================================================*/
return(ValueToLong(valstruct.value));
}
globle double FloatFunction(
void *theEnv)
{
DATA_OBJECT valstruct;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"float",EXACTLY,1) == -1) return(0.0);
/*================================================================*/
/* Check for the correct type of argument. Note that ArgTypeCheck */
/* will convert integers to floats when a float is requested */
/* (which is the purpose of the float function). */
/*================================================================*/
if (EnvArgTypeCheck(theEnv,"float",1,FLOAT,&valstruct) == FALSE) return(0.0);
/*================================================*/
/* Return the numeric value converted to a float. */
/*================================================*/
return(ValueToDouble(valstruct.value));
}
globle int LoadFactsCommand(
void *theEnv)
{
char *fileName;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,"load-facts",EXACTLY,1) == -1) return(FALSE);
/*====================================================*/
/* Get the file name from which facts will be loaded. */
/*====================================================*/
if ((fileName = GetFileName(theEnv,"load-facts",1)) == NULL) return(FALSE);
/*====================================*/
/* Call the LoadFacts driver routine. */
/*====================================*/
if (EnvLoadFacts(theEnv,fileName) == FALSE) return(FALSE);
return(TRUE);
}
globle void ListDefmodulesCommand(
void *theEnv)
{
if (EnvArgCountCheck(theEnv,"list-defmodules",EXACTLY,0) == -1) return;
EnvListDefmodules(theEnv,WDISPLAY);
}
globle void *SetSalienceEvaluationCommand(
void *theEnv)
{
DATA_OBJECT argPtr;
char *argument, *oldValue;
/*==================================================*/
/* Get the current setting for salience evaluation. */
/*==================================================*/
oldValue = SalienceEvaluationName(EnvGetSalienceEvaluation(theEnv));
/*=========================================*/
/* This function expects a single argument */
/* which must be a symbol. */
/*=========================================*/
if (EnvArgCountCheck(theEnv,(char*)"set-salience-evaluation",EXACTLY,1) == -1)
{
return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));
}
if (EnvArgTypeCheck(theEnv,(char*)"set-salience-evaluation",1,SYMBOL,&argPtr) == FALSE)
{
return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));
}
/*=============================================================*/
/* The allowed symbols to pass as an argument to this function */
/* are when-defined, when-activated, and every-cycle. */
/*=============================================================*/
argument = DOToString(argPtr);
if (strcmp(argument,(char*)"when-defined") == 0)
{
EnvSetSalienceEvaluation(theEnv,WHEN_DEFINED);
}
else if (strcmp(argument,(char*)"when-activated") == 0)
{
EnvSetSalienceEvaluation(theEnv,WHEN_ACTIVATED);
}
else if (strcmp(argument,(char*)"every-cycle") == 0)
{
EnvSetSalienceEvaluation(theEnv,EVERY_CYCLE);
}
else
{
ExpectedTypeError1(theEnv,(char*)"set-salience-evaluation",1,
(char*)"symbol with value when-defined, when-activated, or every-cycle");
return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));
}
/*=================================================*/
/* Return the old setting for salience evaluation. */
/*=================================================*/
return((SYMBOL_HN *) EnvAddSymbol(theEnv,oldValue));
}
globle int SetIncrementalResetCommand(
void *theEnv,
EXEC_STATUS)
{
int oldValue;
DATA_OBJECT argPtr;
struct defmodule *theModule;
oldValue = EnvGetIncrementalReset(theEnv,execStatus);
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (EnvArgCountCheck(theEnv,execStatus,"set-incremental-reset",EXACTLY,1) == -1)
{ return(oldValue); }
/*=========================================*/
/* The incremental reset behavior can't be */
/* changed when rules are loaded. */
/*=========================================*/
SaveCurrentModule(theEnv,execStatus);
for (theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,NULL);
theModule != NULL;
theModule = (struct defmodule *) EnvGetNextDefmodule(theEnv,execStatus,theModule))
{
EnvSetCurrentModule(theEnv,execStatus,(void *) theModule);
if (EnvGetNextDefrule(theEnv,execStatus,NULL) != NULL)
{
RestoreCurrentModule(theEnv,execStatus);
PrintErrorID(theEnv,execStatus,"INCRRSET",1,FALSE);
EnvPrintRouter(theEnv,execStatus,WERROR,"The incremental reset behavior cannot be changed with rules loaded.\n");
SetEvaluationError(theEnv,execStatus,TRUE);
return(oldValue);
}
}
RestoreCurrentModule(theEnv,execStatus);
/*==================================================*/
/* The symbol FALSE disables incremental reset. Any */
/* other value enables incremental reset. */
/*==================================================*/
EnvRtnUnknown(theEnv,execStatus,1,&argPtr);
if ((argPtr.value == EnvFalseSymbol(theEnv,execStatus)) && (argPtr.type == SYMBOL))
{ EnvSetIncrementalReset(theEnv,execStatus,FALSE); }
else
{ EnvSetIncrementalReset(theEnv,execStatus,TRUE); }
/*=======================*/
/* Return the old value. */
/*=======================*/
return(oldValue);
}
globle void ResetCommand(
void *theEnv,
EXEC_STATUS)
{
if (EnvArgCountCheck(theEnv,execStatus,"reset",EXACTLY,0) == -1) return;
EnvReset(theEnv,execStatus);
return;
}
globle void *GetClassDefaultsModeCommand(
void *theEnv,
EXEC_STATUS)
{
EnvArgCountCheck(theEnv,execStatus,"get-class-defaults-mode",EXACTLY,0);
return((SYMBOL_HN *) EnvAddSymbol(theEnv,execStatus,GetClassDefaultsModeName(EnvGetClassDefaultsMode(theEnv,execStatus))));
}
globle void GetFocusStackFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
if (EnvArgCountCheck(theEnv,"get-focus-stack",EXACTLY,0) == -1) return;
EnvGetFocusStack(theEnv,returnValue);
}
globle void ClearCommand(
void *theEnv,
EXEC_STATUS)
{
if (EnvArgCountCheck(theEnv,execStatus,"clear",EXACTLY,0) == -1) return;
EnvClear(theEnv,execStatus);
return;
}
globle void LowcaseFunction(
void *theEnv,
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT theArg;
unsigned i;
size_t slen;
char *osptr, *nsptr;
/*================================================*/
/* Function lowcase expects exactly one argument. */
/*================================================*/
if (EnvArgCountCheck(theEnv,"lowcase",EXACTLY,1) == -1)
{
SetpType(returnValue,STRING);
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
return;
}
/*==================================================*/
/* The argument should be of type symbol or string. */
/*==================================================*/
if (EnvArgTypeCheck(theEnv,"lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE)
{
SetpType(returnValue,STRING);
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,""));
return;
}
/*======================================================*/
/* Allocate temporary memory and then copy the original */
/* string or symbol to that memory, while lowercasing */
/* upper case alphabetic characters. */
/*======================================================*/
osptr = DOToString(theArg);
slen = strlen(osptr) + 1;
nsptr = (char *) gm2(theEnv,slen);
for (i = 0 ; i < slen ; i++)
{
if (isupper(osptr[i]))
{ nsptr[i] = (char) tolower(osptr[i]); }
else
{ nsptr[i] = osptr[i]; }
}
/*========================================*/
/* Return the lowercased string and clean */
/* up the temporary memory used. */
/*========================================*/
SetpType(returnValue,GetType(theArg));
SetpValue(returnValue,(void *) EnvAddSymbol(theEnv,nsptr));
rm(theEnv,nsptr,slen);
}
globle void *GetFocusFunction(
void *theEnv)
{
struct defmodule *rv;
EnvArgCountCheck(theEnv,"get-focus",EXACTLY,0);
rv = (struct defmodule *) EnvGetFocus(theEnv);
if (rv == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));
return(rv->name);
}
globle int BatchCommand(
void *theEnv)
{
char *fileName;
if (EnvArgCountCheck(theEnv,(char*)"batch",EXACTLY,1) == -1) return(FALSE);
if ((fileName = GetFileName(theEnv,(char*)"batch",1)) == NULL) return(FALSE);
return(OpenBatch(theEnv,fileName,FALSE));
}
globle int DribbleOnCommand(
void *theEnv)
{
char *fileName;
if (EnvArgCountCheck(theEnv,"dribble-on",EXACTLY,1) == -1) return(FALSE);
if ((fileName = GetFileName(theEnv,"dribble-on",1)) == NULL) return(FALSE);
return (EnvDribbleOn(theEnv,fileName));
}
globle int BatchStarCommand(
void *theEnv)
{
char *fileName;
if (EnvArgCountCheck(theEnv,"batch*",EXACTLY,1) == -1) return(FALSE);
if ((fileName = GetFileName(theEnv,"batch*",1)) == NULL) return(FALSE);
return(EnvBatchStar(theEnv,fileName));
}
globle void ModFunction(
void *theEnv,
DATA_OBJECT_PTR result)
{
DATA_OBJECT item1, item2;
double fnum1, fnum2;
long long lnum1, lnum2;
if (EnvArgCountCheck(theEnv,"mod",EXACTLY,2) == -1)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (EnvArgTypeCheck(theEnv,"mod",1,INTEGER_OR_FLOAT,&item1) == FALSE)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (EnvArgTypeCheck(theEnv,"mod",2,INTEGER_OR_FLOAT,&item2) == FALSE)
{
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if (((item2.type == INTEGER) ? (ValueToLong(item2.value) == 0L) : FALSE) ||
((item2.type == FLOAT) ? ValueToDouble(item2.value) == 0.0 : FALSE))
{
DivideByZeroErrorMessage(theEnv,"mod");
SetEvaluationError(theEnv,TRUE);
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,0L);
return;
}
if ((item1.type == FLOAT) || (item2.type == FLOAT))
{
fnum1 = CoerceToDouble(item1.type,item1.value);
fnum2 = CoerceToDouble(item2.type,item2.value);
result->type = FLOAT;
result->value = (void *) EnvAddDouble(theEnv,fnum1 - (dtrunc(fnum1 / fnum2) * fnum2));
}
else
{
lnum1 = DOToLong(item1);
lnum2 = DOToLong(item2);
result->type = INTEGER;
result->value = (void *) EnvAddLong(theEnv,lnum1 - (lnum1 / lnum2) * lnum2);
}
}
double entryPoint(void * environment)
{
if (EnvArgCountCheck(environment,"entryPoint",EXACTLY,1) == -1) return(-1.0);
const char* streamName;
streamName = EnvRtnLexeme(environment,1);
printf("arg:%s", streamName);
return 1.0;
}
globle int FactExistpFunction(
void *theEnv)
{
struct fact *theFact;
if (EnvArgCountCheck(theEnv,"fact-existp",EXACTLY,1) == -1) return(-1L);
theFact = GetFactAddressOrIndexArgument(theEnv,"fact-existp",1,FALSE);
return(EnvFactExistp(theEnv,theFact));
}
globle void *PopFocusFunction(
void *theEnv)
{
struct defmodule *theModule;
EnvArgCountCheck(theEnv,"pop-focus",EXACTLY,0);
theModule = (struct defmodule *) EnvPopFocus(theEnv);
if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));
return(theModule->name);
}
globle int GetIncrementalResetCommand(
void *theEnv)
{
int oldValue;
oldValue = EnvGetIncrementalReset(theEnv);
if (EnvArgCountCheck(theEnv,"get-incremental-reset",EXACTLY,0) == -1)
{ return(oldValue); }
return(oldValue);
}
globle int GetBetaMemoryResizingCommand(
void *theEnv)
{
int oldValue;
oldValue = EnvGetBetaMemoryResizing(theEnv);
if (EnvArgCountCheck(theEnv,"get-beta-memory-resizing",EXACTLY,0) == -1)
{ return(oldValue); }
return(oldValue);
}
globle int GetResetGlobalsCommand(
void *theEnv)
{
int oldValue;
oldValue = EnvGetResetGlobals(theEnv);
if (EnvArgCountCheck(theEnv,"get-reset-globals",EXACTLY,0) == -1)
{ return(oldValue); }
return(oldValue);
}
globle int GSCCommand(
void *theEnv)
{
int oldValue;
oldValue = EnvGetStaticConstraintChecking(theEnv);
if (EnvArgCountCheck(theEnv,"get-static-constraint-checking",EXACTLY,0) == -1)
{ return(oldValue); }
return(oldValue);
}
globle void *SetStrategyCommand(
void *theEnv)
{
DATA_OBJECT argPtr;
char *argument;
int oldStrategy;
oldStrategy = AgendaData(theEnv)->Strategy;
/*=====================================================*/
/* Check for the correct number and type of arguments. */
/*=====================================================*/
if (EnvArgCountCheck(theEnv,"set-strategy",EXACTLY,1) == -1)
{ return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); }
if (EnvArgTypeCheck(theEnv,"set-strategy",1,SYMBOL,&argPtr) == FALSE)
{ return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv)))); }
argument = DOToString(argPtr);
/*=============================================*/
/* Set the strategy to the specified strategy. */
/*=============================================*/
if (strcmp(argument,"depth") == 0)
{ EnvSetStrategy(theEnv,DEPTH_STRATEGY); }
else if (strcmp(argument,"breadth") == 0)
{ EnvSetStrategy(theEnv,BREADTH_STRATEGY); }
else if (strcmp(argument,"lex") == 0)
{ EnvSetStrategy(theEnv,LEX_STRATEGY); }
else if (strcmp(argument,"mea") == 0)
{ EnvSetStrategy(theEnv,MEA_STRATEGY); }
else if (strcmp(argument,"complexity") == 0)
{ EnvSetStrategy(theEnv,COMPLEXITY_STRATEGY); }
else if (strcmp(argument,"simplicity") == 0)
{ EnvSetStrategy(theEnv,SIMPLICITY_STRATEGY); }
else if (strcmp(argument,"random") == 0)
{ EnvSetStrategy(theEnv,RANDOM_STRATEGY); }
else
{
ExpectedTypeError1(theEnv,"set-strategy",1,
"symbol with value depth, breadth, lex, mea, complexity, simplicity, or random");
return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(EnvGetStrategy(theEnv))));
}
/*=======================================*/
/* Return the old value of the strategy. */
/*=======================================*/
return((SYMBOL_HN *) EnvAddSymbol(theEnv,GetStrategyName(oldStrategy)));
}
static int SingleNumberCheck(
void *theEnv,
const char *functionName,
double *theNumber)
{
DATA_OBJECT theValue;
if (EnvArgCountCheck(theEnv,functionName,EXACTLY,1) == -1) return(FALSE);
if (EnvArgTypeCheck(theEnv,functionName,1,FLOAT,&theValue) == FALSE) return(FALSE);
*theNumber = DOToDouble(theValue);
return(TRUE);
}
globle void *GetCurrentModuleCommand(
void *theEnv)
{
struct defmodule *theModule;
EnvArgCountCheck(theEnv,"get-current-module",EXACTLY,0);
theModule = (struct defmodule *) EnvGetCurrentModule(theEnv);
if (theModule == NULL) return((SYMBOL_HN *) EnvFalseSymbol(theEnv));
return((SYMBOL_HN *) EnvAddSymbol(theEnv,ValueToString(theModule->name)));
}
globle intBool FuzzyvaluepFunction(
void *theEnv)
{
DATA_OBJECT valstruct;
if (EnvArgCountCheck(theEnv,"fuzzyvaluep",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&valstruct);
if (GetType(valstruct) != FUZZY_VALUE) return(FALSE);
return(TRUE);
}
globle intBool PointerpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"pointerp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) != EXTERNAL_ADDRESS) return(FALSE);
return(TRUE);
}
globle intBool MultifieldpFunction(
void *theEnv)
{
DATA_OBJECT item;
if (EnvArgCountCheck(theEnv,"multifieldp",EXACTLY,1) == -1) return(FALSE);
EnvRtnUnknown(theEnv,1,&item);
if (GetType(item) != MULTIFIELD) return(FALSE);
return(TRUE);
}
globle void *FactRelationFunction(
void *theEnv)
{
struct fact *theFact;
if (EnvArgCountCheck(theEnv,"fact-relation",EXACTLY,1) == -1) return(EnvFalseSymbol(theEnv));
theFact = GetFactAddressOrIndexArgument(theEnv,"fact-relation",1,FALSE);
if (theFact == NULL) return(EnvFalseSymbol(theEnv));
return(FactRelation(theFact));
}
