Author: chromatic
Date: Tue Nov 11 11:22:16 2008
New Revision: 32551
Modified:
trunk/languages/perl6/src/pmc/perl6multisub.pmc
Log:
[Rakudo] Tidied some code in Perl6MultiSub PMC. No functional changes.
Modified: trunk/languages/perl6/src/pmc/perl6multisub.pmc
==============================================================================
--- trunk/languages/perl6/src/pmc/perl6multisub.pmc (original)
+++ trunk/languages/perl6/src/pmc/perl6multisub.pmc Tue Nov 11 11:22:16 2008
@@ -48,16 +48,15 @@
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. */
+ 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
@@ -67,11 +66,12 @@
in the graph that we have arrows to.
*/
+
typedef struct candidate_graph_node {
- candidate_info *info;
+ candidate_info *info;
struct candidate_graph_node **edges;
- INTVAL edges_in;
- INTVAL edges_out;
+ INTVAL edges_in;
+ INTVAL edges_out;
} candidate_graph_node;
@@ -136,8 +136,8 @@
/* 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;
+ 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
@@ -382,7 +382,8 @@
/*
-=item C<static PMC* do_dispatch(candidate_info** candidates, int many)>
+=item C<static PMC* do_dispatch(candidate_info **candidates, PMC *args,
+ int many, int num_candidates, opcode_t *next)>
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
@@ -392,15 +393,16 @@
*/
-static PMC* do_dispatch(PARROT_INTERP, candidate_info** candidates, PMC *args,
int many,
- int num_candidates, opcode_t *next) {
+static PMC* do_dispatch(PARROT_INTERP, candidate_info **candidates, PMC *args,
+ int many, int num_candidates, opcode_t *next) {
+ 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;
- 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). */
@@ -416,26 +418,32 @@
}
/* Check if it's admissable by arity. */
- if (num_args < (*cur_candidate)->min_arity || num_args >
(*cur_candidate)->max_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_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 *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);
+ 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;
@@ -449,28 +457,35 @@
/* 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;
+ 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;
+ 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 *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,
+ 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];
@@ -488,13 +503,13 @@
if (matching_count) {
mem_sys_free(possibles);
mem_sys_free(constraint_free);
- possibles = matching;
+ possibles = matching;
possibles_count = matching_count;
}
else if (constraint_free_count) {
mem_sys_free(possibles);
mem_sys_free(matching);
- possibles = constraint_free;
+ possibles = constraint_free;
possibles_count = constraint_free_count;
}
}
@@ -636,10 +651,10 @@
PMC *found;
/* Get arguments. */
- PMC *args = get_args(interp);
+ PMC *args = get_args(interp);
/* Need to make sure a wobload of globals don't get destroyed. */
- PMC *saved_ccont = interp->current_cont;
+ 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;
@@ -649,15 +664,19 @@
/* Make sure that we have a candidate list built. */
candidate_info **candidates = NULL;
- PMC *unsorted;
+ PMC *unsorted;
+
GETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
GETATTR_Perl6MultiSub_candidates(interp, SELF, unsorted);
+
if (!candidates) {
candidates = sort_candidiates(interp, unsorted);
SETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
}
+
if (!candidates)
- Parrot_ex_throw_from_c_args(interp, next, 1, "Failed to build
candidate list");
+ 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. */
@@ -666,12 +685,12 @@
/* 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->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. */
