NAME

src/pmc/perl6multiub.pmc - Perl 6 MultiSub PMC

DESCRIPTION

Subclass of MultiSub that overrides invoke to implement the Perl 6 multiple dispatch algorithm, along with providing various other pieces.

Since we need to store some extra information, we cannot just actually be a ResizablePMCArray, but rather we need to have one.

TODO

This is a list of things that I need to deal with/come back and worry about later (it's not a complete todo list for finishing up the PMC itself, just of fixup tasks in what is already done).

Use Perl 6 types when boxing native arguments in the arg list

Fix pmc2c so we can have ATTR candidate_info **candidates_sorted. We will have to move them to their own .h file, but in pmc2c we need to be able to include that *before* this PMC's generated .h file (I couldn't work out how to do that) and also make it parse double indirections. Then we can toss any (candidate_info**) casts.

Make sure we override everything that ResizablePMCArray and its parents would provide us with. Otherwise, we'll just get segfaults 'cus we don't store stuff the way it does.

INTERNAL STRUCTURES

We have some structures that we use to keep data around internally.

candidate_info

Represents a candidate. We extract various bits of information about it when we are building the sorted candidate list and store them in here for fast access during a dispatch.

*/

#include "parrot/oplib/ops.h"

typedef struct candidate_info { PMC *sub; /* The sub that is the candidate. */ INTVAL min_arity; /* The number of required positonal arguments. */ INTVAL max_arity; /* The number of required and optional positional arguments. */ PMC **types; /* Class or role type constraints for each parameter. */ PMC **constraints; /* Refinement type constraints for each parameter (if there * are many, this will be a junction). */ INTVAL num_types; /* Number of entries in the above two arrays. */ } candidate_info;

/*

candidate_graph_node

Represents the produced information about a candidate as well as the graph edges originating from it. The edges array contains pointers to the edges in the graph that we have arrows to.

*/ typedef struct candidate_graph_node { candidate_info *info; struct candidate_graph_node **edges; INTVAL edges_in; INTVAL edges_out; } candidate_graph_node;

/*

FUNCTIONS

These are worker functions used by the methods of the PMC, and not visible from the outside.

static PMC *get_args()

Gets a list of the arguments that are being passed, taking them from the registers and the constants table and flattening any :flat arguments as required. Returns a ResizablePMCArray of them.

static INTVAL is_narrower(PARROT_INTERP, candidate_info *a, candidate_info *b)

Takes two candidates and determines if the first one is narrower than the second. Returns a true value if they are.

*/ static INTVAL is_narrower(PARROT_INTERP, candidate_info *a, candidate_info *b) { STRING *ACCEPTS = CONST_STRING(interp, "ACCEPTS"); INTVAL narrower = 0; INTVAL tied = 0; INTVAL i;

    /* Check if they have the same number of effective parameters - if
     * not, incomparable. */
    if (a->num_types != b->num_types)
        return 0;

    /* Analyse each parameter in the two candidates. */
    for (i = 0; i < a->num_types; i++) {
        PMC *type_obj_a = a->types[i];
        PMC *type_obj_b = b->types[i];
        if (type_obj_a == type_obj_b) {
            /* Same type, so tied. */
            tied++;
        }
        else {
            PMC *accepts_meth_a = VTABLE_find_method(interp, type_obj_b, ACCEPTS);
            PMC *result_n = (PMC *) Parrot_run_meth_fromc_args(interp, accepts_meth_a, type_obj_b,
                    ACCEPTS, "PP", type_obj_a);
            if (VTABLE_get_integer(interp, result_n)) {
                /* Narrower - note it and we're done. */
                narrower++;
            }
            else {
                /* Make sure it's tied, rather than the other way around. */
                PMC *accepts_meth_b = VTABLE_find_method(interp, type_obj_a, ACCEPTS);
                PMC *result_w = (PMC *) Parrot_run_meth_fromc_args(interp,
                        accepts_meth_b, type_obj_a,
                        ACCEPTS, "PP", type_obj_b);
                if (!VTABLE_get_integer(interp, result_w)) {
                    tied++;
                }
            }
        }
    }

    return narrower > 1 && narrower + tied == a->num_types;
}

