← 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/Eval/TypeTiny.pm
StatementsExecuted 1357 statements in 8.54ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
46226.84ms13.3msEval::TypeTiny::::eval_closureEval::TypeTiny::eval_closure
46115.88ms5.91msEval::TypeTiny::::_clean_evalEval::TypeTiny::_clean_eval
1111.74ms2.15msEval::TypeTiny::::importEval::TypeTiny::import
3811261µs277µsEval::TypeTiny::::_make_lexical_assignmentEval::TypeTiny::_make_lexical_assignment
461151µs51µsEval::TypeTiny::::CORE:substEval::TypeTiny::CORE:subst (opcode)
461123µs23µsEval::TypeTiny::::CORE:sortEval::TypeTiny::CORE:sort (opcode)
11117µs31µsEval::TypeTiny::::BEGIN@34Eval::TypeTiny::BEGIN@34
381116µs16µsEval::TypeTiny::::CORE:matchEval::TypeTiny::CORE:match (opcode)
11115µs32µsEval::TypeTiny::::BEGIN@3Eval::TypeTiny::BEGIN@3
11111µs16µsEval::TypeTiny::::BEGIN@45Eval::TypeTiny::BEGIN@45
1116µs6µsEval::TypeTiny::::BEGIN@5Eval::TypeTiny::BEGIN@5
0000s0sEval::TypeTiny::::HAS_LEXICAL_VARSEval::TypeTiny::HAS_LEXICAL_VARS
0000s0sEval::TypeTiny::::_manufacture_tiesEval::TypeTiny::_manufacture_ties
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package Eval::TypeTiny;
2
3278µs248µs
# spent 32µs (15+16) within Eval::TypeTiny::BEGIN@3 which was called: # once (15µs+16µs) by Type::Library::BEGIN@12 at line 3
use strict;
# spent 32µs making 1 call to Eval::TypeTiny::BEGIN@3 # spent 16µs making 1 call to strict::import
4
5
# spent 6µs within Eval::TypeTiny::BEGIN@5 which was called: # once (6µs+0s) by Type::Library::BEGIN@12 at line 7
BEGIN {
617µs *HAS_LEXICAL_SUBS = ($] >= 5.018) ? sub(){!!1} : sub(){!!0};
71185µs16µs};
# spent 6µs making 1 call to Eval::TypeTiny::BEGIN@5
8
9{
102700ns my $hlv;
11 sub HAS_LEXICAL_VARS () {
12 $hlv = !! eval { require Devel::LexAlias } unless defined $hlv;
13 return $hlv;
14 }
15}
16
17sub _clean_eval
18
# spent 5.91ms (5.88+32µs) within Eval::TypeTiny::_clean_eval which was called 46 times, avg 128µs/call: # 46 times (5.88ms+32µs) by Eval::TypeTiny::eval_closure at line 82, avg 128µs/call
{
19469µs local $@;
204687µs local $SIG{__DIE__};
21465.24ms my $r = eval $_[0];
# spent 5.58ms executing statements in 20 string evals (merged)
# includes 82µs spent executing 20 calls to 2 subs defined therein. # spent 227µs executing statements in 18 string evals (merged)
# includes 85µs spent executing 18 calls to 2 subs defined therein. # spent 117µs executing statements in string eval
# includes 24µs spent executing 2 calls to 3 subs defined therein. # spent 33µs executing statements in string eval
# includes 23µs spent executing 4 calls to 2 subs defined therein. # spent 20µs executing statements in string eval
# includes 8µs spent executing 4 calls to 2 subs defined therein. # spent 12µs executing statements in string eval
# includes 4µs spent executing 1 call to 2 subs defined therein. # spent 12µs executing statements in string eval
# includes 4µs spent executing 1 call to 2 subs defined therein. # spent 12µs executing statements in string eval
# includes 4µs spent executing 1 call to 2 subs defined therein. # spent 11µs executing statements in string eval
# includes 4µs spent executing 1 call to 2 subs defined therein. # spent 11µs executing statements in string eval
# includes 4µs spent executing 1 call to 2 subs defined therein.
224610µs my $e = $@;
2346315µs return ($r, $e);
24}
25
261900nsour $AUTHORITY = 'cpan:TOBYINK';
271200nsour $VERSION = '0.038';
281900nsour @EXPORT = qw( eval_closure );
291700nsour @EXPORT_OK = qw( HAS_LEXICAL_SUBS HAS_LEXICAL_VARS );
30
31sub import
32
# spent 2.15ms (1.74+409µs) within Eval::TypeTiny::import which was called: # once (1.74ms+409µs) by Type::Library::BEGIN@12 at line 12 of Type/Library.pm
{
33 # do the shuffle!
342132µs245µs
# spent 31µs (17+14) within Eval::TypeTiny::BEGIN@34 which was called: # once (17µs+14µs) by Type::Library::BEGIN@12 at line 34
no warnings "redefine";
# spent 31µs making 1 call to Eval::TypeTiny::BEGIN@34 # spent 14µs making 1 call to warnings::unimport
3517µs our @ISA = qw( Exporter::Tiny );
36185µs require Exporter::Tiny;
371800ns my $next = \&Exporter::Tiny::import;
3812µs *import = $next;
391600ns my $class = shift;
401700ns my $opts = { ref($_[0]) ? %{+shift} : () };
4112µs $opts->{into} ||= scalar(caller);
42117µs1200µs return $class->$next($opts, @_);
# spent 200µs making 1 call to Exporter::Tiny::import
43}
44
452805µs221µs
# spent 16µs (11+5) within Eval::TypeTiny::BEGIN@45 which was called: # once (11µs+5µs) by Type::Library::BEGIN@12 at line 45
use warnings;
# spent 16µs making 1 call to Eval::TypeTiny::BEGIN@45 # spent 5µs making 1 call to warnings::import
46
47sub eval_closure
48
# spent 13.3ms (6.84+6.46) within Eval::TypeTiny::eval_closure which was called 46 times, avg 289µs/call: # 38 times (6.61ms+5.32ms) by Type::Library::_mksub at line 100 of Type/Library.pm, avg 314µs/call # 8 times (232µs+1.14ms) by Type::Tiny::_build_compiled_check at line 326 of Type/Tiny.pm, avg 171µs/call
{
494688µs my (%args) = @_;
504636µs my $src = ref $args{source} eq "ARRAY" ? join("\n", @{$args{source}}) : $args{source};
51
524633µs $args{alias} = 0 unless defined $args{alias};
534620µs $args{line} = 1 unless defined $args{line};
5446168µs4651µs $args{description} =~ s/[^\w .:-\[\]\(\)\{\}\']//g if defined $args{description};
# spent 51µs making 46 calls to Eval::TypeTiny::CORE:subst, avg 1µs/call
554644µs $src = qq{#line $args{line} "$args{description}"\n$src} if defined $args{description} && !($^P & 0x10);
564614µs $args{environment} ||= {};
57
58# for my $k (sort keys %{$args{environment}})
59# {
60# next if $k =~ /^\$/ && ref($args{environment}{$k}) =~ /^(SCALAR|REF)$/;
61# next if $k =~ /^\@/ && ref($args{environment}{$k}) eq q(ARRAY);
62# next if $k =~ /^\%/ && ref($args{environment}{$k}) eq q(HASH);
63#
64# require Error::TypeTiny;
65# Error::TypeTiny::croak("Expected a variable name and ref; got %s => %s", $k, $args{environment}{$k});
66# }
67
684610µs my $sandpkg = 'Eval::TypeTiny::Sandbox';
694622µs my $alias = exists($args{alias}) ? $args{alias} : 0;
7046209µs4623µs my @keys = sort keys %{$args{environment}};
# spent 23µs making 46 calls to Eval::TypeTiny::CORE:sort, avg 493ns/call
71465µs my $i = 0;
7246154µs38277µs my $source = join "\n" => (
# spent 277µs making 38 calls to Eval::TypeTiny::_make_lexical_assignment, avg 7µs/call
73 "package $sandpkg;",
74 "sub {",
75 map(_make_lexical_assignment($_, $i++, $alias), @keys),
76 $src,
77 "}",
78 );
79
80465µs _manufacture_ties() if $alias && !HAS_LEXICAL_VARS;
81
824689µs465.91ms my ($compiler, $e) = _clean_eval($source);
# spent 5.91ms making 46 calls to Eval::TypeTiny::_clean_eval, avg 128µs/call
83465µs if ($e)
84 {
85 chomp $e;
86 require Error::TypeTiny::Compilation;
87 "Error::TypeTiny::Compilation"->throw(
88 code => (ref $args{source} eq "ARRAY" ? join("\n", @{$args{source}}) : $args{source}),
89 errstr => $e,
90 environment => $args{environment},
91 );
92 }
93
9446138µs46199µs my $code = $compiler->(@{$args{environment}}{@keys});
954610µs undef($compiler);
96
97465µs if ($alias && HAS_LEXICAL_VARS) {
98 Devel::LexAlias::lexalias($code, $_, $args{environment}{$_}) for grep !/^\&/, @keys;
99 }
100
10146201µs return $code;
102}
103
10410smy $tmp;
105sub _make_lexical_assignment
106
# spent 277µs (261+16) within Eval::TypeTiny::_make_lexical_assignment which was called 38 times, avg 7µs/call: # 38 times (261µs+16µs) by Eval::TypeTiny::eval_closure at line 72, avg 7µs/call
{
1073813µs my ($key, $index, $alias) = @_;
1083828µs my $name = substr($key, 1);
109
1103890µs3816µs if (HAS_LEXICAL_SUBS and $key =~ /^\&/) {
# spent 16µs making 38 calls to Eval::TypeTiny::CORE:match, avg 421ns/call
111 $tmp++;
112 my $tmpname = '$__LEXICAL_SUB__'.$tmp;
113 return
114 "no warnings 'experimental::lexical_subs';".
115 "use feature 'lexical_subs';".
116 "my $tmpname = \$_[$index];".
117 "my sub $name { goto $tmpname };";
118 }
119
1203811µs if (!$alias) {
1213816µs my $sigil = substr($key, 0, 1);
12238145µs return "my $key = $sigil\{ \$_[$index] };";
123 }
124 elsif (HAS_LEXICAL_VARS) {
125 return "my $key;";
126 }
127 else {
128 my $tieclass = {
129 '@' => 'Eval::TypeTiny::_TieArray',
130 '%' => 'Eval::TypeTiny::_TieHash',
131 '$' => 'Eval::TypeTiny::_TieScalar',
132 }->{ substr($key, 0, 1) };
133
134 return sprintf(
135 'tie(my(%s), "%s", $_[%d]);',
136 $key,
137 $tieclass,
138 $index,
139 );
140 }
141}
142
1432100ns{ my $tie; sub _manufacture_ties { $tie ||= eval <<'FALLBACK'; } }
144no warnings qw(void once uninitialized numeric);
145
146{
147 package #
148 Eval::TypeTiny::_TieArray;
149 require Tie::Array;
150 our @ISA = qw( Tie::StdArray );
151 sub TIEARRAY {
152 my $class = shift;
153 bless $_[0] => $class;
154 }
155 sub AUTOLOAD {
156 my $self = shift;
157 my ($method) = (our $AUTOLOAD =~ /(\w+)$/);
158 defined tied(@$self) and return tied(@$self)->$method(@_);
159 require Carp;
160 Carp::croak(qq[Can't call method "$method" on an undefined value]);
161 }
162 sub can {
163 my $self = shift;
164 my $code = $self->SUPER::can(@_)
165 || (defined tied(@$self) and tied(@$self)->can(@_));
166 return $code;
167 }
168 use overload
169 q[bool] => sub { !! tied @{$_[0]} },
170 q[""] => sub { '' . tied @{$_[0]} },
171 q[0+] => sub { 0 + tied @{$_[0]} },
172 fallback => 1,
173 ;
174}
175{
176 package #
177 Eval::TypeTiny::_TieHash;
178 require Tie::Hash;
179 our @ISA = qw( Tie::StdHash );
180 sub TIEHASH {
181 my $class = shift;
182 bless $_[0] => $class;
183 }
184 sub AUTOLOAD {
185 my $self = shift;
186 my ($method) = (our $AUTOLOAD =~ /(\w+)$/);
187 defined tied(%$self) and return tied(%$self)->$method(@_);
188 require Carp;
189 Carp::croak(qq[Can't call method "$method" on an undefined value]);
190 }
191 sub can {
192 my $self = shift;
193 my $code = $self->SUPER::can(@_)
194 || (defined tied(%$self) and tied(%$self)->can(@_));
195 return $code;
196 }
197 use overload
198 q[bool] => sub { !! tied %{$_[0]} },
199 q[""] => sub { '' . tied %{$_[0]} },
200 q[0+] => sub { 0 + tied %{$_[0]} },
201 fallback => 1,
202 ;
203}
204{
205 package #
206 Eval::TypeTiny::_TieScalar;
207 require Tie::Scalar;
208 our @ISA = qw( Tie::StdScalar );
209 sub TIESCALAR {
210 my $class = shift;
211 bless $_[0] => $class;
212 }
213 sub AUTOLOAD {
214 my $self = shift;
215 my ($method) = (our $AUTOLOAD =~ /(\w+)$/);
216 defined tied($$self) and return tied($$self)->$method(@_);
217 require Carp;
218 Carp::croak(qq[Can't call method "$method" on an undefined value]);
219 }
220 sub can {
221 my $self = shift;
222 my $code = $self->SUPER::can(@_)
223 || (defined tied($$self) and tied($$self)->can(@_));
224 return $code;
225 }
226 use overload
227 q[bool] => sub { !! tied ${$_[0]} },
228 q[""] => sub { '' . tied ${$_[0]} },
229 q[0+] => sub { 0 + tied ${$_[0]} },
230 fallback => 1,
231 ;
232}
233
2341;
235FALLBACK
236
23716µs1;
238
239__END__
 
# spent 16µs within Eval::TypeTiny::CORE:match which was called 38 times, avg 421ns/call: # 38 times (16µs+0s) by Eval::TypeTiny::_make_lexical_assignment at line 110, avg 421ns/call
sub Eval::TypeTiny::CORE:match; # opcode
# spent 23µs within Eval::TypeTiny::CORE:sort which was called 46 times, avg 493ns/call: # 46 times (23µs+0s) by Eval::TypeTiny::eval_closure at line 70, avg 493ns/call
sub Eval::TypeTiny::CORE:sort; # opcode
# spent 51µs within Eval::TypeTiny::CORE:subst which was called 46 times, avg 1µs/call: # 46 times (51µs+0s) by Eval::TypeTiny::eval_closure at line 54, avg 1µs/call
sub Eval::TypeTiny::CORE:subst; # opcode