/*
$Id: /mirror/trunk/languages/perl6/src/pmc/perl6multisub.pmc 35790 2009-01-19T15:42:50.660074Z jonathan  $
Copyright (C) 2008, The Perl Foundation.

=head1 NAME

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

=head1 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.

=head1 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).

=over 4

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

=item 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.

=back

=head1 INTERNAL STRUCTURES

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

=over 4

=item 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. */
    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. */
    INTVAL min_arity;   /* The number of required positonal arguments. */
    INTVAL max_arity;   /* # of required and optional positional arguments. */
} candidate_info;

/*

=item 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;


/* Some constants for candidate sorter. */
#define EDGE_REMOVAL_TODO -1
#define EDGE_REMOVED      -2

/* Some constants for the dispatcher. */
#define MMD_ONE_RESULT   0
#define MMD_MANY_RESULTS 1

/*

=back

=head1 FUNCTIONS

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

=over 4

=item C<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.

=cut

*/

PARROT_WARN_UNUSED_RESULT
PARROT_CANNOT_RETURN_NULL
static PMC*
get_args(PARROT_INTERP)
{
    INTVAL sig_len, i;
    PMC    *arg;
    PMC    *sig;

    /* Initialize results list. */
    PMC    * const arg_list       = pmc_new(interp, enum_class_ResizablePMCArray);

    /* Get constants table for current segment, so we can look up sig and any
     * constant arguments. */
    PackFile_Constant **constants = interp->code->const_table->constants;

    /* Make sure we have a place to source the current arguments from. */
    opcode_t   *args_op   = interp->current_args;
    if (!args_op)
        Parrot_ex_throw_from_c_args(interp, NULL, 1,
            "No arguments found to dispatch on");
    PARROT_ASSERT(*args_op == PARROT_OP_set_args_pc);

    /* Get the (Parrot calling conventions) signature PMC. */
    ++args_op;
    sig = constants[*args_op]->u.key;
    ASSERT_SIG_PMC(sig);
    sig_len = SIG_ELEMS(sig);

    /* If we have a zero-length signature, we're done. */
    if (sig_len == 0)
        return arg_list;

    /* Otherwise, we have arguments. */
    ++args_op;
    for (i = 0; i < sig_len; ++i, ++args_op) {
        INTVAL    type = SIG_ITEM(sig, i);
        const int idx  = *args_op;

        /* If we find a named argument, then we know there's no more positional
         * arguments, since they come before named. And we don't dispatch on
         * named arguments. */
        if (type & PARROT_ARG_NAME)
            break;

        /* Put the argument in the list. For some arguments, we must box them into
         * a PMC to be able to have them in the list. XXX Use Perl 6 box types. */
        switch (type & (PARROT_ARG_TYPE_MASK | PARROT_ARG_FLATTEN)) {
            case PARROT_ARG_INTVAL:
                /* Integer constants always in register. */
                arg = pmc_new(interp, enum_class_Integer);
                VTABLE_set_integer_native(interp, arg, REG_INT(interp, idx));
                VTABLE_push_pmc(interp, arg_list, arg);
                break;
            case PARROT_ARG_FLOATVAL:
                /* May have value in an N register or constants table. */
                arg = pmc_new(interp, enum_class_Float);
                if ((type & PARROT_ARG_CONSTANT))
                    VTABLE_set_number_native(interp, arg, constants[idx]->u.number);
                else
                    VTABLE_set_number_native(interp, arg, REG_NUM(interp, idx));
                VTABLE_push_pmc(interp, arg_list, arg);
                break;
            case PARROT_ARG_STRING:
                /* May have value in an S register or constnats table. */
                arg = pmc_new(interp, enum_class_String);
                if ((type & PARROT_ARG_CONSTANT))
                    VTABLE_set_string_native(interp, arg, constants[idx]->u.string);
                else
                    VTABLE_set_string_native(interp, arg, REG_STR(interp, idx));
                VTABLE_push_pmc(interp, arg_list, arg);
                break;
            case PARROT_ARG_PMC:
                /* May have value in a P register or constants table. */
                if ((type & PARROT_ARG_CONSTANT))
                    arg = constants[idx]->u.key;
                else
                    arg = REG_PMC(interp, idx);
                VTABLE_push_pmc(interp, arg_list, arg);
                break;
            case PARROT_ARG_FLATTEN | PARROT_ARG_PMC:  {
                /* Expand flattening arguments; just loop over the array that
                 * is being flattened and get all of the entries within it. */
                int j, n;
                const int idx = *args_op;
                arg           = REG_PMC(interp, idx);
                n             = VTABLE_elements(interp, arg);
                for (j = 0; j < n; ++j)
                    VTABLE_push_pmc(interp, arg_list,
                        VTABLE_get_pmc_keyed_int(interp, arg, j));
                break;
            }
            default:
                Parrot_ex_throw_from_c_args(interp, NULL, 1,
                        "Unknown signature type %d in Parrot_Perl6MultiSub_get_args", type);
                break;
        }
    }

    return arg_list;
}


