Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 6dbc04d484
Fetching contributors…

Cannot retrieve contributors at this time

399 lines (278 sloc) 8.148 kb
# Copyright (C) 2004-2013, Parrot Foundation.
package Parrot::Pmc2c::Emitter;
use strict;
use warnings;
use Parrot::Pmc2c::UtilFunctions qw(count_newlines spew);
use Parrot::Pmc2c::Pmc2cMain ();
use overload '""' => \&stringify;
use overload 'bool' => \&boolify;
=head1 NAME
Parrot::Pmc2c::Emitter
=head1 SYNOPSIS
use Parrot::Pmc2c::Emitter ();
=head1 DESCRIPTION
This package provides various methods for composing parts of files created by
parsing PMCs. Its methods are called by several other packages under
F<lib/Parrot/Pmc2c/>, all of which are ultimately run during the many
instances of F<tools/build/pmc2c.pl> invoked during the F<make> build process.
=head1 PUBLIC METHODS
=head2 C<new()>
=over 4
=item * Purpose
Parrot::Pmc2c::Emitter constructor.
=item * Arguments
Parrot::Pmc2c::Emitter->new( 'path/to/file' );
String holding relative path to file to be written.
=item * Return Value
Parrot::Pmc2c::Emitter object.
=item * Comment
The method's argument is, in practice, the return value of a method call.
Examples:
# lib/Parrot/Pmc2c/PMC.pm
my $c_emitter = Parrot::Pmc2c::Emitter->new( $self->filename(".c") );
my $h_emitter = Parrot::Pmc2c::Emitter->new( $self->filename(".h", $self->is_dynamic) );
# lib/Parrot/Pmc2c/PCCMETHOD.pm
my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename );
my $e = Parrot::Pmc2c::Emitter->new( $pmc->filename(".c") );
=back
=cut
sub new {
my ( $class, $filename ) = @_;
my $data = { filename => $filename, };
return bless $data, $class;
}
=head2 C<text()>
=over 4
=item * Purpose
This, in effect, is a different type of constructor from C<new()>. It takes
up to three arguments and returns an object with a more complex structure.
=item * Arguments
List of one to three strings:
=over 4
=item 1 body
=item 2 filename
=item 3 bline
=back
Examples:
# lib/Parrot/Pmc2c/PMC.pm
body => Parrot::Pmc2c::Emitter->text($body),
# lib/Parrot/Pmc2c/Parser.pm
$pmc->preamble( Parrot::Pmc2c::Emitter->text( $preamble, $filename, 1 ) );
$pmc->postamble( Parrot::Pmc2c::Emitter->text( $post, $filename, $lineno ) );
body => Parrot::Pmc2c::Emitter->text( $methodblock, $filename, $lineno ),
=item * Return Value
Parrot::Pmc2c::Emitter object, apparently suitable for using as value for a
C<body> key in a Parrot::Pmc2c::Method object. B<MUST VERIFY>.
=item * Comment
Also currently (June 2012) used in F<lib/Parrot/Pmc2c/PMC/Null.pm>,
F<lib/Parrot/Pmc2c/PMC/Object.pm>, F<lib/Parrot/Pmc2c/PMC/RO.pm> and
F<lib/Parrot/Pmc2c/PMC/default.pm>.
=back
=cut
sub text {
my ( $class, $body, $filename, $bline ) = @_;
$filename ||= "";
$bline ||= -1;
my %data = (
data => $body,
filename => $filename,
bline => $bline,
eline => $bline + count_newlines($body),
);
return bless \%data, ref($class) || $class;
}
=head2 C<find()>
=over 4
=item * Purpose
Recursively returns strings captured from pattern matches.
=item * Arguments
Single argument: compiled regular expression.
=item * Return Value
If a pattern is matched within a list of items, return the matching string.
Return the object itself it the match is against the C<data> element. Return
a false value otherwise.
=item * Comment
Used in Parrot::Pmc2c::PCCMETHOD. Example:
$matched = $body->find($signature_re);
=back
=cut
sub find {
my ( $self, $regex ) = @_;
if ( $self->{items} ) {
for my $x ( @{ $self->{items} } ) {
my $matched = $x->find($regex);
return $matched if $matched;
}
}
else {
return $self if ( $self->{data} =~ /$regex/ );
}
return 0;
}
=head2 C<subst()>
=over 4
=item * Purpose
Recursively perform substitutions.
=item * Arguments
List of two arguments:
=over 4
=item *
Compiled regular expression.
=item *
Reference to a subroutine which performs a substitution on the string
matched by the first argument's pattern.
=back
=item * Return Value
True value.
=item * Comment
Used in Parrot::Pmc2c::Method. Some of these substitutions can be quite
simple:
$body->subst( qr{\bSELF\b}, sub { '_self' } );
Others are more complex:
# Rewrite STATICSELF.other_method(args...)
$body->subst(
qr{
\bSTATICSELF\b # Macro STATICSELF
\.(\w+) # other_method
\(\s*(.*?)\) # capture argument list
}x,
sub {
"Parrot_${pmcname}"
. ( $pmc->is_vtable_method($1) ? "" : "_nci" ) . "_$1("
. full_arguments($2) . ")";
}
);
=back
=cut
sub subst {
my ( $self, $regex, $replacement ) = @_;
if ( $self->{items} ) {
for my $x ( @{ $self->{items} } ) {
$x->subst( $regex, $replacement );
}
}
else {
while ( $self->{data} =~ m/$regex/ ) {
my $result = $replacement->();
$self->{data} =~ s/$regex/$result/x;
}
}
return 1;
}
=head2 C<replace()>
=over 4
=item * Purpose
=item * Arguments
List of two arguments:
=over 4
=item *
Compiled regular expression.
=item *
Another Parrot::Pmc2c::Emitter object.
=back
=item * Return Value
True value upon success.
=item * Comment
Used in C<Parrot::Pmc2c::PCCMETHOD::rewrite_RETURNs()>. Example:
$matched->replace( $match, $e );
=back
=cut
sub replace {
my ( $self, $regex, $replacement ) = @_;
my $m = $self->{data} =~ /((.*)\Q$regex\E)(.*)/s;
my ( $all, $pre, $post ) = ( $1, $2, $3 );
$self->emit( $pre, $self->filename, $self->{bline} );
$self->add_fragment($replacement);
$self->emit( $post, $self->filename, $self->{bline} + count_newlines($all) );
for my $x (qw( data bline eline )) {
delete $self->{$x};
}
return 1;
}
sub stringify {
my ($self) = @_;
my $out = "";
if ( $self->{items} ) {
for my $x ( @{ $self->{items} } ) {
$out .= $x->stringify;
}
}
else {
$out .= $self->{data};
}
return $out;
}
sub boolify {
my ($self) = @_;
return $self;
}
sub annotate {
my ($self) = @_;
$self->{output} = "";
$self->{current_file} = $self->filename;
$self->{current_line} = 1;
$self->annotate_worker($self);
my $output = $self->{output};
for my $x (qw( output current_line current_file )) {
delete $self->{$x};
}
return $output;
}
sub annotate_worker {
my ( $self, $it ) = @_;
if ( $it->{items} ) {
for my $x ( @{ $it->{items} } ) {
$self->annotate_worker($x);
}
}
else {
my $data;
my $filename = $it->{filename} || $self->filename;
my $line = $it->{bline};
# omit unnecessary #line directives
if ( $line == -1 and $self->filename eq $self->{current_file} ) {
$data = $it->{data};
}
else {
$line = $self->{current_line} if $line == -1;
if (!$Parrot::Pmc2c::Pmc2cMain::OPTIONS->{nolines}) {
( my $filename_escaped = $filename ) =~ s|\\|/|g;
$data .= "#line $line \"$filename_escaped\"\n"
unless $filename_escaped =~ m{\Qlib/Parrot/Pmc2c/PCCMETHOD.pm\E$};
}
$data .= $it->{data};
}
$self->{output} .= $data;
$self->{current_file} = $filename;
$self->{current_line} += count_newlines($data);
}
}
sub emit {
my ( $self, $item, $file, $line ) = @_;
unless ( ref($item) eq 'Parrot::Pmc2c::Emitter' ) {
$file ||= $self->filename;
$line ||= -1;
$item = $self->text( $item, $file, $line );
}
$self->add_fragment($item);
}
sub add_fragment {
my ( $self, $item ) = @_;
push @{ $self->{items} }, $item;
}
sub filename {
my ( $self, $value ) = @_;
$self->{filename} = $value if $value;
return $self->{filename};
}
sub write_to_file {
my ($self) = @_;
spew( $self->filename, $self->annotate );
}
1;
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
Jump to Line
Something went wrong with that request. Please try again.