Author: jonathan
Date: Thu Aug 14 07:08:33 2008
New Revision: 30229
Modified:
trunk/languages/perl6/src/classes/Signature.pir
trunk/languages/perl6/src/pmc/perl6multisub.pmc
trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t
Log:
[rakudo] Collect type information from signatures in the MMD candidate sorter
and and stub in building the DAG.
Modified: trunk/languages/perl6/src/classes/Signature.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Signature.pir (original)
+++ trunk/languages/perl6/src/classes/Signature.pir Thu Aug 14 07:08:33 2008
@@ -19,8 +19,8 @@
* type - the class or role type of the parameter; this references the actual
type object rather than just naming it, and may well be parametric (but that
will have been resolved already)
-* constraints - array of any additional "where" refinement types on the
- parameter
+* constraints - any additional "where" refinement types on the parameter;
+ will be a junction of types
* invocant - is this the invocant (as in, self for a method, not multi)
* multi_invocant - is this an invocant for the purpose of MMD
* optional - is this an optional parameter?
@@ -56,6 +56,17 @@
.return ($P0)
.end
+=item params
+
+Get the array of parameter describing hashes.
+
+=cut
+
+.sub 'params' :method
+ $P0 = getattribute self, "@!params"
+ .return ($P0)
+.end
+
=back
=cut
Modified: trunk/languages/perl6/src/pmc/perl6multisub.pmc
==============================================================================
--- trunk/languages/perl6/src/pmc/perl6multisub.pmc (original)
+++ trunk/languages/perl6/src/pmc/perl6multisub.pmc Thu Aug 14 07:08:33 2008
@@ -54,11 +54,12 @@
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 *type_cons; /* Any class or role type constraints. */
- PMC *refinement_cons; /* Any refinement type constraints (C<subset>). */
+ 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). */
} candidate_info;
@@ -74,6 +75,7 @@
typedef struct candidate_graph_node {
candidate_info *info;
struct candidate_graph_node **edges;
+ int edges_count;
} candidate_graph_node;
@@ -200,6 +202,21 @@
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.
+
+*/
+static INTVAL is_narrower(PARROT_INTERP, candidate_info *a, candidate_info *b)
{
+ /* XXX TODO */
+ return 0;
+}
+
+
/*
=item C<static candidate_info** sort_candidiates(PMC *candidates)>
@@ -209,7 +226,8 @@
*/
static candidate_info** sort_candidiates(PARROT_INTERP, PMC *candidates) {
- INTVAL i;
+ INTVAL i, j, sig_elems;
+ 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
@@ -237,9 +255,39 @@
info->max_arity = info->min_arity + VTABLE_get_integer(interp,
VTABLE_inspect_str(interp, candidate, CONST_STRING(interp,
"pos_optional")));
- /* Add it to graph node. */
- graph[i] = mem_allocate_typed(candidate_graph_node);
+ /* Type information. */
+ meth = VTABLE_find_method(interp, candidate, CONST_STRING(interp,
"signature"));
+ signature = Parrot_run_meth_fromc_args(interp, meth, candidate,
CONST_STRING(interp, "signature"), "P");
+ meth = VTABLE_find_method(interp, signature, CONST_STRING(interp,
"params"));
+ params = 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;
+ }
+
+ /* 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_count] = graph[j];
+ graph[i]->edges_count++;
+ }
+ }
}
/* XXX Here we do the topological sort. For now, just copy the values
@@ -412,6 +460,9 @@
VTABLE opcode_t *invoke(void *next) {
PMC *found;
+ /* Need to make sure current continuation doesn't get destroyed. */
+ PMC *saved_ccont = interp->current_cont;
+
/* Make sure that we have a candidate list built. */
candidate_info **candidates = NULL;
PMC *unsorted;
@@ -430,11 +481,26 @@
VTABLE_elements(interp, unsorted), next);
/* Invoke what was found. */
+ interp->current_cont = saved_ccont;
return VTABLE_invoke(interp, found, next);
}
/*
+=item C<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);
+ }
+
+/*
+
=item VTABLE void push_pmc(PMC *sub)
Adds a new candidate to the candidate list.
Modified: trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t
==============================================================================
--- trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t (original)
+++ trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t Thu Aug 14
07:08:33 2008
@@ -34,10 +34,13 @@
.sub 'simple'
$P0 = new "Perl6MultiSub"
$P1 = find_global 'simple_1'
+ 'attach_any_sig'($P1, 0)
push $P0, $P1
$P1 = find_global 'simple_2'
+ 'attach_any_sig'($P1, 1)
push $P0, $P1
$P1 = find_global 'simple_3'
+ 'attach_any_sig'($P1, 3)
push $P0, $P1
$I0 = $P0()
@@ -72,8 +75,10 @@
.sub 'with_optional'
$P0 = new "Perl6MultiSub"
$P1 = find_global 'with_optional_1'
+ 'attach_any_sig'($P1, 0)
push $P0, $P1
$P1 = find_global 'with_optional_2'
+ 'attach_any_sig'($P1, 2)
push $P0, $P1
$I0 = $P0()
@@ -96,6 +101,7 @@
.sub 'with_slurpy'
$P0 = new "Perl6MultiSub"
$P1 = find_global 'with_slurpy_1'
+ 'attach_any_sig'($P1, 0)
push $P0, $P1
$I0 = $P0()
@@ -114,8 +120,10 @@
.sub 'another_with_slurpy'
$P0 = new "Perl6MultiSub"
$P1 = find_global 'another_with_slurpy_1'
+ 'attach_any_sig'($P1, 0)
push $P0, $P1
$P1 = find_global 'another_with_slurpy_2'
+ 'attach_any_sig'($P1, 1)
push $P0, $P1
$I0 = $P0()
@@ -135,6 +143,31 @@
.end
+.sub 'attach_any_sig'
+ .param pmc sub
+ .param int num_params
+
+ # Get Any type.
+ .local pmc any
+ any = get_hll_global "Any"
+
+ # Make signature.
+ $P0 = new 'Signature'
+ $P1 = new 'Perl6Array'
+ setattribute $P0, "@!params", $P1
+ $I0 = 0
+ param_loop:
+ if $I0 == num_params goto param_loop_end
+ $P2 = new 'Perl6Hash'
+ $P2["type"] = any
+ push $P1, $P2
+ inc $I0
+ goto param_loop
+ param_loop_end:
+
+ setprop sub, '$!signature', $P0
+.end
+
# Local Variables:
# mode: pir
# fill-column: 100
