← Index
NYTProf Performance Profile   « line view »
For examples/Atom-timer.pl
  Run on Mon Aug 12 14:45:28 2013
Reported on Mon Aug 12 14:46:14 2013

Filename/Users/dde/perl5/perlbrew/perls/5.18.0t/lib/5.18.0/overload.pm
StatementsExecuted 89 statements in 677µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
111320µs341µsoverload::::BEGIN@83overload::BEGIN@83
31164µs64µsoverload::::OVERLOADoverload::OVERLOAD
33323µs87µsoverload::::importoverload::import
1117µs12µsoverload::::BEGIN@114overload::BEGIN@114
1117µs68µsoverload::::BEGIN@144overload::BEGIN@144
0000s0soverload::::AddrRefoverload::AddrRef
0000s0soverload::::Methodoverload::Method
0000s0soverload::::Overloadedoverload::Overloaded
0000s0soverload::::OverloadedStringifyoverload::OverloadedStringify
0000s0soverload::::constantoverload::constant
0000s0soverload::::mycanoverload::mycan
0000s0soverload::::niloverload::nil
0000s0soverload::::ov_methodoverload::ov_method
0000s0soverload::::remove_constantoverload::remove_constant
0000s0soverload::::unimportoverload::unimport
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1package overload;
2
31400nsour $VERSION = '1.22';
4
516µs%ops = (
6 with_assign => "+ - * / % ** << >> x .",
7 assign => "+= -= *= /= %= **= <<= >>= x= .=",
8 num_comparison => "< <= > >= == !=",
9 '3way_comparison' => "<=> cmp",
10 str_comparison => "lt le gt ge eq ne",
11 binary => '& &= | |= ^ ^=',
12 unary => "neg ! ~",
13 mutators => '++ --',
14 func => "atan2 cos sin exp abs log sqrt int",
15 conversion => 'bool "" 0+ qr',
16 iterators => '<>',
17 filetest => "-X",
18 dereferencing => '${} @{} %{} &{} *{}',
19 matching => '~~',
20 special => 'nomethod fallback =',
21);
22
231100nsmy %ops_seen;
2412µsfor $category (keys %ops) {
251540µs $ops_seen{$_}++ for (split /\s+/, $ops{$category});
26}
27
28sub nil {}
29
30
# spent 64µs within overload::OVERLOAD which was called 3 times, avg 21µs/call: # 3 times (64µs+0s) by overload::import at line 59, avg 21µs/call
sub OVERLOAD {
313700ns $package = shift;
3234µs my %arg = @_;
333400ns my ($sub, $fb);
34311µs *{$package . "::(("} = \&nil; # Make it findable via fetchmethod.
35312µs for (keys %arg) {
3685µs if ($_ eq 'fallback') {
3738µs for my $sym (*{$package . "::()"}) {
3832µs *$sym = \&nil; # Make it findable via fetchmethod.
3933µs $$sym = $arg{$_};
40 }
41 } else {
4252µs warnings::warnif("overload arg '$_' is invalid")
43 unless $ops_seen{$_};
4451µs $sub = $arg{$_};
4551µs if (not ref $sub) {
46 $ {$package . "::(" . $_} = $sub;
47 $sub = \&nil;
48 }
49 #print STDERR "Setting '$ {'package'}::\cO$_' to \\&'$sub'.\n";
50510µs *{$package . "::(" . $_} = \&{ $sub };
51 }
52 }
53}
54
55
# spent 87µs (23+64) within overload::import which was called 3 times, avg 29µs/call: # once (8µs+30µs) by Moose::Meta::TypeConstraint::BEGIN@14 at line 17 of Moose/Meta/TypeConstraint.pm # once (8µs+19µs) by Moose::Meta::Role::Method::Required::BEGIN@14 at line 15 of Moose/Meta/Role/Method/Required.pm # once (6µs+15µs) by Class::MOP::Method::BEGIN@21 at line 21 of Class/MOP/Method.pm
sub import {
5634µs $package = (caller())[0];
57 # *{$package . "::OVERLOAD"} = \&OVERLOAD;
583400ns shift;
59316µs364µs $package->overload::OVERLOAD(@_);
# spent 64µs making 3 calls to overload::OVERLOAD, avg 21µs/call
60}
61
62sub unimport {
63 $package = (caller())[0];
64 shift;
65 *{$package . "::(("} = \&nil;
66 for (@_) {
67 warnings::warnif("overload arg '$_' is invalid")
68 unless $ops_seen{$_};
69 delete $ {$package . "::"}{$_ eq 'fallback' ? '()' : "(" .$_};
70 }
71}
72
73sub Overloaded {
74 my $package = shift;
75 $package = ref $package if ref $package;
76 mycan ($package, '()') || mycan ($package, '((');
77}
78
79sub ov_method {
80 my $globref = shift;
81 return undef unless $globref;
82 my $sub = \&{*$globref};
832228µs2347µs
# spent 341µs (320+21) within overload::BEGIN@83 which was called: # once (320µs+21µs) by Data::OptList::BEGIN@10 at line 83
no overloading;
# spent 341µs making 1 call to overload::BEGIN@83 # spent 6µs making 1 call to overloading::unimport
84 return $sub if !ref $sub or $sub != \&nil;
85 return shift->can($ {*$globref});
86}
87
88sub OverloadedStringify {
89 my $package = shift;
90 $package = ref $package if ref $package;
91 #$package->can('(""')
92 ov_method mycan($package, '(""'), $package
93 or ov_method mycan($package, '(0+'), $package
94 or ov_method mycan($package, '(bool'), $package
95 or ov_method mycan($package, '(nomethod'), $package;
96}
97
98sub Method {
99 my $package = shift;
100 if(ref $package) {
101 local $@;
102 local $!;
103 require Scalar::Util;
104 $package = Scalar::Util::blessed($package);
105 return undef if !defined $package;
106 }
107 #my $meth = $package->can('(' . shift);
108 ov_method mycan($package, '(' . shift), $package;
109 #return $meth if $meth ne \&nil;
110 #return $ {*{$meth}};
111}
112
113sub AddrRef {
1142123µs218µs
# spent 12µs (7+6) within overload::BEGIN@114 which was called: # once (7µs+6µs) by Data::OptList::BEGIN@10 at line 114
no overloading;
# spent 12µs making 1 call to overload::BEGIN@114 # spent 6µs making 1 call to overloading::unimport
115 "$_[0]";
116}
117
1181800ns*StrVal = *AddrRef;
119
120sub mycan { # Real can would leave stubs.
121 my ($package, $meth) = @_;
122
123 local $@;
124 local $!;
125 require mro;
126
127 my $mro = mro::get_linear_isa($package);
128 foreach my $p (@$mro) {
129 my $fqmeth = $p . q{::} . $meth;
130 return \*{$fqmeth} if defined &{$fqmeth};
131 }
132
133 return undef;
134}
135
13611µs%constants = (
137 'integer' => 0x1000, # HINT_NEW_INTEGER
138 'float' => 0x2000, # HINT_NEW_FLOAT
139 'binary' => 0x4000, # HINT_NEW_BINARY
140 'q' => 0x8000, # HINT_NEW_STRING
141 'qr' => 0x10000, # HINT_NEW_RE
142 );
143
1442184µs2129µs
# spent 68µs (7+61) within overload::BEGIN@144 which was called: # once (7µs+61µs) by Data::OptList::BEGIN@10 at line 144
use warnings::register;
# spent 68µs making 1 call to overload::BEGIN@144 # spent 61µs making 1 call to warnings::register::import
145sub constant {
146 # Arguments: what, sub
147 while (@_) {
148 if (@_ == 1) {
149 warnings::warnif ("Odd number of arguments for overload::constant");
150 last;
151 }
152 elsif (!exists $constants {$_ [0]}) {
153 warnings::warnif ("'$_[0]' is not an overloadable type");
154 }
155 elsif (!ref $_ [1] || "$_[1]" !~ /(^|=)CODE\(0x[0-9a-f]+\)$/) {
156 # Can't use C<ref $_[1] eq "CODE"> above as code references can be
157 # blessed, and C<ref> would return the package the ref is blessed into.
158 if (warnings::enabled) {
159 $_ [1] = "undef" unless defined $_ [1];
160 warnings::warn ("'$_[1]' is not a code reference");
161 }
162 }
163 else {
164 $^H{$_[0]} = $_[1];
165 $^H |= $constants{$_[0]};
166 }
167 shift, shift;
168 }
169}
170
171sub remove_constant {
172 # Arguments: what, sub
173 while (@_) {
174 delete $^H{$_[0]};
175 $^H &= ~ $constants{$_[0]};
176 shift, shift;
177 }
178}
179
180110µs1;
181
182__END__