slime/src/eval.cpp

proc apply_arguments_to_function(Lisp_Object* arguments, Function* function) -> Lisp_Object* {
    Environment* new_env = Memory::create_child_environment(function->parent_environment);
    Lisp_Object* sym, *val; // used as temp storage to use `try`

    // positional arguments
    for (int i = 0; i < function->positional_arguments->next_index; ++i) {
        if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
            create_wrong_number_of_arguments_error(function->positional_arguments->next_index, i);
            return nullptr;
        }
        // TODO(Felix): here we create new lisp_object_symbols from
        // their identifiers but before we converted them to
        // strings from symbols... Wo maybe just use the symbols?

        try sym = Memory::get_or_create_lisp_object_symbol(function->positional_arguments->identifiers[i]);
        define_symbol(sym, arguments->value.pair.first, new_env);

        arguments = arguments->value.pair.rest;
    }

    String_Array_List* read_in_keywords = create_String_array_list();

    if (arguments == Memory::nil)
        goto checks;
    // keyword arguments: use all given ones and keep track of the
    // added ones (array list), if end of parameters in encountered or
    // something that is not a keyword is encountered or a keyword
    // that is not recognized is encoutered, jump out of the loop.

    while (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
        // check if this one is even an accepted keyword
        bool accepted = false;
        for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
            if (string_equal(
                    arguments->value.pair.first->value.identifier,
                    function->keyword_arguments->identifiers[i]))
            {
                accepted = true;
                break;
            }
        }
        if (!accepted) {
            // TODO(Felix): if we are actually done with all the
            // necessary keywords then we have to count the rest
            // as :rest here, instead od always creating an error
            // (special case with default variables)
            create_generic_error(
                "The function does not take the keyword argument ':%s'",
                &(arguments->value.pair.first->value.identifier));
            return nullptr;
        }

        // check if it was already read in
        for (int i = 0; i < read_in_keywords->next_index; ++i) {
            if (string_equal(
                    arguments->value.pair.first->value.identifier,
                    read_in_keywords->data[i]))
            {
                // TODO(Felix): if we are actually done with all the
                // necessary keywords then we have to count the rest
                // as :rest here, instead od always creating an error
                // (special case with default variables)
                create_generic_error(
                    "The function already read the keyword argument ':%s'",
                    &(arguments->value.pair.first->value.identifier));
                return nullptr;
            }
        }

        // okay so we found a keyword that has to be read in and was
        // not already read in, is there a next element to actually
        // set it to?
        if (Memory::get_type(arguments->value.pair.rest) != Lisp_Object_Type::Pair) {
            create_generic_error(
                "Attempting to set the keyword argument ':%s', but no value was supplied.",
                &(arguments->value.pair.first->value.identifier));
            return nullptr;
        }

        // if not set it and then add it to the array list
        try sym = Memory::get_or_create_lisp_object_symbol(arguments->value.pair.first->value.identifier),
        define_symbol(sym, arguments->value.pair.rest->value.pair.first, new_env);

        append_to_array_list(read_in_keywords, arguments->value.pair.first->value.identifier);

        // overstep both for next one
        arguments = arguments->value.pair.rest->value.pair.rest;

        if (arguments == Memory::nil) {
            break;
        }
    }

  checks:
    // check if all necessary keywords have been read in
    for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
        String* defined_keyword = function->keyword_arguments->identifiers[i];
        bool was_set = false;
        for (int j = 0; j < read_in_keywords->next_index; ++j) {
            if (string_equal(
                    read_in_keywords->data[j],
                    defined_keyword))
            {
                was_set = true;
                break;
            }
        }
        if (function->keyword_arguments->values->data[i] == nullptr) {
            // if this one does not have a default value
            if (!was_set) {
                create_generic_error(
                    "There was no value supplied for the required "
                    "keyword argument ':%s'.",
                    &defined_keyword->data);
                return nullptr;
            }
        } else {
            // this one does have a default value, lets see if we have
            // to use it or if the user supplied his own
            if (!was_set) {
                try sym = Memory::get_or_create_lisp_object_symbol(defined_keyword);
                try val = Memory::copy_lisp_object(function->keyword_arguments->values->data[i]);
                define_symbol(sym, val, new_env);
            }
        }
    }


    if (arguments == Memory::nil) {
        if (function->rest_argument) {
            try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
            define_symbol(sym, Memory::nil, new_env);
        }
    } else {
        if (function->rest_argument) {
            try sym = Memory::get_or_create_lisp_object_symbol(function->rest_argument);
            define_symbol(sym, arguments, new_env);
        } else {
            // rest was not declared but additional arguments were found
            create_generic_error(
                "A rest argument was not declared "
                "but the function was called with additional arguments.");
            return nullptr;
        }
    }

    Lisp_Object* result;
    try result = eval_expr(function->body, new_env);
    return result;
}

