void global_env_extend(Obj *key, Obj *val) { assert(global_env); Obj *existing_binding = env_lookup_binding(global_env, key); if(existing_binding->car) { existing_binding->cdr = val; } else { env_extend(global_env, key, val); } }
void global_env_extend(Process *process, Obj *key, Obj *val) { assert(process->global_env); Obj *existing_binding = env_lookup_binding(process, process->global_env, key); if(existing_binding->car) { existing_binding->cdr = val; } else { env_extend(process->global_env, key, val); } }
Obj *env_assoc(Process *process, Obj *env, Obj *key, Obj *value) { Obj *pair = env_lookup_binding(process, env, key); if(pair && pair->car && pair->cdr) { pair->cdr = value; } else { //printf("Pair not found, will add new key.\n"); Obj *new_pair = obj_new_cons(key, value); Obj *new_cons = obj_new_cons(new_pair, env->bindings); env->bindings = new_cons; } return env; }
Obj *env_lookup_binding(Process *process, Obj *env, Obj *symbol) { Obj *p = env->bindings; while(p && p->car) { Obj *pair = p->car; if(obj_eq(process, pair->car, symbol)) { return pair; } else { p = p->cdr; } } if(env->parent) { return env_lookup_binding(process, env->parent, symbol); } else { return nil; } }
// returns NULL if not done yet Obj *bytecode_eval_internal(Process *process, Obj *bytecodeObj, int steps) { Obj *literal, *function, *lookup, *result, *bindings, *let_env, *binding; int arg_count, i, bindings_index, body_index; for(int step = 0; step < steps; step++) { if(eval_error) { return nil; } Obj **literals_array = process->frames[process->frame].bytecodeObj->bytecode_literals->array; char *bytecode = process->frames[process->frame].bytecodeObj->bytecode; int p = process->frames[process->frame].p; char c = bytecode[p]; //printf("frame = %d, c = %c\n", frame, c); switch(c) { case 'l': i = bytecode[p + 1] - 65; literal = literals_array[i]; //printf("Pushing literal "); obj_print_cout(literal); printf("\n"); stack_push(process, literal); process->frames[process->frame].p += 2; break; case 'd': i = bytecode[p + 1] - 65; literal = literals_array[i]; result = env_extend(process->global_env, literal, stack_pop(process)); stack_push(process, result->cdr); process->frames[process->frame].p += 2; break; case 'n': if(is_true(stack_pop(process))) { stack_push(process, lisp_false); } else { stack_push(process, lisp_true); } process->frames[process->frame].p += 1; break; case 'r': i = bytecode[p + 1] - 65; literal = literals_array[i]; binding = env_lookup_binding(process, process->frames[process->frame].env, literal); if(binding->car) { //printf("binding: %s\n", obj_to_string(process, binding)->s); binding->cdr = stack_pop(process); stack_push(process, binding->cdr); } else { eval_error = obj_new_string("reset! can't find variable to reset: "); obj_string_mut_append(eval_error, obj_to_string(process, literal)->s); return nil; } process->frames[process->frame].p += 2; break; case 't': //printf("entering let\n"); //shadow_stack_push(process, let_env); bindings_index = bytecode[p + 1] - 65; body_index = bytecode[p + 2] - 65; bindings = literals_array[bindings_index]; //printf("bindings: %s\n", obj_to_string(process, bindings)->s); let_env = obj_new_environment(process->frames[process->frame].env); for(int i = 0; i < bindings->count; i++) { env_extend(let_env, bindings->array[i], stack_pop(process)); } process->frames[process->frame].p += 3; process->frames[process->frame + 1].p = 0; process->frames[process->frame + 1].bytecodeObj = literals_array[body_index]; process->frames[process->frame + 1].env = let_env; process->frame++; //printf("will now execute: %s\n", obj_to_string(process, process->frames[process->frame].bytecodeObj)->s); break; case 'y': i = bytecode[p + 1] - 65; literal = literals_array[i]; //printf("Looking up literal "); obj_print_cout(literal); printf("\n"); lookup = env_lookup(process, process->frames[process->frame].env, literal); if(!lookup) { set_error_return_nil("Failed to lookup ", literal); } stack_push(process, lookup); process->frames[process->frame].p += 2; break; case 'i': i = bytecode[p + 1] - 65; if(is_true(stack_pop(process))) { process->frames[process->frame].p = 0; process->frames[process->frame].bytecodeObj = literals_array[i]; process->frames[process->frame].env = process->frames[process->frame - 1].env; } else { process->frames[process->frame].p = 0; process->frames[process->frame].bytecodeObj = literals_array[i + 1]; process->frames[process->frame].env = process->frames[process->frame - 1].env; } break; case 'c': function = stack_pop(process); arg_count = bytecode[p + 1] - 65; Obj **args = NULL; if(arg_count > 0) { args = malloc(sizeof(Obj*) * arg_count); } for(int i = 0; i < arg_count; i++) { Obj *arg = stack_pop(process); args[arg_count - i - 1] = arg; //shadow_stack_push(process, arg); } process->frames[process->frame].p += 2; if(function->tag == 'P') { stack_push(process, function->primop((struct Process*)process, args, arg_count)); } else if(function->tag == 'F') { call_foreign_function(process, function, args, arg_count); } else if(function->tag == 'K') { if(arg_count != 1) { eval_error = obj_new_string("Args to keyword lookup must be a single arg."); } else if(args[0]->tag != 'E') { eval_error = obj_new_string("Arg 0 to keyword lookup must be a dictionary: "); obj_string_mut_append(eval_error, obj_to_string(process, args[0])->s); } else { Obj *value = env_lookup(process, args[0], function); if(value) { stack_push(process, value); } else { eval_error = obj_new_string("Failed to lookup keyword '"); obj_string_mut_append(eval_error, obj_to_string(process, function)->s); obj_string_mut_append(eval_error, "'"); obj_string_mut_append(eval_error, " in \n"); obj_string_mut_append(eval_error, obj_to_string(process, args[0])->s); obj_string_mut_append(eval_error, "\n"); } } } else if(function->tag == 'L') { Obj *calling_env = obj_new_environment(function->env); //printf("arg_count = %d\n", arg_count); env_extend_with_args(process, calling_env, function, arg_count, args, true); process->frame++; process->frames[process->frame].p = 0; if(function->body->tag != 'X') { set_error_return_nil("The body of the lambda must be bytecode, ", function); } process->frames[process->frame].bytecodeObj = function->body; process->frames[process->frame].env = calling_env; //printf("Pushing new stack frame with bytecode '%s'\n", process->frames[process->frame].bytecode); // and env %s\n", process->frames[process->frame].bytecode, obj_to_string(process, calling_env)->s); } else { printf("Can't handle other calling methods yet %c\n", function->tag); obj_print_cout(function); return nil; } break; case 'q': process->frame--; if(process->frame < 0) { goto done; } break; default: printf("Unhandled instruction: %c\n", c); exit(-1); } } done:; return stack_pop(process); }