slime/src/built_ins.cpp

inline proc maybe_wrap_body_in_begin(Lisp_Object* body) -> Lisp_Object* {
    Lisp_Object* begin_symbol = Memory::get_or_create_lisp_object_symbol("begin");
    if (body->value.pair.rest == Memory::nil)
        return body->value.pair.first;
    else
        return Memory::create_lisp_object_pair(begin_symbol, body);
}

proc lisp_object_equal(Lisp_Object* n1, Lisp_Object* n2) -> bool {
    if (n1 == n2)
        return true;
    if (Memory::get_type(n1) != Memory::get_type(n2))
        return false;

    switch (Memory::get_type(n1)) {

    case Lisp_Object_Type::CFunction: // if they have the same
                                      // pointer, true is returned a
                                      // few lines above
    case Lisp_Object_Type::Function:
    case Lisp_Object_Type::Pointer:   // TODO(Felix): should a pointer
                                      // object compare the pointer?
    case Lisp_Object_Type::Continuation:  return false;
    case Lisp_Object_Type::T:  // code for t and nil should never be
                               // reached since they are memory unique
    case Lisp_Object_Type::Nil:    return true;
    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::HashMap:
    case Lisp_Object_Type::Pair:
    case Lisp_Object_Type::Vector:
        create_not_yet_implemented_error();
    case Lisp_Object_Type::Symbol:
    case Lisp_Object_Type::Keyword:
        return false;
    }

    // we should never reach here
    return false;
}

proc built_in_load(String* file_name) -> Lisp_Object* {
    // char* full_file_name = find_slime_file(file_name);
    char* file_content;
    char fullpath[4096];
    sprintf(fullpath, "%s", Memory::get_c_str(file_name));
    file_content = read_entire_file(Memory::get_c_str(file_name));

    if (!file_content) {
        // try slime's bin dir
        // save the current working directory

        // get the direction of the exe
        char* exe_path = get_exe_dir();
        defer {
            free(exe_path);
        };

        fullpath[0] = '\0';
        sprintf(fullpath, "%s%s", exe_path, Memory::get_c_str(file_name));
        // printf("Fullpath: %s\n", fullpath);
        file_content = read_entire_file(fullpath);

        if (!file_content) {
            char* cwd = get_cwd();
            defer {
                free(cwd);
            };
            create_generic_error("The file to load '%s' was not found: "
                                 "neither in the cwd (%s) "
                                 "nor in slime's exe dir (%s)",
                                 Memory::get_c_str(file_name), cwd, fullpath);
            return nullptr;
        }
    }

    Lisp_Object* result = Memory::nil;
    Lisp_Object_Array_List program;
    try program = Parser::parse_program(Memory::create_string(fullpath), file_content);

    for (int i = 0; i < program.next_index; ++i) {
        try result = eval_expr(program.data[i]);
    }
    return result;
}

proc built_in_import(String* file_name) -> Lisp_Object* {
    // create new empty environment
    Environment* new_env;
    try new_env = Memory::create_child_environment(get_root_environment());
    append_to_array_list(&get_current_environment()->parents, new_env);

    push_environment(new_env);
    defer {
        pop_environment();
    };

    Lisp_Object* res = built_in_load(file_name);

    return res;
}

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