/*
   (prog
     (define type--before type)
     (define type
       (lambda (e)
         (if (and (= (type--before e) :pair) (= (first e) :my-type))
             :my-type
           (type--before e))))
   )
*/

/**
   This parses the argument specification of funcitons into their
   Function struct. It dois this by allocating new
   positional_arguments, keyword_arguments and rest_argument and
   filling it in
*/
proc parse_argument_list(Lisp_Object* arguments, Function* function) -> void {
    // first init the fields
    function->positional_arguments = create_positional_argument_list(16);
    function->keyword_arguments    = create_keyword_argument_list(16);
    function->rest_argument        = nullptr;

    // okay let's try to read some positional arguments
    while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
        if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
            if (string_equal(arguments->value.pair.first->value.identifier, "keys") ||
                string_equal(arguments->value.pair.first->value.identifier, "rest"))
                break;
            else {
                create_parsing_error("A non recognized marker was found "
                                     "in the lambda list: ':%s'",
                                     &arguments->value.pair.first->value.identifier);
                return;
            }
        }

        if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
            create_parsing_error("Only symbols and keywords can be "
                                 "parsed here, but found '%s'",
                                 Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
            return;
        }

        // okay wow we found an actual symbol
        append_to_positional_argument_list(
            function->positional_arguments,
            arguments->value.pair.first->value.identifier);

        arguments = arguments->value.pair.rest;
    }

    // okay we are done with positional arguments, lets check for
    // keywords,
    if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
        if (arguments != Memory::nil)
            create_parsing_error("The lambda list must be nil terminated.");
        return;
    }

    if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
        string_equal(arguments->value.pair.first->value.identifier, "keys"))
    {
        arguments = arguments->value.pair.rest;
        if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
            create_parsing_error("Actual keys have to follow the :keys indicator.");
        }
        // if (arguments->value.pair.first->type != Lisp_Object_Type::Symbol) {
        //     create_parsing_error(
        //         "Only symbols can be parsed here, but found '%s'.",
        //         Lisp_Object_Type_to_string(arguments->value.pair.first->type));
        //     return;
        // }

        while (Memory::get_type(arguments) == Lisp_Object_Type::Pair) {
            if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword) {
                if (string_equal(arguments->value.pair.first->value.identifier, "rest"))
                    break;
                else {
                    create_parsing_error(
                        "Only the :rest keyword can be parsed here, but got ':%s'.",
                        &arguments->value.pair.first->value.identifier->data);
                    return;
                }
            }

            if (Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol) {
                create_parsing_error(
                    "Only symbols can be parsed here, but found '%s'.",
                    Lisp_Object_Type_to_string(Memory::get_type(arguments->value.pair.first)));
                return;
            }

            // we found a symbol (arguments->value.pair->first) for
            // the keyword args! Let's check if the next arguement is
            // :defaults-to
            Lisp_Object* next = arguments->value.pair.rest;
            if (Memory::get_type(next) == Lisp_Object_Type::Pair &&
                Memory::get_type(next->value.pair.first) == Lisp_Object_Type::Keyword &&
                string_equal(next->value.pair.first->value.identifier,
                              "defaults-to"))
            {
                // check if there is a next argument too, otherwise it
                // would be an error
                next = next->value.pair.rest;
                if (Memory::get_type(next) == Lisp_Object_Type::Pair) {
                    append_to_keyword_argument_list(function->keyword_arguments,
                                                    arguments->value.pair.first->value.identifier,
                                                    next->value.pair.first);
                    arguments = next->value.pair.rest;
                } else {
                    create_parsing_error("Expecting a value after 'defaults-to'");
                    return;
                }
            } else {
                // No :defaults-to, so just add it to the list
                append_to_keyword_argument_list(function->keyword_arguments,
                                                arguments->value.pair.first->value.identifier,
                                                nullptr);
                arguments = next;
            }
        }
    }


    // Now we are also done with keyword arguments, lets check for
    // if there is a rest argument
    if (Memory::get_type(arguments) != Lisp_Object_Type::Pair) {
        if (arguments != Memory::nil)
            create_parsing_error("The lambda list must be nil terminated.");
        return;
    }

    if (Memory::get_type(arguments->value.pair.first) == Lisp_Object_Type::Keyword &&
        string_equal(arguments->value.pair.first->value.identifier, "rest"))
    {
        arguments = arguments->value.pair.rest;
        if (// arguments->type != Lisp_Object_Type::Pair ||
            Memory::get_type(arguments->value.pair.first) != Lisp_Object_Type::Symbol)
        {
            create_parsing_error("After the 'rest' marker there must follow a symbol.");
            return;
        }
        function->rest_argument = arguments->value.pair.first->value.identifier;
        if (arguments->value.pair.rest != Memory::nil) {
            create_parsing_error("The lambda list must end after the rest symbol");
        }
    } else {
        printf("this should not happen?");
        create_generic_error("What is happening?");
    }
}


