slime/src/env.cpp

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);
}