← Index
NYTProf Performance Profile   « line view »
For fastest.pl
  Run on Fri Jan 31 20:48:16 2014
Reported on Fri Jan 31 20:49:41 2014

Filename/opt/perl-5.18.1/lib/site_perl/5.18.1/Sub/Quote.pm
StatementsExecuted 174 statements in 1.98ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
3111.28ms1.37msSub::Quote::::_clean_evalSub::Quote::_clean_eval
311221µs234µsSub::Quote::::capture_unrollSub::Quote::capture_unroll
63395µs201µsSub::Quote::::quote_subSub::Quote::quote_sub
31186µs1.69msSub::Quote::::unquote_subSub::Quote::unquote_sub
11122µs79µsSub::Quote::::BEGIN@3Sub::Quote::BEGIN@3
21119µs21µsSub::Quote::::inlinifySub::Quote::inlinify
11112µs48µsSub::Quote::::BEGIN@7Sub::Quote::BEGIN@7
41110µs10µsSub::Quote::::quoted_from_subSub::Quote::quoted_from_sub
1119µs24µsSub::Quote::::BEGIN@108Sub::Quote::BEGIN@108
1119µs36µsSub::Quote::::BEGIN@8Sub::Quote::BEGIN@8
1119µs36µsSub::Quote::::BEGIN@9Sub::Quote::BEGIN@9
1119µs82µsSub::Quote::::BEGIN@10Sub::Quote::BEGIN@10
6218µs8µsSub::Quote::::CORE:matchSub::Quote::CORE:match (opcode)
0000s0sSub::Quote::::CLONESub::Quote::CLONE
0000s0sSub::Quote::::__ANON__[:69]Sub::Quote::__ANON__[:69]
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Sub::Quote;
2
3368µs3135µs
# spent 79µs (22+57) within Sub::Quote::BEGIN@3 which was called: # once (22µs+57µs) by Foo::Moo::QS::BEGIN@130 at line 3
use strictures 1;
# spent 79µs making 1 call to Sub::Quote::BEGIN@3 # spent 40µs making 1 call to strictures::import # spent 16µs making 1 call to strictures::VERSION
4
53289µs
# spent 1.37ms (1.28+90µs) within Sub::Quote::_clean_eval which was called 3 times, avg 458µs/call: # 3 times (1.28ms+90µs) by Sub::Quote::unquote_sub at line 110, avg 458µs/call
sub _clean_eval { eval $_[0] }
# spent 368µs executing statements in string eval
# includes 32µs spent executing 3 calls to 2 subs defined therein. # spent 358µs executing statements in string eval
# includes 47µs spent executing 4 calls to 2 subs defined therein. # spent 347µs executing statements in string eval
# includes 30µs spent executing 3 calls to 2 subs defined therein.
6
7245µs283µs
# spent 48µs (12+35) within Sub::Quote::BEGIN@7 which was called: # once (12µs+35µs) by Foo::Moo::QS::BEGIN@130 at line 7
use Sub::Defer;
# spent 48µs making 1 call to Sub::Quote::BEGIN@7 # spent 35µs making 1 call to Exporter::import
8233µs264µs
# spent 36µs (9+27) within Sub::Quote::BEGIN@8 which was called: # once (9µs+27µs) by Foo::Moo::QS::BEGIN@130 at line 8
use B 'perlstring';
# spent 36µs making 1 call to Sub::Quote::BEGIN@8 # spent 28µs making 1 call to Exporter::import
9233µs263µs
# spent 36µs (9+27) within Sub::Quote::BEGIN@9 which was called: # once (9µs+27µs) by Foo::Moo::QS::BEGIN@130 at line 9
use Scalar::Util qw(weaken);
# spent 36µs making 1 call to Sub::Quote::BEGIN@9 # spent 27µs making 1 call to Exporter::import
102767µs2156µs
# spent 82µs (9+74) within Sub::Quote::BEGIN@10 which was called: # once (9µs+74µs) by Foo::Moo::QS::BEGIN@130 at line 10
use base qw(Exporter);
# spent 82µs making 1 call to Sub::Quote::BEGIN@10 # spent 74µs making 1 call to base::import
11
121800nsour $VERSION = '1.003001';
13115µs$VERSION = eval $VERSION;
# spent 3µs executing statements in string eval
14
1511µsour @EXPORT = qw(quote_sub unquote_sub quoted_from_sub);
16
171200nsour %QUOTED;
18
1910sour %WEAK_REFS;
20
21
# spent 234µs (221+13) within Sub::Quote::capture_unroll which was called 3 times, avg 78µs/call: # 3 times (221µs+13µs) by Sub::Quote::unquote_sub at line 89, avg 78µs/call
sub capture_unroll {
2231µs my ($from, $captures, $indent) = @_;
234184µs47µs join(
# spent 7µs making 4 calls to Sub::Quote::CORE:match, avg 2µs/call
24 '',
25 map {
26319µs /^([\@\%\$])/
27 or die "capture key should start with \@, \% or \$: $_";
28832µs46µs (' ' x $indent).qq{my ${_} = ${1}{${from}->{${\perlstring $_}}};\n};
# spent 6µs making 4 calls to B::perlstring, avg 2µs/call
29 } keys %$captures
30 );
31}
32
33
# spent 21µs (19+2) within Sub::Quote::inlinify which was called 2 times, avg 10µs/call: # 2 times (19µs+2µs) by Method::Generate::Accessor::_generate_call_code at line 442 of Method/Generate/Accessor.pm, avg 10µs/call
sub inlinify {
3421µs my ($code, $args, $extra, $local) = @_;
3522µs my $do = 'do { '.($extra||'');
36214µs22µs if (my ($code_args, $body) = $code =~ / +my \(([^)]+)\) = \@_;(.*)$/s) {
# spent 2µs making 2 calls to Sub::Quote::CORE:match, avg 900ns/call
37 if ($code_args eq $args) {
38 $do.$body.' }'
39 } else {
40 $do.'my ('.$code_args.') = ('.$args.'); '.$body.' }';
41 }
42 } else {
432900ns my $assign = '';
4422µs if ($local || $args ne '@_') {
45 $assign = ($local ? 'local ' : '').'@_ = ('.$args.'); ';
46 }
4722µs $do.$assign.$code.' }';
48 }
49}
50
51
# spent 201µs (95+106) within Sub::Quote::quote_sub which was called 6 times, avg 34µs/call: # 3 times (52µs+34µs) by Method::Generate::Constructor::generate_method at line 98 of Method/Generate/Constructor.pm, avg 28µs/call # 2 times (30µs+60µs) by Method::Generate::Accessor::generate_method at line 132 of Method/Generate/Accessor.pm, avg 45µs/call # once (13µs+12µs) by main::RUNTIME at line 131 of fastest.pl
sub quote_sub {
52 # HOLY DWIMMERY, BATMAN!
53 # $name => $code => \%captures => \%options
54 # $name => $code => \%captures
55 # $name => $code
56 # $code => \%captures => \%options
57 # $code
5868µs my $options =
59 (ref($_[-1]) eq 'HASH' and ref($_[-2]) eq 'HASH')
60 ? pop
61 : {};
6262µs my $captures = pop if ref($_[-1]) eq 'HASH';
6365µs undef($captures) if $captures && !keys %$captures;
6462µs my $code = pop;
6562µs my $name = $_[0];
666600ns my $quoted_info;
67 my $deferred = defer_sub +($options->{no_install} ? undef : $name) => sub {
68 unquote_sub($quoted_info->[4]);
69626µs6101µs };
# spent 101µs making 6 calls to Sub::Defer::defer_sub, avg 17µs/call
7068µs $quoted_info = [ $name, $code, $captures, undef, $deferred ];
71623µs64µs weaken($QUOTED{$deferred} = $quoted_info);
# spent 4µs making 6 calls to Scalar::Util::weaken, avg 750ns/call
72621µs return $deferred;
73}
74
75
# spent 10µs within Sub::Quote::quoted_from_sub which was called 4 times, avg 2µs/call: # 4 times (10µs+0s) by Method::Generate::Accessor::_generate_call_code at line 428 of Method/Generate/Accessor.pm, avg 2µs/call
sub quoted_from_sub {
7641µs my ($sub) = @_;
77413µs $QUOTED{$sub||''};
78}
79
80
# spent 1.69ms (86µs+1.61) within Sub::Quote::unquote_sub which was called 3 times, avg 565µs/call: # 3 times (86µs+1.61ms) by Method::Generate::Constructor::__ANON__[/opt/perl-5.18.1/lib/site_perl/5.18.1/Method/Generate/Constructor.pm:64] at line 61 of Method/Generate/Constructor.pm, avg 565µs/call
sub unquote_sub {
8131µs my ($sub) = @_;
8236µs unless ($QUOTED{$sub}[3]) {
8337µs my ($name, $code, $captures) = @{$QUOTED{$sub}};
84
8531µs my $make_sub = "{\n";
86
8733µs my %captures = $captures ? %$captures : ();
8834µs $captures{'$_QUOTED'} = \$QUOTED{$sub};
8936µs3234µs $make_sub .= capture_unroll("\$_[1]", \%captures, 2);
# spent 234µs making 3 calls to Sub::Quote::capture_unroll, avg 78µs/call
90
9133µs $make_sub .= (
92 $name
93 # disable the 'variable $x will not stay shared' warning since
94 # we're not letting it escape from this scope anyway so there's
95 # nothing trying to share it
96 ? " no warnings 'closure';\n sub ${name} {\n"
97 : " \$_QUOTED->[3] = sub {\n"
98 );
9931µs $make_sub .= $code;
10032µs $make_sub .= " }".($name ? '' : ';')."\n";
10132µs if ($name) {
102 $make_sub .= " \$_QUOTED->[3] = \\&${name}\n";
103 }
1043600ns $make_sub .= "}\n1;\n";
10532µs $ENV{SUB_QUOTE_DEBUG} && warn $make_sub;
106 {
10764µs local $@;
1082283µs238µs
# spent 24µs (9+15) within Sub::Quote::BEGIN@108 which was called: # once (9µs+15µs) by Foo::Moo::QS::BEGIN@130 at line 108
no strict 'refs';
# spent 24µs making 1 call to Sub::Quote::BEGIN@108 # spent 15µs making 1 call to strict::unimport
10937µs local *{$name} if $name;
11038µs31.37ms unless (_clean_eval $make_sub, \%captures) {
# spent 1.37ms making 3 calls to Sub::Quote::_clean_eval, avg 458µs/call
111 die "Eval went very, very wrong:\n\n${make_sub}\n\n$@";
112 }
113 }
114 }
115314µs $QUOTED{$sub}[3];
116}
117
118sub CLONE {
119 %QUOTED = map { defined $_ ? ($_->[4] => $_) : () } values %QUOTED;
120 weaken($_) for values %QUOTED;
121}
122
12315µs1;
124
125=head1 NAME
126
127Sub::Quote - efficient generation of subroutines via string eval
128
129=head1 SYNOPSIS
130
131 package Silly;
132
133 use Sub::Quote qw(quote_sub unquote_sub quoted_from_sub);
134
135 quote_sub 'Silly::kitty', q{ print "meow" };
136
137 quote_sub 'Silly::doggy', q{ print "woof" };
138
139 my $sound = 0;
140
141 quote_sub 'Silly::dagron',
142 q{ print ++$sound % 2 ? 'burninate' : 'roar' },
143 { '$sound' => \$sound };
144
145And elsewhere:
146
147 Silly->kitty; # meow
148 Silly->doggy; # woof
149 Silly->dagron; # burninate
150 Silly->dagron; # roar
151 Silly->dagron; # burninate
152
153=head1 DESCRIPTION
154
155This package provides performant ways to generate subroutines from strings.
156
157=head1 SUBROUTINES
158
159=head2 quote_sub
160
161 my $coderef = quote_sub 'Foo::bar', q{ print $x++ . "\n" }, { '$x' => \0 };
162
163Arguments: ?$name, $code, ?\%captures, ?\%options
164
165C<$name> is the subroutine where the coderef will be installed.
166
167C<$code> is a string that will be turned into code.
168
169C<\%captures> is a hashref of variables that will be made available to the
170code. The keys should be the full name of the variable to be made available,
171including the sigil. The values should be references to the values. The
172variables will contain copies of the values. See the L</SYNOPSIS>'s
173C<Silly::dagron> for an example using captures.
174
175=head3 options
176
177=over 2
178
179=item * no_install
180
181B<Boolean>. Set this option to not install the generated coderef into the
182passed subroutine name on undefer.
183
184=back
185
186=head2 unquote_sub
187
188 my $coderef = unquote_sub $sub;
189
190Forcibly replace subroutine with actual code.
191
192If $sub is not a quoted sub, this is a no-op.
193
194=head2 quoted_from_sub
195
196 my $data = quoted_from_sub $sub;
197
198 my ($name, $code, $captures, $compiled_sub) = @$data;
199
200Returns original arguments to quote_sub, plus the compiled version if this
201sub has already been unquoted.
202
203Note that $sub can be either the original quoted version or the compiled
204version for convenience.
205
206=head2 inlinify
207
208 my $prelude = capture_unroll '$captures', {
209 '$x' => 1,
210 '$y' => 2,
211 };
212
213 my $inlined_code = inlinify q{
214 my ($x, $y) = @_;
215
216 print $x + $y . "\n";
217 }, '$x, $y', $prelude;
218
219Takes a string of code, a string of arguments, a string of code which acts as a
220"prelude", and a B<Boolean> representing whether or not to localize the
221arguments.
222
223=head2 capture_unroll
224
225 my $prelude = capture_unroll '$captures', {
226 '$x' => 1,
227 '$y' => 2,
228 }, 4;
229
230Arguments: $from, \%captures, $indent
231
232Generates a snippet of code which is suitable to be used as a prelude for
233L</inlinify>. C<$from> is a string will be used as a hashref in the resulting
234code. The keys of C<%captures> are the names of the variables and the values
235are ignored. C<$indent> is the number of spaces to indent the result by.
236
237=head1 CAVEATS
238
239Much of this is just string-based code-generation, and as a result, a few caveats
240apply.
241
242=head2 return
243
244Calling C<return> from a quote_sub'ed sub will not likely do what you intend.
245Instead of returning from the code you defined in C<quote_sub>, it will return
246from the overall function it is composited into.
247
248So when you pass in:
249
250 quote_sub q{ return 1 if $condition; $morecode }
251
252It might turn up in the intended context as follows:
253
254 sub foo {
255
256 <important code a>
257 do {
258 return 1 if $condition;
259 $morecode
260 };
261 <important code b>
262
263 }
264
265Which will obviously return from foo, when all you meant to do was return from
266the code context in quote_sub and proceed with running important code b.
267
268=head2 strictures
269
270Sub::Quote compiles quoted subs in an environment where C<< use strictures >>
271is in effect. L<strictures> enables L<strict> and FATAL L<warnings>.
272
273The following dies I<< Use of uninitialized value in print... >>
274
275 no warnings;
276 quote_sub 'Silly::kitty', q{ print undef };
277
278If you need to disable parts of strictures, do it within the quoted sub:
279
280 quote_sub 'Silly::kitty', q{ no warnings; print undef };
281
282=head1 SUPPORT
283
284See L<Moo> for support and contact information.
285
286=head1 AUTHORS
287
288See L<Moo> for authors.
289
290=head1 COPYRIGHT AND LICENSE
291
292See L<Moo> for the copyright and license.
 
# spent 8µs within Sub::Quote::CORE:match which was called 6 times, avg 1µs/call: # 4 times (7µs+0s) by Sub::Quote::capture_unroll at line 23, avg 2µs/call # 2 times (2µs+0s) by Sub::Quote::inlinify at line 36, avg 900ns/call
sub Sub::Quote::CORE:match; # opcode