/*

static candidate_info** sort_candidiates(PMC *candidates)

Takes a ResizablePMCArray of the candidates, collects information about them and then does a topological sort of them.

*/ static candidate_info** sort_candidiates(PARROT_INTERP, PMC *candidates) { INTVAL i, j, sig_elems, candidates_to_sort, result_pos; PMC *signature, *params, *meth;

    /* Allocate results array (just allocate it for worst case, which
     * is no ties ever, so a null between all of them, and then space
     * for the terminating null. */
    INTVAL num_candidates = VTABLE_elements(interp, candidates);
    candidate_info** result = mem_allocate_n_zeroed_typed(
            2 * num_candidates + 1, candidate_info*);

    /* Create a node for each candidate in the graph. */
    candidate_graph_node** graph = mem_allocate_n_zeroed_typed(
            num_candidates, candidate_graph_node*);
    for (i = 0; i < num_candidates; i++) {
        /* Get information about this candidate. */
        candidate_info *info = mem_allocate_zeroed_typed(candidate_info);
        PMC *candidate = VTABLE_get_pmc_keyed_int(interp, candidates, i);
        info->sub = candidate;

        /* Arity. */
        info->min_arity = VTABLE_get_integer(interp,
                VTABLE_inspect_str(interp, candidate, CONST_STRING(interp, "pos_required")));
        if (VTABLE_get_integer(interp, VTABLE_inspect_str(interp, candidate,
               CONST_STRING(interp, "pos_slurpy"))))
            info->max_arity = 1 << 30;
        else
            info->max_arity = info->min_arity + VTABLE_get_integer(interp,
                    VTABLE_inspect_str(interp, candidate, CONST_STRING(interp, "pos_optional")));

        /* Type information. */
        meth = VTABLE_find_method(interp, candidate,
                CONST_STRING(interp, "signature"));
        signature = (PMC*)Parrot_run_meth_fromc_args(interp, meth, candidate,
                CONST_STRING(interp, "signature"), "P");
        meth = VTABLE_find_method(interp, signature,
                CONST_STRING(interp, "params"));
        params = (PMC*)Parrot_run_meth_fromc_args(interp, meth, signature,
                CONST_STRING(interp, "params"), "P");
        sig_elems = VTABLE_elements(interp, params);
        info->types = mem_allocate_n_zeroed_typed(sig_elems + 1, PMC*);
        info->constraints = mem_allocate_n_zeroed_typed(sig_elems + 1, PMC*);
        for (j = 0; j < sig_elems; j++) {
            PMC *param = VTABLE_get_pmc_keyed_int(interp, params, j);
            PMC *type = VTABLE_get_pmc_keyed_str(interp, param,
                    CONST_STRING(interp, "type"));
            PMC *constraints = VTABLE_get_pmc_keyed_str(interp, param,
                    CONST_STRING(interp, "constraints"));
            info->types[j] = type;
            info->constraints[j] = constraints;
        }
        info->num_types = sig_elems;

        /* Add it to graph node, and initialize list of edges. */
        graph[i] = mem_allocate_zeroed_typed(candidate_graph_node);
        graph[i]->info = info;
        graph[i]->edges = mem_allocate_n_zeroed_typed(num_candidates, candidate_graph_node*);
    }

    /* Now analyze type narrowness of the candidates relative to each other
     * and create the edges. */
    for (i = 0; i < num_candidates; i++) {
        for (j = 0; j < num_candidates; j++) {
            if (i == j)
                continue;
            if (is_narrower(interp, graph[i]->info, graph[j]->info)) {
                graph[i]->edges[graph[i]->edges_out] = graph[j];
                graph[i]->edges_out++;
                graph[j]->edges_in++;
            }
        }
    }

    /* Perform the topological sort. */
    candidates_to_sort = num_candidates;
    result_pos = 0;
    while (candidates_to_sort > 0) {
        INTVAL rem_start_point = result_pos;

        /* Find any nodes that have no incoming edges and add them to results. */
        for (i = 0; i < num_candidates; i++) {
            if (graph[i]->edges_in == 0) {
                /* Add to results. */
                result[result_pos] = graph[i]->info;
                result_pos++;
                candidates_to_sort--;
                graph[i]->edges_in = -1;

                /* Now we have added this node, remove its outgoing edges. */
                for (j = 0; j < graph[i]->edges_out; j++)
                    graph[i]->edges[j]->edges_in--;
            }
        }
        if (rem_start_point == result_pos)
            Parrot_ex_throw_from_c_args(interp, 0, 1,
                    "Circularity detected in multi sub types.");

        /* This is end of a tied group, so leave a gap. */
        result_pos++;
    }

    return result;
}

/*

static PMC *do_dispatch(candidate_info** candidates, int many)

Runs the Perl 6 MMD algorithm. If many is set to a true value, returns a ResizablePMCArray of all possible candidates, which may be empty. If many is false, then returns either the one winning unambiguous candidate or throws an error saying that the dispatch failed if there were no candidates or that it was ambiguous if there were tied candidates.

*/

