// 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); }
void apply(Process *process, Obj *function, Obj **args, int arg_count) { if(function->tag == 'L') { //printf("Calling lambda "); obj_print_cout(function); printf(" with params: "); obj_print_cout(function->params); printf("\n"); //printf("Applying %s with arg count %d\n", obj_to_string(process, function)->s, arg_count); #if BYTECODE_EVAL Obj *calling_env = obj_new_environment(function->env); bool allow_rest_args = true; env_extend_with_args(process, calling_env, function, arg_count, args, allow_rest_args); //printf("calling_env: %s\n", obj_to_string(process, calling_env)->s); shadow_stack_push(process, function); shadow_stack_push(process, calling_env); /* printf("before\n"); */ /* shadow_stack_print(process); */ Obj *result = bytecode_sub_eval_internal(process, calling_env, function->body); if(eval_error) { return; } assert(result); //printf("result = %s\n", obj_to_string(process, result)->s); stack_push(process, result); // put it back on stack (TODO: fix this unnecessary work?) /* printf("after\n"); */ /* shadow_stack_print(process); */ Obj *pop1 = shadow_stack_pop(process); Obj *pop2 = shadow_stack_pop(process); assert(pop1 == calling_env); assert(pop2 == function); #else Obj *calling_env = obj_new_environment(function->env); bool allow_rest_args = true; env_extend_with_args(process, calling_env, function, arg_count, args, allow_rest_args); //printf("Lambda env: %s\n", obj_to_string(calling_env)->s); shadow_stack_push(process, function); shadow_stack_push(process, calling_env); if(function->body->tag == 'X') { eval_error = obj_new_string("Can't apply lambda with bytecode body."); } else { eval_internal(process, calling_env, function->body); } if(eval_error) { return; } Obj *pop1 = shadow_stack_pop(process); Obj *pop2 = shadow_stack_pop(process); assert(pop1 == calling_env); assert(pop2 == function); #endif } else if(function->tag == 'P') { Obj *result = function->primop((struct Process *)process, args, arg_count); stack_push(process, result); } 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 == 'E' && obj_eq(process, env_lookup(process, function, obj_new_keyword("struct")), lisp_true)) { //printf("Calling struct: %s\n", obj_to_string(process, function)->s); if(obj_eq(process, env_lookup(process, function, obj_new_keyword("generic")), lisp_true)) { //printf("Calling generic struct constructor.\n"); Obj *function_call_symbol = obj_new_symbol("dynamic-generic-constructor-call"); shadow_stack_push(process, function_call_symbol); Obj **copied_args = malloc(sizeof(Obj *) * arg_count); for(int i = 0; i < arg_count; i++) { copied_args[i] = obj_copy(process, args[i]); if(args[i]->meta) { copied_args[i]->meta = obj_copy(process, args[i]->meta); } } Obj *carp_array = obj_new_array(arg_count); carp_array->array = copied_args; Obj *call_to_concretize_struct = obj_list(function_call_symbol, function, carp_array); shadow_stack_push(process, call_to_concretize_struct); eval_internal(process, process->global_env, call_to_concretize_struct); shadow_stack_pop(process); shadow_stack_pop(process); } else { call_struct_constructor(process, function, args, arg_count); } } else { set_error("Can't call non-function: ", function); } }