/*

=item C<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.

=cut

*/
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;
}


/*

=item C<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.

=cut

*/
static candidate_info** sort_candidiates(PARROT_INTERP, PMC *candidates, PMC **proto_out) {
    INTVAL i, j, sig_elems, candidates_to_sort, result_pos;
    PMC    *signature, *params, *meth;
    PMC    *found_proto = PMCNULL;
    char   *error       = NULL;

    /* 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*);
    INTVAL insert_pos = 0;
    for (i = 0; i < num_candidates; i++) {
        candidate_info *info;

        /* Get information about this candidate. */
        PMC *candidate = VTABLE_get_pmc_keyed_int(interp, candidates, i);
        PMC *proto     = VTABLE_getprop(interp, candidate, CONST_STRING(interp, "proto"));

        /* Is it a proto? */
        if (!PMC_IS_NULL(proto) && VTABLE_get_bool(interp, proto)) {
            if (PMC_IS_NULL(found_proto))
                found_proto = candidate;
            else
                error = "Can only have one proto in a single scope.";
            continue;
        }

        /* Otherwise, need an entry. */
        info = mem_allocate_zeroed_typed(candidate_info);
        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. */
        signature = VTABLE_getprop(interp, candidate, CONST_STRING(interp, "$!signature"));
        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, "nom_type"));
            PMC *constraints = VTABLE_get_pmc_keyed_str(interp, param,
                    CONST_STRING(interp, "cons_type"));
            PMC *multi_inv   = VTABLE_get_pmc_keyed_str(interp, param,
                    CONST_STRING(interp, "multi_invocant"));
            info->types[j] = type;
            info->constraints[j] = constraints;
            if (!PMC_IS_NULL(multi_inv) && VTABLE_get_bool(interp, multi_inv))
                info->num_types++;
        }

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

    /* If we found duplicate protos, don't go any further. */
    if (!error) {
        /* The actual number of candidates needs to discount any protos. */
        num_candidates = insert_pos;

        /* 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 = EDGE_REMOVAL_TODO;
                }
            }
            if (rem_start_point == result_pos) {
                error = "Circularity detected in multi sub types.";
                break;
            }

            /* Now we need to decrement edges in counts for things that had edges
             * from candidates we added here. */
            for (i = 0; i < num_candidates; i++) {
                if (graph[i]->edges_in == EDGE_REMOVAL_TODO) {
                    for (j = 0; j < graph[i]->edges_out; j++)
                        graph[i]->edges[j]->edges_in--;
                    graph[i]->edges_in = EDGE_REMOVED;
                }
            }

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

    /* Free memory associated with the graph. */
    for (i = 0; i < num_candidates; i++) {
        if (error)
            mem_sys_free(graph[i]->info);
        mem_sys_free(graph[i]->edges);
        mem_sys_free(graph[i]);
    }
    mem_sys_free(graph);

    /* If we had an error, free memory for result array and throw exception. */
    if (error) {
        mem_sys_free(result);
        Parrot_ex_throw_from_c_args(interp, 0, 1, error);
    }

    *proto_out = found_proto;
    return result;
}


/*

=item C<static INTVAL has_junctional_args(PARROT_INTERP, PMC *args)>

Checks if any of the args are junctional.

=cut

*/

static INTVAL has_junctional_args(PARROT_INTERP, PMC *args) {
    INTVAL num_args  = VTABLE_elements(interp, args);
    STRING *junction = CONST_STRING(interp, "Junction");
    INTVAL i;
    for (i = 0; i < num_args; i++) {
        PMC *arg = VTABLE_get_pmc_keyed_int(interp, args, i);
        if (VTABLE_isa(interp, arg, junction))
            return 1;
    }
    return 0;
}


