slime/src/built_ins.cpp

namespace Slime {
    proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
        if (n1 == n2)
            return true;
        if (n1->type != n2->type)
            return false;

        switch (n1->type) {

        case Lisp_Object_Type::T:
        case Lisp_Object_Type::Nil:
        case Lisp_Object_Type::Symbol:
        case Lisp_Object_Type::Keyword:
        case Lisp_Object_Type::Function:
            // QUESTION(Felix): should a pointer
            // object compare the pointer?
        case Lisp_Object_Type::Pointer:
        case Lisp_Object_Type::Continuation:  return false;
        case Lisp_Object_Type::Number: return n1->value.number == n2->value.number;
        case Lisp_Object_Type::String: return string_equal(n1->value.string, n2->value.string);
        case Lisp_Object_Type::Pair: {
            return lisp_object_equal(n1->value.pair.first, n2->value.pair.first) &&
                lisp_object_equal(n1->value.pair.rest, n2->value.pair.rest);
        } break;
        case Lisp_Object_Type::HashMap: {
            auto n1_keys = n1->value.hashMap->get_all_keys();
            auto n2_keys = n2->value.hashMap->get_all_keys();
            defer {
                n1_keys.dealloc();
                n2_keys.dealloc();
            };

            if (n1_keys.next_index != n2_keys.next_index)
                return false;

            n1_keys.sort();
            n2_keys.sort();

            for (u32 i = 0; i < n1_keys.next_index; ++i) {
                if (!lisp_object_equal(n1_keys[i], n2_keys[i]))
                    return false;
                if (!lisp_object_equal(n1->value.hashMap->get_object(n1_keys[i]),
                                       n2->value.hashMap->get_object(n2_keys[i])))
                    return false;
            }
            return true;

        }
        case Lisp_Object_Type::Vector: {
            if (n1->value.vector.length != n2->value.vector.length )
                return false;
            for (u32 i = 0; i < n1->value.vector.length; ++i) {
                if (!lisp_object_equal(n1->value.vector.data+i, n2->value.vector.data+i))
                    return false;
            }
            return true;
        } break;
        default: create_not_yet_implemented_error();
        }

