add inlinability for Accessor.pm
Matt S Trout [Sat, 13 Nov 2010 03:05:29 +0000 (03:05 +0000)]
lib/Method/Generate/Accessor.pm
lib/Method/Inliner.pm [new file with mode: 0644]
lib/Sub/Quote.pm

index 48cb964..971f9bc 100644 (file)
@@ -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 (file)
index 0000000..b047ace
--- /dev/null
@@ -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;
index 2f6c463..5c34715 100644 (file)
@@ -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.' }';