object *lookup_variable_value(object *var, object *env) {
object *frame;
object *vars;
object *vals;
if (debug)
{
fprintf(stderr, "entering lookup_variable_value searching for %s\n", var->data.symbol.value);
}
while (!is_the_empty_list(env)) {
frame = first_frame(env);
vars = frame_variables(frame);
vals = frame_values(frame);
if (debug)
{
fprintf(stderr, "1 searching symbol %s\n", var->data.symbol.value);
fprintf(stderr, "1 vars %p\n", vars);
}
while (!is_the_empty_list(vars)) {
if (is_pair(vars)) {
if (var == car(vars)) {
if (debug)
{
fprintf(stderr, "vals---\n");
write(stdout, is_pair(vals) ? car(vals) : the_empty_list);
fflush(stdout);
fprintf(stderr, "\nend---\n");
}
return is_pair(vals) ? car(vals) : the_empty_list;
}
}
else if(is_symbol(vars)) {
if (debug)
{
fprintf(stderr, "2 searched symbol %s\n", var->data.symbol.value);
fprintf(stderr, "last cdr symbol %s\n", vars->data.symbol.value);
}
if (var == vars) {
if (debug)
{
fprintf(stderr, "vals---\n");
write(stdout, vals);
fflush(stdout);
fprintf(stderr, "\nend---\n");
}
return vals;
}
else
{
break;
}
}
vars = cdr(vars);
vals = cdr(vals);
}
env = enclosing_environment(env);
}
fprintf(stderr, "unbound variable, %s\n", var->data.symbol.value);
exit(1);
}
object *expand_clauses(object *clauses) {
object *first;
object *rest;
if (is_the_empty_list(clauses)) {
return false;
}
else {
first = car(clauses);
rest = cdr(clauses);
if (is_cond_else_clause(first)) {
if (is_the_empty_list(rest)) {
return sequence_to_exp(cond_actions(first));
}
else {
fprintf(stderr, "else clause isn't last cond->if");
exit(1);
}
}
else {
return make_if(cond_predicate(first),
sequence_to_exp(cond_actions(first)),
expand_clauses(rest));
}
}
}
object *make_symbol(char *value) {
object *obj;
object *element;
/* search for they symbol in the symbol table */
element = symbol_table;
while (!is_the_empty_list(element)) {
if (strcmp(car(element)->data.symbol.value, value) == 0) {
return car(element);
}
element = cdr(element);
};
/* create the symbol and add it to the symbol table */
obj = alloc_object();
obj->type = SYMBOL;
obj->data.symbol.value = malloc(strlen(value) + 1);
if (obj->data.symbol.value == NULL) {
fprintf(stderr, "out of memory\n");
exit(1);
}
strcpy(obj->data.symbol.value, value);
symbol_table = cons(obj, symbol_table);
return obj;
}
object *if_alternative(object *exp) {
if (is_the_empty_list(cdddr(exp))) {
return false;
} else {
return cadddr(exp);
}
}
object *prepare_apply_operands(object *arguments) {
if (is_the_empty_list(cdr(arguments))) {
return car(arguments);
} else {
return cons(car(arguments), prepare_apply_operands(cdr(arguments)));
}
}
object *mul_proc(object *arguments) {
long result = 1;
while (!is_the_empty_list(arguments)) {
result *= (car(arguments))->data.fixnum.value;
arguments = cdr(arguments);
}
return make_fixnum(result);
}
object *sub_proc(object *arguments) {
long result;
result = (car(arguments))->data.fixnum.value;
while (!is_the_empty_list(arguments = cdr(arguments))) {
result -= (car(arguments))->data.fixnum.value;
}
return make_fixnum(result);
}
object *is_number_equal_proc(object *arguments) {
long value;
value = (car(arguments))->data.fixnum.value;
while (!is_the_empty_list(arguments = cdr(arguments))) {
if (value != ((car(arguments))->data.fixnum.value)) {
return false;
}
}
return true;
}
object *sequence_to_exp(object *seq) {
if (is_the_empty_list(seq)) {
return seq;
}
else if (is_last_exp(seq)) {
return first_exp(seq);
}
else {
return make_begin(seq);
}
}
object *min_proc(object *arguments) {
long min;
min = (car(arguments))->data.fixnum.value;
while(!is_the_empty_list(arguments = cdr(arguments))) {
if (min > car(arguments)->data.fixnum.value) {
min = car(arguments)->data.fixnum.value;
}
}
return make_fixnum(min);
}
object *list_to_string_proc(object *arguments) {
char str[BUFFER_MAX];
object *list = car(arguments);
int i;
for (i = 0; !is_the_empty_list(list) && i < BUFFER_MAX; i++) {
str[i] = car(list)->data.character.value;
list = cdr(list);
}
str[i] = '\0';
return make_string(str);
}
object *max_proc(object *arguments) {
long max;
max = (car(arguments))->data.fixnum.value;
while(!is_the_empty_list(arguments = cdr(arguments))) {
if (max < car(arguments)->data.fixnum.value) {
max = car(arguments)->data.fixnum.value;
}
}
return make_fixnum(max);
}
object *is_greater_than_proc(object *arguments) {
long previous;
long next;
previous = (car(arguments))->data.fixnum.value;
while (!is_the_empty_list(arguments = cdr(arguments))) {
next = (car(arguments))->data.fixnum.value;
if (previous > next) {
previous = next;
}
else {
return false;
}
}
return true;
}
object *make_symbol(char *value) {
object *obj;
object *element;
element = symbol_table;
while (!is_the_empty_list(element)) {
if (strcmp(car(element)->data.symbol.value, value) == 0) {
return car(element);
}
element = cdr(element);
}
obj = alloc_object();
obj->type = SYMBOL;
obj->data.symbol.value = malloc(strlen(value) + 1);
if (obj->data.symbol.value == NULL) {
fprintf(stderr, "out of memory\n");
}
strcpy(obj->data.symbol.value, value);
symbol_table = cons(obj, symbol_table);
return obj;
}
char is_no_operands(object *ops) {
return is_the_empty_list(ops);
}
void define_variable(object *var, object *val, object *env) {
object *frame;
object *vars;
object *vals;
object *prevals;
frame = first_frame(env);
vars = frame_variables(frame);
vals = frame_values(frame);
while (!is_the_empty_list(vars)) {
/* if (var == car(vars)) { */
/* set_car(vals, val); */
/* return; */
/* } */
if (is_pair(vars)) {
// printf("ispair\n");
if (var == car(vars)) {
if (debug)
{
printf("found match\n");
printf("\n---vals\n"); write(stdout, vals);
}
if (is_pair(vals))
{
set_car(vals, val);
return;
}
else
{
assert(0);
}
}
}
else if(is_symbol(vars)) {
if (debug)
{
printf("symbol\n");
fprintf(stderr, "2 searched symbol %s\n", var->data.symbol.value);
fprintf(stderr, "last cdr symbol %s\n", vars->data.symbol.value);
}
if (var == vars) {
if (debug)
{
printf("\n---vals\n"); write(stdout, vals);
printf("\n---prevals\n"); write(stdout, prevals);
}
// assert(0);
set_cdr(prevals, val);
// return vals;
return;
}
else
{
printf("\nx yes\n");
// assert(0);
break;
}
}
vars = cdr(vars);
prevals = vals;
vals = cdr(vals);
}
add_binding_to_frame(var, val, frame);
}
object *bindings_parameters(object *bindings) {
return is_the_empty_list(bindings) ?
the_empty_list :
cons(binding_parameter(car(bindings)),
bindings_parameters(cdr(bindings)));
}
object *bindings_arguments(object *bindings) {
return is_the_empty_list(bindings) ?
the_empty_list :
cons(binding_argument(car(bindings)),
bindings_arguments(cdr(bindings)));
}
object *is_null_proc(object *arguments) {
return is_the_empty_list(car(arguments)) ? true : false;
}
void set_variable_value(object *var, object *val, object *env) {
object *frame;
object *vars;
object *vals;
object *prevals;
while (!is_the_empty_list(env)) {
frame = first_frame(env);
vars = frame_variables(frame);
vals = frame_values(frame);
if (debug)
{
printf("\n---env\n"); write(stdout, env);
printf("\n---frame\n"); write(stdout, frame);
printf("\n---vars\n"); write(stdout, vars);
printf("\n---vals\n"); write(stdout, vals);
printf("\n---\n");
}
while (!is_the_empty_list(vars)) {
/* if (var == car(vars)) { */
/* set_car(vals, val); */
/* return; */
/* } */
if (is_pair(vars)) {
// printf("ispair\n");
if (var == car(vars)) {
if (debug)
{
printf("found match\n");
printf("\n---vals\n");
write(stdout, vals);
}
if (is_pair(vals))
{
set_car(vals, val);
return;
}
else /* TODO */
{
set_cdr(prevals, cons(val, the_empty_list));
return;
}
}
}
else if(is_symbol(vars)) {
if (debug)
{
printf("symbol\n");
fprintf(stderr, "2 searched symbol %s\n", var->data.symbol.value);
fprintf(stderr, "last cdr symbol %s\n", vars->data.symbol.value);
}
if (var == vars) {
if (debug)
{
printf("\n---vals\n"); write(stdout, vals);
printf("\n---prevals\n"); write(stdout, prevals);
}
// assert(0);
set_cdr(prevals, val);
// return vals;
return;
}
else
{
if (debug)
{
printf("\nx yes\n");
}
// assert(0);
break;
}
}
vars = cdr(vars);
prevals = vals;
vals = cdr(vals);
}
env = enclosing_environment(env);
}
fprintf(stderr, "unbound variable, %s\n", var->data.symbol.value);
exit(1);
}
char is_last_exp(object *seq) {
return is_the_empty_list(cdr(seq));
}