void add_let(Process *process, Obj *env, Obj *bytecodeObj, int *position, Obj *form) {
Obj *bindings = form->cdr->car;
Obj *body = form->cdr->cdr->car;
shadow_stack_push(process, bindings);
shadow_stack_push(process, body);
//printf("bindings: %s\n", obj_to_string(process, bindings)->s);
Obj *bindings_only_symbols = obj_new_array(bindings->count / 2);
shadow_stack_push(process, bindings_only_symbols);
for(int i = 0; i < bindings_only_symbols->count; i++) {
bindings_only_symbols->array[i] = bindings->array[i * 2];
visit_form(process, env, bytecodeObj, position, bindings->array[i * 2 + 1]);
}
//printf("bindings_only_symbols: %s\n", obj_to_string(process, bindings_only_symbols)->s);
Obj *literals = bytecodeObj->bytecode_literals;
char new_literal_index = literals->count;
Obj *let_body_code = form_to_bytecode(process, env, body);
obj_array_mut_append(literals, bindings_only_symbols);
obj_array_mut_append(literals, let_body_code);
bytecodeObj->bytecode[*position] = 't';
bytecodeObj->bytecode[*position + 1] = new_literal_index + 65;
bytecodeObj->bytecode[*position + 2] = new_literal_index + 1 + 65;
*position += 3;
shadow_stack_pop(process);
shadow_stack_pop(process);
shadow_stack_pop(process);
}
bool obj_match_arrays(Process *process, Obj *env, Obj *attempt, Obj *value) {
//printf("Matching arrays %s with %s\n", obj_to_string(attempt)->s, obj_to_string(value)->s);
int i;
for(i = 0; i < attempt->count; i++) {
Obj *o = attempt->array[i];
if(obj_eq(process, o, dotdotdot) && ((i + 1) < attempt->count)) {
int rest_count = value->count - i;
//printf("rest_count: %d\n", rest_count);
Obj *rest = obj_new_array(rest_count);
for(int j = 0; j < rest_count; j++) {
rest->array[j] = value->array[i + j]; // copy the rest of the objects to a smaller array
}
//printf("rest: %s\n", obj_to_string(rest)->s);
Obj *symbol_after_dotdotdot = attempt->array[i + 1];
//printf("symbol_after_dotdotdot: %s\n", obj_to_string(symbol_after_dotdotdot)->s);
bool matched_rest = obj_match(process, env, symbol_after_dotdotdot, rest);
//printf("%s\n", matched_rest ? "match" : "no match");
return matched_rest;
}
else if(i >= value->count) {
return false;
}
bool result = obj_match(process, env, o, value->array[i]);
if(!result) {
return false;
}
}
if(i < value->count) {
//printf("The value list is too long.\n");
return false;
}
else {
//printf("Found end of list, it's a match.\n");
return true;
}
}
void env_extend_with_args(Process *process, Obj *calling_env, Obj *function, int arg_count, Obj **args, bool allow_restargs) {
// TODO: remove the whole 'C' branch and only allow arrays for parameters
Obj *paramp = function->params;
if(paramp->tag == 'C') {
for(int i = 0; i < arg_count; i++) {
if(allow_restargs && obj_eq(process, paramp->car, dotdotdot)) {
printf("Found dotdotdot\n");
if(paramp->cdr->car) {
int rest_count = arg_count - i;
printf("Rest count: %d\n", rest_count);
Obj *rest_array = obj_new_array(rest_count);
for(int j = 0; j < rest_count; j++) {
rest_array->array[j] = args[i + j];
}
env_extend(calling_env, paramp->cdr->car, rest_array);
return;
}
else {
printf("No arguments after dotdotdot\n");
return;
}
}
if(!paramp || !paramp->car) {
set_error("Too many arguments (C) to function: ", function);
}
env_extend(calling_env, paramp->car, args[i]);
paramp = paramp->cdr;
}
if(paramp && paramp->cdr) {
set_error("Too few arguments to function: ", function);
}
}
else if(paramp->tag == 'A') {
int i = 0;
for(; i < arg_count; i++) {
if(allow_restargs && obj_eq(process, paramp->array[i], dotdotdot)) {
int rest_count = arg_count - i;
Obj *rest_list = obj_new_cons(NULL, NULL);
Obj *last = rest_list;
for(int j = 0; j < rest_count; j++) {
Obj *new_element = args[i + j];
last->car = new_element;
Obj *new_last = obj_new_cons(NULL, NULL);
last->cdr = new_last;
last = new_last;
}
env_extend(calling_env, paramp->array[i + 1], rest_list);
return;
}
env_extend(calling_env, paramp->array[i], args[i]);
}
if(i < paramp->count) {
if(allow_restargs && obj_eq(process, paramp->array[i], dotdotdot)) {
env_extend(calling_env, paramp->array[i + 1], obj_new_array(0));
}
else {
set_error("Too few arguments to function/macro: ", function);
}
}
if(arg_count > paramp->count) {
printf("arguments: %s\n", obj_to_string(process, paramp)->s);
//printf("meta: %s\n", (function->meta ? obj_to_string(process, function->meta)->s : "NULL"));
Obj *name = function;
if(function->meta) {
Obj *name_lookup = env_lookup(process, function->meta, obj_new_keyword("name"));
if(name_lookup) {
name = name_lookup;
}
}
set_error("Too many arguments (A) to function/macro: ", name);
}
}
}
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);
}
}