cvsuser 04/05/29 22:21:35
Modified: languages/perl6/P6C Addcontext.pm IMCC.pm
languages/perl6/P6C/IMCC Sub.pm
Log:
Various miscellaneous tweaks, fixes, and changes that I seem to have
made along the way but that don't really do much.
Revision Changes Path
1.28 +1 -1 parrot/languages/perl6/P6C/Addcontext.pm
Index: Addcontext.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/Addcontext.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -w -r1.27 -r1.28
--- Addcontext.pm 30 May 2004 05:08:46 -0000 1.27
+++ Addcontext.pm 30 May 2004 05:21:31 -0000 1.28
@@ -658,7 +658,7 @@
P6C::Context::block_ctx($x->block,
new P6C::Context type => 'PerlArray');
}
- } elsif ($x->block->isa('P6C::rule')) {
+ } elsif ($x->is_rule) {
$x->block->ctx_right(new P6C::Context type => 'PerlUndef');
} else {
die "Internal error: closure body is ", $x->block;
1.43 +23 -23 parrot/languages/perl6/P6C/IMCC.pm
Index: IMCC.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/IMCC.pm,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- IMCC.pm 30 May 2004 05:08:46 -0000 1.42
+++ IMCC.pm 30 May 2004 05:21:31 -0000 1.43
@@ -205,6 +205,7 @@
next;
}
$name = mangled_name($name);
+ print "\n";
print ".sub $name prototyped\n";
$sub->emit;
print ".end\n";
@@ -854,7 +855,7 @@
code(<<END);
$end:
END
- return [EMAIL PROTECTED];
+ return [EMAIL PROTECTED];
} elsif ($ctx->is_scalar) {
my $itmp = gentmp 'int';
code(<<END);
@@ -1078,7 +1079,7 @@
$x->vals($i)->val;
}
}
- return [EMAIL PROTECTED];
+ return [EMAIL PROTECTED];
} elsif ($ctx->is_array) {
# In array context, the list's value is an array of all its
@@ -1473,6 +1474,8 @@
# XXX: since IMCC doesn't give us access to cmp, cmp_num, and
# cmp_string separately, we need to go through num and str temporaries
# to get the right kind of comparison.
+#
+# FIXME: The above is no longer correct.
use vars '%type';
BEGIN {
@@ -1582,7 +1585,7 @@
use P6C::IMCC::prefix 'wrap_with_catch';
use P6C::IMCC ':all';
-# A sub with no explicit parameter list gets @_.
+# A sub with no explicit parameter list gets ([EMAIL PROTECTED]).
sub default_signature {
return $P6C::IMCC::DEFAULT_SIGNATURE ||=
@@ -1667,12 +1670,13 @@
$ofunc = set_function($name);
}
+ # Figure out params:
$x->params(get_params($x));
set_function_params($x->params);
if ($x->is_rule) {
- set_function_return([ 'int', 'int' ]);
+ P6C::Rules::adjust_rule_return($IMCC::curfunc);
} elsif ($ctx->{noreturn}) {
# Do nothing.
} else {
@@ -1821,23 +1825,18 @@
END
} else {
$clonev = $tmpv;
- code(<<END);
- $name = $tmpv
-END
+ code("\t$name = $tmpv");
}
return val_in_context $clonev, $x->type, $x->{ctx};
} else {
if ($do_clone) {
- code(<<END);
-# ASSIGN TO @{[$x->name(), $global ? " (global)" : ""]}
- $name = clone $tmpv
-END
+ my $desc = $x->name;
+ $desc .= " (global)" if $global;
+ code("\t$name = clone $tmpv # ASSIGN TO $desc");
} else {
# assign non-scalar to scalar => no need to clone.
- code(<<END);
- $name = $tmpv
-END
+ code("\t$name = $tmpv");
}
return val_in_context $name, $x->type, $x->{ctx};
}
@@ -2035,14 +2034,15 @@
my $ptmp = gentmp 'PerlUndef';
my $ret_index = gentmp 'int';
code(<<END);
- $ret_index = $indexval
- $ret = $ret_index
+ $ret_index = $indexval # for i = slice.length
+ $ret = $ret_index # preallocate dest
END
- code(gen_counted_loop($ret_index, <<END));
+ code(gen_counted_loop($ret_index, <<END, "slice in array ctx"));
$itmp = $indexval\[$ret_index]
$ptmp = $thing\[$itmp]
- $ret\[$ret_index] = $ptmp
+ $ret\[$ret_index] = $ptmp # dest[i] = src[slice[i]]
END
+ code("# slice in array context complete");
} elsif ($ctx->is_tuple) {
my $itmp = gentmp $temptype{$type};
@@ -2119,7 +2119,7 @@
$iter = $short
END
# Assign them:
- code(gen_counted_loop($iter, <<END));
+ code(gen_counted_loop($iter, <<END, "slice assignment"));
$index = $indexval\[$iter]
$ptmp = $rhs\[$iter]
$lhs\[$index] = $ptmp
@@ -2243,11 +2243,11 @@
rx_pos - position after applying rule (to match or backtrack)
status - 1 for success, 0 for failure
-TODO: Rather than returning a status code, this really ought to just jump to
-the appropriate continuation.
+TODO: Rather than returning a status code, this really ought to just
+invoke the appropriate continuation.
-TODO: It would also be nice to have two different entry points rather than
-the hokey C<mode> param.
+TODO: It would also be nice to have two different entry points rather
+than the hokey C<mode> param.
=cut
1.4 +4 -2 parrot/languages/perl6/P6C/IMCC/Sub.pm
Index: Sub.pm
===================================================================
RCS file: /cvs/public/parrot/languages/perl6/P6C/IMCC/Sub.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- Sub.pm 30 May 2004 05:03:54 -0000 1.3
+++ Sub.pm 30 May 2004 05:21:35 -0000 1.4
@@ -135,7 +135,9 @@
# 3. call the continuation to "return"
#
# FIXME: Non-PMC arguments/params are not yet handled.
-# FIXME: Pass-by-value only implemented
+# FIXME: Pass-by-value only implemented. Err... wait... actually, I
+# think I have pass-by-reference for PMCs and pass-by-value for
+# ints and nums. Not sure for strings. Need tests.
sub emit {
my ($x, $prototyped) = @_;
my $params = $x->params;
@@ -157,7 +159,7 @@
$param_count++;
}
- # The slurpy array, if any, is passed as an array PMC
+ # The slurpy array, if any, gathers up the rest of the arguments.
if ($params->slurpy_array) {
my $slurpy = $params->slurpy_array->var->name;
my $slurpy_name = P6C::IMCC::mangled_name($slurpy);
