namespace Slime { proc define_symbol(Lisp_Object* symbol, Lisp_Object* value) -> void { profile_with_comment(&symbol->value.symbol->data); Environment* env = get_current_environment(); env->hm.set_object((void*)symbol, value); } inline proc lookup_symbol_in_this_envt(Lisp_Object* sym, Environment* env) -> Lisp_Object* { return (Lisp_Object*)env->hm.get_object((void*)sym); } proc environment_binds_symbol(Lisp_Object* sym, Environment* env) -> bool { return lookup_symbol_in_this_envt(sym, env) != nullptr; } proc find_binding_environment(Lisp_Object* sym, Environment* env) -> Environment* { if (environment_binds_symbol(sym, env)) return env; for (auto it : env->parents) { if (Environment* ret = find_binding_environment(sym, it)) return ret; } return nullptr; } proc try_lookup_symbol(Lisp_Object* node, Environment* env) -> Lisp_Object* { // first check current environment Lisp_Object* result; result = lookup_symbol_in_this_envt(node, 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; } auto nil_sym = Memory::get_symbol("nil"); auto t_sym = Memory::get_symbol("t"); if (node == nil_sym) { return Memory::nil; } if (node == t_sym) { return Memory::t; } return nullptr; } inline proc push_environment(Environment* env) -> void { using namespace Globals::Current_Execution; envi_stack.append(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* { profile_with_comment(&node->value.symbol->data); // print(node); assert_type(node, Lisp_Object_Type::Symbol); Lisp_Object* result = try_lookup_symbol(node, env); if (result) return result; String* identifier = node->value.symbol; print_environment(env); printf("\n"); create_symbol_undefined_error("The symbol '%s' is not defined.", &identifier->data); return nullptr; } proc print_environment_indent(Environment* env, int indent) -> void { proc print_indent = [](int indent) { for (int i = 0; i < indent; ++i) { printf(" "); } }; if(env == get_root_environment()) { print_indent(indent); printf("[built-ins]-Environment (%lld)\n", (long long)env); return; } for_hash_map (env->hm) { print_indent(indent); printf("-> %s :: ", &(((Lisp_Object*)key)->value.symbol->data)); print((Lisp_Object*)value); printf(" (0x%016llx)", (unsigned long long)value); puts(""); } for (int i = 0; i < env->parents.next_index; ++i) { print_indent(indent); printf("parent (0x%016llx)", (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 === (0x%016llx)\n", (long long)env); print_environment_indent(env, 0); } }