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

    // positional arguments
    for (int i = 0; i < function->positional_arguments->next_index; ++i) {
        if (arguments->type == Lisp_Object_Type::Pair) {
            // 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?
            define_symbol(
                Memory::create_lisp_object_symbol(function->positional_arguments->identifiers[i]),
                arguments->value.pair->first, new_env);
        } else {

            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            return nullptr;
        }
        arguments = arguments->value.pair->rest;
    }

    String_Array_List* read_in_keywords = create_String_array_list(16);

    if (arguments->type == Lisp_Object_Type::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 (arguments->value.pair->first->type == 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.keyword->identifier,
                    function->keyword_arguments->identifiers[i]))
            {
                accepted = true;
                break;
            }
        }
        if (!accepted) {
            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            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.keyword->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_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
                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 (arguments->value.pair->rest->type != Lisp_Object_Type::Pair) {
            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            return nullptr;
        }

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

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

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

        if (arguments->type == Lisp_Object_Type::Nil) {
            break;
        }
    }

  checks:
    // check if all necessary keywords have been read in
    for (int i = 0; i < function->keyword_arguments->next_index; ++i) {
        char* 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_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
                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) {
                define_symbol(
                    Memory::create_lisp_object_symbol(defined_keyword),
                    Memory::copy_lisp_object(function->keyword_arguments->values->data[i]), new_env);
            }
        }
    }


    if (arguments->type == Lisp_Object_Type::Nil) {
        if (function->rest_argument) {
            define_symbol(
                Memory::create_lisp_object_symbol(function->rest_argument),
                Memory::create_lisp_object_nil(), new_env);
        }
    } else {
        if (function->rest_argument) {
            define_symbol(
                Memory::create_lisp_object_symbol(function->rest_argument),
                arguments, new_env);
        } else {
            // rest was not declared but additional arguments were found
            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            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 (arguments->type == Lisp_Object_Type::Pair) {
        if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword) {
            if (string_equal(arguments->value.pair->first->value.keyword->identifier, "keys") ||
                string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
                break;
            else {
                create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
                return;
            }
        }

        if (arguments->value.pair->first->type != Lisp_Object_Type::Symbol) {
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
            return;
        }

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

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

    // okay we are done with positional arguments, lets check for
    // keywords,
    if (arguments->type != Lisp_Object_Type::Pair) {
        if (arguments->type != Lisp_Object_Type::Nil)
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
        return;
    }

    if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword &&
        string_equal(arguments->value.pair->first->value.keyword->identifier, "keys"))
    {
        arguments = arguments->value.pair->rest;
        if (arguments->type != Lisp_Object_Type::Pair ||
            arguments->value.pair->first->type != Lisp_Object_Type::Symbol)
        {
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
            return;
        }

        while (arguments->type == Lisp_Object_Type::Pair) {
            if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword) {
                if (string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
                    break;
                else {
                    create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
                    return;
                }
            }

            if (arguments->value.pair->first->type != Lisp_Object_Type::Symbol) {
                create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
                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 (next->type == Lisp_Object_Type::Pair &&
                next->value.pair->first->type == Lisp_Object_Type::Keyword &&
                string_equal(next->value.pair->first->value.keyword->identifier,
                              "defaults-to"))
            {
                // check if there is a next argument too, otherwise it
                // would be an error
                next = next->value.pair->rest;
                if (next->type == Lisp_Object_Type::Pair) {
                    append_to_keyword_argument_list(function->keyword_arguments,
                                                    arguments->value.pair->first->value.symbol->identifier,
                                                    next->value.pair->first);
                    arguments = next->value.pair->rest;
                } else {
                    create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
                    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.symbol->identifier,
                                                nullptr);
                arguments = next;
            }
        }
    }


    // Now we are also done with keyword arguments, lets check for
    // if there is a rest argument
    if (arguments->type != Lisp_Object_Type::Pair) {
        if (arguments->type != Lisp_Object_Type::Nil)
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
        return;
    }

    if (arguments->value.pair->first->type == Lisp_Object_Type::Keyword &&
        string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
    {
        arguments = arguments->value.pair->rest;
        if (arguments->type != Lisp_Object_Type::Pair ||
            arguments->value.pair->first->type != Lisp_Object_Type::Symbol)
        {
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
            return;
        }
        function->rest_argument = arguments->value.pair->first->value.symbol->identifier;
        if (arguments->value.pair->rest->type != Lisp_Object_Type::Nil) {
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
        }
    } else {
        printf("this should not happen?");
        create_error(Error_Type::Unknown_Error, arguments->sourceCodeLocation);
    }
}


proc list_length(Lisp_Object* node) -> int {
    if (node->type == Lisp_Object_Type::Nil)
        return 0;

    if (node->type != Lisp_Object_Type::Pair) {
        create_error(Error_Type::Type_Missmatch, node->sourceCodeLocation);
        return 0;
    }

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

    create_error(Error_Type::Ill_Formed_List, node->sourceCodeLocation);
    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.keyword->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->type == Lisp_Object_Type::Nil) {
        return arguments;
    }

    Lisp_Object* evaluated_arguments = Memory::create_lisp_object_pair(nullptr, nullptr);
    Lisp_Object* evaluated_arguments_head = evaluated_arguments;
    Lisp_Object* current_head = arguments;
    while (current_head->type == Lisp_Object_Type::Pair) {
        try {
            evaluated_arguments_head->value.pair->first =
                eval_expr(current_head->value.pair->first, env);
        }
        current_head = current_head->value.pair->rest;

        if (current_head->type == Lisp_Object_Type::Pair) {
            evaluated_arguments_head->value.pair->rest = Memory::create_lisp_object_pair(nullptr, nullptr);
            evaluated_arguments_head = evaluated_arguments_head->value.pair->rest;
        } else if (current_head->type == Lisp_Object_Type::Nil) {
            evaluated_arguments_head->value.pair->rest = current_head;
        } else {
            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            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* {
#define report_error(_type) {                           \
        create_error(_type, node->sourceCodeLocation);  \
        return nullptr;                                 \
    }

    if (error)
        return nullptr;

    switch (node->type) {
    case Lisp_Object_Type::T:
    case Lisp_Object_Type::Nil:
        return node;
    case Lisp_Object_Type::Symbol: {
        Lisp_Object* symbol;
        try {
            symbol = lookup_symbol(node, env);
        }
        return symbol;
    }
    case Lisp_Object_Type::Number:
    case Lisp_Object_Type::Keyword:
    case Lisp_Object_Type::String:
        return node;
    case Lisp_Object_Type::Pair: {
        Lisp_Object* lispOperator;
        if (node->value.pair->first->type != Lisp_Object_Type::CFunction &&
            node->value.pair->first->type != 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 (lispOperator->type == Lisp_Object_Type::CFunction) {
            Lisp_Object* result = lispOperator->value.cfunction->function(arguments, env);
            return result;
        }

        // check for lisp function
        if (lispOperator->type == 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: {
        report_error(Error_Type::Not_A_Function);
    }
    }
#undef report_error
}

proc is_truthy (Lisp_Object* expression, Environment* env) -> bool {
    Lisp_Object* result;
    try {
        result = eval_expr(expression, env);
    }
    if (result->type == Lisp_Object_Type::Nil)
        return false;
    return true;
}

proc interprete_file (char* file_name) -> Lisp_Object* {
    Memory::init();
    Environment* env = Memory::create_empty_environment();
    Parser::init(env);

    char* file_content = read_entire_file(file_name);
    if (!file_content) {
        create_error(Error_Type::Unknown_Error, nullptr);
    }

    load_built_ins_into_environment(env);

    try {
        built_in_load("pre.slime", env);
    }

    Lisp_Object_Array_List* program;
    try {
        program = Parser::parse_program(file_name, file_content);
    }

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

    return result;
}

proc interprete_stdin() -> void {
    Memory::init();
    Environment* env = Memory::create_built_ins_environment();
    Parser::init(env);

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

    char* line;

    built_in_load("pre.slime", env);
    built_in_load("test.slime", env);

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

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