Author: chromatic
Date: Wed Feb 20 21:52:00 2008
New Revision: 25917
Modified:
branches/pdd17pmc/lib/Parrot/Pmc2c/PMC.pm
branches/pdd17pmc/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/pdd17pmc/lib/Parrot/Pmc2c/Parser.pm
Log:
[lib] Minor cleanups in PMC parsing and emitting.
Modified: branches/pdd17pmc/lib/Parrot/Pmc2c/PMC.pm
==============================================================================
--- branches/pdd17pmc/lib/Parrot/Pmc2c/PMC.pm (original)
+++ branches/pdd17pmc/lib/Parrot/Pmc2c/PMC.pm Wed Feb 20 21:52:00 2008
@@ -78,19 +78,19 @@
sub has_method {
my ( $self, $methodname ) = @_;
- return exists $self->{has_method}->{$methodname};
+ return exists $self->{has_method}{$methodname};
}
sub method_index {
my ( $self, $methodname ) = @_;
- return $self->{has_method}->{$methodname};
+ return $self->{has_method}{$methodname};
}
sub get_method {
my ( $self, $methodname ) = @_;
my $method_index = $self->method_index($methodname);
return unless defined $method_index;
- return $self->{methods}->[$method_index];
+ return $self->{methods}[$method_index];
}
sub inherits_method {
@@ -100,7 +100,7 @@
sub parent_has_method {
my ( $self, $parent_name, $vt_meth ) = @_;
- return exists $self->{'has_parent'}{$parent_name}{$vt_meth};
+ return exists $self->{has_parent}{$parent_name}{$vt_meth};
}
# parents
@@ -229,8 +229,8 @@
# should only be called once by the pmc parser
sub set_parents {
my ( $self, $value ) = @_;
- $value = [] unless $value;
- $self->{parents} = $value;
+ $value ||= [];
+ $self->{parents} = $value;
return 1;
}
@@ -330,15 +330,18 @@
if ( ref($super_pmc) ) {
my $super_method = $super_pmc->get_method($vt_meth);
$super_pmc_name = $super_method->parent_name;
- $self->add_mixin($super_pmc_name) unless
$self->is_parent($super_pmc_name);
+
+ $self->add_mixin($super_pmc_name)
+ unless $self->is_parent($super_pmc_name);
$self->super_attrs( $vt_meth, $super_method->attrs );
$self->inherit_attrs($vt_meth) if $self->get_method($vt_meth);
my $super_mmd_rights = $super_method->mmd_rights;
- if ( $super_mmd_rights && scalar @{$super_mmd_rights} ) {
- $self->{super_mmd_rights}{$vt_meth}->{$super_pmc_name} =
$super_mmd_rights;
+ if ( $super_mmd_rights && @{$super_mmd_rights} ) {
+ $self->{super_mmd_rights}{$vt_meth}{$super_pmc_name} =
+ $super_mmd_rights;
}
}
else {
@@ -376,8 +379,9 @@
sub inherit_attrs {
my ( $self, $vt_meth ) = @_;
- my $attrs = $self->get_method($vt_meth)->attrs;
- my $super_attrs = $self->super_attrs($vt_meth);
+ my $attrs = $self->get_method($vt_meth)->attrs;
+ my $super_attrs = $self->super_attrs($vt_meth);
+
if ( ( $super_attrs->{read} or $super_attrs->{write} )
and not( $attrs->{read} or $attrs->{write} ) )
{
@@ -408,8 +412,9 @@
sub dump_is_current {
my ($self) = @_;
my $dumpfile = $self->filename('.dump');
- my $pmcfile = $self->filename('.pmc');
return 0 unless -e $dumpfile;
+
+ my $pmcfile = $self->filename('.pmc');
return ( stat $dumpfile )[9] > ( stat $pmcfile )[9];
}
@@ -421,4 +426,3 @@
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
-
Modified: branches/pdd17pmc/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pdd17pmc/lib/Parrot/Pmc2c/PMCEmitter.pm (original)
+++ branches/pdd17pmc/lib/Parrot/Pmc2c/PMCEmitter.pm Wed Feb 20 21:52:00 2008
@@ -575,11 +575,13 @@
EOC
$cout .= <<"EOC";
/* create vtable - clone it - we have to set a few items */
- VTABLE * const vt_clone = Parrot_clone_vtable(interp,
&temp_base_vtable);
+ VTABLE * const vt_clone = Parrot_clone_vtable(interp,
+ &temp_base_vtable);
EOC
for my $k ( keys %extra_vt ) {
$cout .= <<"EOC";
- VTABLE * const vt_${k}_clone = Parrot_clone_vtable(interp,
&temp_${k}_vtable);
+ VTABLE * const vt_${k}_clone = Parrot_clone_vtable(interp,
+ &temp_${k}_vtable);
EOC
}
Modified: branches/pdd17pmc/lib/Parrot/Pmc2c/Parser.pm
==============================================================================
--- branches/pdd17pmc/lib/Parrot/Pmc2c/Parser.pm (original)
+++ branches/pdd17pmc/lib/Parrot/Pmc2c/Parser.pm Wed Feb 20 21:52:00 2008
@@ -372,7 +372,7 @@
pmclass # pmclass keyword
\s+ # whitespace
([\w]*) # pmc name
- ([\s+\w+]*) # pmc attributes
+ ((?:\s+\w+)*) # pmc attributes
\s* # whitespace
)
\{ # pmc body beginning marker
@@ -390,7 +390,7 @@
return ( $preamble, $pmcname, $flags, $parents, $body, $postamble,
$chewed_lines );
}
-our %has_value = map { $_ => 1 } qw(group hll);
+our %has_value = map { $_ => 1 } qw(does group hll);
our %has_values = map { $_ => 1 } qw(provides extends maps lib);
=head2 C<parse_flags()>