/*

=item C<static PMC* do_dispatch(PARROT_INTERP, PMC *self, candidate_info **candidates,
                                PMC *proto, PMC *args, int many, int num_candidates,
                                opcode_t *next, MMD_Cache *cache)>

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.

=cut

*/

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

    /* Iterate over the candidates and collect best ones; terminate
     * when we see two nulls (may break out earlier). */
    while (cur_candidate[0] || cur_candidate[1]) {
        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're at a single candidate here, it's safe to cache for the future,
     * since it's a purely structural type-based rather than value based
     * dispatch. Note that we could also store the current candidate set and
     * re-enter the dispatch algorithm below, making it cheaper to get to that
     * point. */
    if (possibles_count == 1 && cache)
        Parrot_mmd_cache_store_by_values(interp, cache, "", args, possibles[0]->sub);

    /* 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 *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);
                    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;
        }
        else {
            possibles_count = 0;
            mem_sys_free(matching);
            mem_sys_free(constraint_free);
        }
    }

    /* Check is default trait if we still have multiple options. */
    if (possibles_count > 1) {
        /* Locate any default candidates; if we find multiple defaults, this is
         * no help, so we'll not bother collection just which ones are good. */
        candidate_info *default_cand = NULL;
        for (i = 0; i < possibles_count; i++) {
            PMC *default_prop = VTABLE_getprop(interp, possibles[i]->sub,
                    CONST_STRING(interp, "default"));
            if (!PMC_IS_NULL(default_prop)) {
                if (default_cand == NULL) {
                    default_cand = possibles[i];
                }
                else {
                    default_cand = NULL;
                    break;
                }
            }
        }
        if (default_cand) {
            possibles[0] = default_cand;
            possibles_count = 1;
        }
    }

    if (!many) {
        /* Need a unique candidate. */
        if (possibles_count == 1) {
            return possibles[0]->sub;
        }
        else if (possibles_count == 0 && has_junctional_args(interp, args)) {
            /* Look up multi junction dispatcher, clone it, attach this multi-sub
             * as a property and hand that back as the dispatch result. We also
             * stick it in the MMD cache for next time around. */
            PMC *sub = Parrot_find_global_n(interp, Parrot_get_ctx_HLL_namespace(interp),
                    CONST_STRING(interp, "!DISPATCH_JUNCTION_MULTI"));
            sub = VTABLE_clone(interp, sub);
            VTABLE_setprop(interp, sub, CONST_STRING(interp, "sub"), self);
            if (cache)
                Parrot_mmd_cache_store_by_values(interp, cache, "", args, sub);
            return sub;
        }
        else if (!PMC_IS_NULL(proto)) {
            /* If we have a proto at this point, use that. */
            return proto;
        }
        else if (possibles_count == 0) {
            Parrot_ex_throw_from_c_args(interp, next, 1,
                "No applicable candidates found to dispatch to for '%Ss'",
                    VTABLE_get_string(interp, candidates[0]->sub));
        }
        else {
            /* Get signatures of ambiguous candidates. */
            STRING *sig_name = CONST_STRING(interp, "signature");
            STRING *perl_name = CONST_STRING(interp, "perl");
            STRING *newline = CONST_STRING(interp, "\n");
            STRING *signatures = string_from_cstring(interp, "", 0);
            for (i = 0; i < possibles_count; i++) {
                PMC    *sig_meth  = VTABLE_find_method(interp, possibles[i]->sub, sig_name);
                PMC    *sig_obj   = (PMC *)Parrot_run_meth_fromc_args(interp, sig_meth,
                        possibles[i]->sub, sig_name, "P");
                PMC    *perl_meth = VTABLE_find_method(interp, sig_obj, perl_name);
                STRING *sig_perl  = (STRING *)Parrot_run_meth_fromc_args(interp, perl_meth,
                        sig_obj, perl_name, "S");
                signatures = string_append(interp, signatures, sig_perl);
                signatures = string_append(interp, signatures, newline);
            }
            Parrot_ex_throw_from_c_args(interp, next, 1,
                "Ambiguous dispatch to multi '%Ss'. Ambiguous candidates had signatures:\n%Ss",
                    VTABLE_get_string(interp, candidates[0]->sub), signatures);
        }
    }
    else {
        /* Build PMC array of all possibles. */
        PMC *results = pmc_new(interp, enum_class_ResizablePMCArray);
        for (i = 0; i < possibles_count; i++)
            VTABLE_push_pmc(interp, results, possibles[i]->sub);
        return results;
    }
}

/*

=item C<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.

=cut

*/
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);
}

/*

=back

=head1 ATTRIBUTES

=over 4

=item candidates

Unsorted list of all candidates.

=item 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.

=item cache

A multiple dispatch cache, which memorizes the types we were invoked with so
we can dispatch more quickly.

=item proto

The proto that is in effect.

=back

=head1 METHODS

=over 4

=cut

*/


