object_t *eval(object_t *exp, object_t *env) {
object_t *ret = NULL;
if (evaluate_to_self(exp)) {
ret = exp;
}
else if (quoted(exp)) {
ret = car(cdr(exp));
}
else if (definition(exp)) {
object_t *symb = car(cdr(exp)),
*val = car(cdr(cdr(exp)));
if (val == NULL) {
create_new_variable(symb, get_nil(), env);
} else {
create_new_variable(symb,
eval(val, env),
env);
}
ret = symb;
}
else if (is_symbol(exp)) {
//printf("\nfound symbol: %s\n\n", exp->values.symbol.value);
ret = find_variable_value(exp, env);
}
else if (function(exp)) {
object_t *arguments = make_arguments(cdr(exp), env);
object_t *func = eval(car(exp), env);
if (func == NULL || func == get_nil() ||
func->type != t_primitive) {
fprintf(stderr, "func: %d\n", (unsigned int)func);
//fprintf(stderr, "type: %d\n", func->type);
die("Not a primitive!\n");
} else {
ret = (func->values.primitive.function)(arguments);
}
} else if (maybe_eval_to_function(exp)) {
object_t *c = car(exp);
object_t *func = eval(c, env);
if (!(func == NULL || nilp(func))) {
object_t *arguments = make_arguments(cdr(exp), env);
ret = (func->values.primitive.function)(arguments);
}
else {
die("Not a function!\n");
}
}
else {
die("Can't eval!\n");
}
return ret;
}
object_t *make_arguments(object_t *args, object_t *env) {
if (nilp(args)) {
return get_nil();
} else {
return create_cons(eval(car(args), env),
make_arguments(cdr(args), env));
}
}
void builtin_println(VM * vm) {
println_slot( get(vm,2) );
printf("\n");
set(vm,0,get_nil());
}
LispObj *read_from_yybuf(YY_BUFFER_STATE yy_buf)
{
yy_switch_to_buffer(yy_buf);
Token token = get_token();
if (token.str == NULL) /* a NULL pointer = EOF */
return NULL;
switch (token.type) {
case T_INTEGER: {
int x;
sscanf(token.str, "%d", &x);
free(token.str);
return make_int(x);
}
case T_CHAR: {
char c = token.str[2]; /* TODO: name-char reading */
free(token.str);
return make_char(c);
}
case T_STRING: {
int len = strlen(token.str);
/* Take a substring of token.str, skipping the first
* and last chars */
char *str = malloc(sizeof(char) * (len - 2));
strncpy(str, token.str + 1, len - 2);
*(str + (len - 2)) = '\0';
free(token.str);
return make_string(str);
}
case T_SYMBOL: {
return make_symbol(token.str);
}
case T_OPEN_PAREN: {
free(token.str);
LispObj *car = read_from_yybuf(yy_buf);
if (car == NULL) /* Unmatched open parenthesis */
return NULL; /* TODO: Error handling/reporting */
if ((car->type == ERROR) &&
(car->value.l_err == UNMATCHED_CLOSE_PAREN)) {
always_free_lisp_obj(car);
return get_nil();
}
Cons *curr_cons = cons(car, get_nil());
LispObj *list = make_cons(curr_cons);
for (;;) {
car = read_from_yybuf(yy_buf);
if (car == NULL)
return NULL;
if ((car->type == ERROR) &&
(car->value.l_err == UNMATCHED_CLOSE_PAREN)) {
always_free_lisp_obj(car);
break;
}
curr_cons->cdr = make_cons(cons(car, get_nil()));
curr_cons = curr_cons->cdr->value.l_cons;
}
return list;
}
case T_CLOSE_PAREN:
free(token.str);
return make_error(UNMATCHED_CLOSE_PAREN);
}
return NULL;
}
