LakeVal *eval(LakeCtx *ctx, Env *env, LakeVal *expr)
{
LakeVal *result;
LakeList *list;
switch (expr->type) {
/* self evaluating types */
case TYPE_BOOL:
case TYPE_INT:
case TYPE_STR:
result = expr;
break;
case TYPE_SYM:
result = env_get(env, (void *)SYM(expr));
if (!result) {
ERR("undefined variable: %s", sym_repr(SYM(expr)));
}
break;
case TYPE_DLIST:
ERR("malformed function call");
result = NULL;
break;
case TYPE_COMM:
result = NULL;
break;
case TYPE_LIST:
list = LIST(expr);
if (LIST_N(list) == 0) {
result = expr;
}
else {
if (is_special_form(ctx, list)) {
result = eval_special_form(ctx, env, list);
}
else {
LakeVal *fn = eval(ctx, env, LIST_VAL(list, 0));
if (!fn) {
return NULL;
}
LakeList *args = list_make_with_capacity(LIST_N(list) - 1);
int i;
LakeVal *v;
for (i = 1; i < LIST_N(list); ++i) {
v = eval(ctx, env, LIST_VAL(list, i));
if (v != NULL) {
list_append(args, v);
}
else {
list_free(args);
result = NULL;
goto done;
}
}
result = apply(ctx, fn, args);
}
}
break;
default:
ERR("unrecognized value, type %d, size %zu bytes", expr->type, expr->size);
DIE("we don't eval that around here!");
}
done: return result;
}
Value * evaluate(Environment *env, Value *expr) {
EvaluationContext *ctx;
Value *temp, *result;
Value *operator;
Value *operand_val, *operand_cons;
Value *operands, *operands_end, *nil_value;
int num_operands;
/* Set up a new evaluation context and record our local variables, so that
* the garbage-collector can see any temporary values we use.
*/
ctx = push_new_evalctx(env, expr);
evalctx_register(&temp);
evalctx_register(&result);
evalctx_register(&operator);
evalctx_register(&operand_val);
evalctx_register(&operand_cons);
evalctx_register(&operands);
evalctx_register(&operands_end);
evalctx_register(&nil_value);
#ifdef VERBOSE_EVAL
printf("\nEvaluating expression: ");
print_value(stdout, expr);
printf("\n");
#endif
/* If this is a special form, evaluate it. Otherwise, this function will
* simply pass the input through to the result.
*/
result = eval_special_form(env, expr);
if (result != expr)
goto Done; /* It was a special form. */
/*
* If the input is an atom, we need to resolve it to a value, using the
* current environment.
*/
if (is_atom(expr)) {
/* Treat the atom as a name - resolve it to a value. */
result = resolve_binding(env, expr->string_val);
if (result == NULL) {
result = make_error("couldn't resolve name \"%s\" to a value!",
expr->string_val);
}
goto Done;
}
/*
* If the input isn't an atom and isn't a cons-pair, then assume it's a
* value that doesn't need evaluating, and just return it.
*/
if (!is_cons_pair(expr)) {
result = expr;
goto Done;
}
/*
* Evaluate operator into a lambda expression.
*/
temp = get_car(expr);
operator = evaluate(env, temp);
if (is_error(operator)) {
result = operator;
goto Done;
}
if (!is_lambda(operator)) {
result = make_error("operator is not a valid lambda expression");
goto Done;
}
#ifdef VERBOSE_EVAL
printf("Operator: ");
print_value(stdout, operator);
printf("\n");
#endif
/*
* Evaluate each operand into a value, and build a list up of the values.
*/
#ifdef VERBOSE_EVAL
printf("Starting evaluation of operands.\n");
#endif
num_operands = 0;
operands_end = NULL;
operands = nil_value = make_nil();
temp = get_cdr(expr);
while (is_cons_pair(temp)) {
Value *raw_operand;
num_operands++;
/* This is the raw unevaluated value. */
raw_operand = get_car(temp);
/* Evaluate the raw input into a value. */
operand_val = evaluate(env, raw_operand);
if (is_error(operand_val)) {
result = operand_val;
goto Done;
}
operand_cons = make_cons(operand_val, nil_value);
if (operands_end != NULL)
set_cdr(operands_end, operand_cons);
else
operands = operand_cons;
operands_end = operand_cons;
temp = get_cdr(temp);
}
/*
* Apply the operator to the operands, to generate a result.
*/
if (operator->lambda_val->native_impl) {
/* Native lambdas don't need an environment created for them. Rather,
* we just pass the list of arguments to the native function, and it
* processes the arguments as needed.
*/
result = operator->lambda_val->func(num_operands, operands);
}
else {
/* These don't need registered on the explicit stack. (I hope.) */
Environment *child_env;
Value *body_iter;
/* It's an interpreted lambda. Create a child environment, then
* populate it with values based on the lambda's argument-specification
* and the input operands.
*/
child_env = make_environment(operator->lambda_val->parent_env);
temp = bind_arguments(child_env, operator->lambda_val, operands);
if (is_error(temp)) {
result = temp;
goto Done;
}
/* Evaluate each expression in the lambda, using the child environment.
* The result of the last expression is the result of the lambda.
*/
body_iter = operator->lambda_val->body;
do {
result = evaluate(child_env, get_car(body_iter));
body_iter = get_cdr(body_iter);
}
while (!is_nil(body_iter));
}
Done:
#ifdef VERBOSE_EVAL
printf("Result: ");
print_value(stdout, result);
printf("\n\n");
#endif
/* Record the result and then perform garbage-collection. */
pop_evalctx(result);
collect_garbage();
return result;
}
LObject *
lipa_eval (LObject *obj)
{
gboolean found;
LObject *tmp;
if (!obj)
return NULL;
switch (obj->type)
{
case L_OBJ_LIST:
tmp = eval_special_form (lipa_car (obj), lipa_cdr (obj), &found);
if (found)
{
return tmp;
}
else
{
tmp = eval_function (lipa_car (obj), lipa_cdr (obj), &found);
if (found)
{
return tmp;
}
else
{
fputs ("can't be evaluated as a function: ", stdout);
lipa_print (obj);
fputc ('\n', stdout);
}
}
break;
case L_OBJ_FUNCTION:
fputs ("This should not be happning?!?!!?!?!\n", stderr);
return NULL;
break;
case L_OBJ_SYMBOLNAME:
return (lipa_eval(lipa_symbolname_lookup (L_SYMBOLNAME(obj)->str)));
break;
case L_OBJ_SYMBOL:
return L_SYMBOL(obj).value;
break;
/* these evaluate to themselves */
case L_OBJ_STRING:
case L_OBJ_INT:
case L_OBJ_FLOAT:
case L_OBJ_CHAR:
case L_OBJ_TRUE:
case L_OBJ_FALSE:
case L_OBJ_USEROBJECT:
return obj;
break;
}
return NULL;
}
