/*

$Id$

Copyright (C) 2008-2009, 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. */

const 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 = VTABLE_elements(interp, 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) {

const INTVAL type = VTABLE_get_integer_keyed_int(interp, 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 * const 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 * const type_obj_a = a->types[i];

PMC * const type_obj_b = b->types[i];

if (type_obj_a == type_obj_b) {

/* Same type, so tied. */

tied++;

}

else {

PMC * const accepts_meth_a = VTABLE_find_method(interp, type_obj_b, ACCEPTS);

PMC * const 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 * const accepts_meth_b = VTABLE_find_method(interp, type_obj_a, ACCEPTS);

PMC * const 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_candidates(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_candidates(PARROT_INTERP, PMC *candidates, PMC **proto_out) {

INTVAL i;

PMC *found_proto = PMCNULL;

const 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** const result = mem_allocate_n_zeroed_typed(

2 * num_candidates + 1, candidate_info*);

/* Create a node for each candidate in the graph. */

candidate_graph_node** const graph = mem_allocate_n_zeroed_typed(

num_candidates, candidate_graph_node*);

INTVAL insert_pos = 0;

for (i = 0; i < num_candidates; i++) {

PMC *signature;

PMC *params;

PMC *meth;

candidate_info *info;

INTVAL sig_elems;

INTVAL j;

/* Get information about this candidate. */

PMC * const candidate = VTABLE_get_pmc_keyed_int(interp, candidates, i);

PMC * const 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 * const param = VTABLE_get_pmc_keyed_int(interp, params, j);

PMC * const type = VTABLE_get_pmc_keyed_str(interp, param,

CONST_STRING(interp, "nom_type"));

PMC * const constraints = VTABLE_get_pmc_keyed_str(interp, param,

CONST_STRING(interp, "cons_type"));

PMC * const multi_inv = VTABLE_get_pmc_keyed_str(interp, param,

CONST_STRING(interp, "multi_invocant"));

info->types[j] = type;

info->constraints[j] = PMC_IS_NULL(constraints) || VTABLE_isa(interp,

constraints, CONST_STRING(interp, "Failure")) ?

PMCNULL : 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) {

INTVAL candidates_to_sort;

INTVAL result_pos;

/* 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++) {

INTVAL j;

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

const 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) {

INTVAL j;

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

const INTVAL num_args = VTABLE_elements(interp, args);

STRING * const junction = CONST_STRING(interp, "Junction");

INTVAL i;

for (i = 0; i < num_args; i++) {

PMC * const 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 * const ACCEPTS = CONST_STRING(interp, "ACCEPTS");

INTVAL possibles_count = 0;

const INTVAL num_args = VTABLE_elements(interp, args);

candidate_info **cur_candidate = candidates;

candidate_info **possibles = mem_allocate_n_typed(num_candidates,

candidate_info *);

INTVAL type_check_count;

PMC *junctional_res = PMCNULL;

/* 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]) {

INTVAL i;

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 * const param = VTABLE_get_pmc_keyed_int(interp, args, i);

PMC * const type_obj = (*cur_candidate)->types[i];

PMC * const accepts_meth = VTABLE_find_method(interp, type_obj, ACCEPTS);

PMC * const 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, and there are no constraints, it's

* safe to cache for the future, since it's a purely nominal 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 this point. */

if (possibles_count == 1 && cache) {

INTVAL has_constraints = 0;

INTVAL i;

for (i = 0; i < possibles[0]->num_types; i++) {

if (!PMC_IS_NULL(possibles[0]->constraints[i])) {

has_constraints = 1;

break;

}

}

if (!has_constraints)

Parrot_mmd_cache_store_by_values(interp, cache, "", args, possibles[0]->sub);

}

/* If we have candidates from arity/nominal type, check out any constraints. */

if (possibles_count > 0) {

candidate_info ** const matching = mem_allocate_n_typed(possibles_count,

candidate_info *);

candidate_info ** const constraint_free = mem_allocate_n_typed(possibles_count,

candidate_info *);

INTVAL matching_count = 0;

INTVAL constraint_free_count = 0;

INTVAL i;

for (i = 0; i < possibles_count; i++) {

/* Check if we match any constraints. */

INTVAL constraint_checked = 0;

INTVAL constraint_failed = 0;

INTVAL j;

for (j = 0; j < possibles[i]->num_types; j++) {

PMC * const type_obj = possibles[i]->constraints[j];

if (!PMC_IS_NULL(type_obj)) {

PMC * const param = VTABLE_get_pmc_keyed_int(interp, args, j);

PMC * const accepts_meth = VTABLE_find_method(interp, type_obj, ACCEPTS);

PMC * const 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;

INTVAL i;

for (i = 0; i < possibles_count; i++) {

PMC * const 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;

}

}

/* Perhaps we found nothing but have juncitonal arguments? */

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

junctional_res = sub;

}

if (!many) {

/* Need a unique candidate. */

if (possibles_count == 1) {

PMC *result = possibles[0]->sub;

mem_sys_free(possibles);

return result;

}

else if (!PMC_IS_NULL(junctional_res)) {

return junctional_res;

}

else if (!PMC_IS_NULL(proto)) {

/* If we have a proto at this point, use that. */

mem_sys_free(possibles);

return proto;

}

else if (possibles_count == 0) {

mem_sys_free(possibles);

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 * const sig_name = CONST_STRING(interp, "signature");

STRING * const perl_name = CONST_STRING(interp, "perl");

STRING * const newline = CONST_STRING(interp, "\n");

STRING *signatures = Parrot_str_new(interp, "", 0);

INTVAL i;

for (i = 0; i < possibles_count; i++) {

PMC * const sig_meth = VTABLE_find_method(interp, possibles[i]->sub, sig_name);

PMC * const sig_obj = (PMC *)Parrot_run_meth_fromc_args(interp, sig_meth,

possibles[i]->sub, sig_name, "P");

PMC * const perl_meth = VTABLE_find_method(interp, sig_obj, perl_name);

STRING * const sig_perl = (STRING *)Parrot_run_meth_fromc_args(interp, perl_meth,

sig_obj, perl_name, "S");

signatures = Parrot_str_append(interp, signatures, sig_perl);

signatures = Parrot_str_append(interp, signatures, newline);

}

mem_sys_free(possibles);

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 * const results = pmc_new(interp, enum_class_ResizablePMCArray);

INTVAL i;

for (i = 0; i < possibles_count; i++)

VTABLE_push_pmc(interp, results, possibles[i]->sub);

mem_sys_free(possibles);

/* If nothing was found at all, then supply the proto or junction auto-threader

* if there is one. */

if (!PMC_IS_NULL(junctional_res))

VTABLE_push_pmc(interp, results, junctional_res);

else if (possibles_count == 0 && !PMC_IS_NULL(proto))

VTABLE_push_pmc(interp, results, proto);

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 * const 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_candidates(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 * const saved_ccont = interp->current_cont;

opcode_t * const current_args = interp->current_args;

opcode_t * const current_params = interp->current_params;

opcode_t * const current_returns = interp->current_returns;

PMC * const args_signature = interp->args_signature;

PMC * const params_signature = interp->params_signature;

PMC * const 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_candidates(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);