[svn:parrot] r23915 - in trunk/lib/Parrot/Pmc2c: . PMC

Author: petdance
Date: Sat Dec 15 00:38:40 2007
New Revision: 23915

Modified:
   trunk/lib/Parrot/Pmc2c/Method.pm
   trunk/lib/Parrot/Pmc2c/PMC/Ref.pm
   trunk/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm
   trunk/lib/Parrot/Pmc2c/UtilFunctions.pm

Log:
code that figures out what parms will get passed through in methods to 
lower-level functions now handles constructs like "const STRING *"

Modified: trunk/lib/Parrot/Pmc2c/Method.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/Method.pm    (original)
+++ trunk/lib/Parrot/Pmc2c/Method.pm    Sat Dec 15 00:38:40 2007
@@ -7,7 +7,7 @@
 use constant VTABLE       => 'VTABLE';
 use constant NON_VTABLE   => 'NON_VTABLE';
 use Carp;
-use Parrot::Pmc2c::UtilFunctions qw(count_newlines);
+use Parrot::Pmc2c::UtilFunctions qw(count_newlines args_from_parameter_list 
passable_args_from_parameter_list);
 
 sub new {
     my ( $class, $self_hash ) = @_;
@@ -99,17 +99,11 @@
 sub signature {
     my ($self) = @_;
 
-    my $return_type = $self->return_type;
-    my $n           = 0;
-    my ( @types, @args );
-
-    for my $x ( split / /, $self->parameters ) {
-        push @{ ( $n++ & 1 ) ? \@args : \@types }, $x;
-    }
-
-    my $args             = @args ? ", " . join( ' ', @args ) : '';
+    my $args             = passable_args_from_parameter_list( 
$self->parameters );
+    my ($types,$vars)    = args_from_parameter_list( $self->parameters );
+    my $return_type      = $self->return_type;
     my $return_type_char = $self->trans($return_type);
-    my $sig              = $self->trans($return_type) . join '', map { 
$self->trans($_) } @types;
+    my $sig              = $self->trans($return_type) . join '', map { 
$self->trans($_) } @{$types};
     my $return_prefix    = '';
     my $method_suffix    = '';
 

Modified: trunk/lib/Parrot/Pmc2c/PMC/Ref.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PMC/Ref.pm   (original)
+++ trunk/lib/Parrot/Pmc2c/PMC/Ref.pm   Sat Dec 15 00:38:40 2007
@@ -11,7 +11,7 @@
 use base 'Parrot::Pmc2c::PMC';
 use strict;
 use warnings;
-use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
+use Parrot::Pmc2c::UtilFunctions qw( gen_ret passable_args_from_parameter_list 
);
 
 =item C<prederef($method)>
 
@@ -70,10 +70,7 @@
             }
         );
 
-        my $n    = 0;
-        my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $method->parameters;
-        my $arg  = @args ? ", " . join( ' ', @args ) : '';
-
+        my $arg        = passable_args_from_parameter_list( 
$method->parameters );
         my $pre        = $self->prederef($method);
         my $post       = $self->postderef($method);
         my $deref      = $self->raw_deref($method);

Modified: trunk/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm     (original)
+++ trunk/lib/Parrot/Pmc2c/PMC/deleg_pmc.pm     Sat Dec 15 00:38:40 2007
@@ -6,7 +6,7 @@
 use base 'Parrot::Pmc2c::PMC';
 use strict;
 use warnings;
-use Parrot::Pmc2c::UtilFunctions qw( gen_ret );
+use Parrot::Pmc2c::UtilFunctions qw( gen_ret passable_args_from_parameter_list 
);
 
 =over 4
 
@@ -35,9 +35,7 @@
             }
         );
 
-        my $n    = 0;
-        my @args = grep { $n++ & 1 ? $_ : 0 } split / /, $method->parameters;
-        my $arg  = @args ? ", " . join( ' ', @args ) : '';
+        my $arg  = passable_args_from_parameter_list( $method->parameters );
         my $ret  = gen_ret( $method, "VTABLE_$vt_method_name(interp, 
attr$arg)" );
         $new_method->body( Parrot::Pmc2c::Emitter->text(<<"EOC") );
     PMC * const attr = get_attrib_num(PMC_data_typed(pmc, SLOTTYPE *), 0);

Modified: trunk/lib/Parrot/Pmc2c/UtilFunctions.pm
==============================================================================
--- trunk/lib/Parrot/Pmc2c/UtilFunctions.pm     (original)
+++ trunk/lib/Parrot/Pmc2c/UtilFunctions.pm     Sat Dec 15 00:38:40 2007
@@ -6,10 +6,50 @@
 use warnings;
 use base qw( Exporter );
 our @EXPORT_OK = qw( count_newlines gen_ret dont_edit dynext_load_code
-    c_code_coda slurp spew splat open_file filename escape_filename );
+    c_code_coda slurp spew splat open_file filename escape_filename
+    args_from_parameter_list
+    passable_args_from_parameter_list
+);
 
 =over 4
 
+=item C<passable_args_from_parameter_list( $parms )>
+
+Given I<$parms> like C<const STRING *foo, int bar>, returns C<, foo, bar>.
+It's handy for passing into function calls.
+
+=cut
+
+sub passable_args_from_parameter_list {
+    my $parameters = shift;
+
+    my ($types,$vars) = args_from_parameter_list( $parameters );
+
+    return @{$vars} ? ', ' . join( ', ', @{$vars} ) : '';
+}
+
+=item C<args_from_parameter_list( $parms )>
+
+Returns two arrayrefs of arg types and var names.
+
+=cut
+
+sub args_from_parameter_list {
+    my $parameters = shift;
+
+    my @types;
+    my @vars;
+    my @parms = split /\s*,\s*/, $parameters;
+
+    for my $parm ( @parms ) {
+        $parm =~ /^(.+)\s+(\S+)$/ or die qq{Can't parse "$parm"};
+        push( @types, $1 );
+        push( @vars, $2 );
+    }
+    return \@types, \@vars;
+}
+
+
 =item C<count_newlines($string)>
 
 Returns the number of newlines (C<\n>) in C<$string>.