static PMC* do_dispatch(PARROT_INTERP, candidate_info** candidates, PMC *args, int many, int num_candidates, opcode_t *next) { INTVAL i, j, type_check_count; INTVAL num_args = VTABLE_elements(interp, args); candidate_info **cur_candidate = candidates; candidate_info **possibles = mem_allocate_n_typed(num_candidates, candidate_info*); INTVAL possibles_count = 0; INTVAL type_mismatch; STRING *ACCEPTS = CONST_STRING(interp, "ACCEPTS");

    /* Iterate over the candidates and collect best ones; terminate
     * when we see two nulls (may break out earlier). */
    while (cur_candidate[0] != NULL || cur_candidate[1] != NULL) {
        if (*cur_candidate == NULL) {
            /* If we're after just one candidate and we have found some, then
             * we've hit the end of a tied group now, so stop looking if we are
             * only after one. */
            if (!many && possibles_count)
                break;
            cur_candidate++;
            continue;
        }

        /* Check if it's admissable by arity. */
        if (num_args < (*cur_candidate)->min_arity || num_args > (*cur_candidate)->max_arity) {
            cur_candidate++;
            continue;
        }

        /* Check if it's admissable by type. */
        type_check_count = (*cur_candidate)->num_types > num_args ?
                num_args : (*cur_candidate)->num_types;
        type_mismatch = 0;
        for (i = 0; i < type_check_count; i++) {
            PMC *param = VTABLE_get_pmc_keyed_int(interp, args, i);
            PMC *type_obj = (*cur_candidate)->types[i];
            PMC *accepts_meth = VTABLE_find_method(interp, type_obj, ACCEPTS);
            PMC *result = (PMC*)Parrot_run_meth_fromc_args(interp, accepts_meth, type_obj,
                    ACCEPTS, "PP", param);
            if (!VTABLE_get_integer(interp, result)) {
                type_mismatch = 1;
                break;
            }
        }
        if (type_mismatch) {
            cur_candidate++;
            continue;
        }

        /* If we get here, it's an admissable candidate; add to list. */
        possibles[possibles_count] = *cur_candidate;
        possibles_count++;
        cur_candidate++;
    }

    /* If we have multiple candidates left, tie-break on any constraints. */
    if (possibles_count > 1) {
        candidate_info **matching = mem_allocate_n_typed(possibles_count, candidate_info*);
        candidate_info **constraint_free = mem_allocate_n_typed(possibles_count, candidate_info*);
        INTVAL matching_count = 0;
        INTVAL constraint_free_count = 0;
        for (i = 0; i < possibles_count; i++) {
            /* Check if we match any constraints. */
            INTVAL constraint_checked = 0;
            INTVAL constraint_failed = 0;
            for (j = 0; j < possibles[i]->num_types; j++) {
                PMC *type_obj = possibles[i]->constraints[j];
                if (!PMC_IS_NULL(type_obj)) {
                    PMC *param = VTABLE_get_pmc_keyed_int(interp, args, j);
                    PMC *result = Parrot_runops_fromc_args(interp, type_obj,
                            "PP", param);
                    constraint_checked = 1;
                    if (!VTABLE_get_integer(interp, result)) {
                        constraint_failed = 1;
                        break;
                    }
                }
            }
            if (!constraint_failed) {
                if (constraint_checked) {
                    matching[matching_count] = possibles[i];
                    matching_count++;
                }
                else {
                    constraint_free[constraint_free_count] = possibles[i];
                    constraint_free_count++;
                }
            }
        }

        /* If we did find constraints to check, choose the matching over the
         * ones without any constraints. */
        if (matching_count) {
            mem_sys_free(possibles);
            mem_sys_free(constraint_free);
            possibles = matching;
            possibles_count = matching_count;
        }
        else if (constraint_free_count) {
            mem_sys_free(possibles);
            mem_sys_free(matching);
            possibles = constraint_free;
            possibles_count = constraint_free_count;
        }
    }

    /* XXX Check is default trait */

    /* XXX If still none/ambiguous, try and find a proto to call. */

    if (!many) {
        /* Need a unique candidate. */
        if (possibles_count == 1) {
            return possibles[0]->sub;
        }
        else if (possibles_count == 0) {
            Parrot_ex_throw_from_c_args(interp, next, 1,
                    "No applicable candidates found to dispatch to.");
        }
        else {
            Parrot_ex_throw_from_c_args(interp, next, 1,
                    "Ambiguous dispatch.");
        }
    }
}

/*

static int assert_invokable(PARROT_INTERP, PMC *value)

Checks if a PMC is invokable; returns a true value if so and a false value if not.

*/ static int check_invokable(PARROT_INTERP, PMC *value) { STRING * const _sub = CONST_STRING(interp, "Sub"); STRING * const _nci = CONST_STRING(interp, "NCI"); return VTABLE_isa(interp, value, _sub) || VTABLE_isa(interp, value, _nci); }

/*

ATTRIBUTES

candidates

Unsorted list of all candidates.

candidates_sorted

C array of canididate_info structures. It stores a sequence of candidates length one or greater that are tied, followed by a NULL, followed by the next bunch that are less narrow but tied and so forth. It is terminated by a double NULL.

METHODS

VTABLE void init()

Allocates the PMC's underlying storage.

VTABLE void destroy()

Frees the memory associated with this PMC's underlying storage.

VTABLE opcode_t invoke()

Does a dispatch to the best candidate with the current arguments, according to the Perl 6 MMD algorithm.

VTABLE void mark()

Marks the candidate list.

*/ VTABLE void mark() { PMC *candidates; GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates); if (!PMC_IS_NULL(candidates)) pobject_lives(interp, (PObj*)candidates); }

/*

VTABLE void push_pmc(PMC *sub)

Adds a new candidate to the candidate list.

VTABLE INTVAL elements()

Gets the number of candidate on the candidate list.