pmclass Perl6MultiSub extends MultiSub need_ext dynpmc group perl6_group {
    ATTR PMC  *candidates;
    ATTR struct candidate_info **candidates_sorted;
    ATTR MMD_Cache *cache;
    ATTR PMC *proto;

/*

=item VTABLE void init()

Allocates the PMC's underlying storage.

=cut

*/
    VTABLE void init() {
        MMD_Cache *cache;

        /* Allocate the underlying struct and make candidate list an empty
         * ResizablePMCArray. */
        PMC *candidates = pmc_new(interp, enum_class_ResizablePMCArray);
        PMC_data(SELF) = mem_allocate_zeroed_typed(Parrot_Perl6MultiSub_attributes);
        SETATTR_Perl6MultiSub_candidates(interp, SELF, candidates)

        /* Set up a cache. */
        cache = Parrot_mmd_cache_create(interp);
        SETATTR_Perl6MultiSub_cache(interp, SELF, cache)

        /* Need custom mark and destroy. */
        PObj_custom_mark_SET(SELF);
        PObj_active_destroy_SET(SELF);
    }

/*

=item VTABLE void destroy()

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

=cut

*/
    VTABLE void destroy() {
        candidate_info **candidates = NULL;
        MMD_Cache *cache;

        /* If we built a sorted candidate list, free that. */
        GETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
        if (candidates) {
            candidate_info **cur_candidate = candidates;
            while (cur_candidate[0] || cur_candidate[1]) {
                if (*cur_candidate)
                    mem_sys_free(*cur_candidate);
                cur_candidate++;
            }
            mem_sys_free(candidates);
        }

        /* Free the cache. */
        GETATTR_Perl6MultiSub_cache(interp, SELF, cache)
        Parrot_mmd_cache_destroy(interp, cache);

        /* Free memory associated with this PMC's underlying struct. */
        mem_sys_free(PMC_data(SELF));
        PMC_data(SELF) = NULL;
    }

    VTABLE PMC* get_pmc_keyed_int(INTVAL value) {
        PMC *candidates;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        return VTABLE_get_pmc_keyed_int(interp, candidates, value);
    }

/*

=item VTABLE opcode_t invoke()

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

=cut

*/
    VTABLE opcode_t *invoke(void *next) {
        PMC             *found;
        MMD_Cache       *cache;
        candidate_info **candidates = NULL;
        PMC             *unsorted;

        /* Get arguments. */
        PMC *args                   = get_args(interp);

        /* Need to make sure a wobload of globals don't get destroyed. */
        PMC      *saved_ccont       = interp->current_cont;
        opcode_t *current_args      = interp->current_args;
        opcode_t *current_params    = interp->current_params;
        opcode_t *current_returns   = interp->current_returns;
        PMC      *args_signature    = interp->args_signature;
        PMC      *params_signature  = interp->params_signature;
        PMC      *returns_signature = interp->returns_signature;

        /* See if we have a cache entry. */
        GETATTR_Perl6MultiSub_cache(interp, SELF, cache);
        found = Parrot_mmd_cache_lookup_by_values(interp, cache, "", args);
        if (PMC_IS_NULL(found)) {
            PMC *proto;

            /* Make sure that we have a candidate list built. */
            GETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
            GETATTR_Perl6MultiSub_candidates(interp, SELF, unsorted);
            GETATTR_Perl6MultiSub_proto(interp, SELF, proto);

            if (!candidates) {
                candidates = sort_candidiates(interp, unsorted, &proto);
                SETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
                SETATTR_Perl6MultiSub_proto(interp, SELF, proto);
            }

            if (!candidates)
                Parrot_ex_throw_from_c_args(interp, next, 1,
                    "Failed to build candidate list");

            /* Now do the dispatch on the args we are being invoked with;
             * if it can't find anything, it will throw the required exception. */
            found = do_dispatch(interp, SELF, candidates, proto, args, MMD_ONE_RESULT,
                    VTABLE_elements(interp, unsorted), (opcode_t *)next, cache);
        }

        /* Restore stuff that might have got overwriten by calls during the
         * dispatch algorithm. */
        interp->current_cont      = saved_ccont;
        interp->current_args      = current_args;
        interp->current_params    = current_params;
        interp->current_returns   = current_returns;
        interp->args_signature    = args_signature;
        interp->params_signature  = params_signature;
        interp->returns_signature = returns_signature;

        /* Invoke the winner. */
        return VTABLE_invoke(interp, found, next);
    }

/*

=item METHOD PMC *find_possible_candidates()

Takes an array of arguments and finds all possible matching candidates.

=cut

*/
    METHOD PMC *find_possible_candidates(PMC *args :slurpy) {
        candidate_info **candidates = NULL;
        PMC             *unsorted;
        PMC             *proto;
        PMC             *results;

        /* Need to make sure a wobload of globals don't get destroyed. */
        PMC      *saved_ccont       = interp->current_cont;
        opcode_t *current_args      = interp->current_args;
        opcode_t *current_params    = interp->current_params;
        opcode_t *current_returns   = interp->current_returns;
        PMC      *args_signature    = interp->args_signature;
        PMC      *params_signature  = interp->params_signature;
        PMC      *returns_signature = interp->returns_signature;

        /* Make sure that we have a candidate list built. */
        GETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
        GETATTR_Perl6MultiSub_candidates(interp, SELF, unsorted);
        GETATTR_Perl6MultiSub_proto(interp, SELF, proto);

        if (!candidates) {
            candidates = sort_candidiates(interp, unsorted, &proto);
            SETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
            SETATTR_Perl6MultiSub_proto(interp, SELF, proto);
        }

        if (!candidates)
            Parrot_ex_throw_from_c_args(interp, NULL, 1,
                "Failed to build candidate list");

        /* Now do the dispatch on the args we have been supplied with, and
         * get back a PMC array of possibles. */
        results = do_dispatch(interp, SELF, candidates, proto, args, MMD_MANY_RESULTS,
                VTABLE_elements(interp, unsorted), NULL, NULL);

        /* Restore stuff that might have got overwriten by calls during the
         * dispatch algorithm. */
        interp->current_cont      = saved_ccont;
        interp->current_args      = current_args;
        interp->current_params    = current_params;
        interp->current_returns   = current_returns;
        interp->args_signature    = args_signature;
        interp->params_signature  = params_signature;
        interp->returns_signature = returns_signature;

        /* Return the results that were found. */
        RETURN(PMC *results);
    }

/*

=item C<VTABLE void mark()>

Marks the candidate list.

=cut

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

/*

=item VTABLE void push_pmc(PMC *sub)

Adds a new candidate to the candidate list.

=cut

*/
    VTABLE void push_pmc(PMC *sub) {
        PMC *candidates;
        MMD_Cache *cache;

        /* Make sure it's invokable. */
        if (!check_invokable(interp, sub))
            Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                    "Cannot add non-Sub PMC to a MultiSub.");

        /* Add it to the candidates list. */
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        VTABLE_push_pmc(interp, candidates, sub);

        /* Invalidate the sorted list - we'll need to re-build it. */
        SETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, NULL);

        /* Invalidate the cache. */
        GETATTR_Perl6MultiSub_cache(interp, SELF, cache)
        Parrot_mmd_cache_destroy(interp, cache);
        cache = Parrot_mmd_cache_create(interp);
        SETATTR_Perl6MultiSub_cache(interp, SELF, cache)
    }

