proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { // NOTE(Felix): right now we are simply adding the symol at the // back of the list without checking if it already exists but are // also searching for thesymbol from the back, so we will find the // latest defined one first, but a bit messy. Later we should use // a hashmap here. @refactor Environment* env = get_current_environment(); if (env->next_index == env->capacity) { env->capacity *= 2; env->keys = (char**)realloc(env->keys, env->capacity * sizeof(char*)); env->values = (Lisp_Object**)realloc(env->values, env->capacity * sizeof(Lisp_Object*)); } env->keys [env->next_index] = Memory::get_c_str(symbol->value.symbol.identifier); env->values[env->next_index] = value; ++env->next_index; } proc lookup_symbol_in_this_envt(String* identifier, Environment* env) -> Lisp_Object* { for (int i = env->next_index - 1; i >= 0; --i) if (string_equal(env->keys[i], Memory::get_c_str(identifier))) return env->values[i]; return nullptr; } proc environment_binds_symbol(String* identifier, Environment* env) -> bool { return lookup_symbol_in_this_envt(identifier, env) != nullptr; } proc find_binding_environment(String* identifier, Environment* env) -> Environment* { if (environment_binds_symbol(identifier, env)) return env; for (int i = 0; i < env->parents.next_index; ++i) { if (environment_binds_symbol(identifier, env->parents.data[i])) return env->parents.data[i]; } return get_root_environment(); } proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { // first check current environment String* identifier = node->value.symbol.identifier; Lisp_Object* result; result = lookup_symbol_in_this_envt(identifier, env); if (result) return result; for (int i = 0; i < env->parents.next_index; ++i) { result = try_lookup_symbol(node, env->parents.data[i]); if (result) return result; } if (string_equal(Memory::get_c_str(identifier), "nil")) { return Memory::nil; } if (string_equal(Memory::get_c_str(identifier), "t")) { return Memory::t; } return nullptr; } inline proc push_environment(Environment* env) -> void { using namespace Globals::Current_Execution; append_to_array_list(&envi_stack, env); } inline proc pop_environment() -> void { using namespace Globals::Current_Execution; --envi_stack.next_index; } inline proc get_root_environment() -> Environment* { using namespace Globals::Current_Execution; return envi_stack.data[0]; } inline proc get_current_environment() -> Environment* { using namespace Globals::Current_Execution; return envi_stack.data[envi_stack.next_index-1]; } proc lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { assert_type(node, Lisp_Object_Type::Symbol); Lisp_Object* result = try_lookup_symbol(node, env); if (result) return result; String* identifier = node->value.symbol.identifier; create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); print_environment(env); return nullptr; } proc print_indent(int indent) -> void { for (int i = 0; i < indent; ++i) { printf(" "); } } proc print_environment_indent(Environment* env, int indent) -> void { if(env == get_root_environment()) { print_indent(indent); printf("[built-ins]-Environment (%lld)\n", (long long)env); return; } for (int i = 0; i < env->next_index; ++i) { print_indent(indent); printf("-> %s :: ", env->keys[i]); print(env->values[i]); printf(" (%lld)", (long long)env->values[i]); puts(""); } for (int i = 0; i < env->parents.next_index; ++i) { print_indent(indent); printf("parent (%lld)", (long long)env->parents.data[i]); puts(":"); print_environment_indent(env->parents.data[i], indent+4); } } proc print_environment(Environment* env) -> void { printf("\n=== Environment === (%lld)\n", (long long)env); print_environment_indent(env, 0); }