globle void EvalFunction(
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT theArg;
/*=============================================*/
/* Function eval expects exactly one argument. */
/*=============================================*/
if (ArgCountCheck("eval",EXACTLY,1) == -1)
{
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,FalseSymbol);
return;
}
/*==================================================*/
/* The argument should be of type SYMBOL or STRING. */
/*==================================================*/
if (ArgTypeCheck("eval",1,SYMBOL_OR_STRING,&theArg) == FALSE)
{
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,FalseSymbol);
return;
}
/*======================*/
/* Evaluate the string. */
/*======================*/
Eval(DOToString(theArg),returnValue);
}
globle void CheckSyntaxFunction(
DATA_OBJECT *returnValue)
{
DATA_OBJECT theArg;
/*===============================*/
/* Set up a default return value */
/* (TRUE for problems found). */
/*===============================*/
SetpType(returnValue,SYMBOL);
SetpValue(returnValue,TrueSymbol);
/*=====================================================*/
/* Function check-syntax expects exactly one argument. */
/*=====================================================*/
if (ArgCountCheck("check-syntax",EXACTLY,1) == -1) return;
/*========================================*/
/* The argument should be of type STRING. */
/*========================================*/
if (ArgTypeCheck("check-syntax",1,STRING,&theArg) == FALSE)
{ return; }
/*===================*/
/* Check the syntax. */
/*===================*/
CheckSyntax(DOToString(theArg),returnValue);
}
globle void LowcaseFunction(
DATA_OBJECT_PTR returnValue)
{
DATA_OBJECT theArg;
int i, slen;
char *osptr, *nsptr;
/*================================================*/
/* Function lowcase expects exactly one argument. */
/*================================================*/
if (ArgCountCheck("lowcase",EXACTLY,1) == -1)
{
SetpType(returnValue,STRING);
SetpValue(returnValue,(void *) AddSymbol(""));
return;
}
/*==================================================*/
/* The argument should be of type symbol or string. */
/*==================================================*/
if (ArgTypeCheck("lowcase",1,SYMBOL_OR_STRING,&theArg) == FALSE)
{
SetpType(returnValue,STRING);
SetpValue(returnValue,(void *) AddSymbol(""));
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(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 *) AddSymbol(nsptr));
rm(nsptr,slen);
}
globle void StrIndexFunction(
DATA_OBJECT_PTR result)
{
DATA_OBJECT theArgument1, theArgument2;
char *strg1, *strg2;
int i, j;
result->type = SYMBOL;
result->value = FalseSymbol;
/*===================================*/
/* Check and retrieve the arguments. */
/*===================================*/
if (ArgCountCheck("str-index",EXACTLY,2) == -1) return;
if (ArgTypeCheck("str-index",1,SYMBOL_OR_STRING,&theArgument1) == FALSE) return;
if (ArgTypeCheck("str-index",2,SYMBOL_OR_STRING,&theArgument2) == FALSE) return;
strg1 = DOToString(theArgument1);
strg2 = DOToString(theArgument2);
/*=================================*/
/* Find the position in string2 of */
/* string1 (counting from 1). */
/*=================================*/
if (strlen(strg1) == 0)
{
result->type = INTEGER;
result->value = (void *) AddLong((long) strlen(strg2) + 1L);
return;
}
for (i=1; *strg2; i++, strg2++)
{
for (j=0; *(strg1+j) && *(strg1+j) == *(strg2+j); j++)
{ /* Do Nothing */ }
if (*(strg1+j) == '\0')
{
result->type = INTEGER;
result->value = (void *) AddLong((long) i);
return;
}
}
return;
}
globle SYMBOL_HN *SetStrategyCommand()
{
DATA_OBJECT argPtr;
char *argument;
int oldStrategy = Strategy;
/*=====================================================*/
/* Check for the correct number and type of arguments. */
/*=====================================================*/
if (ArgCountCheck("set-strategy",EXACTLY,1) == -1)
{ return((SYMBOL_HN *) AddSymbol(GetStrategyName(GetStrategy()))); }
if (ArgTypeCheck("set-strategy",1,SYMBOL,&argPtr) == FALSE)
{ return((SYMBOL_HN *) AddSymbol(GetStrategyName(GetStrategy()))); }
argument = DOToString(argPtr);
/*=============================================*/
/* Set the strategy to the specified strategy. */
/*=============================================*/
if (strcmp(argument,"depth") == 0)
{ SetStrategy(DEPTH_STRATEGY); }
else if (strcmp(argument,"breadth") == 0)
{ SetStrategy(BREADTH_STRATEGY); }
else if (strcmp(argument,"lex") == 0)
{ SetStrategy(LEX_STRATEGY); }
else if (strcmp(argument,"mea") == 0)
{ SetStrategy(MEA_STRATEGY); }
else if (strcmp(argument,"complexity") == 0)
{ SetStrategy(COMPLEXITY_STRATEGY); }
else if (strcmp(argument,"simplicity") == 0)
{ SetStrategy(SIMPLICITY_STRATEGY); }
else if (strcmp(argument,"random") == 0)
{ SetStrategy(RANDOM_STRATEGY); }
else
{
ExpectedTypeError1("set-strategy",1,
"symbol with value depth, breadth, lex, mea, complexity, simplicity, or random");
return((SYMBOL_HN *) AddSymbol(GetStrategyName(GetStrategy())));
}
/*=======================================*/
/* Return the old value of the strategy. */
/*=======================================*/
return((SYMBOL_HN *) AddSymbol(GetStrategyName(oldStrategy)));
}
globle int GetWatchItemCommand()
{
DATA_OBJECT theValue;
char *argument;
int recognized;
/*============================================*/
/* Check for the correct number of arguments. */
/*============================================*/
if (ArgCountCheck("get-watch-item",EXACTLY,1) == -1)
{ return(FALSE); }
/*========================================*/
/* Determine which item is to be watched. */
/*========================================*/
if (ArgTypeCheck("get-watch-item",1,SYMBOL,&theValue) == FALSE)
{ return(FALSE); }
argument = DOToString(theValue);
ValidWatchItem(argument,&recognized);
if (recognized == FALSE)
{
SetEvaluationError(TRUE);
ExpectedTypeError1("get-watch-item",1,"watchable symbol");
return(FALSE);
}
/*===========================*/
/* Get the watch item value. */
/*===========================*/
if (GetWatchItem(argument) == 1)
{ return(TRUE); }
return(FALSE);
}
globle int BuildFunction()
{
DATA_OBJECT theArg;
/*==============================================*/
/* Function build expects exactly one argument. */
/*==============================================*/
if (ArgCountCheck("build",EXACTLY,1) == -1) return(FALSE);
/*==================================================*/
/* The argument should be of type SYMBOL or STRING. */
/*==================================================*/
if (ArgTypeCheck("build",1,SYMBOL_OR_STRING,&theArg) == FALSE)
{ return(FALSE); }
/*======================*/
/* Build the construct. */
/*======================*/
return(Build(DOToString(theArg)));
}
globle long int StrLengthFunction()
{
DATA_OBJECT theArg;
/*===================================================*/
/* Function str-length expects exactly one argument. */
/*===================================================*/
if (ArgCountCheck("str-length",EXACTLY,1) == -1)
{ return(-1L); }
/*==================================================*/
/* The argument should be of type symbol or string. */
/*==================================================*/
if (ArgTypeCheck("str-length",1,SYMBOL_OR_STRING,&theArg) == FALSE)
{ return(-1L); }
/*============================================*/
/* Return the length of the string or symbol. */
/*============================================*/
return( (long) strlen(DOToString(theArg)));
}
globle void ResetCommand()
{
if (ArgCountCheck("reset",EXACTLY,0) == -1) return;
Reset();
return;
}
globle void ClearCommand()
{
if (ArgCountCheck("clear",EXACTLY,0) == -1) return;
Clear();
return;
}
CmdFn BinderArg3(void (Core::*fn)(ExecutionStream&, TArg0, TArg1, TArg2), QStringList args)
{
ArgCountCheck(args, 3);
return boost::bind( fn, &m_owner, _1, ArgTo<TArg0>(args.at(0)), ArgTo<TArg1>(args.at(1)), ArgTo<TArg2>(args.at(2)) );
}
CmdFn BinderArg0(void (Core::*fn)(ExecutionStream&), QStringList args)
{
ArgCountCheck(args, 0);
return boost::bind( fn, &m_owner, _1 );
}
globle SYMBOL_HN *GetStrategyCommand()
{
ArgCountCheck("get-strategy",EXACTLY,0);
return((SYMBOL_HN *) AddSymbol(GetStrategyName(GetStrategy())));
}
globle void *SubStringFunction()
{
DATA_OBJECT theArgument;
char *tempString, *returnString;
int start, end, i, j;
void *returnValue;
/*===================================*/
/* Check and retrieve the arguments. */
/*===================================*/
if (ArgCountCheck("sub-string",EXACTLY,3) == -1)
{ return((void *) AddSymbol("")); }
if (ArgTypeCheck("sub-string",1,INTEGER,&theArgument) == FALSE)
{ return((void *) AddSymbol("")); }
start = CoerceToInteger(theArgument.type,theArgument.value) - 1;
if (ArgTypeCheck("sub-string",2,INTEGER,&theArgument) == FALSE)
{ return((void *) AddSymbol("")); }
end = CoerceToInteger(theArgument.type,theArgument.value) - 1;
if (ArgTypeCheck("sub-string",3,SYMBOL_OR_STRING,&theArgument) == FALSE)
{ return((void *) AddSymbol("")); }
/*================================================*/
/* If parameters are out of range return an error */
/*================================================*/
if (start < 0) start = 0;
if (end > (int) strlen(DOToString(theArgument)))
{ end = strlen(DOToString(theArgument)); }
/*==================================*/
/* If the start is greater than the */
/* end, return a null string. */
/*==================================*/
if (start > end)
{ return((void *) AddSymbol("")); }
/*=============================================*/
/* Otherwise, allocate the string and copy the */
/* designated portion of the old string to the */
/* new string. */
/*=============================================*/
else
{
returnString = (char *) gm2(end - start +2); /* (end - start) inclusive + EOS */
tempString = DOToString(theArgument);
for(j=0, i=start;i <= end; i++, j++)
{ *(returnString+j) = *(tempString+i); }
*(returnString+j) = '\0';
}
/*========================*/
/* Return the new string. */
/*========================*/
returnValue = (void *) AddSymbol(returnString);
rm(returnString,end - start + 2);
return(returnValue);
}
globle void PrimitiveTablesInfo()
{
int i;
SYMBOL_HN **symbolArray, *symbolPtr;
FLOAT_HN **floatArray, *floatPtr;
INTEGER_HN **integerArray, *integerPtr;
BITMAP_HN **bitMapArray, *bitMapPtr;
unsigned long int symbolCount = 0, integerCount = 0;
unsigned long int floatCount = 0, bitMapCount = 0;
ArgCountCheck("primitives-info",EXACTLY,0);
/*====================================*/
/* Count entries in the symbol table. */
/*====================================*/
symbolArray = GetSymbolTable();
for (i = 0; i < SYMBOL_HASH_SIZE; i++)
{
for (symbolPtr = symbolArray[i]; symbolPtr != NULL; symbolPtr = symbolPtr->next)
{ symbolCount++; }
}
/*====================================*/
/* Count entries in the integer table. */
/*====================================*/
integerArray = GetIntegerTable();
for (i = 0; i < INTEGER_HASH_SIZE; i++)
{
for (integerPtr = integerArray[i]; integerPtr != NULL; integerPtr = integerPtr->next)
{ integerCount++; }
}
/*====================================*/
/* Count entries in the float table. */
/*====================================*/
floatArray = GetFloatTable();
for (i = 0; i < FLOAT_HASH_SIZE; i++)
{
for (floatPtr = floatArray[i]; floatPtr != NULL; floatPtr = floatPtr->next)
{ floatCount++; }
}
/*====================================*/
/* Count entries in the bitmap table. */
/*====================================*/
bitMapArray = GetBitMapTable();
for (i = 0; i < BITMAP_HASH_SIZE; i++)
{
for (bitMapPtr = bitMapArray[i]; bitMapPtr != NULL; bitMapPtr = bitMapPtr->next)
{ bitMapCount++; }
}
/*========================*/
/* Print the information. */
/*========================*/
PrintRouter(WDISPLAY,"Symbols: ");
PrintLongInteger(WDISPLAY,(long) symbolCount);
PrintRouter(WDISPLAY,"\n");
PrintRouter(WDISPLAY,"Integers: ");
PrintLongInteger(WDISPLAY,(long) integerCount);
PrintRouter(WDISPLAY,"\n");
PrintRouter(WDISPLAY,"Floats: ");
PrintLongInteger(WDISPLAY,(long) floatCount);
PrintRouter(WDISPLAY,"\n");
PrintRouter(WDISPLAY,"BitMaps: ");
PrintLongInteger(WDISPLAY,(long) bitMapCount);
PrintRouter(WDISPLAY,"\n");
}
int gdbm_lookup_p(char *dbm,char *word)
{
GDBM_FILE dbf;
datum key,value;
// int flag;
char abs_db_path[1000];
int len=0,len1=0;
char *dbm1;
DATA_OBJECT temp;
/*=================================*/
/* Check for exactly two argument. */
/*=================================*/
if (ArgCountCheck("gdbm_lookup_p",EXACTLY,2) == -1)
{ return(FALSE); }
/*=================================*/
/* Check the datatype of 2nd argument. */
/*=================================*/
if (ArgTypeCheck("gdbm_lookup_p",2,SYMBOL_OR_STRING,&temp) == 0)
{ return(1L);}
/*==========================================================================================*/
/*RtnLexeme returns a character pointer from either a symbol, string, or instance name data type */
/*=========================================================================================*/
len=(strlen(RtnLexeme(1)));
dbm=malloc(sizeof(char)*len+1);
strcpy(dbm,RtnLexeme(1));
strcpy(abs_db_path,ABS_ANU_PATH);
strcat(abs_db_path,dbm);
free(dbm);
len1=(strlen(abs_db_path));
dbm1=malloc(sizeof(char)*len1+1);
strcpy(dbm1,abs_db_path);
word = RtnLexeme(2);
//PrintRouter(WDISPLAY,"Database: ");PrintRouter(WDISPLAY,RtnLexeme(1));PrintRouter(WDISPLAY," word :");PrintRouter(WDISPLAY,RtnLexeme(2));PrintRouter(WDISPLAY,"\n");
/*=================================*/
/* To open the gdbm file. */
/*=================================*/
dbf = gdbm_open(dbm1,512,GDBM_READER,0644,0);
/*=================================*/
/* Check whether databse is empty. */
/*=================================*/
if (dbf == NULL)
{ PrintRouter(WDISPLAY,"Warning :: Database Not Found ------ OR ----- Database Is Empty.\n");
// PrintRouter(WDISPLAY,"\n");
// PrintRouter(WDISPLAY,RtnLexeme(2));
// PrintRouter(WDISPLAY,"\n");
return(1L); }
key.dptr=word;
key.dsize=strlen(key.dptr);
value = gdbm_fetch(dbf,key);
gdbm_close (dbf);
if(value.dptr!=NULL)
return(TRUE);
else
return(FALSE);
}