#define fetch1(var)                                                                     \
    Lisp_Object* var##_symbol = Memory::get_or_create_lisp_object_symbol(#var);         \
    Lisp_Object* var = lookup_symbol(var##_symbol, get_current_environment());          \
    if (Globals::error) printf("in %s:%d\n", __FILE__, __LINE__)

#define  fetch2(var1, var2)                                                                                                                                                                                                                                                                                                        fetch1(var1);  fetch1(var2)
#define  fetch3(var1, var2, var3)                                                                                                                                                                                                                                                                                           fetch2(var1,  var2);  fetch1(var3)
#define  fetch4(var1, var2, var3, var4)                                                                                                                                                                                                                                                                              fetch3(var1,  var2,  var3);  fetch1(var4)
#define  fetch5(var1, var2, var3, var4, var5)                                                                                                                                                                                                                                                                 fetch4(var1,  var2,  var3,  var4);  fetch1(var5)
#define  fetch6(var1, var2, var3, var4, var5, var6)                                                                                                                                                                                                                                                    fetch5(var1,  var2,  var3,  var4,  var5);  fetch1(var6)
#define  fetch7(var1, var2, var3, var4, var5, var6, var7)                                                                                                                                                                                                                                       fetch6(var1,  var2,  var3,  var4,  var5,  var6);  fetch1(var7)
#define  fetch8(var1, var2, var3, var4, var5, var6, var7, var8)                                                                                                                                                                                                                          fetch7(var1,  var2,  var3,  var4,  var5,  var6,  var7);  fetch1(var8)
#define  fetch9(var1, var2, var3, var4, var5, var6, var7, var8, var9)                                                                                                                                                                                                             fetch8(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8);  fetch1(var9)
#define fetch10(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10)                                                                                                                                                                                               fetch9(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9); fetch1(var10)
#define fetch11(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11)                                                                                                                                                                                fetch10(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10); fetch1(var11)
#define fetch12(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12)                                                                                                                                                                  fetch11(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11); fetch1(var12)
#define fetch13(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13)                                                                                                                                                    fetch12(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12); fetch1(var13)
#define fetch14(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14)                                                                                                                                      fetch13(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13); fetch1(var14)
#define fetch15(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15)                                                                                                                        fetch14(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13, var14); fetch1(var15)
#define fetch16(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16)                                                                                                          fetch15(var1,  var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13, var14, var15); fetch1(var16)
#define fetch17(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17)                                                                                             fetch16(var1, var2,  var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13, var14, var15, var16); fetch1(var17)
#define fetch18(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18)                                                                                fetch17(var1, var2, var3,  var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13, var14, var15, var16, var17); fetch1(var18)
#define fetch19(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19)                                                                   fetch18(var1, var2, var3, var4,  var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13, var14, var15, var16, var17, var18); fetch1(var19)
#define fetch20(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20)                                                      fetch19(var1, var2, var3, var4, var5,  var6,  var7,  var8,  var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19); fetch1(var20)
#define fetch21(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21)                                         fetch20(var1, var2, var3, var4, var5, var6,  var7,  var8,  var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20); fetch1(var21)
#define fetch22(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22)                            fetch21(var1, var2, var3, var4, var5, var6, var7,  var8,  var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21); fetch1(var22)
#define fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23)               fetch22(var1, var2, var3, var4, var5, var6, var7, var8,  var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22); fetch1(var23)
#define fetch24(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23, var24)  fetch23(var1, var2, var3, var4, var5, var6, var7, var8, var9, var10, var11, var12, var13, var14, var15, var16, var17, var18, var19, var20, var21, var22, var23); fetch1(var24)

#define GET_MACRO(                                \
    _1,   _2,  _3,  _4,  _5,  _6,                 \
    _7,   _8,  _9, _10, _11, _12,                 \
    _13, _14, _15, _16, _17, _18,                 \
    _19, _20, _21, _22, _23, _24,                 \
    NAME, ...) NAME
#ifdef _MSC_VER
#define EXPAND( x ) x
#define fetch(...) EXPAND(                                              \
        GET_MACRO(                                                      \
            __VA_ARGS__,                                                \
            fetch24, fetch23, fetch22, fetch21, fetch20, fetch19,       \
            fetch18, fetch17, fetch16, fetch15, fetch14, fetch13,       \
            fetch12, fetch11, fetch10, fetch9,  fetch8,  fetch7,        \
            fetch6,  fetch5,  fetch4,  fetch3,  fetch2,  fetch1         \
            )(__VA_ARGS__))
#else
#define fetch(...)                                                      \
    GET_MACRO(                                                          \
        __VA_ARGS__,                                                    \
        fetch24, fetch23, fetch22, fetch21, fetch20, fetch19,           \
        fetch18, fetch17, fetch16, fetch15, fetch14, fetch13,           \
        fetch12, fetch11, fetch10, fetch9,  fetch8,  fetch7,            \
        fetch6,  fetch5,  fetch4,  fetch3,  fetch2,  fetch1             \
        )(__VA_ARGS__)
