99 lines
2.7 KiB
C
99 lines
2.7 KiB
C
#include "eval.h"
|
|
|
|
#include "builtins.h"
|
|
#include "lexer.h"
|
|
#include "parser.h"
|
|
#include "syntax.h"
|
|
|
|
#include <assert.h>
|
|
#include <stddef.h>
|
|
#include <string.h>
|
|
|
|
static struct Object *lookup(struct Object *namespace, struct Object *name);
|
|
|
|
static struct Object *eval_list(
|
|
struct Object *object,
|
|
struct Object *environment
|
|
);
|
|
|
|
struct Object *eval(
|
|
struct Object *const object,
|
|
struct Object *const environment
|
|
) {
|
|
assert(Object_is_pair(environment));
|
|
assert(OBJECT_IS_NULL(environment->pair.cdr));
|
|
|
|
// NULL is an empty list, can't eval
|
|
assert(!OBJECT_IS_NULL(object));
|
|
|
|
// SYMBOL performs lookup
|
|
if (Object_is_symbol(object)) return lookup(environment->pair.car, object);
|
|
|
|
// Almost everything evaluates to itself
|
|
if (!Object_is_pair(object)) return object;
|
|
|
|
struct Object *const func_expr = object->pair.car;
|
|
struct Object *const args = object->pair.cdr;
|
|
|
|
if (Object_is_symbol(func_expr)) {
|
|
if (strcmp(func_expr->s, "begin") == 0) {
|
|
return syntax_begin(args, environment);
|
|
}
|
|
if (strcmp(func_expr->s, "define") == 0) {
|
|
return syntax_define(args, environment);
|
|
}
|
|
if (strcmp(func_expr->s, "quote") == 0) {
|
|
return syntax_quote(args, environment);
|
|
}
|
|
if (strcmp(func_expr->s, "if") == 0) {
|
|
return syntax_if(args, environment);
|
|
}
|
|
}
|
|
|
|
struct Object *const func = eval(func_expr, environment);
|
|
assert(Object_is_procedure(func));
|
|
struct Object *const evaluated_args = eval_list(args, environment);
|
|
return Object_procedure_call(func, evaluated_args);
|
|
}
|
|
|
|
struct Object *eval_list(
|
|
struct Object *const object,
|
|
struct Object *const environment
|
|
) {
|
|
assert(OBJECT_IS_LIST_HEAD(object));
|
|
|
|
if (OBJECT_IS_NULL(object)) return NULL;
|
|
|
|
if (OBJECT_IS_NULL(object->pair.car)) {
|
|
return Object_new_pair(
|
|
NULL,
|
|
eval_list(object->pair.cdr, environment)
|
|
);
|
|
} else {
|
|
return Object_new_pair(
|
|
eval(object->pair.car, environment),
|
|
eval_list(object->pair.cdr, environment)
|
|
);
|
|
}
|
|
}
|
|
|
|
struct Object *lookup(struct Object *namespace, struct Object *const name)
|
|
{
|
|
assert(OBJECT_IS_LIST_HEAD(namespace));
|
|
assert(Object_is_symbol(name));
|
|
|
|
while (!OBJECT_IS_NULL(namespace)) {
|
|
assert(Object_is_pair(namespace));
|
|
struct Object *const item = namespace->pair.car;
|
|
assert(Object_is_pair(item));
|
|
assert(Object_is_symbol(item->pair.car));
|
|
if (strcmp(item->pair.car->s, name->s) == 0) return item->pair.cdr;
|
|
namespace = namespace->pair.cdr;
|
|
}
|
|
|
|
struct Object *const builtin_procedure = builtins_get(name->s);
|
|
if (builtin_procedure) return builtin_procedure;
|
|
|
|
assert(0);
|
|
}
|