Author: Whiteknight
Date: Thu Aug 14 14:00:59 2008
New Revision: 30236
Added:
branches/gsoc_pdd09/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t
- copied unchanged from r30235,
/trunk/languages/perl6/t/pmc/perl6multisub-dispatch-arity.t
Modified:
branches/gsoc_pdd09/compilers/pirc/new/pircompunit.c
branches/gsoc_pdd09/config/gen/makefiles/root.in
branches/gsoc_pdd09/languages/cardinal/src/parser/actions.pm
branches/gsoc_pdd09/languages/cardinal/src/parser/grammar.pg
branches/gsoc_pdd09/languages/cardinal/t/02-functions.t
branches/gsoc_pdd09/languages/cardinal/t/99-other.t
branches/gsoc_pdd09/languages/perl6/docs/spectest-progress.csv
branches/gsoc_pdd09/languages/perl6/src/classes/Signature.pir
branches/gsoc_pdd09/languages/perl6/src/parser/grammar.pg
branches/gsoc_pdd09/languages/perl6/src/pmc/perl6multisub.pmc
branches/gsoc_pdd09/languages/perl6/tools/test_summary.pl
branches/gsoc_pdd09/lib/Parrot/Configure/Compiler.pm
branches/gsoc_pdd09/src/debug.c
branches/gsoc_pdd09/tools/dev/pbc_to_exe_gen.pl
Log:
[gsoc_pdd09] update to trunk from r30211
Modified: branches/gsoc_pdd09/compilers/pirc/new/pircompunit.c
==============================================================================
--- branches/gsoc_pdd09/compilers/pirc/new/pircompunit.c (original)
+++ branches/gsoc_pdd09/compilers/pirc/new/pircompunit.c Thu Aug 14
14:00:59 2008
@@ -49,6 +49,14 @@
return NULL;
}
+/*
+
+=item C<void
+parse_error(struct lexer_state *lexer, int linenr, char const * const message,
...)>
+
+=cut
+
+*/
void
parse_error(struct lexer_state *lexer, int linenr, char const * const message,
...) {
va_list arg_ptr;
@@ -63,8 +71,15 @@
/*
-experimental: reset the register numbers for all types.
-this is currently done before each sub.
+=item C<void
+reset_register_allocator(struct lexer_state *lexer)>
+
+Reset the register numbers for all types. After this
+function has been invoked, the next request for a new
+(PASM) register will start at register 0 again (for all
+types).
+
+=cut
*/
void
@@ -238,6 +253,17 @@
}
}
+/*
+
+=item C<void
+set_curtarget(struct lexer_state *lexer, target *t)>
+
+Sets the target C<t> as the current target in C<lexer> to
+make it accessible to other parse actions.
+
+=cut
+
+*/
void
set_curtarget(struct lexer_state *lexer, target *t) {
lexer->curtarget = t;
@@ -326,6 +352,18 @@
return t;
}
+/*
+
+=item C<target *
+add_param(struct lexer_state *lexer, pir_type type, char * const name)>
+
+Add a parameter of type C<type> and named C<name> to the current
+subroutine. The parameter will be declared as a local symbol in the
+current subroutine, and a new register is allocated for it.
+
+=cut
+
+*/
target *
add_param(struct lexer_state *lexer, pir_type type, char * const name) {
target *t = new_target(type, name);
@@ -357,6 +395,17 @@
}
+/*
+
+=item C<void
+set_alias(struct lexer_state *lexer, char *alias)>
+
+Set the argument of the :named flag for the current target
+(parameter).
+
+=cut
+
+*/
void
set_alias(struct lexer_state *lexer, char *alias) {
assert(lexer->curtarget != NULL);
@@ -364,6 +413,17 @@
SET_FLAG(lexer->curtarget->flags, TARGET_FLAG_NAMED);
}
+/*
+
+=item target *
+add_param_named(struct lexer_state *lexer, pir_type type, char *name, char
*alias)>
+
+Add a named parameter to the current subroutine and set its alias; this is the
+argument to the C<:named> flag.
+
+=cut
+
+*/
target *
add_param_named(struct lexer_state *lexer, pir_type type, char *name, char
*alias) {
target *t = add_param(lexer, type, name);
@@ -372,18 +432,48 @@
return t;
}
+/*
+
+=item C<void
+set_param_named(target *t, char *alias)>
+
+Set the alias of the named parameter C<t>.
+=cut
+
+*/
void
set_param_named(target *t, char *alias) {
SET_FLAG(t->flags, TARGET_FLAG_NAMED); /* should already be the case */
t->named_flag_arg = alias;
}
+/*
+
+=item C<void
+set_param_flag(target *param, target_flag flag)>
+
+Set the flag C<flag> on parameter C<param>. The actual value
+of C<flag> may encode several flags at a time.
+
+=cut
+
+*/
void
set_param_flag(target *param, target_flag flag) {
SET_FLAG(param->flags, flag);
}
+/*
+
+=item C<argument *
+new_argument(expression *expr)>
+
+Create a new argument node which wraps C<expr>.
+
+=cut
+
+*/
argument *
new_argument(expression *expr) {
argument *arg = (argument *)calloc(1, sizeof (argument));
@@ -397,6 +487,10 @@
/*
+=item C<argument *
+add_arg(argument *arg1, argument *arg2)>
+
+=cut
*/
argument *
Modified: branches/gsoc_pdd09/config/gen/makefiles/root.in
==============================================================================
--- branches/gsoc_pdd09/config/gen/makefiles/root.in (original)
+++ branches/gsoc_pdd09/config/gen/makefiles/root.in Thu Aug 14 14:00:59 2008
@@ -778,7 +778,8 @@
$(MINIPARROT)
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/main$(O) $(SRC_DIR)/parrot_config$(O) \
- @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) $(LINK_DYNAMIC) \
+ @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS) $(LINK_DYNAMIC)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
pbc_to_exe.pir : $(PARROT) tools/dev/pbc_to_exe_gen.pl
$(PERL) tools/dev/pbc_to_exe_gen.pl \
@@ -807,6 +808,7 @@
lib/Parrot/OpLib/core.pm $(SRC_DIR)/null_config$(O)
$(LINK) @[EMAIL PROTECTED]@ $(SRC_DIR)/main$(O)
$(SRC_DIR)/null_config$(O) \
@rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(INSTALLABLEPARROT) : $(SRC_DIR)/main$(O) $(GEN_HEADERS) $(LIBPARROT) \
lib/Parrot/OpLib/core.pm $(SRC_DIR)/install_config$(O) \
@@ -814,6 +816,7 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/main$(O) \
$(ALL_PARROT_LIBS) $(LINKFLAGS) $(SRC_DIR)/install_config$(O)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(INC_DIR)/parrot.h : $(INC_DIR)/pbcversion.h $(INC_DIR)/vtable.h
@@ -877,6 +880,7 @@
$(LIBPARROT_STATIC) : $(O_FILES)
$(MKPATH) @blib_dir@
$(AR_CR) @[EMAIL PROTECTED]@ @ar_extra@ $(O_FILES)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;2
$(RANLIB) $@
$(LIBPARROT_SHARED) : $(O_FILES)
@@ -884,6 +888,7 @@
$(LD) $(LD_SHARE_FLAGS) $(LDFLAGS) @[EMAIL PROTECTED]@
@libparrot_soname@ \
#CONDITIONED_LINE(cygchkdll):
-Wl,--out-implib=blib/lib/libparrot.dll.a \
$(O_FILES) $(C_LIBS) $(ICU_SHARED)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;2
#CONDITIONED_LINE(libparrot_shared_alias): ( cd @blib_dir@ ; ln -sf
@libparrot_shared@ @libparrot_shared_alias@ )
@@ -897,11 +902,13 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/parrot_debugger$(O) \
@rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(INSTALLABLEPDB) : $(SRC_DIR)/parrot_debugger$(O) $(LIBPARROT)
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/parrot_debugger$(O) \
$(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
#
# Parrot Disassembler
@@ -913,11 +920,13 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pbc_disassemble$(O) \
@rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(INSTALLABLEDIS) : $(SRC_DIR)/pbc_disassemble$(O) $(LIBPARROT)
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pbc_disassemble$(O) \
$(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
#
# Parrot Dump
@@ -927,6 +936,7 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pdump$(O) \
$(SRC_DIR)/packdump$(O) @rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(SRC_DIR)/pdump$(O) : $(GEN_HEADERS)
@@ -934,6 +944,7 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pdump$(O) \
$(SRC_DIR)/packdump$(O) $(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
# pbc_info
@@ -941,6 +952,7 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pbc_info$(O) \
@rpath_blib@ $(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(SRC_DIR)/pbc_info$(O) : $(GEN_HEADERS)
@@ -948,6 +960,7 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pbc_info$(O) \
$(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
#
# Parrot Bytecode File Merger
@@ -957,14 +970,15 @@
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pbc_merge$(O) \
$(SRC_DIR)/parrot_config$(O) \
- $(SRC_DIR)/string_primitives$(O) \
@rpath_blib@ $(ALL_PARROT_LIBS) $(LINK_DYNAMIC) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
$(INSTALLABLEPBCMERGE) : $(SRC_DIR)/pbc_merge$(O) $(LIBPARROT)
$(LINK) @[EMAIL PROTECTED]@ \
$(SRC_DIR)/pbc_merge$(O) \
$(SRC_DIR)/install_config$(O) \
$(ALL_PARROT_LIBS) $(LINKFLAGS)
+#CONDITIONED_LINE(win32): if exist [EMAIL PROTECTED] mt.exe -manifest
[EMAIL PROTECTED] -outputresource:$@;1
###############################################################################
Modified: branches/gsoc_pdd09/languages/cardinal/src/parser/actions.pm
==============================================================================
--- branches/gsoc_pdd09/languages/cardinal/src/parser/actions.pm
(original)
+++ branches/gsoc_pdd09/languages/cardinal/src/parser/actions.pm Thu Aug
14 14:00:59 2008
@@ -473,7 +473,7 @@
method functiondef($/) {
my $past := $( $<comp_stmt> );
my $name := $<fname>;
- my $arity := $past[0]<arity>;
+ my $arity := +$past[0]<arity>;
#my $args := $( $<argdecl> );
#$past.push($args);
$past.name(~$name);
@@ -482,7 +482,7 @@
make $past;
}
-method argdecl($/) {
+method block_signature($/) {
my $params := PAST::Stmts.new( :node($/) );
my $past := PAST::Block.new($params, :blocktype('declaration'));
for $<identifier> {
@@ -496,9 +496,11 @@
}
if $<block_param> {
-
+ my $block := $( $<block_param>[0] );
+ $past.symbol($block.name(), :scope('lexical'));
+ $params.push($block);
}
- $params.arity( +$<identifier> );
+ $params.arity( +$<identifier> + +$<block_param> );
our $?BLOCK_SIGNATURED := $past;
make $past;
}
@@ -512,7 +514,7 @@
method block_param($/) {
my $past := $( $<identifier> );
- # XXX
+ $past.scope('parameter');
make $past;
}
@@ -564,25 +566,16 @@
}
method call_args($/) {
- if ~$/ ne '()' {
- make $( $<args> );
+ my $past;
+ if $<args> {
+ $past := $( $<args> );
}
else {
- make PAST::Op.new( :pasttype('call'), :node($/) );
+ $past := PAST::Op.new( :pasttype('call'), :node($/) );
}
-}
-
-method do_args($/) {
- my $params := PAST::Stmts.new( :node($/) );
- my $past := PAST::Block.new($params, :blocktype('declaration'));
- for $<identifier> {
- my $parameter := $( $_ );
- $past.symbol($parameter.name(), :scope('lexical'));
- $parameter.scope('parameter');
- $params.push($parameter);
+ if $<do_block> {
+ $past.push( $( $<do_block>[0] ) );
}
- $params.arity( +$<identifier> );
- our $?BLOCK_SIGNATURED := $past;
make $past;
}
Modified: branches/gsoc_pdd09/languages/cardinal/src/parser/grammar.pg
==============================================================================
--- branches/gsoc_pdd09/languages/cardinal/src/parser/grammar.pg
(original)
+++ branches/gsoc_pdd09/languages/cardinal/src/parser/grammar.pg Thu Aug
14 14:00:59 2008
@@ -137,14 +137,23 @@
<.identifier> ('!'|'?')?
}
+#XXX UGLY! Refactor into <args> maybe?
token call_args {
- | '()' {*}
- | <args> {*}
- | '(' <.ws> <args> <.ws> ')' {*}
+ | '()' [<.ws> <do_block>]? {*}
+ | <args> [<.ws> <do_block>]? {*}
+ | '(' <.ws> <args> <.ws> ')' [<.ws> <do_block>]? {*}
}
rule do_args {
- '|' [ <identifier> [',' <identifier>]*]?'|' {*}
+ '|' <block_signature> '|'
+}
+
+rule block_signature {
+ [
+ | <identifier> [',' <identifier>]* [',' <slurpy_param>]? [','
<block_param>]?
+ | <slurpy_param> [',' <block_param>]?
+ | <block_param>?
+ ] {*}
}
token variable {
@@ -186,6 +195,7 @@
| <literal> {*} #= literal
| <funcall> {*} #= funcall
| <variable> {*} #= variable
+ | <do_block> {*} #= do_block
| <array> {*} #= array
| <ahash> {*} #= ahash
| <pcomp_stmt> {*} #= pcomp_stmt
@@ -290,12 +300,8 @@
rule argdecl {
['('
- [ <identifier> [',' <identifier>]* [',' <slurpy_param>]? [','
<block_param>]?
- | <slurpy_param> [',' <block_param>]?
- | <block_param>?
- ]
+ <block_signature>
')']?
- {*}
}
token slurpy_param {
Modified: branches/gsoc_pdd09/languages/cardinal/t/02-functions.t
==============================================================================
--- branches/gsoc_pdd09/languages/cardinal/t/02-functions.t (original)
+++ branches/gsoc_pdd09/languages/cardinal/t/02-functions.t Thu Aug 14
14:00:59 2008
@@ -1,4 +1,4 @@
-puts "1..5"
+puts "1..6"
def first
puts "ok 1"
@@ -21,7 +21,14 @@
end
end
+def blocks(n,&f)
+ f(n)
+end
+
first
second(2)
third(3,4)
second fib(6) - 3;
+blocks(6) do |i|
+ puts 'ok ', i
+end
Modified: branches/gsoc_pdd09/languages/cardinal/t/99-other.t
==============================================================================
--- branches/gsoc_pdd09/languages/cardinal/t/99-other.t (original)
+++ branches/gsoc_pdd09/languages/cardinal/t/99-other.t Thu Aug 14 14:00:59 2008
@@ -1,4 +1,4 @@
-puts "1..7"
+puts "1..8"
n = 5
@@ -11,3 +11,11 @@
end
foo[1].upto(7) { |i| puts "ok ", i }
+
+a = do |a,&f|
+ f(a)
+end
+
+a(8) do |i|
+ puts 'ok ', i
+end
Modified: branches/gsoc_pdd09/languages/perl6/docs/spectest-progress.csv
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/docs/spectest-progress.csv
(original)
+++ branches/gsoc_pdd09/languages/perl6/docs/spectest-progress.csv Thu Aug
14 14:00:59 2008
@@ -83,3 +83,4 @@
"2008-08-11 00:00",30161,121,3205,2196,0,131,878,6065
"2008-08-12 00:00",30179,121,3205,0,3205,0,0,6075
"2008-08-13 00:00",30201,121,3205,2196,0,131,878,6075
+"2008-08-14 00:00",30217,121,3205,2196,0,131,878,6075
Modified: branches/gsoc_pdd09/languages/perl6/src/classes/Signature.pir
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/classes/Signature.pir
(original)
+++ branches/gsoc_pdd09/languages/perl6/src/classes/Signature.pir Thu Aug
14 14:00:59 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: branches/gsoc_pdd09/languages/perl6/src/parser/grammar.pg
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/parser/grammar.pg (original)
+++ branches/gsoc_pdd09/languages/perl6/src/parser/grammar.pg Thu Aug 14
14:00:59 2008
@@ -555,7 +555,7 @@
## XXX: cheat until we get term:pi, term:rand, term:undef, etc.
token named_0ary {
- [pi|rand|undef|nothing] >>
+ [pi|rand|undef|nothing|time] >>
}
rule package_declarator {
Modified: branches/gsoc_pdd09/languages/perl6/src/pmc/perl6multisub.pmc
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/src/pmc/perl6multisub.pmc
(original)
+++ branches/gsoc_pdd09/languages/perl6/src/pmc/perl6multisub.pmc Thu Aug
14 14:00:59 2008
@@ -54,12 +54,31 @@
typedef struct candidate_info {
- PMC *sub; /* The sub that is the candidate. */
- INTVAL arity; /* The number of required 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;
+
+/*
+
+=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;
+ int edges_count;
+} candidate_graph_node;
+
+
/*
=back
@@ -183,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)>
@@ -192,7 +226,77 @@
*/
static candidate_info** sort_candidiates(PARROT_INTERP, PMC *candidates) {
- candidate_info** result = mem_allocate_n_zeroed_typed(2, candidate_info*);
+ 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
+ * 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 = 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
+ * with the arity to the array, and nothing is narrower than anything
+ * else. */
+ for (i = 0; i < num_candidates; i++) {
+ result[i] = graph[i]->info;
+ }
+
return result;
}
@@ -202,15 +306,62 @@
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 set to a false value, 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.
+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, int many) {
- Parrot_ex_throw_from_c_args(interp, NULL, 1, "Unimplemented.");
- return PMCNULL;
+static PMC* do_dispatch(PARROT_INTERP, candidate_info** candidates, PMC *args,
int many,
+ int num_candidates, opcode_t *next) {
+ 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;
+
+ /* Iterate over the candidates and collect best ones; terminate
+ * when we see two nulls (may break out earlier). */
+ while (*cur_candidate != NULL) {
+ /* Check if it's admissable by arity. */
+ if (num_args < (*cur_candidate)->min_arity || num_args >
(*cur_candidate)->max_arity) {
+ cur_candidate++;
+ continue;
+ }
+
+ /* XXX Check if it's admissable by type. */
+
+ /* If we get here, it's an admissable candidate; add to list. */
+ possibles[possibles_count] = *cur_candidate;
+ possibles_count++;
+
+ /* Next candidate. */
+ cur_candidate++;
+ 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)
+ break;
+ cur_candidate++;
+ }
+ }
+
+ /* XXX Loooooads of other disambiguation logic comes here. */
+
+ 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.");
+ }
+ }
}
/*
@@ -259,7 +410,7 @@
pmclass Perl6MultiSub extends MultiSub need_ext dynpmc group perl6_group {
ATTR PMC *candidates;
- ATTR struct candidate_info *candidates_sorted;
+ ATTR void *candidates_sorted;
/*
@@ -306,31 +457,50 @@
=cut
*/
- VTABLE opcode_t* invoke(void* next) {
+ 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;
GETATTR_Perl6MultiSub_candidates_sorted(interp, SELF, candidates);
+ GETATTR_Perl6MultiSub_candidates(interp, SELF, unsorted);
if (!candidates) {
- PMC *unsorted;
- GETATTR_Perl6MultiSub_candidates(interp, SELF, unsorted);
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");
- /* Now do the dispatch - if it can't find anything, it will throw the
required
- * exceptions. */
- found = do_dispatch(interp, candidates, 0);
+ /* 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, candidates, get_args(interp), 0,
+ 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: branches/gsoc_pdd09/languages/perl6/tools/test_summary.pl
==============================================================================
--- branches/gsoc_pdd09/languages/perl6/tools/test_summary.pl (original)
+++ branches/gsoc_pdd09/languages/perl6/tools/test_summary.pl Thu Aug 14
14:00:59 2008
@@ -43,7 +43,8 @@
my @tfiles = sort @pure, @fudge;
my $max = 0;
for my $tfile (@tfiles) {
- if (length($tfile) > $max) { $max = length($tfile); }
+ my $tname = $tfile; $tname =~ s!^t/spec/!!;
+ if (length($tname) > $max) { $max = length($tname); }
}
$| = 1;
@@ -57,7 +58,8 @@
if (/^\s*plan\D*(\d+)/) { $plan = $1; last; }
}
close($th);
- printf "%s%s..%4d", $tfile, '.' x ($max - length($tfile)), $plan;
+ my $tname = $tfile; $tname =~ s!^t/spec/!!;
+ printf "%s%s..%4d", $tname, '.' x ($max - length($tname)), $plan;
my $cmd = "../../parrot -G perl6.pbc $tfile";
my @results = split "\n", `$cmd`;
my ($test, $pass, $fail, $todo, $skip) = (0,0,0,0,0);
Modified: branches/gsoc_pdd09/lib/Parrot/Configure/Compiler.pm
==============================================================================
--- branches/gsoc_pdd09/lib/Parrot/Configure/Compiler.pm (original)
+++ branches/gsoc_pdd09/lib/Parrot/Configure/Compiler.pm Thu Aug 14
14:00:59 2008
@@ -162,8 +162,10 @@
sub cc_clean { ## no critic Subroutines::RequireFinalReturn
my $conf = shift;
- unlink map "test_${$}$_", qw( .c .cco .ldo .out),
- $conf->data->get(qw( o exe ));
+ unlink map "test_${$}$_", qw( .c .cco .ldo .out ),
+ $conf->data->get(qw( o exe )),
+ # MSVC
+ qw( .exe.manifest .ilk .pdb );
}
=item C<genfile()>
Modified: branches/gsoc_pdd09/src/debug.c
==============================================================================
--- branches/gsoc_pdd09/src/debug.c (original)
+++ branches/gsoc_pdd09/src/debug.c Thu Aug 14 14:00:59 2008
@@ -99,6 +99,9 @@
/* HEADERIZER BEGIN: static */
/* Don't modify between HEADERIZER BEGIN / HEADERIZER END. Your changes will
be lost. */
+static void debugger_cmdline(PARROT_INTERP)
+ __attribute__nonnull__(1);
+
static void dump_string(PARROT_INTERP, ARGIN_NULLOK(const STRING *s))
__attribute__nonnull__(1);
@@ -384,6 +387,23 @@
return command;
}
+static void
+debugger_cmdline(PARROT_INTERP)
+{
+ TRACEDEB_MSG("debugger_cmdline");
+
+ /*while (!(interp->pdb->state & PDB_EXIT)) {*/
+ while (interp->pdb->state & PDB_STOPPED) {
+ const char * command;
+ PDB_get_command(interp);
+ command = interp->pdb->cur_command;
+ if (command[0] == '\0')
+ command = interp->pdb->last_command;
+
+ PDB_run_command(interp, command);
+ }
+}
+
/*
=item C<void Parrot_debugger_init>
@@ -505,15 +525,8 @@
interp->pdb->state |= PDB_STOPPED;
- while (interp->pdb->state & PDB_STOPPED) {
- const char * command;
- PDB_get_command(interp);
- command = interp->pdb->cur_command;
- if (command[0] == '\0')
- command = interp->pdb->last_command;
+ debugger_cmdline(interp);
- PDB_run_command(interp, command);
- }
if (interp->pdb->state & PDB_EXIT)
Parrot_exit(interp, 0);
}
@@ -561,11 +574,7 @@
PDB_set_break(interp, NULL);
- while (!(interp->pdb->state & PDB_EXIT)) {
- PDB_get_command(interp);
- command = interp->pdb->cur_command;
- PDB_run_command(interp, command);
- }
+ debugger_cmdline(interp);
/* RT #42378 this is not ok */
/* exit(EXIT_SUCCESS); */
Modified: branches/gsoc_pdd09/tools/dev/pbc_to_exe_gen.pl
==============================================================================
--- branches/gsoc_pdd09/tools/dev/pbc_to_exe_gen.pl (original)
+++ branches/gsoc_pdd09/tools/dev/pbc_to_exe_gen.pl Thu Aug 14 14:00:59 2008
@@ -434,10 +434,36 @@
say link
.local int status
status = spawnw link
- unless status goto linked
+ unless status goto check_manifest
die "linking failed"
+ check_manifest:
+ # Check if there is a MSVC app manifest
+ .local pmc file
+ file = new 'File'
+ .local string manifest_file_name
+ manifest_file_name = exefile
+ manifest_file_name .= '.manifest'
+ .local pmc manifest_exists
+ manifest_exists = file.'exists'( manifest_file_name )
+ unless manifest_exists goto linked
+
+ embed_manifest:
+ # MSVC app manifest exists, embed it
+ .local string embed_manifest
+ embed_manifest = 'mt.exe -manifest '
+ embed_manifest .= manifest_file_name
+ embed_manifest .= ' -outputresource:'
+ embed_manifest .= exefile
+ embed_manifest .= ';1'
+
+ say embed_manifest
+ .local int embed_manifest_status
+ embed_manifest_status = spawnw embed_manifest
+ unless embed_manifest_status goto linked
+ die 'manifest embedding failed'
+
linked:
print "Linked: "
say exefile
