SICP/shared/scm2c/env.c

98 lines
2.4 KiB
C

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "env.h"
#include "primitives.h"
datum* define_variable(const char *var, datum *value, environment *env) {
if (env->first_mapping == NULL) {
env->first_mapping = new_mapping(var, value);
return NULL;
}
mapping* m = env->first_mapping;
while (1) {
if (strcmp(var, m->variable) == 0) {
m->value = value;
}
if (m->next) {
m = m->next;
} else {
break;
}
}
m->next = new_mapping(var, value);
return NULL;
}
datum* lookup_variable_value(char* var, environment* env) {
environment* e = env;
mapping* m;
while (e) {
m = e->first_mapping;
while (m) {
if (strcmp(var, m->variable) == 0) {
return m->value;
}
m = m->next;
}
e = e->outer_env;
}
printf("UNDEFINED VARIABLE %s", var);
exit(-1);
}
datum* make_compiled_proc(void* entry, environment* e) {
datum* r = malloc(sizeof(datum));
if (!r) exit(-1);
r->type = datum_type_compiled_proc;
r->compiled_procedure_entry = entry;
r->env = e;
return r;
}
environment* extend_environment(const char **args, datum *argl, environment* outer_env) {
environment* env = malloc(sizeof(environment));
if (!env) exit(-1);
env->first_mapping = NULL;
env->outer_env = outer_env;
size_t i = 0;
while (argl && args[i]) {
define_variable(args[i], argl, env);
i += 1;
argl = argl->next;
}
return env;
}
environment* get_global_environment(void) {
environment* env = malloc(sizeof(environment));
if (!env) exit(-1);
env->first_mapping = NULL;
env->outer_env = NULL;
define_variable("+", const_primitive_proc(&add), env);
define_variable("-", const_primitive_proc(&sub), env);
define_variable("*", const_primitive_proc(&mul), env);
define_variable("=", const_primitive_proc(&eq), env);
define_variable("<", const_primitive_proc(&lt), env);
define_variable("display", const_primitive_proc(&display), env);
define_variable("newline", const_primitive_proc(&newline), env);
return env;
}
mapping* new_mapping(const char* var, datum* value) {
mapping* m = malloc(sizeof(mapping));
if (!m) exit(-1);
m->variable = var;
m->value = value;
m->next = NULL;
return m;
}