#endif

// NOTE(Felix): we have to copy the string because we need
// it to be mutable for the parser to work, because the
// parser relys on being able to temporaily put in markers
// in the code
#define _define_helper(def, docs, special)                              \
    auto label(params,__LINE__) = Parser::parse_single_expression(      \
        Memory::get_c_str(Memory::create_string(#def))                  \
        );                                                              \
    assert_type(label(params,__LINE__), Lisp_Object_Type::Pair);        \
    assert_type(label(params,__LINE__)->value.pair.first, Lisp_Object_Type::Symbol); \
    auto label(sym,__LINE__) = label(params,__LINE__)->value.pair.first; \
    auto label(sfun,__LINE__) = Memory::create_lisp_object_cfunction(special); \
    /*NOTE(Felix): for evaluating default args*/                        \
    /*push_environment(get_root_environment());*/                           \
    create_arguments_from_lambda_list_and_inject(label(params,__LINE__)->value.pair.rest, label(sfun,__LINE__)); \
    /*pop_environment(); */                                                 \
    label(sfun,__LINE__)->sourceCodeLocation =  new(Source_Code_Location); \
    label(sfun,__LINE__)->sourceCodeLocation->file   = file_name_built_ins; \
    label(sfun,__LINE__)->sourceCodeLocation->line   = __LINE__;        \
    label(sfun,__LINE__)->sourceCodeLocation->column = 0;               \
    label(sfun,__LINE__)->docstring = Memory::create_string(docs);      \
    define_symbol(label(sym,__LINE__), label(sfun,__LINE__));           \
    label(sfun,__LINE__)->value.cFunction->body = (std::function<Lisp_Object* ()>)[&]() -> Lisp_Object*

#define define(def, docs)         _define_helper(def, docs, false)
#define define_special(def, docs) _define_helper(def, docs, true)
#define in_caller_env fluid_let(                                        \
        Globals::Current_Execution::envi_stack.next_index,              \
        Globals::Current_Execution::envi_stack.next_index-1)

        define((helper), "") {
                return Memory::create_lisp_object_number(101);
        };
        define((test (:k (helper))), "") {
                fetch(k);
                return k;
        };
    define((= . args),
          "Takes 0 or more arguments and returns =t= if all arguments are equal "
          "and =()= otherwise.")
    {
        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")
    {
        fetch(args);
        double last_number = strtod("Inf", NULL);

        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")
    {
        fetch(args);
        double last_number = strtod("Inf", NULL);

        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")
    {
        fetch(args);
        double last_number = strtod("-Inf", NULL);

        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")
    {
        fetch(args);
        double last_number = strtod("-Inf", NULL);

        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")
    {
        fetch(args);
        double sum = 0;

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

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


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

        if (args->value.pair.rest == Memory::nil) {
            return Memory::create_lisp_object_number(-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_number(difference);
    };
    define((* . args),  "TODO")
    {
        fetch(args);
        if (args == Memory::nil) {
            return Memory::create_lisp_object_number(1);
        }

        double product = 1;

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

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

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

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

        double 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_number(quotient);
    };
    define((** a b), "TODO") {
        fetch(a, b);
        try assert_type(a, Lisp_Object_Type::Number);
        try assert_type(b, Lisp_Object_Type::Number);
        return Memory::create_lisp_object_number(pow(a->value.number,
                                                     b->value.number));
    };
    define((% a b), "TODO") {
        fetch(a, b);
        try assert_type(a, Lisp_Object_Type::Number);
        try assert_type(b, Lisp_Object_Type::Number);
        return Memory::create_lisp_object_number((int)a->value.number %
                                                 (int)b->value.number);
    };
    define((get-random-between a b), "TODO") {
        fetch(a, b);
        try assert_type(a, Lisp_Object_Type::Number);
        try assert_type(b, Lisp_Object_Type::Number);

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

        return Memory::create_lisp_object_number(x);
    };
    define_special((bound? var), "TODO") {
        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((assert test), "TODO") {
        fetch(test);

        if (is_truthy(test))
            return Memory::t;

        create_generic_error("Userland assertion.");
        return nullptr;
    };
    define_special((define-syntax form (:doc "") . body), "TODO") {
        fetch(form, doc, body);

        // static Lisp_Object *form_symbol = Memory::get_or_create_lisp_object_symbol("form");
        // static Lisp_Object *doc_symbol = Memory::get_or_create_lisp_object_symbol("doc");
        // static Lisp_Object *body_symbol = Memory::get_or_create_lisp_object_symbol("body");

        // printf("\n\nin define-syntax:: envi stack depth: %d\n",
               // Globals::Current_Execution::envi_stack.next_index);
        // print_environment(get_current_environment());

        // Lisp_Object *form = lookup_symbol(form_symbol, get_current_environment());
        // Lisp_Object *doc  = lookup_symbol(doc_symbol, get_current_environment());
        // Lisp_Object *body = lookup_symbol(body_symbol, get_current_environment());

        try assert_type(doc, Lisp_Object_Type::String);
        // if no doc string, we dont have to store it
        if (Memory::get_c_str(doc)[0] == '\0') {
            doc = nullptr;
        }

        if (Memory::get_type(form) != 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();
        Memory::set_type(func, Lisp_Object_Type::Function);
        func->value.function.type = Function_Type::Macro;

        if (doc) func->docstring = doc->value.string;

        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 = maybe_wrap_body_in_begin(body);
            define_symbol(symbol, func);
        }
        return Memory::nil;
    };
    define_special((define definee (:doc "") . body), "TODO") {
        fetch(definee, doc, body);

        // print_hm(get_current_environment()->hm);
        try assert_type(doc, Lisp_Object_Type::String);

        // if no doc string, we dont have to store it
        if (Memory::get_c_str(doc)[0] == '\0') {
            doc = nullptr;
        }

        if (Memory::get_type(definee) == Lisp_Object_Type::Symbol) {
            if (body == Memory::nil) {
                create_parsing_error("You at least have to put a value when "
                                     "you are trying to define a variable.");
                return nullptr;
            } else if (body->value.pair.rest != Memory::nil) {
                create_parsing_error("You cannot define more than one thing "
                                     "for one variable.");
                return nullptr;
            }
            auto value = body->value.pair.first;
            in_caller_env {
                value = eval_expr(value);
                define_symbol(definee, value);
            }
        } else if (Memory::get_type(definee) == Lisp_Object_Type::Pair) {
            // definee: (sym . lambdalist)
            Lisp_Object* symbol     = definee->value.pair.first;
            Lisp_Object* lambdalist = definee->value.pair.rest;

            // creating new lisp object and setting type
            Lisp_Object* func;
            try func = Memory::create_lisp_object();
            Memory::set_type(func, Lisp_Object_Type::Function);
            func->value.function.type = Function_Type::Lambda;

            if (doc)
                func->docstring = doc->value.string;

            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 = maybe_wrap_body_in_begin(body);
                define_symbol(symbol, func);
            }

        } else {
            create_parsing_error("The to be defined object has to be a "
                                 "symbol or a list. But got a %s.",
                                 Lisp_Object_Type_to_string(
                                     Memory::get_type(definee)));
            return nullptr;
        }
        return Memory::nil;
    };
    define((mutate target source), "TODO") {
        fetch(target, source);

        if (target == Memory::nil ||
            target == Memory::t   ||
            Memory::get_type(target) == Lisp_Object_Type::Keyword ||
            Memory::get_type(target) == 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   ||
            Memory::get_type(source) == Lisp_Object_Type::Keyword ||
            Memory::get_type(source) == Lisp_Object_Type::Symbol)
        {
            create_generic_error("You cannot mutate nil, t, keywords or symbols");
        }

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

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

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

        try assert(int_idx >= 0);
        try assert(int_idx < vec->value.vector.length);

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

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

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

        try assert(int_idx >= 0);
        try assert(int_idx < vec->value.vector.length);

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

        return val;
    };
    define_special((set! sym val), "TODO") {
        fetch(sym, val);

        try assert_type(sym, Lisp_Object_Type::Symbol);
        Environment* target_env;
        in_caller_env {
            val = eval_expr(val);
            target_env = find_binding_environment(sym, get_current_environment());
            if (!target_env)
                target_env = get_root_environment();
        }


        push_environment(target_env);
        {
            printf("set!ing:: ");
            print(sym);
            printf(" to ");
            print(val);
            printf(" in %llu\n", (unsigned long long) target_env);
            define_symbol(sym, val);
        }
        pop_environment();

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

        try assert_type(target, Lisp_Object_Type::Pair);

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

        try assert_type(target, Lisp_Object_Type::Pair);

        *target->value.pair.rest = *source;
        return source;
    };
    define_special((if test then_part else_part), "TODO") {
        fetch(test, then_part, else_part);

        bool truthy;
        Lisp_Object* result;

        in_caller_env {
            try truthy = is_truthy(test);
            if (truthy) try result = eval_expr(then_part);
            else        try result = eval_expr(else_part);
        }

        return result;
    };
    define_special((quote datum), "TODO") {
        fetch(datum);
        return datum;
    };
    define_special((quasiquote expr), "TODO") {
        fetch(expr);
        Lisp_Object* unquote_sym          = Memory::get_or_create_lisp_object_symbol("unquote");
        Lisp_Object* unquote_splicing_sym = Memory::get_or_create_lisp_object_symbol("unquote-splicing");
        /* recursive lambdas in lambdas yay!! */
        // NOTE(Felix): first we have to initialize the variable
        // with a garbage lambda, so that we can then overwrite it
        // a recursive lambda
        std::function<Lisp_Object*(Lisp_Object*)> unquoteSomeExpressions; // = [] (Lisp_Object* expr) -> Lisp_Object* {return nullptr;};
        unquoteSomeExpressions = [&] (Lisp_Object* expr) -> Lisp_Object* {
            // if it is an atom, return it
            if (Memory::get_type(expr) != Lisp_Object_Type::Pair)
                return Memory::copy_lisp_object(expr);

            // it is a pair!
            Lisp_Object* originalPair = expr->value.pair.first;
            if (originalPair == unquote_sym || originalPair == unquote_splicing_sym)
            {
                // eval replace the stuff

                Lisp_Object* ret;
                in_caller_env {
                    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 (Memory::get_type(head) == Lisp_Object_Type::Pair) {
                // if it is ,@ we have to actually do more work
                // and inline the result
                if (Memory::get_type(head->value.pair.first) == Lisp_Object_Type::Pair &&
                    head->value.pair.first->value.pair.first == unquote_splicing_sym)
                {
                    Lisp_Object* spliced = unquoteSomeExpressions(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 = unquoteSomeExpressions(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(expr);
        return expr;
    };
    define_special((and . args), "TODO") {
        fetch(args);
        bool result = true;
        in_caller_env {
            for_lisp_list (args) {
                try result &= is_truthy(it);
                if (!result)
                    return Memory::nil;
            }
        }
        return Memory::t;
    };
    define_special((or . args), "TODO") {
        fetch(args);
        bool result = false;
        in_caller_env {
            for_lisp_list (args) {
                try result |= is_truthy(it);
                if (result)
                    return Memory::t;
            }
        }
        return Memory::nil;
    };
    define_special((not test), "TODO") {
        fetch(test);
        bool truthy;
        in_caller_env {
            try truthy = is_truthy(test);
        }
        return (truthy) ? 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_or_create_lisp_object_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") {
        fetch(args, body);

        Lisp_Object* fun;
        try fun = Memory::create_lisp_object();
        Memory::set_type(fun, Lisp_Object_Type::Function);
        fun->value.function.type = Function_Type::Lambda;

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

        try create_arguments_from_lambda_list_and_inject(args, fun);
        fun->value.function.body = maybe_wrap_body_in_begin(body);
        return fun;
    };
    define_special((special-lambda args . body), "TODO") {
        fetch(args, body);

        Lisp_Object* fun;
        try fun = Memory::create_lisp_object();
        Memory::set_type(fun, Lisp_Object_Type::Function);
        fun->value.function.type = Function_Type::Special_Lambda;

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

        try create_arguments_from_lambda_list_and_inject(args, fun);
        fun->value.function.body = maybe_wrap_body_in_begin(body);
        return fun;
    };
    define((eval expr), "TODO") {
        fetch(expr);
        Lisp_Object* result;

        in_caller_env {
            try result = eval_expr(expr);
        }

        return result;
    };
    define_special((begin . args), "TODO") {
        fetch(args);
        Lisp_Object* result = Memory::nil;
        in_caller_env {
            for_lisp_list(args) {
                try result = eval_expr(it);
            }
        }
        return result;
    };
    define((list . args), "TODO") {
        fetch(args);
        return args;
    };
    define((create-hash-map), "TODO") {
        Lisp_Object* ret;
        try ret = Memory::create_lisp_object_hash_map();
        return ret;
    };
    define((hash-map-get hm key), "TODO") {
        fetch(hm, key);
        try assert_type(hm,  Lisp_Object_Type::HashMap);

        Lisp_Object* ret = (Lisp_Object*)hm_get_object(hm->value.hashMap, 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") {
        fetch(hm, key, value);
        try assert_type(hm,  Lisp_Object_Type::HashMap);
        hm_set(hm->value.hashMap, key, value);
        return Memory::nil;
    };
    define((vector . args), "TODO") {
        fetch(args);
        Lisp_Object* ret;
        int length = list_length(args);
        try ret = Memory::create_lisp_object_vector(length, args);
        return ret;
    };
    define((pair car cdr), "TODO") {
        fetch(car, cdr);

        Lisp_Object* ret;
        try ret = Memory::create_lisp_object_pair(car, cdr);
        return ret;
    };
    define((first seq), "TODO") {
        fetch(seq);
        if (seq == Memory::nil)
            return Memory::nil;
        try assert_type(seq, Lisp_Object_Type::Pair);
        return seq->value.pair.first;
    };
    define((rest seq), "TODO") {
        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") {
        fetch(node, new_type);
        try assert_type(new_type, Lisp_Object_Type::Keyword);
        node->userType = new_type;
        return node;
    };
    define((delete-type! n), "TODO") {
        fetch(n);
        n->userType = nullptr;
        return Memory::t;
    };
    define((type n), "TODO") {
        fetch(n);

        if (n->userType) {
            return n->userType;
        }

        Lisp_Object_Type type  = Memory::get_type(n);

        switch (type) {
        case Lisp_Object_Type::Continuation: return Memory::get_or_create_lisp_object_keyword("continuation");
        case Lisp_Object_Type::CFunction: return Memory::get_or_create_lisp_object_keyword("cfunction");
        case Lisp_Object_Type::Function: {
            Function* fun = &n->value.function;
            if (fun->type == Function_Type::Lambda)
                return Memory::get_or_create_lisp_object_keyword("lambda");
            else if (fun->type == Function_Type::Special_Lambda)
                return Memory::get_or_create_lisp_object_keyword("special-lambda");
            else if (fun->type == Function_Type::Macro)
                return Memory::get_or_create_lisp_object_keyword("macro");
            else return Memory::get_or_create_lisp_object_keyword("unknown");
        }
        case Lisp_Object_Type::HashMap: return Memory::get_or_create_lisp_object_keyword("hashmap");
        case Lisp_Object_Type::Keyword: return Memory::get_or_create_lisp_object_keyword("keyword");
        case Lisp_Object_Type::Nil:     return Memory::get_or_create_lisp_object_keyword("nil");
        case Lisp_Object_Type::Number:  return Memory::get_or_create_lisp_object_keyword("number");
        case Lisp_Object_Type::Pair:    return Memory::get_or_create_lisp_object_keyword("pair");
        case Lisp_Object_Type::Pointer: return Memory::get_or_create_lisp_object_keyword("pointer");
        case Lisp_Object_Type::String:  return Memory::get_or_create_lisp_object_keyword("string");
        case Lisp_Object_Type::Symbol:  return Memory::get_or_create_lisp_object_keyword("symbol");
        case Lisp_Object_Type::T:       return Memory::get_or_create_lisp_object_keyword("t");
        case Lisp_Object_Type::Vector:  return Memory::get_or_create_lisp_object_keyword("vector");
        }
        return Memory::get_or_create_lisp_object_keyword("unknown");
    };
    define((mem-reset), "TODO") {
        Memory::reset();
        return Memory::nil;
    };
    // 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
    define_special((info n), "TODO") {
        fetch(n);

        print(n);

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

        printf(" is of type ");
        print(type);
        printf(" (internal: %s)", Lisp_Object_Type_to_string(Memory::get_type(val)));
        printf("\nand is printed as: ");
        print(val);
        printf("\n\ndocs: \n  %s\n",
               (val->docstring)
               ? Memory::get_c_str(val->docstring)
               : "No docs avaliable");

        if (Memory::get_type(val) == Lisp_Object_Type::Function ||
            Memory::get_type(val) == Lisp_Object_Type::CFunction)
        {
            Arguments* args;
            if (Memory::get_type(val) == Lisp_Object_Type::Function)
                args = &val->value.function.args;
            else
                args = &val->value.cFunction->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.identifier));
                for (int i = 1; i < args->positional.symbols.next_index; ++i) {
                    printf(", %s",
                           Memory::get_c_str(args->positional.symbols.data[i]->value.symbol.identifier));
                }
            }
            printf("}\n");
            printf("Keyword:     {");
            if (args->keyword.values.next_index != 0) {
                printf("%s",
                       Memory::get_c_str(args->keyword.keywords.data[0]->value.symbol.identifier));
                if (args->keyword.values.data[0]) {
                    printf(" (");
                    print(args->keyword.values.data[0], true);
                    printf(")");
                }
                for (int i = 1; i < args->keyword.values.next_index; ++i) {
                    printf(", %s",
                           Memory::get_c_str(args->keyword.keywords.data[i]->value.symbol.identifier));
                    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.identifier));
            printf("}\n");

        }
        return Memory::nil;
    };
    define((show n), "TODO") {
        fetch(n);
        try assert_type(n, Lisp_Object_Type::Function);

        puts("body:\n");
        print(n->value.function.body);
        puts("\n");
        printf("parent_env: %lld\n",
               (long long)n->value.function.parent_environment);

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

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

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

        print(end);
        return Memory::nil;
    };
    define((read (:prompt ">")), "TODO") {
        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_string(strLine);
    };
    define((exit (:code 0)), "TODO") {
        fetch(code);
        try assert_type(code, Lisp_Object_Type::Number);
        exit((int)code->value.number);
    };
    define((break), "TODO") {
        in_caller_env {
            print_environment(get_current_environment());
        }
        return Memory::nil;
    };
    define((memstat), "TODO") {
        Memory::print_status();
        return Memory::nil;
    };
    define_special((mytry try_part catch_part), "TODO") {
        fetch(try_part, catch_part);

        Lisp_Object* result;

        in_caller_env {
            result = eval_expr(try_part);
            if (Globals::error) {
                delete_error();
                try result = eval_expr(catch_part);
            }
        }
        return result;
    };
    define((load file), "TODO") {
        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") {
        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") {
        fetch(obj);
        // TODO(Felix): if we are copying string nodes, then
        // shouldn't the string itself also get copied??
        return Memory::copy_lisp_object(obj);
    };
    define((error type message), "TODO") {
        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") {
        fetch(sym);
        try assert_type(sym, Lisp_Object_Type::Symbol);
        return Memory::get_or_create_lisp_object_keyword(sym->value.symbol.identifier);
    };
    define((string->symbol str), "TODO") {
        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_or_create_lisp_object_symbol(
            Memory::duplicate_string(str->value.string));
    };
    define((symbol->string sym), "TODO") {
        fetch(sym);

        try assert_type(sym, Lisp_Object_Type::Symbol);
        return Memory::create_lisp_object_string(
            Memory::duplicate_string(sym->value.symbol.identifier));
    };
    define((concat-strings . strings), "TODO") {
        fetch(strings);

        int 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);
        int 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_string(resulting_string);
    };
}