/*

=item VTABLE INTVAL elements()

Gets the number of candidate on the candidate list.

=cut

*/
    VTABLE INTVAL elements() {
        PMC *candidates;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        return VTABLE_elements(interp, candidates);
    }

/*

=item VTABLE PMC * get_iter()

Get an iterator over the candidates.

=cut

*/
    VTABLE PMC * get_iter() {
        PMC *candidates;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        return VTABLE_get_iter(interp, candidates);
    }

/*

=item VTABLE PMC * get_pmc_keyed_int()

Gets the candidate at index C<i>.

=cut

*/
    VTABLE PMC * get_pmc_keyed_int(INTVAL i) {
        PMC *candidates;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        return VTABLE_get_pmc_keyed_int(interp, candidates, i);
    }

/*

=item VTABLE PMC * get_pmc_keyed_str()

Converts C<s> to an integer and gets the key at that index.

=cut

*/
    VTABLE PMC * get_pmc_keyed_str(STRING *s) {
        PMC *candidates;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        return VTABLE_get_pmc_keyed_str(interp, candidates, s);
    }

/*

=item VTABLE PMC * get_pmc_keyed()

Converts C<p> to an integer and gets the key at that index.

=cut

*/
    VTABLE PMC * get_pmc_keyed(PMC *p) {
        PMC *candidates;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, candidates);
        return VTABLE_get_pmc_keyed(interp, candidates, p);
    }

/*

=item VTABLE PMC * clone()

Makes a copy of this Perl6MultiSub PMC.

=cut

*/
    VTABLE PMC * clone() {
        PMC *copy = pmc_new(interp, SELF->vtable->base_type);
        PMC *unsorted;
        GETATTR_Perl6MultiSub_candidates(interp, SELF, unsorted);
        unsorted = VTABLE_clone(interp, unsorted);
        SETATTR_Perl6MultiSub_candidates(interp, copy, unsorted);
        return copy;
    }
}

/*

=back

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */
