slime/src/env.cpp

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

}