slime/src/eval.cpp

Ast_Node* eval_expr(Ast_Node* node, Environment* env);

Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, Environment* parent) {
    // NOTE(Felix): if it is a macro, we will set it later, so we can
    // use the default "define_symbol" method here instead of
    // switching between "define_symbol" and "define_macro_symbol" all
    // the time

    Environment* new_env = create_child_environment(parent, Environment_Type::Lambda);

    // positional arguments
    for (int i = 0; i < function->positional_arguments->next_index; ++i) {
        if (arguments->type == Ast_Node_Type::Pair) {
            // TODO(Felix): here we create new ast_node_symbols from
            // their identifiers but before we converted them to
            // strings from symbols... Wo maybe just use the symbols?
            define_symbol(
                create_ast_node_symbol(function->positional_arguments->identifiers[i]),
                arguments->value.pair->first, new_env);
        } else {
            // not enough arguments given
            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            return nullptr;
        }
        arguments = arguments->value.pair->rest;
    }

    if (arguments->type == Ast_Node_Type::Nil)
        goto eval_time;

    String_Array_List* read_in_keywords = create_String_array_list(16);
    // 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 == Ast_Node_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 != Ast_Node_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(
            create_ast_node_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 == Ast_Node_Type::Nil) {
            break;
        }
    }


    // 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(
                    create_ast_node_symbol(defined_keyword),
                    copy_ast_node(function->keyword_arguments->values->data[i]), new_env);
            }
        }
    }


    if (arguments->type == Ast_Node_Type::Nil) {
        if (function->rest_argument) {
            define_symbol(
                create_ast_node_symbol(function->rest_argument),
                create_ast_node_nil(), new_env);
        }
    } else {
        if (function->rest_argument) {
            define_symbol(
                create_ast_node_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;
        }
    }

  eval_time: {
        Ast_Node* result;

        // don't have to check every time if it is macro environment or
        // not
        if (function->is_macro)
            new_env->type = Environment_Type::Macro;

        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
*/
void parse_argument_list(Ast_Node* arguments, Function* function) {
    // 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 == Ast_Node_Type::Pair) {
        if (arguments->value.pair->first->type == Ast_Node_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 != Ast_Node_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 != Ast_Node_Type::Pair) {
        if (arguments->type != Ast_Node_Type::Nil)
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
        return;
    }

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

        while (arguments->type == Ast_Node_Type::Pair) {
            if (arguments->value.pair->first->type == Ast_Node_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 != Ast_Node_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
            Ast_Node* next = arguments->value.pair->rest;
            if (next->type == Ast_Node_Type::Pair &&
                next->value.pair->first->type == Ast_Node_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 == Ast_Node_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 != Ast_Node_Type::Pair) {
        if (arguments->type != Ast_Node_Type::Nil)
            create_error(Error_Type::Ill_Formed_Lambda_List, arguments->sourceCodeLocation);
        return;
    }

    if (arguments->value.pair->first->type == Ast_Node_Type::Keyword &&
        string_equal(arguments->value.pair->first->value.keyword->identifier, "rest"))
    {
        arguments = arguments->value.pair->rest;
        if (arguments->type != Ast_Node_Type::Pair ||
            arguments->value.pair->first->type != Ast_Node_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 != Ast_Node_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);
    }
}


int list_length(Ast_Node* node) {
    if (node->type == Ast_Node_Type::Nil)
        return 0;

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

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

    create_error(Error_Type::Ill_Formed_List, node->sourceCodeLocation);
    return 0;
}

bool is_truthy (Ast_Node* expression, Environment* env);

Ast_Node* extract_keyword_value(char* keyword, Parsed_Arguments* args) {
    // 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;
}

Ast_Node* eval_arguments(Ast_Node* arguments, Environment* env, int *out_arguments_length) {
    *out_arguments_length = 0;
    if (arguments->type == Ast_Node_Type::Nil) {
        return arguments;
    }

    Ast_Node* evaluated_arguments = create_ast_node_pair(nullptr, nullptr);
    Ast_Node* evaluated_arguments_head = evaluated_arguments;
    Ast_Node* current_head = arguments;
    while (current_head->type == Ast_Node_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 == Ast_Node_Type::Pair) {
            evaluated_arguments_head->value.pair->rest = create_ast_node_pair(nullptr, nullptr);
            evaluated_arguments_head = evaluated_arguments_head->value.pair->rest;
        } else if (current_head->type == Ast_Node_Type::Nil) {
            evaluated_arguments_head->value.pair->rest = current_head;
        } else {
            create_error(Error_Type::Ill_Formed_Arguments, arguments->sourceCodeLocation);
            return nullptr;
        }
        ++(*out_arguments_length);
    }
    return evaluated_arguments;
}

Ast_Node* eval_expr(Ast_Node* node, Environment* env) {
#define report_error(_type) {                           \
        create_error(_type, node->sourceCodeLocation);  \
        return nullptr;                                 \
    }

    if (error)
        return nullptr;

    Ast_Node* ret = new(Ast_Node);
    switch (node->type) {
    case Ast_Node_Type::T:
    case Ast_Node_Type::Nil:
        return node;
    case Ast_Node_Type::Symbol: {
        Ast_Node* symbol;
        try {
            symbol = lookup_symbol(node, env);
        }
        return symbol;
    }
    case Ast_Node_Type::Number:
    case Ast_Node_Type::Keyword:
    case Ast_Node_Type::String:
        return node;
    case Ast_Node_Type::Pair: {
        Ast_Node* lispOperator;
        if (node->value.pair->first->type != Ast_Node_Type::CFunction &&
            node->value.pair->first->type != Ast_Node_Type::Function)
        {
            try {
                lispOperator = eval_expr(node->value.pair->first, env);
            }
        } else {
                lispOperator = node->value.pair->first;
        }

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

        // check for c function
        if (lispOperator->type == Ast_Node_Type::CFunction) {
            Ast_Node* result = lispOperator->value.cfunction->function(arguments, env);
            return result;
        }

        // check for list function
        if (lispOperator->type == Ast_Node_Type::Function) {
            if (!lispOperator->value.function->is_macro) {
                try {
                    arguments = eval_arguments(arguments, env, &arguments_length);
                }
            }

            Ast_Node* result;
            try {
                result = apply_arguments_to_function(arguments, lispOperator->value.function, env);
            }
            return result;
        }
    }
    default: {
#ifdef _DEBUG
        __debugbreak();
#endif
        report_error(Error_Type::Not_A_Function);
    }
    }
#undef report_error
}

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

}