le * evaluateBranch( lithp_burrito *lb, le * trybranch)
{
le * keyword;
int tryit = 0;
if (!trybranch) return( NULL );
if (trybranch->branch) {
keyword = evaluateBranch(lb, trybranch->branch);
} else
keyword = leNew( trybranch->data );
if (!keyword->data) {
leWipe( keyword );
return( leNew( "NIL" ));
}
for ( tryit=0 ; evalTable[tryit].word ; tryit++) {
if (!strcmp(evalTable[tryit].word, keyword->data)) {
leWipe( keyword );
return( evalTable[tryit].callback(
lb,
countNodes( trybranch ),
trybranch) );
}
}
leWipe( keyword );
return( evaluateNode( lb, trybranch ));
}
le * eval_cb_car( lithp_burrito * lb, const int argc, le * branch )
{
le * result = NULL;
le * temp = NULL;
if (!branch || argc != 2 ) return( leNew( "NIL" ));
result = evaluateNode(lb, branch->list_next);
if( result == NULL ) return( leNew( "NIL" ) );
if (countNodes(result) <= 1) {
if (result->branch) {
temp = result;
result = result->branch;
temp->branch = NULL;
leWipe( temp );
}
return( result );
}
result->list_next->list_prev = NULL;
leWipe( result->list_next );
result->list_next = NULL;
if (result->branch) {
temp = result;
result = result->branch;
temp->branch = NULL;
leWipe( temp );
}
return( result );
}
static le *
evaluateBranch (le * trybranch)
{
le *keyword;
fentry * func;
if (trybranch == NULL)
return NULL;
if (trybranch->branch)
keyword = evaluateBranch (trybranch->branch);
else
keyword = leNew (trybranch->data);
if (keyword->data == NULL)
{
leWipe (keyword);
return leNIL;
}
func = get_fentry (keyword->data);
leWipe (keyword);
if (func)
return func->func (1, false, trybranch);
return NULL;
}
le * eval_cb_whenunless_helper(
enum whenunless which,
lithp_burrito * lb, const int argc,
le * branch
) {
le * retval = NULL;
le * trythis = NULL;
if (!branch || argc < 3 ) return( leNew( "NIL" ));
/* conditional */
retval = evaluateNode(lb, branch->list_next);
if ( which == WU_UNLESS )
{
/* unless - it wasn't true... bail */
if ( strcmp( retval->data, "NIL" )) {
leWipe( retval );
return( leNew( "NIL" ) );
}
} else {
/* when: it wasn't false... bail */
if ( !strcmp( retval->data, "NIL" ))
return( retval );
}
trythis = branch->list_next->list_next;
while( trythis ) {
if (retval) leWipe( retval );
retval = evaluateNode(lb, trythis);
trythis = trythis->list_next;
}
return( retval );
}
static le * eval_getint_2( lithp_burrito *lb, le * branch, int *a, int *b )
{
le * retle = evaluateNode( lb, branch->list_next );
*a = evalCastLeToInt( retle );
leWipe( retle );
retle = evaluateNode( lb, branch->list_next->list_next );
*b = evalCastLeToInt( retle );
leWipe( retle );
return( branch->list_next->list_next->list_next );
}
le * evaluateDefun( lithp_burrito *lb, le * fcn, le * params )
{
le * function;
le * thisparam;
le * result;
int count;
/* make sure both lists exist */
if (!fcn) return( leNew( "NIL" ));
/* check for the correct number of parameters */
if (countNodes(fcn->branch) > countNodes(params))
return( leNew( "NIL" ));
/* allocate another function definition, since we're gonna hack it */
function = leDup(fcn);
/* pass 1: tag each node properly.
for each parameter: (fcn)
- look for it in the tree, tag those with the value
*/
count = 0;
thisparam = fcn->branch;
while (thisparam)
{
leTagData(function, thisparam->data, count);
thisparam = thisparam->list_next;
count++;
}
/* pass 2: replace
for each parameter: (param)
- evaluate the passed in value
- replace it in the tree
*/
count = 0;
thisparam = params;
while (thisparam)
{
result = evaluateNode( lb, thisparam );
leTagReplace(function, count, result);
thisparam = thisparam->list_next;
leWipe(result);
count++;
}
/* then evaluate the resulting tree */
result = evaluateBranch( lb, function->list_next );
/* free any space allocated */
leWipe( function );
/* return the evaluation */
return( result );
}
static le * eval_getint_3_noskip( lithp_burrito *lb, le * node, int *a, int *b, int *c )
{
le * retle = evaluateNode( lb, node );
*a = evalCastLeToInt( retle );
leWipe( retle );
retle = evaluateNode( lb, node->list_next );
*b = evalCastLeToInt( retle );
leWipe( retle );
retle = evaluateNode( lb, node->list_next->list_next );
*c = evalCastLeToInt( retle );
leWipe( retle );
return( node->list_next->list_next->list_next );
}
void Lithp_callDefun( lithp_burrito *lb, char * fname )
{
le * ret;
le * fcn;
le * temp = variableGet( lb->defunList, fname );
if( !temp ) return;
fcn = leNew( fname );
ret = evaluateNode( lb, fcn );
leWipe( ret );
leWipe( fcn );
}
le * eval_cb_select( lithp_burrito * lb, const int argc, le * branch )
{
le * result;
if (argc < 2) return( leNew( "NIL" ));
branch = branch->list_next;
result = evaluateNode(lb, branch);
branch = branch->list_next;
while( branch ) {
if( branch->branch ) {
le * check = branch->branch;
if (check && check->data
&& (!strcmp( check->data, result->data ))) {
/* we're in the right place, evaluate and return */
le * computelist = check->list_next;
while( computelist )
{
leWipe( result );
result = evaluateNode( lb, computelist );
computelist = computelist->list_next;
}
return( result );
}
}
branch = branch->list_next;
}
return( result );
}
le * eval_cb_cons( lithp_burrito * lb, const int argc, le * branch )
{
le * result1 = NULL;
le * result2 = NULL;
if (!branch || argc != 3 ) return( leNew( "NIL" ));
result1 = evaluateNode(lb, branch->list_next);
if ( result1 == NULL ) return( leNew( "NIL" ));
result2 = evaluateNode(lb, branch->list_next->list_next);
if ( result2 == NULL ) {
leWipe( result1 );
return( leNew( "NIL" ));
}
if ( countNodes(result1) > 1 ) {
le * temp = leNew( NULL );
temp->branch = result1;
result1 = temp;
}
result1->list_next = result2;
result2->list_prev = result1;
return( result1 );
}
le * eval_cb_prog( lithp_burrito * lb, const int argc, le * branch, int returnit )
{
le * curr;
le * retval = NULL;
le * tempval = NULL;
int current = 0;
if (!branch || argc < (returnit +1) ) return( leNew( "NIL" ));
curr = branch->list_next;
while (curr)
{
++current;
if ( tempval ) leWipe (tempval);
tempval = evaluateNode( lb, curr );
if (current == returnit) retval = leDup( tempval );
curr = curr->list_next;
}
if (!retval) retval = tempval;
return( retval );
}
le * eval_cb_eqsign( lithp_burrito * lb, const int argc, le * branch )
{
le * letemp;
int value1, value2;
if (!branch || argc != 3 ) return( leNew( "NIL" ) );
letemp = evaluateNode( lb, branch->list_next );
value1 = evalCastLeToInt( letemp );
leWipe( letemp );
letemp = evaluateNode( lb, branch->list_next->list_next );
value2 = evalCastLeToInt( letemp );
leWipe( letemp );
return( leNew ( (value1 == value2 )?"T":"NIL" ) );
}
le * eval_cb_modulus( lithp_burrito * lb, const int argc, le * branch )
{
le * letemp;
int value1, value2;
if (!branch || argc != 3) return( leNew( "NIL" ) );
letemp = evaluateNode( lb, branch->list_next );
value1 = evalCastLeToInt( letemp );
leWipe( letemp );
letemp = evaluateNode( lb, branch->list_next->list_next );
value2 = evalCastLeToInt( letemp );
leWipe( letemp );
return( evalCastIntToLe ( value1 % value2 ) );
}
void variableSetString(le **varlist, char *key, char *value)
{
if (key && value) {
le *temp = leNew(value);
variableSet(varlist, key, temp);
leWipe(temp);
}
}
le * eval_cb_equal( lithp_burrito * lb, const int argc, le * branch )
{
le * list1 = NULL;
le * list2 = NULL;
int retval = 0;
if (!branch || argc != 3 ) return( leNew( "NIL" ) );
list1 = evaluateNode( lb, branch->list_next );
list2 = evaluateNode( lb, branch->list_next->list_next );
retval = eval_cb_lists_same( list1, list2 );
leWipe( list1 );
leWipe( list2 );
return( leNew ( (retval == 1) ? "T" : "NIL" ) );
}
le * eval_cb_eval( lithp_burrito * lb, const int argc, le * branch )
{
le * temp;
le * retval;
if (!branch || argc != 2 ) return( leNew( "NIL" ));
temp = evaluateNode(lb, branch->list_next);
retval = evaluateBranch(lb, temp);
leWipe( temp );
return( retval );
}
le * eval_cb_oneplus( lithp_burrito * lb, const int argc, le * branch )
{
le * retle;
int value;
if (!branch || argc < 2) return( leNew( "NIL" ) );
retle = evaluateNode( lb, branch->list_next );
value = evalCastLeToInt( retle );
leWipe( retle );
return( evalCastIntToLe(value + 1) );
}
le * eval_cb_atom( lithp_burrito * lb, const int argc, le * branch )
{
le * result = NULL;
if (!branch || argc != 2 ) return( leNew( "NIL" ));
result = evaluateNode( lb, branch->list_next );
if (countNodes(result) == 1) {
leWipe( result );
return( leNew( "T" ) );
}
return( leNew( "NIL" ) );
}
le * eval_cb_if( lithp_burrito * lb, const int argc, le * branch )
{
le * retcond = NULL;
if (!branch || argc < 3 || argc > 4) return( leNew( "NIL" ));
/* if */
retcond = evaluateNode(lb, branch->list_next);
if (!strcmp ( retcond->data, "NIL" ))
{
if (argc == 3) /* no else */
return( retcond );
leWipe( retcond );
return( evaluateNode( lb, branch->list_next->list_next->list_next ) );
}
/* then */
leWipe( retcond );
return( evaluateNode(lb, branch->list_next->list_next) );
}
le * eval_cb_divide( lithp_burrito * lb, const int argc, le * branch )
{
int firstitem = 0;
le * lefirst;
if (!branch || argc < 2) return( leNew( "NIL" ) );
lefirst = evaluateNode( lb, branch->list_next );
firstitem = evalCastLeToInt( lefirst );
leWipe( lefirst );
return( evalCastIntToLe(
eval_cume_helper( C_DIVIDE, lb, firstitem,
branch->list_next->list_next)));
}
le * eval_cb_not( lithp_burrito * lb, const int argc, le * branch )
{
le * result = NULL;
if (!branch || argc != 2 ) return( leNew( "NIL" ));
result = evaluateNode( lb, branch->list_next );
if (result->data) {
if (!strcmp (result->data, "NIL" )) {
leWipe( result );
return( leNew( "T" ) );
} else {
leWipe( result );
return( leNew( "NIL" ) );
}
} else if (result->branch) {
leWipe( result );
return( leNew( "NIL" ) );
}
leWipe( result );
return( leNew( "T" ));
}
le * eval_cb_cond( lithp_burrito * lb, const int argc, le * branch )
{
le * retval = NULL;
le * retblock = NULL;
le * trythis = NULL;
le * tryblock = NULL;
int newargc;
if (!branch || argc < 2 ) return( leNew( "NIL" ));
trythis = branch->list_next;
while (trythis) {
newargc = countNodes( trythis->branch );
if (newargc == 0) continue;
/* conditional */
if (retval) leWipe(retval);
retval = evaluateNode(lb, trythis->branch);
if ( strcmp(retval->data, "NIL" )) {
if (newargc == 1) return( retval );
tryblock = trythis->branch->list_next;
while (tryblock) {
if (retblock) leWipe(retblock);
retblock = NULL;
retblock = evaluateNode(lb, tryblock);
tryblock = tryblock->list_next;
}
return( retblock );
}
trythis = trythis->list_next;
}
return( retval );
}
void variableSet(le **varlist, char *key, le *value)
{
if (key && value) {
le *temp = variableFind(*varlist, key);
if (temp)
leWipe(temp->branch);
else {
temp = leNew(key);
*varlist = leAddHead(*varlist, temp);
}
temp->branch = leDup(value);
}
}
le * eval_gfx_Rand ( lithp_burrito * lb, const int argc, le * branch )
{
le * retle;
int value;
int r;
if (!branch || argc != 2) return( leNew( "NIL" ) );
retle = evaluateNode( lb, branch->list_next );
value = evalCastLeToInt( retle );
leWipe( retle );
r = (int)((float)value * rand() / (RAND_MAX + 1.0));
return( evalCastIntToLe( r ) );
}
le * eval_cb_princ( lithp_burrito * lb, const int argc, le * branch )
{
le * thisnode;
le * retblock = NULL;
if (!branch || argc < 1 ) return( leNew( "NIL" ));
thisnode = branch->list_next;
while (thisnode) {
if (retblock) leWipe( retblock );
retblock = evaluateNode(lb, thisnode);
leDumpReformat(stdout, retblock);
thisnode = thisnode->list_next;
}
return( retblock );
}
le * eval_cb_subtract( lithp_burrito * lb, const int argc, le * branch )
{
int firstitem = 0;
le * lefirst;
if (!branch || argc < 2) return( leNew( "NIL" ) );
lefirst = evaluateNode( lb, branch->list_next );
firstitem = evalCastLeToInt( lefirst );
leWipe( lefirst );
if (argc == 2) {
return( evalCastIntToLe( -1 * firstitem) );
}
return( evalCastIntToLe( eval_cume_helper( C_SUBTRACT, lb, firstitem,
branch->list_next->list_next)));
}
le * eval_cb_or( lithp_burrito * lb, const int argc, le * branch )
{
le * temp;
le * result = NULL;
if (!branch || argc < 2 ) return( leNew( "NIL" ));
temp = branch->list_next;
while( temp ) {
if( result ) leWipe( result );
result = evaluateNode(lb, temp);
if (result->data) {
if (strcmp ( result->data, "NIL" )) {
return( result );
}
}
temp = temp->list_next;
}
return( result );
}
le * eval_cb_list( lithp_burrito * lb, const int argc, le * branch )
{
le * currelement = NULL;
le * finaltree = NULL;
le * lastadded = NULL;
le * result = NULL;
if (!branch) return( leNew( "NIL" ));
currelement = branch->list_next;
while (currelement)
{
result = evaluateNode(lb, currelement);
if ( result == NULL ) {
leWipe( finaltree );
return( leNew( "NIL" ));
}
if( countNodes(result) > 1) {
le * temp = leNew( NULL );
temp->branch = result;
result = temp;
}
if (!finaltree) {
finaltree = result;
lastadded = result;
} else {
lastadded->list_next = result;
result->list_prev = lastadded;
lastadded = result;
}
currelement = currelement->list_next;
}
if (!finaltree) {
return( leNew( "NIL" ));
}
return( finaltree );
}
int eval_cume_helper( enum cumefcn function, lithp_burrito * lb, int value, le * branch)
{
int newvalue = 0;
le * temp = branch;
le * value_le;
if (!branch) return( 0 );
while (temp) {
value_le = evaluateNode(lb, temp);
newvalue = evalCastLeToInt(value_le);
leWipe(value_le);
switch(function) {
case( C_ADD ):
value += newvalue;
break;
case( C_SUBTRACT ):
value -= newvalue;
break;
case( C_MULTIPLY ):
value *= newvalue;
break;
case( C_DIVIDE ):
value /= newvalue;
break;
case( C_NONE ):
break;
}
temp = temp->list_next;
}
return( value );
}
le * eval_cb_set_helper(
enum setfcn function,
lithp_burrito * lb, const int argc,
le * branch
)
{
le * newkey = NULL;
le * newvalue = NULL;
le * current = NULL;
if (!branch || argc < 3) return( leNew( "NIL" ) );
current = branch->list_next;
while ( current ) {
if (!current->list_next) {
newvalue = leNew( "NIL" );
} else {
newvalue = evaluateNode(lb, current->list_next);
}
if ( function == S_SET ) newkey = evaluateNode(lb, current);
lb->mainVarList = variableSet(
lb->mainVarList,
( function == S_SET )? newkey->data : current->data,
newvalue
);
if ( function == S_SET ) leWipe(newkey);
if (!current->list_next) {
current = NULL;
} else {
current = current->list_next->list_next;
}
}
return( leDup(newvalue) );
}