Author: allison
Date: Wed Aug 20 12:53:32 2008
New Revision: 30391
Added:
branches/pdd27mmd/lib/Parrot/Pmc2c/MULTI.pm
Modified:
branches/pdd27mmd/lib/Parrot/Pmc2c/Method.pm
branches/pdd27mmd/lib/Parrot/Pmc2c/PMCEmitter.pm
branches/pdd27mmd/lib/Parrot/Pmc2c/Parser.pm
Log:
[pdd27mmd] Parse and compile MULTI declarations in .pmc files.
Added: branches/pdd27mmd/lib/Parrot/Pmc2c/MULTI.pm
==============================================================================
--- (empty file)
+++ branches/pdd27mmd/lib/Parrot/Pmc2c/MULTI.pm Wed Aug 20 12:53:32 2008
@@ -0,0 +1,116 @@
+# Copyright (C) 2004-2008, The Perl Foundation.
+# $Id: PCCMETHOD.pm 29952 2008-08-02 22:45:13Z allison $
+
+package Parrot::Pmc2c::MULTI;
+#use base 'Parrot::Pmc2c::PCCMETHOD';
+use strict;
+use warnings;
+use Carp qw(longmess croak);
+
+=head1 NAME
+
+Parrot::Pmc2c::MULTI - Parses and preps MULTI dispatch subs
+
+=head1 SYNOPSIS
+
+ use Parrot::Pmc2c::MULTI;
+
+=head1 DESCRIPTION
+
+Parrot::Pmc2c::MULTI - Parses and preps MULTI multiple dispatch declarations
+called from F<Parrot:Pmc2c::Pmc2cMain>
+
+=cut
+
+=head1 FUNCTIONS
+
+=head2 Publicly Available Methods
+
+=head3 C<rewrite_multi_sub($method, $pmc)>
+
+B<Purpose:> Parse and Build PMC multiple dispatch subs.
+
+B<Arguments:>
+
+=over 4
+
+=item * C<self>
+
+=item * C<method>
+
+Current Method Object
+
+=item * C<body>
+
+Current Method Body
+
+=back
+
+=cut
+
+sub rewrite_parameters {
+ my ($parameters) = @_;
+ my @param_types = ();
+ my @new_params = ();
+ my $new_param_string = "";
+
+ for my $param ( split /,/, $parameters ) {
+ my ( $type, $name, $rest ) = split /\s+/,
&Parrot::Pmc2c::PCCMETHOD::trim($param), 3;
+
+ die "Invalid MULTI parameter '$param': missing type or name\n"
+ unless defined $name;
+
+ die "Invalid MULTI parameter '$param': attributes not allowed on
multis\n"
+ if defined $rest;
+
+ if ($name =~ /[\**]?(\"?\w+\"?)/) {
+ $name = $1;
+ }
+
+ # Capture the actual type for the sub name
+ push @param_types, $type;
+
+ # Pass standard parameter types unmodified.
+ # All other param types are rewritten as PMCs.
+ if ($type eq 'STRING' or $type eq 'PMC' or $type eq 'INTVAL' or $type
eq 'FLOATVAL') {
+ push @new_params, $param;
+ } else {
+ push @new_params, "PMC *$name";
+ }
+ }
+ $new_param_string = join (",", @new_params);
+
+ return ($new_param_string, @param_types);
+}
+
+=head3 C<rewrite_multi_sub()>
+
+ rewrite_multi_sub($method, $pmc);
+
+=cut
+
+sub rewrite_multi_sub {
+ my ( $self, $pmc ) = @_;
+
+ # Fixup the parameters, standardizing PMC types and extracting type names
+ # for the multi name.
+ my ($paramstring, @paramlist) = rewrite_parameters( $self->parameters );
+ $self->parameters($paramstring);
+
+ my $sub_name = "multi_" . $self->name . "_" . join ('_', @paramlist);
+
+ $self->name($sub_name);
+
+ $self->{MULTI} = 1;
+
+ return 1;
+}
+
+1;
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: branches/pdd27mmd/lib/Parrot/Pmc2c/Method.pm
==============================================================================
--- branches/pdd27mmd/lib/Parrot/Pmc2c/Method.pm (original)
+++ branches/pdd27mmd/lib/Parrot/Pmc2c/Method.pm Wed Aug 20 12:53:32 2008
@@ -6,6 +6,7 @@
use constant VTABLE_ENTRY => 'VTABLE_ENTRY';
use constant VTABLE => 'VTABLE';
use constant NON_VTABLE => 'NON_VTABLE';
+use constant MULTI => 'MULTI';
use Parrot::Pmc2c::UtilFunctions qw(count_newlines args_from_parameter_list
passable_args_from_parameter_list);
sub new {
Modified: branches/pdd27mmd/lib/Parrot/Pmc2c/PMCEmitter.pm
==============================================================================
--- branches/pdd27mmd/lib/Parrot/Pmc2c/PMCEmitter.pm (original)
+++ branches/pdd27mmd/lib/Parrot/Pmc2c/PMCEmitter.pm Wed Aug 20 12:53:32 2008
@@ -29,6 +29,7 @@
qw( gen_ret dont_edit count_newlines dynext_load_code c_code_coda );
use Text::Balanced 'extract_bracketed';
use Parrot::Pmc2c::PCCMETHOD;
+use Parrot::Pmc2c::MULTI;
use Parrot::Pmc2c::PMC::RO;
use Parrot::Pmc2c::PMC::ParrotClass;
Modified: branches/pdd27mmd/lib/Parrot/Pmc2c/Parser.pm
==============================================================================
--- branches/pdd27mmd/lib/Parrot/Pmc2c/Parser.pm (original)
+++ branches/pdd27mmd/lib/Parrot/Pmc2c/Parser.pm Wed Aug 20 12:53:32 2008
@@ -158,8 +158,8 @@
((?:PARROT_\w+\s+)+)? # decorators
- # vtable|method marker
- (?:(VTABLE|METHOD)\s+)?
+ # vtable, method, or multi marker
+ (?:(VTABLE|METHOD|MULTI)\s+)?
((?:\w+\s*?\**\s*)?\w+) # method name (includes return type)
\s*
@@ -226,6 +226,10 @@
$pmc->set_flag('need_fia_header');
}
+ if ( $marker and $marker =~ /MULTI/ ) {
+ Parrot::Pmc2c::MULTI::rewrite_multi_sub( $method, $pmc );
+ }
+
# PCCINVOKE needs FixedIntegerArray header
$pmc->set_flag('need_fia_header') if $methodblock =~ /PCCINVOKE/;
@@ -235,13 +239,20 @@
}
else {
- # Name-mangle NCI methods to avoid conflict with vtable methods.
- if ( $marker and $marker !~ /VTABLE/ ) {
- $method->type(Parrot::Pmc2c::Method::NON_VTABLE);
- $method->name("nci_$methodname");
- $method->symbol($methodname);
+ # Name-mangle NCI and multi methods to avoid conflict with vtable
methods.
+ if ( $marker) {
+ if ( $marker =~ /MULTI/ ) {
+ $method->type(Parrot::Pmc2c::Method::MULTI);
+ $method->symbol($methodname);
+ }
+ elsif ( $marker !~ /VTABLE/ ) {
+ $method->type(Parrot::Pmc2c::Method::NON_VTABLE);
+ $method->name("nci_$methodname");
+ $method->symbol($methodname);
+ }
}
+ # To be deprecated
parse_mmds( $method, $filename, $lineno )
if $methodblock =~ /\bMMD_(\w+):/;