        // we should never reach here
        return false;
    }

    proc add_to_load_path(const path_char* path) -> void {
        using Globals::load_path;

        load_path.append((path_char*)path);
    }

    proc built_in_load(String file_name) -> Lisp_Object* {
        profile_with_comment(file_name.data);
        char* file_content;
        path_char fullpath[MAX_PATH];
#ifdef UNICODE
        path_char* temp = char_to_path_char(Memory::get_c_str(file_name));
        swprintf(fullpath, MAX_PATH,L"%s", temp);
        file_content = read_entire_file(temp);
        free(temp);
#else
        sprintf(fullpath, "%s", Memory::get_c_str(file_name));
        file_content = read_entire_file(Memory::get_c_str(file_name));
#endif



        if (!file_content) {
            for (auto it: Globals::load_path) {
#ifdef UNICODE
                fullpath[0] = L'\0';
                path_char* temp = char_to_path_char(Memory::get_c_str(file_name));
                swprintf(fullpath, MAX_PATH, L"%s%s", it, temp);
                free(temp);
#else
                fullpath[0] = '\0';
                sprintf(fullpath, "%s%s", it, Memory::get_c_str(file_name));
#endif
                file_content = read_entire_file(fullpath);
                if (file_content)
                    break;
            }
            if (!file_content) {
                printf("Load path:\n");
                for (auto it : Globals::load_path) {
                    printf("  - %s\n", (char*) it);
                }
                create_generic_error("The file to load '%s' was not found in the load path.",
                                     Memory::get_c_str(file_name));
                return nullptr;
            }

        }


        Lisp_Object* result = Memory::nil;
        Array_List<Lisp_Object*>* program;
#ifdef UNICODE
        char* temp_c = path_char_to_char(fullpath);
        String spath = Memory::create_string(temp_c);
        free(temp_c);
#else
        String spath = Memory::create_string(fullpath);
#endif
        defer {
            free(spath.data);
        };
        try program = Parser::parse_program(spath, file_content);

        // NOTE(Felix): deferred so even if the eval failes, it will
        // run
        defer {
            program->dealloc();
            free(program);
            free(file_content);
        };
        for (auto expr : *program) {
            try result = eval_expr(expr);
        }

        return result;
    }

    proc built_in_import(String file_name) -> Lisp_Object* {
        profile_this();
        Environment* new_env;
        try assert("You cannot use import inside of the root-env (parent cycle)",
                   get_root_environment() != get_current_environment());

        new_env = Memory::file_to_env_map.get_object(Memory::get_c_str(file_name));


        if (!new_env) {
            // create new empty environment
            try new_env = Memory::create_child_environment(get_root_environment());
            // TODO(Felix): check absoulute paths in the map, not just
            // relative ones
            Memory::file_to_env_map.set_object(Memory::get_c_str(file_name), new_env);
            push_environment(new_env);
            defer {
                pop_environment();
            };

            Lisp_Object* res;
            try res = built_in_load(file_name);
        }

        get_current_environment()->parents.append(new_env);

        return Memory::nil;
    }

    proc load_built_ins_into_environment() -> void* {
        profile_this();
        String file_name_built_ins = Memory::create_string(__FILE__);
        defer_free(file_name_built_ins.data);

        define_macro((call/cc fun), "TODO") {
            profile_with_name("(call/cc)");

            using Globals::Current_Execution;
            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
            try_void assert_list_length(args, 1);

            Lisp_Object* fun = args->value.pair.first;

            // 2. push cont on the stack and call, the fun is already
            // there
            Current_Execution.ats.append([] {
                try_void assert_type(Current_Execution.cs.data[Current_Execution.cs.next_index-1]
                                     , Lisp_Object_Type::Function);
                Lisp_Object* cont = Memory::create_lisp_object_continuation();

                Current_Execution.ams.append(Current_Execution.cs.next_index-1);
                Current_Execution.pcs.append(Memory::nil);
                --cont->value.continuation->cs.next_index;
                Current_Execution.cs.append(cont);
                (Current_Execution.nass.end()-1)->append(NasAction::Step);
            });
            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);

            // 1. resolve the function
            Current_Execution.cs.append(fun);
            (Current_Execution.nass.end()-1)->append(NasAction::Eval);

        };
        define_macro((set! sym val), "TODO") {
            // NOTE(Felix): This COULD be a define_special in theory,
            // but because of call/cc, it cannot be anymore because
            // the define_symbol would not be a part of the
            // continuation. This happens for example in:
            /**
              (set! res (+ 2 (call/cc (lambda (cont)
                                         (set! add-5 cont) 1))
                           3))
            */
            // So if 'set! WAS a define_special, then the param would
            // not be evaluated, but the whole call gets removed from
            // the stack, and in the body of 'set!, the 'val would be
            // recursively evaluated, and the 'call/cc would not see
            // the variable definition as part of the continuation. So
            // what we do istead, is writing 'set! as a macro and have
            // the variable definition as a and_then_action, so that
            // it is part of the continuation.
            profile_with_name("(set!)");
            using Globals::Current_Execution;

            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
            try_void assert_list_length(args, 2);

            Lisp_Object* sym = args->value.pair.first;
            Lisp_Object* val = args->value.pair.rest->value.pair.first;

            try_void assert_type(sym, Lisp_Object_Type::Symbol);

            // 2. find the binding and rebind
            Current_Execution.cs.append(sym);
            Current_Execution.ats.append([] {
                using Globals::Current_Execution;
                Lisp_Object* val = Current_Execution.cs.data[--Current_Execution.cs.next_index];
                Lisp_Object* sym = Current_Execution.cs.data[Current_Execution.cs.next_index-1];

                Environment* target_env = find_binding_environment(sym, get_current_environment());
                    if (!target_env)
                        target_env = get_root_environment();
                define_symbol(sym, val, target_env);
            });
            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);

            // 1. eval the val
            Current_Execution.cs.append(val);
            (Current_Execution.nass.end()-1)->append(NasAction::Eval);

        };
        define_macro((apply fun fun_args), "TODO") {
            // NOTE(Felix): is has to be a macro because apply by
            // itself cannot return the result, we have to invoke eval
            // and to prevent recursion, apply is a macro

            profile_with_name("(apply)");
            using Globals::Current_Execution;

            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
            try_void assert_list_length(args, 2);

            Lisp_Object* fun      = args->value.pair.first;
            Lisp_Object* fun_args = args->value.pair.rest->value.pair.first;

            // 3. push args on the stack and apply
            Current_Execution.ats.append([] {
                // BUG(Felix): we are not pushing on the ams, are we
                // doing it wrong?
                // Current_Execution.ams.append(Current_Execution.cs.next_index-2);

                Lisp_Object* args_as_list = Current_Execution.cs[--Current_Execution.cs.next_index];
                for_lisp_list (args_as_list) {
                    Current_Execution.cs.append(it);
                }
                Current_Execution.pcs.append(Memory::nil);
                (Current_Execution.nass.end()-1)->append(NasAction::Step);
            });
            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);

            // 2. Eval fun_args and keep them on the stack
            Current_Execution.ats.append([] {
                // NOTE(Felix): Flip the top 2 elements on cs because
                // top is now the evaluated function, and below is the unevaluated args
                Lisp_Object* tmp = Current_Execution.cs[Current_Execution.cs.next_index-1];
                Current_Execution.cs[Current_Execution.cs.next_index-1] = Current_Execution.cs[Current_Execution.cs.next_index-2];
                Current_Execution.cs[Current_Execution.cs.next_index-2] = tmp;
                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
            });
            (Current_Execution.nass.end()-1)->append(NasAction::And_Then_Action);


            // 1. Eval function and keep it on the stack, below it
            // store the unevaluated argument list
            Current_Execution.ams.append(Current_Execution.cs.next_index);
            Current_Execution.cs.append(fun_args);
            Current_Execution.cs.append(fun);
            (Current_Execution.nass.end()-1)->append(NasAction::Eval);

        };
        define((get-counter),
               "When called returns a procedure that represents\n"
               "a counter. Each time it is called it returns the\n"
               "next whole number.")
        {
            define_symbol(
                Memory::get_symbol("c"),
                Memory::create_lisp_object((f64)0));
            String file_name_built_ins = Memory::create_string(__FILE__);
            define((lambda), "") {
                fetch(c);
                c->value.number++;
                return c;
            };
            fetch(lambda);
            return lambda;
        };
        define_macro((eval expr),
                     "Takes one argument, and evaluates it two times.")
        {
            profile_with_name("(eval)");
            using Globals::Current_Execution;
            // we know cs.data[cs.next_index] is allocated because the
            // macro cal lwas there just before
            Current_Execution.cs.data[Current_Execution.cs.next_index++] = Current_Execution.pcs[--Current_Execution.pcs.next_index]->value.pair.first;
            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
            (Current_Execution.nass.end()-1)->append(NasAction::Eval);

        };
        define_macro((begin . rest),
                     "Takes any number of forms. Evaluates them in order, "
                     "and returns the last result.")
        {
            profile_with_name("(begin)");
            using Globals::Current_Execution;
            Lisp_Object* args = Current_Execution.pcs[--Current_Execution.pcs.next_index];
            u32 length = list_length(args);
            Current_Execution.cs.reserve(length);
            for_lisp_list(args) {
                Current_Execution.cs.data[Current_Execution.cs.next_index - 1 + (length - it_index)] = it;
                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
                (Current_Execution.nass.end()-1)->append(NasAction::Pop);
            }

            --(Current_Execution.nass.end()-1)->next_index;
            Current_Execution.cs.next_index += length;
        };
        define_macro((if test then_part else_part),
                     "Takes 3 arguments. If the first arguments evaluates to a truthy  "
                     "value, the if expression evaluates the second argument, else "
                     "it will evaluete the third one and return them respectively.")
        {
            profile_with_name("(if)");
            using Globals::Current_Execution;
            /* |          |    |   <test>  |
               |          | -> |   <then>  |
               |   <if>   |    |   <else>  |
               |   ....   |    |   ......  | */
            Lisp_Object* args = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
            Lisp_Object* test = args->value.pair.first;
            args = args->value.pair.rest;
            try_void assert_type(args, Lisp_Object_Type::Pair);
            Lisp_Object* consequence = args->value.pair.first;
            args = args->value.pair.rest;
            try_void assert_type(args, Lisp_Object_Type::Pair);
            Lisp_Object* alternative = args->value.pair.first;
            args = args->value.pair.rest;
            try_void assert_type(args, Lisp_Object_Type::Nil);

            Current_Execution.cs.append(alternative);
            Current_Execution.cs.append(consequence);
            Current_Execution.cs.append(test);

            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
            (Current_Execution.nass.end()-1)->append(NasAction::If);
            (Current_Execution.nass.end()-1)->append(NasAction::Eval);
        };
        define_macro((define definee . args), "") {
            // NOTE(Felix): define has to be a macro, because we need
            // to evaluate the value for definee in case it is a
            // simple variable (not a function). So ebcause we don't
            // want to recursivly evaluate the value, we use a macro
            // and a NasAction.
            profile_with_name("(define)");
            using Globals::Current_Execution;

            Lisp_Object* form    = Current_Execution.pcs.data[--Current_Execution.pcs.next_index];
            Lisp_Object* definee = form->value.pair.first;
            form = form->value.pair.rest;
            if (definee->type == Lisp_Object_Type::Symbol) {
                try_void assert_type(form, Lisp_Object_Type::Pair);
            }
            Lisp_Object* thing = form->value.pair.first;
            Lisp_Object* thing_cons = form;
            form = form->value.pair.rest;
            Lisp_Object_Type type = definee->type;
            switch (type) {
            case Lisp_Object_Type::Symbol: {
                if (form != Memory::nil) {
                    Lisp_Object* doc = thing;
                    try_void assert_type(doc,  Lisp_Object_Type::String);
                    try_void assert_type(form, Lisp_Object_Type::Pair);
                    thing = form->value.pair.first;
                    try_void assert("list must end here.", form->value.pair.rest == Memory::nil);
                    // TODO docs (maybe with hooks) we have to attach
                    // the docs to the result of evaluating
                }
                Current_Execution.cs.append(definee);
                Current_Execution.cs.append(thing);
                (Current_Execution.nass.end()-1)->append(NasAction::Define_Var);
                (Current_Execution.nass.end()-1)->append(NasAction::Eval);
            } break;
            case Lisp_Object_Type::Pair: {
                try_void assert_type(definee->value.pair.first, Lisp_Object_Type::Symbol);
                Lisp_Object* func;
                try_void func =  Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);
                func->value.function->parent_environment = get_current_environment();
                create_arguments_from_lambda_list_and_inject(definee->value.pair.rest, func);

                if (thing_cons->type == Lisp_Object_Type::Pair &&
                    // if there is stuff in the function body
                    thing_cons->value.pair.first->type == Lisp_Object_Type::String &&
                    // if the first is a string
                    thing_cons->value.pair.rest != Memory::nil
                    // if it is not the last
                    ) {
                    // we found docs
                    Globals::docs.set_object(
                        func,
                        Memory::duplicate_string(
                            thing_cons->value.pair.first->value.string).data);
                    thing_cons = thing_cons->value.pair.rest;
                }
                func->value.function->body.lisp_body = maybe_wrap_body_in_begin(thing_cons);

                define_symbol(definee->value.pair.first, func);
                Current_Execution.cs.append(definee->value.pair.first);
            } break;
            default: {
                create_generic_error("you can only define symbols");
                return;
            }
            }
        };
        define((helper), "") {
            profile_with_name("(helper)");
            return Memory::create_lisp_object(101.0);
        };
        define((enable-debug-log), "") {
            profile_with_name("(enable-debug-log)");
            Globals::debug_log = true;
            return Memory::t;
        };
        define((disable-debug-log), "") {
            profile_with_name("(disable-debug-log)");
            Globals::debug_log = false;
            return Memory::t;
        };
        define_special((with-debug-log . rest), "") {
            profile_with_name("(enable-debug-log)");
            fetch(rest);
            Lisp_Object* result = Memory::nil;
            Globals::debug_log = true;
            in_caller_env {
                for_lisp_list(rest) {
                    // TODO(Felix): hooky would be really nice to
                    // have. Then this would be a macro and we would
                    // reset the debug log
                    try result = eval_expr(it);
                }
            }
            Globals::debug_log = false;
            return result;
        };
        define((test (:k (helper))), "") {
            profile_with_name("(test)");
            fetch(k);
            return k;
        };
        define((= . args),
               "Takes 0 or more arguments and returns =t= if all arguments are equal "
               "and =()= otherwise.")
        {
            profile_with_name("(=)");
            fetch(args);

            if (args == Memory::nil)
                return Memory::t;

            Lisp_Object* first = args->value.pair.first;

            for_lisp_list (args) {
                if (!lisp_object_equal(it, first))
                    return Memory::nil;
            }

            return Memory::t;
        };
        define((> . args),  "TODO") {
            profile_with_name("(>)");
            fetch(args);
            f64 last_number = strtod("Inf", 0);

            for_lisp_list (args) {
                try assert_type(it, Lisp_Object_Type::Number);
                if (it->value.number >= last_number)
                    return Memory::nil;
                last_number = it->value.number;
            }

            return Memory::t;
        };
        define((>= . args),  "TODO")
        {
            profile_with_name("(>=)");
            fetch(args);
            f64 last_number = strtod("Inf", 0);

            for_lisp_list (args) {
                try assert_type(it, Lisp_Object_Type::Number);
                if (it->value.number > last_number)
                    return Memory::nil;
                last_number = it->value.number;
            }

            return Memory::t;
        };
        define((< . args),  "TODO")
        {
            profile_with_name("(<)");
            fetch(args);
            f64 last_number = strtod("-Inf", 0);

            for_lisp_list (args) {
                try assert_type(it, Lisp_Object_Type::Number);
                if (it->value.number <= last_number)
                    return Memory::nil;
                last_number = it->value.number;
            }

            return Memory::t;
        };
        define((<= . args),  "TODO")
        {
            profile_with_name("(<=)");
            fetch(args);
            f64 last_number = strtod("-Inf", 0);

            for_lisp_list (args) {
                try assert_type(it, Lisp_Object_Type::Number);
                if (it->value.number < last_number)
                    return Memory::nil;
                last_number = it->value.number;
            }

            return Memory::t;
        };
        define((+ . args),  "TODO")
        {
            profile_with_name("(+)");
            fetch(args);

            f64 sum = 0;

            for_lisp_list (args) {
                try assert_type(it, Lisp_Object_Type::Number);
                sum += it->value.number;
            }

            return Memory::create_lisp_object(sum);
        };
        define((- . args),  "TODO")
        {
            profile_with_name("(-)");
            fetch(args);
            if (args == Memory::nil)
                return Memory::create_lisp_object(0.0);


            try assert_type(args->value.pair.first, Lisp_Object_Type::Number);
            f64 difference = args->value.pair.first->value.number;

            if (args->value.pair.rest == Memory::nil) {
                return Memory::create_lisp_object(-difference);
            }

            for_lisp_list (args->value.pair.rest) {
                try assert_type(it, Lisp_Object_Type::Number);
                difference -= it->value.number;
            }

            return Memory::create_lisp_object(difference);
        };
        define((* . args),  "TODO")
        {
            profile_with_name("(*)");
            fetch(args);
            if (args == Memory::nil) {
                return Memory::create_lisp_object(1);
            }

            f64 product = 1;

            for_lisp_list (args) {
                try assert_type(it, Lisp_Object_Type::Number);
                product *= it->value.number;
            }

            return Memory::create_lisp_object(product);
        };
        define((/ . args),  "TODO")
        {
            profile_with_name("(/)");
            fetch(args);

            if (args == Memory::nil) {
                return Memory::create_lisp_object(1);
            }

            try assert_type(args->value.pair.first, Lisp_Object_Type::Number);

            f64 quotient = args->value.pair.first->value.number;

            for_lisp_list (args->value.pair.rest) {
                try assert_type(it, Lisp_Object_Type::Number);
                quotient /= it->value.number;
            }

            return Memory::create_lisp_object(quotient);
        };
        define((** a b), "TODO") {
            profile_with_name("(**)");
            fetch(a, b);
            try assert_type(a, Lisp_Object_Type::Number);
            try assert_type(b, Lisp_Object_Type::Number);
            return Memory::create_lisp_object(pow(a->value.number,
                                                  b->value.number));
        };
        define((% a b), "TODO") {
            profile_with_name("(%)");
            fetch(a, b);
            try assert_type(a, Lisp_Object_Type::Number);
            try assert_type(b, Lisp_Object_Type::Number);
            return Memory::create_lisp_object((s32)a->value.number %
                                              (s32)b->value.number);
        };
        define((get-random-between a b), "TODO") {
            profile_with_name("(get-random-between)");
            fetch(a, b);
            try assert_type(a, Lisp_Object_Type::Number);
            try assert_type(b, Lisp_Object_Type::Number);

            f64 fa = a->value.number;
            f64 fb = b->value.number;
            f64 x = (f64)rand()/(f64)(RAND_MAX);
            x *= (fb - fa);
            x += fa;

            return Memory::create_lisp_object(x);
        };
        define((gensym), "TODO") {
            profile_with_name("(gensym)");
            Lisp_Object* node;
            try node = Memory::create_lisp_object();
            node->type = Lisp_Object_Type::Symbol;
            node->value.symbol = Memory::create_string("gensym");
            return node;
        };
        define_special((bound? var), "TODO") {
            profile_with_name("(bound?)");
            fetch(var);
            try assert_type(var, Lisp_Object_Type::Symbol);

            Lisp_Object* res;
            in_caller_env {
                res = try_lookup_symbol(var, get_current_environment());
            }
            if (res)
                return Memory::t;
            return Memory::nil;
        };
        define_special((assert test), "TODO") {
            profile_with_name("(assert)");
            fetch(test);
            // TODO(Felix): it's probably cleaner to have assert be a
            // macro + and_then_action to check for error. This is
            // also cool so we don't see an anditoinal recursive call
            // in the profiler
            in_caller_env {
                Lisp_Object* res;
                try res = eval_expr(test);
                if (is_truthy(res))
                    return Memory::t;
            }

            char* string = lisp_object_to_string(test, true);
            create_generic_error("Userland assertion. (%s)", string);
            free(string);
            return nullptr;
        };
        define_special((define-macro form . body), "TODO") {
            profile_with_name("(define-macro)");
            fetch(form,  body);
            // TODO(Felix): Macros cannot have docs now

            if (form->type != Lisp_Object_Type::Pair) {
                create_parsing_error("You can only create function macros.");
                return nullptr;
            }

            Lisp_Object* symbol     = form->value.pair.first;
            Lisp_Object* lambdalist = form->value.pair.rest;

            // creating new lisp object and setting type
            Lisp_Object* func;
            try func = Memory::create_lisp_object_function(Lisp_Function_Type::Macro);
            in_caller_env {
                // setting parent env
                func->value.function->parent_environment = get_current_environment();
                create_arguments_from_lambda_list_and_inject(lambdalist, func);
                func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
                define_symbol(symbol, func);
            }
            return Memory::nil;
        };
        define((mutate! target source), "TODO") {
            profile_with_name("(mutate!)");
            fetch(target, source);

            if (target == Memory::nil ||
                target == Memory::t   ||
                target->type == Lisp_Object_Type::Keyword ||
                target->type == Lisp_Object_Type::Symbol)
            {
                create_generic_error("You cannot mutate to nil, t, keywords or symbols because they have to be unique");
            }

            if (source == Memory::nil ||
                source == Memory::t   ||
                source->type == Lisp_Object_Type::Keyword ||
                source->type == Lisp_Object_Type::Symbol)
            {
                create_generic_error("You cannot mutate nil, t, keywords or symbols");
            }

            *target = *source;
            return target;
        };
        define((vector-length v), "TODO") {
            profile_with_name("(vector-length)");
            fetch(v);
            try assert_type(v, Lisp_Object_Type::Vector);
            return Memory::create_lisp_object((f64)v->value.vector.length);
        };
        define((vector-ref vec idx), "TODO") {
            profile_with_name("(vector-ref)");
            fetch(vec, idx);

            try assert_type(vec, Lisp_Object_Type::Vector);
            try assert_type(idx, Lisp_Object_Type::Number);

            s32 int_idx = ((s32)idx->value.number);

            try assert("vector access index must be >= 0", int_idx >= 0);
            try assert("vector access index must be < length", (u32)int_idx < vec->value.vector.length);

            return vec->value.vector.data+int_idx;
        };
        define((vector-set! vec idx val), "TODO") {
            profile_with_name("(vector-set!)");
            fetch(vec, idx, val);

            try assert_type(vec, Lisp_Object_Type::Vector);
            try assert_type(idx, Lisp_Object_Type::Number);

            s32 int_idx = ((s32)idx->value.number);

            try assert("vector access index must be >= 0", int_idx >= 0);
            try assert("vector access index must be < length", (u32)int_idx < vec->value.vector.length);

            vec->value.vector.data[int_idx] = *val;

            return val;
        };
        define((set-car! target source), "TODO") {
            profile_with_name("(set-car!)");
            fetch(target, source);

            try assert_type(target, Lisp_Object_Type::Pair);

            *target->value.pair.first = *source;
            return source;
        };
        define((set-cdr! target source), "TODO") {
            profile_with_name("(set-cdr!)");
            fetch(target, source);

            try assert_type(target, Lisp_Object_Type::Pair);

            *target->value.pair.rest = *source;
            return source;
        };
        define_special((quote datum), "TODO") {
            profile_with_name("(quote)");
            fetch(datum);
            return datum;
        };
        define_special((quasiquote expr), "TODO") {
            profile_with_name("(quasiquote)");
            fetch(expr);
            Lisp_Object* quasiquote_sym       = Memory::get_symbol("quasiquote");
            Lisp_Object* unquote_sym          = Memory::get_symbol("unquote");
            Lisp_Object* unquote_splicing_sym = Memory::get_symbol("unquote-splicing");
            // NOTE(Felix): first we have to initialize the variable
            // with a garbage lambda, so that we can then overwrite it
            // a recursive lambda
            const auto unquoteSomeExpressions = [&] (const auto & self, Lisp_Object* expr) -> Lisp_Object* {
                // if it is an atom, return it
                if (expr->type != Lisp_Object_Type::Pair)
                    return Memory::copy_lisp_object(expr);

                // it is a pair!
                Lisp_Object* originalPair = expr->value.pair.first;

                // if we find quasiquote, uhu
                if (originalPair == quasiquote_sym)
                    return expr;

                if (originalPair == unquote_sym || originalPair == unquote_splicing_sym)
                {
                    // eval replace the stuff

                    Lisp_Object* ret;
                    in_caller_env {
                        try ret = eval_expr(expr->value.pair.rest->value.pair.first);
                    }

                    return ret;
                }

                // it is a list but not starting with the symbol
                // unquote, so search in there for stuff to unquote.
                // While copying the list

                //NOTE(Felix): Of fucking course we have to copy the
                // list. The quasiquote will be part of the body of a
                // funciton, we can't just modify it because otherwise
                // we modify the body of the function and would bake
                // in the result...
                Lisp_Object* newPair = Memory::nil;
                Lisp_Object* newPairHead = newPair;
                Lisp_Object* head = expr;

                while (head->type == Lisp_Object_Type::Pair) {
                    // if it is ,@ we have to actually do more work
                    // and inline the result
                    if (head->value.pair.first->type == Lisp_Object_Type::Pair &&
                        head->value.pair.first->value.pair.first == unquote_splicing_sym)
                    {
                        Lisp_Object* spliced = self(self, head->value.pair.first);

                        if (spliced == Memory::nil) {
                            head = head->value.pair.rest;
                            continue;
                        }

                        try assert_type(spliced, Lisp_Object_Type::Pair);
                        if (newPair == Memory::nil) {
                            try newPair  = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
                            newPairHead  = newPair;
                        } else {
                            try newPairHead->value.pair.rest  = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
                            newPairHead = newPairHead->value.pair.rest;
                            newPairHead->value.pair.first = spliced->value.pair.first;
                            newPairHead->value.pair.rest = spliced->value.pair.rest;

                            // now skip to the end
                            while (newPairHead->value.pair.rest != Memory::nil) {
                                newPairHead = newPairHead->value.pair.rest;
                            }
                        }

                    } else {
                        if (newPair == Memory::nil) {
                            try newPair  = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
                            newPairHead  = newPair;
                        } else {
                            try newPairHead->value.pair.rest  = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
                            newPairHead = newPairHead->value.pair.rest;
                        }
                        newPairHead->value.pair.first = self(self, head->value.pair.first);
                    }

                    // if (Memory::get_type(head->value.pair.rest) != Lisp_Object_Type::Pair) {
                    // break;
                    // }

                    head = head->value.pair.rest;

                }
                newPairHead->value.pair.rest = Memory::nil;

                return newPair;
            };

            expr = unquoteSomeExpressions(unquoteSomeExpressions, expr);
            return expr;
        };
        define((not test), "TODO") {
            profile_with_name("(not)");
            fetch(test);
            return is_truthy(test) ? Memory::nil : Memory::t;
        };
        // // // defun("while", "TODO", __LINE__, cLambda {
        // // //         try arguments_length = list_length(arguments);
        // // //         try assert(arguments_length >= 2);

        // // //         Lisp_Object* condition_part = arguments->value.pair.first;
        // // //         Lisp_Object* condition;
        // // //         Lisp_Object* then_part = arguments->value.pair.rest;
        // // //         Lisp_Object* wrapped_then_part;

        // // //         try wrapped_then_part = Memory::create_lisp_object_pair(
        // // //             Memory::get_symbol("begin"),
        // // //             then_part);

        // // //         Lisp_Object* result = Memory::nil;

        // // //         while (true) {
        // // //             try condition = eval_expr(condition_part);

        // // //             if (condition == Memory::nil)
        // // //                 break;

        // // //             try result = eval_expr(wrapped_then_part);
        // // //         }
        // // //         return result;

        // // //     });
        define_special((lambda args . body), "TODO") {
            profile_with_name("(lambda)");
            fetch(args, body);

            // creating new lisp object and setting type
            Lisp_Object* func;
            try func =  Memory::create_lisp_object_function(Lisp_Function_Type::Lambda);

            in_caller_env {
                func->value.function->parent_environment = get_current_environment();
            }

            try create_arguments_from_lambda_list_and_inject(args, func);
            func->value.function->body.lisp_body = maybe_wrap_body_in_begin(body);
            return func;
        };
        define((list . args), "TODO") {
            profile_with_name("(list)");
            fetch(args);
            return args;
        };
        define((hash-map . args), "TODO") {
            profile_with_name("(hash-map)");
            fetch(args);
            Lisp_Object* ret;
            try ret = Memory::create_lisp_object_hash_map();
            for_lisp_list (args) {
                try assert_type(head->value.pair.rest, Lisp_Object_Type::Pair);
                head = head->value.pair.rest;
                ret->value.hashMap->set_object(it, head->value.pair.first);
            }

            return ret;
        };
        define((hash-map-get hm key), "TODO") {
            profile_with_name("(hash-map-get)");
            fetch(hm, key);
            try assert_type(hm, Lisp_Object_Type::HashMap);

            Lisp_Object* ret = (Lisp_Object*)hm->value.hashMap->get_object(key);
            if (!ret)
                create_symbol_undefined_error("The key was not set in the hashmap");

            return ret;
        };
        define((hash-map-set! hm key value), "TODO") {
            profile_with_name("(hash-map-set!)");
            fetch(hm, key, value);
            try assert_type(hm,  Lisp_Object_Type::HashMap);
            hm->value.hashMap->set_object(key, value);
            return Memory::nil;
        };
        define((hash-map-delete! hm key), "TODO") {
            profile_with_name("(hash-map-delete!)");
            fetch(hm, key);
            try assert_type(hm,  Lisp_Object_Type::HashMap);
            hm->value.hashMap->delete_object(key);
            return Memory::nil;
        };
        define((vector . args), "TODO") {
            profile_with_name("(vector)");
            fetch(args);
            Lisp_Object* ret;
            u32 length = list_length(args);
            try ret = Memory::create_lisp_object_vector(length, args);
            return ret;
        };
        define((cons car cdr), "TODO") {
            profile_with_name("(cons)");
            fetch(car, cdr);

            Lisp_Object* ret;
            try ret = Memory::create_lisp_object_pair(car, cdr);
            return ret;
        };
        define((car seq), "TODO") {
            profile_with_name("(car)");
            fetch(seq);
            if (seq == Memory::nil)
                return Memory::nil;
            try assert_type(seq, Lisp_Object_Type::Pair);
            return seq->value.pair.first;
        };
        define((cdr seq), "TODO") {
            profile_with_name("(cdr)");
            fetch(seq);
            if (seq == Memory::nil)
                return Memory::nil;
            try assert_type(seq, Lisp_Object_Type::Pair);
            return seq->value.pair.rest;
        };
        define((set-type! node new_type), "TODO") {
            profile_with_name("(set-type!)");
            fetch(node, new_type);
            try assert_type(new_type, Lisp_Object_Type::Keyword);
            Globals::user_types.set_object(node, new_type);
            return node;
        };
        define((delete-type! n), "TODO") {
            profile_with_name("(delete-type!)");
            fetch(n);
            Globals::user_types.delete_object(n);
            return Memory::t;
        };
        define((type n), "TODO") {
            profile_with_name("(type)");
            fetch(n);


            if (Globals::user_types.key_exists(n)) {
                return (Lisp_Object*)Globals::user_types.get_object(n);
            }

            Lisp_Object_Type type  = n->type;

            switch (type) {
            case Lisp_Object_Type::Continuation: return Memory::get_keyword("continuation");
            case Lisp_Object_Type::Function: {
                Function* fun = n->value.function;
                if (fun->is_c) {
                    switch (fun->type.c_function_type) {
                    case C_Function_Type::cMacro: return Memory::get_keyword("cMacro");
                    case C_Function_Type::cFunction: return Memory::get_keyword("cFunction");
                    case C_Function_Type::cSpecial: return Memory::get_keyword("cSpecial");
                    default: return Memory::get_keyword("c??");
                    }
                } else {
                    switch (fun->type.lisp_function_type) {
                    case Lisp_Function_Type::Lambda: return Memory::get_keyword("lambda");
                    case Lisp_Function_Type::Macro: return Memory::get_keyword("macro");
                    default: return Memory::get_keyword("??");
                    }
                }
            }
            case Lisp_Object_Type::HashMap: return Memory::get_keyword("hashmap");
            case Lisp_Object_Type::Keyword: return Memory::get_keyword("keyword");
            case Lisp_Object_Type::Nil:     return Memory::get_keyword("nil");
            case Lisp_Object_Type::Number:  return Memory::get_keyword("number");
            case Lisp_Object_Type::Pair:    return Memory::get_keyword("pair");
            case Lisp_Object_Type::Pointer: return Memory::get_keyword("pointer");
            case Lisp_Object_Type::String:  return Memory::get_keyword("string");
            case Lisp_Object_Type::Symbol:  return Memory::get_keyword("symbol");
            case Lisp_Object_Type::T:       return Memory::get_keyword("t");
            case Lisp_Object_Type::Vector:  return Memory::get_keyword("vector");
            case(Lisp_Object_Type::Invalid_Garbage_Collected):  return Memory::get_keyword("Invalid: Garbage Collected");
            case(Lisp_Object_Type::Invalid_Under_Construction): return Memory::get_keyword("Invalid: Under Construction");
            }
            return Memory::get_keyword("unknown");
        };
        define_special((info n), "TODO")
        {
            // NOTE(Felix): we need to define_special because the docstring is
            // attached to the symbol. Because some object are singletons
            // (symbols, keyowrds, nil, t) we dont want to store docs on the
            // object. Otherwise (define k :doc "hallo" :keyword) would modify
            // // the global keyword
            profile_with_name("(info)");
            fetch(n);
            print(n);

            Lisp_Object* type;
            Lisp_Object* val;
            in_caller_env {
                try type = eval_expr(Memory::create_list(Memory::get_symbol("type"), n));
                try val = eval_expr(n);
            }

            printf(" is of type ");
            print(type);
            printf(" (internal: %s)", lisp_object_type_to_string(val->type));
            printf("\nand is printed as: ");
            print(val);
            printf("\n\ndocs:\n=====\n  %s\n\n",
                   (Globals::docs.get_object(val))
                   ? Globals::docs.get_object(val)
                   : "No docs avaliable");

            if (val->type == Lisp_Object_Type::Function)
            {
                Arguments* args = &val->value.function->args;


                printf("Arguments:\n==========\n");
                printf("Postitional: {");
                if (args->positional.symbols.next_index != 0) {
                    printf("%s",
                           Memory::get_c_str(args->positional.symbols.data[0]->value.symbol));
                    for (u32 i = 1; i < args->positional.symbols.next_index; ++i) {
                        printf(", %s",
                               Memory::get_c_str(args->positional.symbols.data[i]->value.symbol));
                    }
                }
                printf("}\n");
                printf("Keyword:     {");
                if (args->keyword.values.next_index != 0) {
                    printf("%s",
                           Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol));
                    if (args->keyword.values.data[0]) {
                        printf(" (");
                        print(args->keyword.values.data[0], true);
                        printf(")");
                    }
                    for (u32 i = 1; i < args->keyword.values.next_index; ++i) {
                        printf(", %s",
                               Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol));
                        if (args->keyword.values.data[i]) {
                            printf(" (");
                            print(args->keyword.values.data[i], true);
                            printf(")");
                        }
                    }
                }
                printf("}\n");
                printf("Rest:        {");
                if (args->rest)
                    printf("%s",
                           Memory::get_c_str(args->rest->value.symbol));
                printf("}\n");

            }
            return Memory::nil;
        };
        define((show n), "TODO") {
            profile_with_name("(show)");
            fetch(n);
            try assert_type(n, Lisp_Object_Type::Function);
            try assert("c-functoins cannot be shown", !n->value.function->is_c);
            puts("body:\n");
            print(n->value.function->body.lisp_body);
            puts("\n");
            printf("parent_env: %p\n",
                   n->value.function->parent_environment);

            return Memory::nil;
        };
        define((addr-of var), "TODO") {
            profile_with_name("(addr-of-var)");
            fetch(var);
            return Memory::create_lisp_object(&var);
        };
        define((generate-docs-file file_name), "TODO") {
            profile_with_name("(generate-docs-file)");
            fetch(file_name);
            try assert_type(file_name, Lisp_Object_Type::String);
            in_caller_env {
                try generate_docs(file_name->value.string);
            }
            return Memory::t;
        };
        define((print (:sep " ") (:end "\n") (:repr ()) . things), "TODO") {
            profile_with_name("(print)");
            fetch(sep, end, repr, things);

            if (things != Memory::nil) {
                bool print_repr = (repr != Memory::nil);
                print(things->value.pair.first, print_repr);

                for_lisp_list(things->value.pair.rest) {
                    print(sep);
                    print(it, print_repr);
                }
            }

            print(end);
            return Memory::nil;
        };
        define((read (:prompt ">")), "TODO") {
            profile_with_name("(read)");
            fetch(prompt);
            print(prompt);

            // TODO(Felix): make read_line return a String*
            char* line = read_line();
            defer {
                free(line);
            };
            String strLine = Memory::create_string(line);
            return Memory::create_lisp_object(strLine);
        };
        define((exit (:code 0)), "TODO") {
            profile_with_name("(exit)");
            fetch(code);
            try assert_type(code, Lisp_Object_Type::Number);
            exit((s32)code->value.number);
        };
        define((show-environment), "TODO") {
            profile_with_name("(show-environment)");
            in_caller_env {
                print_environment(get_current_environment());
            }
            return Memory::nil;
        };
        define((memstat), "TODO") {
            profile_with_name("(memstat)");
            Memory::print_status();
            return Memory::nil;
        };
        define_special((attempt try_part catch_part), "TODO") {
            profile_with_name("(attempt)");
            fetch(try_part, catch_part);

            Lisp_Object* result;

            in_caller_env {
                ignore_logging {
                    dont_break_on_errors {
                        result = eval_expr(try_part);
                        if (Globals::error) {
                            delete_error();
                            try result = eval_expr(catch_part);
                        }
                    }
                }
            }
            return result;
        };
        define((load file), "TODO") {
            profile_with_name("(load)");
            fetch(file);
            try assert_type(file, Lisp_Object_Type::String);

            Lisp_Object* result;
            in_caller_env {
                try result = built_in_load(file->value.string);
            }
            return result;
        };
        define((import f), "TODO") {
            profile_with_name("(import)");
            fetch(f);
            try assert_type(f, Lisp_Object_Type::String);

            Lisp_Object *result;
            in_caller_env {
                try result = built_in_import(f->value.string);
            }

            return Memory::t;
        };
        define((copy obj), "TODO") {
            profile_with_name("(copy)");
            fetch(obj);
            return Memory::copy_lisp_object(obj);
        };
        define((error type message), "TODO") {
            profile_with_name("(error)");
            fetch(type, message);
            // TODO(Felix): make the error function useful
            try assert_type(type, Lisp_Object_Type::Keyword);
            try assert_type(message, Lisp_Object_Type::String);

            using Globals::error;
            error = new(Error);
            error->type = type;
            error->message = message->value.string;

            create_generic_error("Userlanderror");
            return nullptr;
        };
        define((symbol->keyword sym), "TODO") {
            profile_with_name("(symbol->keyword)");
            fetch(sym);
            try assert_type(sym, Lisp_Object_Type::Symbol);
            return Memory::get_keyword(sym->value.symbol);
        };
        define((symbol->string sym), "TODO") {
            profile_with_name("(symbol->string)");
            fetch(sym);

            try assert_type(sym, Lisp_Object_Type::Symbol);
            return Memory::create_lisp_object(
                Memory::duplicate_string(sym->value.symbol));
        };
        define((string->symbol str), "TODO") {
            profile_with_name("(string->symbol)");
            fetch(str);
            // TODO(Felix): do some sanity checks on the string. For
            // example, numbers are not valid symbols.

            try assert_type(str, Lisp_Object_Type::String);
            return Memory::get_symbol(Memory::duplicate_string(str->value.string));
        };
        define((concat-strings . strings), "TODO") {
            profile_with_name("(concat-strings)");
            fetch(strings);

            u32 resulting_string_len = 0;
            for_lisp_list (strings) {
                try assert_type(it, Lisp_Object_Type::String);
                resulting_string_len += it->value.string.length;
            }

            String resulting_string = Memory::create_string("", resulting_string_len);
            u32 index_in_string = 0;

            for_lisp_list (strings) {
                strcpy(resulting_string.data+index_in_string,
                       Memory::get_c_str(it->value.string));
                index_in_string += it->value.string.length;
            }

            return Memory::create_lisp_object(resulting_string);
        };
        return nullptr;
    }
}