slime/src/eval.c

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

Ast_Node* apply_arguments_to_function(Ast_Node* arguments, Function* function, Environment* parent) {
    Environment* new_env = create_child_environment(parent);

    // positional arguments
    for (int i = 0; i < function->positional_arguments->next_index; ++i) {
        if (arguments->type == Ast_Node_Type_Pair) {
            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);
            return nullptr;
        }
        arguments = arguments->value.pair->rest;
    }

    Ast_Node* result;

    try {
        result = eval_expr(function->body, new_env);
    }

    return result;
}

/* (define type (lambda (e) (if (and (= (old-type e) :pair) (= (first e) :my-type)) :my-type (old-type 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);
                return;
            }
        }

        if (arguments->value.pair->first->type != Ast_Node_Type_Symbol) {
            create_error(Error_Type_Ill_Formed_Lambda_List, arguments);
            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);
        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);
            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);
                    return;
                }
            }

            if (arguments->value.pair->first->type != Ast_Node_Type_Symbol) {
                create_error(Error_Type_Ill_Formed_Lambda_List, arguments);
                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);
                    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);
        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);
            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);
        }
    } else {
        printf("this should not happen?");
        create_error(Error_Type_Unknown_Error, arguments);
    }
}


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);
        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);
    return 0;
}

/**
   Copies a list, in that it creates a new list, however the items are
   the same as in the original (same pointers). This is needed to copy
   a list when evaluating a parameters list, but not wanting to change
   the parameters list. This happens if you have someting like:

   (define a 10)
   (define condition (quote (= a 10)))
   (eval condition)
   > 1.00000

   If we wouldn't copy the parameters list, after calling eval would
   be baked into the quoted list. So even after changing a, the result
   of (eval condition) would be 1.00000.
**/
Ast_Node* copy_list(Ast_Node* node) {
    // we don't copy immutables in here
    if (node->type != Ast_Node_Type_Pair) {
        return node;
    }

    Ast_Node* result = new(Ast_Node);
    result->type = Ast_Node_Type_Pair;
    result->value.pair = new(Pair);

    result->value.pair->first = copy_list(node->value.pair->first);
    result->value.pair->rest  = copy_list(node->value.pair->rest);

    return result;
}

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);
            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);              \
        return nullptr;                         \
    }
    if (error)
        return nullptr;

    Ast_Node* ret = new(Ast_Node);
    switch (node->type) {
    case Ast_Node_Type_Nil:
        ret->type = Ast_Node_Type_Nil;
        return ret;
    case Ast_Node_Type_Symbol: {
        Ast_Node* symbol;
        try {
            symbol = lookup_symbol(node->value.symbol, 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* operator;
        if (node->value.pair->first->type != Ast_Node_Type_Built_In_Function) {
            try {
                operator = eval_expr(node->value.pair->first, env);
            }
        } else {
                operator = node->value.pair->first;
        }

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

        // check for special form
        if (operator->type == Ast_Node_Type_Built_In_Function) {
            switch (operator->value.built_in_function->type) {
            case Built_In_Lambda: {
                /*
                 *  (lambda ())
                 *  (lambda (x d) (+ 1 2) (- 1 2) (* 1 2))
                 */
                try {
                    arguments_length = list_length(arguments);
                }
                if (arguments_length == 0)
                    report_error(Error_Type_Wrong_Number_Of_Arguments);


                Function* function = new(Function);
                // if parameters were specified
                if (arguments->value.pair->first->type != Ast_Node_Type_Nil) {
                    try {
                        assert_type(arguments->value.pair->first, Ast_Node_Type_Pair);
                    }
                    try {
                        parse_argument_list(arguments->value.pair->first, function);
                    }
                }

                arguments = arguments->value.pair->rest;
                // if there is a docstring, use it
                if (arguments->value.pair->first->type == Ast_Node_Type_String) {
                    function->docstring = arguments->value.pair->first->value.string->value;
                    arguments = arguments->value.pair->rest;
                }

                // we are now in the function body, just wrap it in an
                // implicit prog
                function->body = create_ast_node_pair(
                    create_ast_node_built_in_function("prog"),
                    arguments);

                Ast_Node* ret = new(Ast_Node);
                ret->type = Ast_Node_Type_Function;
                ret->value.function = function;
                return ret;
            }
            case Built_In_And: {
                bool result = true;
                while (arguments->type != Ast_Node_Type_Nil) {
                    if (arguments->type != Ast_Node_Type_Pair) {
                        report_error(Error_Type_Ill_Formed_List);
                    }
                    try {
                        result &= is_truthy(arguments->value.pair->first, env);
                    }
                    arguments = arguments->value.pair->rest;

                    if (!result) return create_ast_node_nil();
                }

                return create_ast_node_number(1);
            }
            case Built_In_Or: {
                bool result = false;
                while (arguments->type != Ast_Node_Type_Nil) {
                    if (arguments->type != Ast_Node_Type_Pair) {
                        report_error(Error_Type_Ill_Formed_List);
                    }
                    try {
                        result |= is_truthy(arguments->value.pair->first, env);
                    }
                    arguments = arguments->value.pair->rest;

                    if (result) return create_ast_node_number(1);;
                }

                return create_ast_node_nil();
            }
            case Built_In_Not: {
                try {
                    arguments_length = list_length(arguments);
                }
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                bool truthy;
                try {
                    truthy = is_truthy(arguments->value.pair->first, env);
                }
                if (truthy)
                    return create_ast_node_nil();
                return create_ast_node_number(1);
            }
            case Built_In_If: {
                try {
                    arguments_length = list_length(arguments);
                }
                if (arguments_length != 2 && arguments_length != 3) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }

                Ast_Node* condition = arguments->value.pair->first;
                Ast_Node* then_part = arguments->value.pair->rest;
                Ast_Node* else_part = then_part->value.pair->rest;

                bool truthy;
                try {
                    truthy = is_truthy(condition, env);
                }
                Ast_Node* result;
                if (truthy)
                    try{
                        result = eval_expr(then_part->value.pair->first, env);
                    }
                else if (arguments_length == 3)
                    try {
                        result = eval_expr(else_part->value.pair->first, env);
                    }
                else return create_ast_node_nil();
                return result;
            }
            case Built_In_Quote: {
                arguments_length = list_length(arguments);
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                return arguments->value.pair->first;
            }
            case Built_In_Define: {
                try {
                    arguments_length = list_length(arguments);
                }
                if (arguments_length != 2) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }

                Ast_Node* symbol = arguments->value.pair->first;
                if (symbol->type != Ast_Node_Type_Symbol)
                    report_error(Error_Type_Type_Missmatch);

                Ast_Node* value = arguments->value.pair->rest->value.pair->first;
                try {
                    value = eval_expr(value, env);
                }

                define_symbol(symbol, value, env);

                return value;
            }
            }

            // okay it is not a special form, so in any case we want
            // to evaluate the arguments; eval_arguments will also tell
            // us the arguments_length.
            Ast_Node* evaluated_arguments;
            try {
                evaluated_arguments = eval_arguments(arguments, env, &arguments_length);
            }

            switch (operator->value.built_in_function->type) {
            case Built_In_Addition: {
                return built_in_add(evaluated_arguments);
            }
            case Built_In_Subtraction: {
                return built_in_substract(evaluated_arguments);
            }
            case Built_In_Multiplication: {
                return built_in_multiply(evaluated_arguments);
            }
            case Built_In_Division: {
                return built_in_divide(evaluated_arguments);
            }
            case Built_In_Equal: {
                return built_in_equals(evaluated_arguments);
            }
            case Built_In_Pair: {
                if (arguments_length != 2) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                return create_ast_node_pair(evaluated_arguments->value.pair->first, evaluated_arguments->value.pair->rest->value.pair->first);
            }
            case Built_In_First: {
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                if (evaluated_arguments->value.pair->first->type == Ast_Node_Type_Nil)
                    return create_ast_node_nil();
                if (evaluated_arguments->value.pair->first->type != Ast_Node_Type_Pair)
                    report_error(Error_Type_Type_Missmatch);

                return evaluated_arguments->value.pair->first->value.pair->first;
            }
            case Built_In_Rest: {
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                if (evaluated_arguments->value.pair->first->type == Ast_Node_Type_Nil)
                    return create_ast_node_nil();
                if (evaluated_arguments->value.pair->first->type != Ast_Node_Type_Pair)
                    report_error(Error_Type_Type_Missmatch);

                return evaluated_arguments->value.pair->first->value.pair->rest;
            }
            case Built_In_Eval: {
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                Ast_Node* result;
                try {
                    result = eval_expr(evaluated_arguments->value.pair->first, env);
                }
                return result;
            }
            case Built_In_Prog: {
                if (evaluated_arguments->type == Ast_Node_Type_Nil)
                    return evaluated_arguments;

                // skip to the last evaluated operand and return it,
                // we use eval_arguments here instead of doing it
                // manually, because we want to increase code reuse,
                // but at the cost that we have to find the end of the
                // list again
                while (evaluated_arguments->value.pair->rest->type == Ast_Node_Type_Pair) {
                    evaluated_arguments = evaluated_arguments->value.pair->rest;
                }
                return evaluated_arguments->value.pair->first;
            }
            case Built_In_List: {
                return evaluated_arguments;
            }
            case Built_In_Print: {
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }
                print(evaluated_arguments->value.pair->first);
                printf("\n");
                return arguments->value.pair->first;
            }
            case Built_In_Read: {
                if (arguments_length > 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }

                if (arguments_length == 1) {
                    Ast_Node* prompt = evaluated_arguments->value.pair->first;
                    if (prompt->type == Ast_Node_Type_String)
                        printf("%s", prompt->value.string->value);
                    else
                        print(evaluated_arguments->value.pair->first);
                }
                char* line = read_line();
                return create_ast_node_string(line, (int)strlen(line));
            }
            case Built_In_Type: {
                if (arguments_length != 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }

                Ast_Node_Type type = evaluated_arguments->value.pair->first->type;
                switch (type) {
                case Ast_Node_Type_Built_In_Function: return create_ast_node_keyword("built-in-function");
                case Ast_Node_Type_Function:          return create_ast_node_keyword("dynamic-function");
                case Ast_Node_Type_Keyword:           return create_ast_node_keyword("keyword");
                case Ast_Node_Type_Nil:               return create_ast_node_keyword("nil");
                case Ast_Node_Type_Number:            return create_ast_node_keyword("number");
                case Ast_Node_Type_Pair:              return create_ast_node_keyword("pair");
                case Ast_Node_Type_String:            return create_ast_node_keyword("string");
                case Ast_Node_Type_Symbol:            return create_ast_node_keyword("symbol");
                }
            }
            case Built_In_Exit: {
                if (arguments_length > 1) {
                    report_error(Error_Type_Wrong_Number_Of_Arguments);
                }

                if (arguments_length == 1) {
                    Ast_Node* error_code = evaluated_arguments->value.pair->first;
                    if (error_code->type != Ast_Node_Type_Number)
                        report_error(Error_Type_Type_Missmatch);

                    exit((int)error_code->value.number->value);
                }
                exit(0);
            }

            default:
                report_error(Error_Type_Not_Yet_Implemented);
            }

        }

        // assume it's lambda function and evaluate the arguments
        arguments = eval_arguments(arguments, env, &arguments_length);
        if (operator->type == Ast_Node_Type_Function) {
            Ast_Node* result;
            try {
                result = apply_arguments_to_function(arguments, operator->value.function, env);
            }
            return result;
        }
    }

    default:
        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;

}