proc list_length(Lisp_Object* node) -> int {
    if (node == Memory::nil)
        return 0;

    assert_type(node, Lisp_Object_Type::Pair);

    int len = 0;
    while (Memory::get_type(node) == Lisp_Object_Type::Pair) {
        ++len;
        node = node->value.pair.rest;
        if (node == Memory::nil)
            return len;
    }

    create_parsing_error("Can't calculate length of ill formed list.");
    return 0;
}

proc extract_keyword_value(char* keyword, Parsed_Arguments* args) -> Lisp_Object* {
    // NOTE(Felix): This will be a hashmap lookup later
    for (int i = 0; i < args->keyword_keys->next_index; ++i) {
        if (string_equal(args->keyword_keys->data[i]->value.identifier, keyword))
            return args->keyword_values->data[i];
    }
    return nullptr;
}

proc eval_arguments(Lisp_Object* arguments, Environment* env, int *out_arguments_length) -> Lisp_Object* {
    int my_out_arguments_length = 0;
    if (arguments == Memory::nil) {
        *(out_arguments_length) = 0;
        return arguments;
    }

    Lisp_Object* evaluated_arguments;
    try evaluated_arguments = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);

    Lisp_Object* evaluated_arguments_head = evaluated_arguments;
    Lisp_Object* current_head = arguments;

    while (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
        try evaluated_arguments_head->value.pair.first = eval_expr(current_head->value.pair.first, env);

        evaluated_arguments_head->value.pair.first->sourceCodeLocation = current_head->value.pair.first->sourceCodeLocation;
        current_head = current_head->value.pair.rest;

        if (Memory::get_type(current_head) == Lisp_Object_Type::Pair) {
            try evaluated_arguments_head->value.pair.rest = Memory::create_lisp_object_pair(Memory::nil, Memory::nil);
            evaluated_arguments_head = evaluated_arguments_head->value.pair.rest;
        } else if (current_head == Memory::nil) {
            evaluated_arguments_head->value.pair.rest = current_head;
        } else {
            create_parsing_error("Attempting to evaluate ill formed argument list.");
            return nullptr;
        }
        ++my_out_arguments_length;
    }
    *(out_arguments_length) = my_out_arguments_length;
    return evaluated_arguments;
}

