From: Matt S Trout Date: Sat, 13 Nov 2010 03:05:29 +0000 (+0000) Subject: add inlinability for Accessor.pm X-Git-Tag: 0.009001~27 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f537c36467dafa0ff7eff17d822f4e04a6e11d2c;p=gitmo%2FRole-Tiny.git add inlinability for Accessor.pm --- diff --git a/lib/Method/Generate/Accessor.pm b/lib/Method/Generate/Accessor.pm index 48cb964..971f9bc 100644 --- a/lib/Method/Generate/Accessor.pm +++ b/lib/Method/Generate/Accessor.pm @@ -341,7 +341,7 @@ sub _generate_simple_set { sub _generate_getset { my ($self, $name, $spec) = @_; q{(@_ > 1}."\n ? ".$self->_generate_set($name, $spec) - ."\n : ".$self->_generate_get($name)."\n )"; + ."\n : ".$self->_generate_get($name, $spec)."\n )"; } sub _generate_delegation { diff --git a/lib/Method/Inliner.pm b/lib/Method/Inliner.pm new file mode 100644 index 0000000..b047ace --- /dev/null +++ b/lib/Method/Inliner.pm @@ -0,0 +1,53 @@ +package Method::Inliner; + +use strictures 1; +use Text::Balanced qw(extract_bracketed); +use Sub::Quote (); + +sub slurp { do { local (@ARGV, $/) = $_[0]; <> } } +sub splat { + open my $out, '>', $_[1] or die "can't open $_[1]: $!"; + print $out $_[0] or die "couldn't write to $_[1]: $!"; +} + +sub inlinify { + my $file = $_[0]; + my @chunks = split /(^sub.*?^}$)/sm, slurp $file; + warn join "\n--\n", @chunks; + my %code; + foreach my $chunk (@chunks) { + if (my ($name, $body) = + $chunk =~ /^sub (\S+) {\n(.*)\n}$/s + ) { + $code{$name} = $body; + } + } + foreach my $chunk (@chunks) { + my ($me) = $chunk =~ /^sub.*{\n my \((\$\w+).*\) = \@_;\n/ or next; + my $meq = quotemeta $me; + #warn $meq, $chunk; + my $copy = $chunk; + my ($fixed, $rest); + while ($copy =~ s/^(.*?)${meq}->(\S+)(?=\()//s) { + my ($front, $name) = ($1, $2); + ((my $body), $rest) = extract_bracketed($copy, '()'); + warn "spotted ${name} - ${body}"; + if ($code{$name}) { + warn "replacing"; + s/^\(//, s/\)$// for $body; + $body = "${me}, ".$body; + $fixed .= $front.Sub::Quote::inlinify($code{$name}, $body); + } else { + $fixed .= $front.$me.'->'.$name.$body; + } + #warn $fixed; warn $rest; + $copy = $rest; + } + $fixed .= $rest if $fixed; + warn $fixed if $fixed; + $chunk = $fixed if $fixed; + } + print join '', @chunks; +} + +1; diff --git a/lib/Sub/Quote.pm b/lib/Sub/Quote.pm index 2f6c463..5c34715 100644 --- a/lib/Sub/Quote.pm +++ b/lib/Sub/Quote.pm @@ -33,7 +33,7 @@ sub inlinify { if ($code_args eq $args) { $do.$body.' }' } else { - $do.'my '.$code_args.' = ('.$args.'); '.$body.' }'; + $do.'my ('.$code_args.') = ('.$args.'); '.$body.' }'; } } else { $do.($local ? 'local ' : '').'@_ = ('.$args.'); '.$code.' }';