proc eval_expr(Lisp_Object* node, Environment* env) -> Lisp_Object* {
    Globals::current_source_code = node;

    switch (Memory::get_type(node)) {
    case Lisp_Object_Type::T:
    case Lisp_Object_Type::Nil:
    case Lisp_Object_Type::Number:
    case Lisp_Object_Type::Keyword:
    case Lisp_Object_Type::String:
        return node;
    case Lisp_Object_Type::Symbol: {
        Lisp_Object* symbol;
        try symbol = lookup_symbol(node, env);

        return symbol;
    }
    case Lisp_Object_Type::Pair: {

        Lisp_Object* lispOperator;
        if (Memory::get_type(node->value.pair.first) != Lisp_Object_Type::CFunction &&
            Memory::get_type(node->value.pair.first) != Lisp_Object_Type::Function)
        {
            try lispOperator = eval_expr(node->value.pair.first, env);
        } else {
            lispOperator = node->value.pair.first;
        }

        Lisp_Object* arguments = node->value.pair.rest;
        int arguments_length;

        // check for c function
        if (Memory::get_type(lispOperator) == Lisp_Object_Type::CFunction) {
            Lisp_Object* result = lispOperator->value.cFunction->function(arguments, env);
            return result;
        }

        // check for lisp function
        if (Memory::get_type(lispOperator) == Lisp_Object_Type::Function) {
            // only for lambdas we evaluate the arguments before
            // apllying
            if (lispOperator->value.function.type == Function_Type::Lambda) {
                try arguments = eval_arguments(arguments, env, &arguments_length);
            }

            Lisp_Object* result;
            try result = apply_arguments_to_function(arguments, &lispOperator->value.function);
            return result;
        }
    }
    default: {
        create_generic_error("%s is not a function.", Lisp_Object_Type_to_string(Memory::get_type(node)));
        return nullptr;
    }
    }
}

proc is_truthy(Lisp_Object* expression, Environment* env) -> bool {
    Lisp_Object* result;
    try result = eval_expr(expression, env);
    return result != Memory::nil;
}

proc interprete_file (char* file_name) -> Lisp_Object* {
    Memory::init(4096 * 256, 4096 * 256);
    Environment* root_env = Globals::root_environment;
    Environment* user_env = Memory::create_child_environment(root_env);
    Parser::environment_for_macros = user_env;

    char* file_content;
    try file_content = read_entire_file(file_name);

    built_in_load(Memory::create_string("pre.slime"), root_env);

    Lisp_Object_Array_List* program;
    program = Parser::parse_program(Memory::create_string(file_name), file_content);

    Lisp_Object* result = Memory::nil;
    for (int i = 0; i < program->next_index; ++i) {
        result = eval_expr(program->data[i], user_env);

        if (Globals::error) {
            log_error();
            delete_error();
            return nullptr;
        }
    }

    return result;
}

proc interprete_stdin() -> void {
    Memory::init(4096 * 256, 4096 * 256);
    Environment* root_env = Globals::root_environment;
    Environment* user_env = Memory::create_child_environment(root_env);
    Parser::environment_for_macros = user_env;

    printf("Welcome to the lispy interpreter.\n");

    char* line;

    built_in_import(Memory::create_string("pre.slime"), user_env);

    if (Globals::error) {
        log_error();
        delete_error();
    }

    Lisp_Object* parsed, * evaluated;
    while (true) {
        printf(">");
        line = read_expression();
        parsed = Parser::parse_single_expression(line);
        free(line);
        if (Globals::error) {
            log_error();
            delete_error();
            continue;
        }
        evaluated = eval_expr(parsed, user_env);
        if (Globals::error) {
            log_error();
            delete_error();
            continue;
        }
        print(evaluated);
        printf("\n");
    }
}