← Index
NYTProf Performance Profile   « block view • line view • sub view »
For -e
  Run on Wed Nov 17 21:45:08 2010
Reported on Wed Nov 17 22:13:25 2010

Filename/home/doy/perl5/perlbrew/perls/perl-5.10.1/lib/site_perl/5.10.1/x86_64-linux/List/MoreUtils.pm
StatementsExecuted 26 statements in 1.77ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
540317.32ms7.32msList::MoreUtils::::firstidxList::MoreUtils::firstidx (xsub)
121436.43ms43.7msList::MoreUtils::::allList::MoreUtils::all (xsub)
5543840µs852µsList::MoreUtils::::anyList::MoreUtils::any (xsub)
111237µs237µsList::MoreUtils::::bootstrapList::MoreUtils::bootstrap (xsub)
822122µs122µsList::MoreUtils::::uniqList::MoreUtils::uniq (xsub)
111118µs118µsList::MoreUtils::::BEGIN@3List::MoreUtils::BEGIN@3
11140µs361µsList::MoreUtils::::BEGIN@8List::MoreUtils::BEGIN@8
11138µs56µsList::MoreUtils::::BEGIN@4List::MoreUtils::BEGIN@4
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package List::MoreUtils;
2
33168µs1118µs
# spent 118µs within List::MoreUtils::BEGIN@3 which was called: # once (118µs+0s) by Class::MOP::Class::BEGIN@18 at line 3
use 5.00503;
# spent 118µs making 1 call to List::MoreUtils::BEGIN@3
43137µs274µs
# spent 56µs (38+18) within List::MoreUtils::BEGIN@4 which was called: # once (38µs+18µs) by Class::MOP::Class::BEGIN@18 at line 4
use strict;
# spent 56µs making 1 call to List::MoreUtils::BEGIN@4 # spent 18µs making 1 call to strict::import
5
614µsrequire Exporter;
713µsrequire DynaLoader;
831.20ms2682µs
# spent 361µs (40+321) within List::MoreUtils::BEGIN@8 which was called: # once (40µs+321µs) by Class::MOP::Class::BEGIN@18 at line 8
use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
# spent 361µs making 1 call to List::MoreUtils::BEGIN@8 # spent 321µs making 1 call to vars::import
9147µs@ISA = qw(Exporter DynaLoader);
10
11125µs%EXPORT_TAGS = (
12 all => [ qw(any all none notall true false firstidx first_index lastidx
13 last_index insert_after insert_after_string apply after after_incl before
14 before_incl indexes firstval first_value lastval last_value each_array
15 each_arrayref pairwise natatime mesh zip uniq minmax part) ],
16);
17
18161µs@EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
19
2013µs$VERSION = '0.22';
21
2218µseval {
2313µs local $ENV{PERL_DL_NONLAZY} = 0 if $ENV{PERL_DL_NONLAZY};
24130µs11.17ms bootstrap List::MoreUtils $VERSION;
# spent 1.17ms making 1 call to DynaLoader::bootstrap
2513µs 1;
26} if not $ENV{LIST_MOREUTILS_PP};
27
2814µseval <<'EOP' if not defined &any;
29
30sub any (&@) {
31 my $f = shift;
32 return if ! @_;
33 for (@_) {
34 return 1 if $f->();
35 }
36 return 0;
37}
38
39sub all (&@) {
40 my $f = shift;
41 return if ! @_;
42 for (@_) {
43 return 0 if ! $f->();
44 }
45 return 1;
46}
47
48sub none (&@) {
49 my $f = shift;
50 return if ! @_;
51 for (@_) {
52 return 0 if $f->();
53 }
54 return 1;
55}
56
57sub notall (&@) {
58 my $f = shift;
59 return if ! @_;
60 for (@_) {
61 return 1 if ! $f->();
62 }
63 return 0;
64}
65
66sub true (&@) {
67 my $f = shift;
68 my $count = 0;
69 for (@_) {
70 $count++ if $f->();
71 }
72 return $count;
73}
74
75sub false (&@) {
76 my $f = shift;
77 my $count = 0;
78 for (@_) {
79 $count++ if ! $f->();
80 }
81 return $count;
82}
83
84sub firstidx (&@) {
85 my $f = shift;
86 for my $i (0 .. $#_) {
87 local *_ = \$_[$i];
88 return $i if $f->();
89 }
90 return -1;
91}
92
93sub lastidx (&@) {
94 my $f = shift;
95 for my $i (reverse 0 .. $#_) {
96 local *_ = \$_[$i];
97 return $i if $f->();
98 }
99 return -1;
100}
101
102sub insert_after (&$\@) {
103 my ($code, $val, $list) = @_;
104 my $c = -1;
105 local *_;
106 for my $i (0 .. $#$list) {
107 $_ = $list->[$i];
108 $c = $i, last if $code->();
109 }
110 @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
111 return 0;
112}
113
114sub insert_after_string ($$\@) {
115 my ($string, $val, $list) = @_;
116 my $c = -1;
117 for my $i (0 .. $#$list) {
118 local $^W = 0;
119 $c = $i, last if $string eq $list->[$i];
120 }
121 @$list = (@{$list}[0..$c], $val, @{$list}[$c+1..$#$list]) and return 1 if $c != -1;
122 return 0;
123}
124
125sub apply (&@) {
126 my $action = shift;
127 &$action for my @values = @_;
128 wantarray ? @values : $values[-1];
129}
130
131sub after (&@)
132{
133 my $test = shift;
134 my $started;
135 my $lag;
136 grep $started ||= do { my $x=$lag; $lag=$test->(); $x}, @_;
137}
138
139sub after_incl (&@)
140{
141 my $test = shift;
142 my $started;
143 grep $started ||= $test->(), @_;
144}
145
146sub before (&@)
147{
148 my $test = shift;
149 my $keepgoing=1;
150 grep $keepgoing &&= !$test->(), @_;
151}
152
153sub before_incl (&@)
154{
155 my $test = shift;
156 my $keepgoing=1;
157 my $lag=1;
158 grep $keepgoing &&= do { my $x=$lag; $lag=!$test->(); $x}, @_;
159}
160
161sub indexes (&@)
162{
163 my $test = shift;
164 grep {local *_=\$_[$_]; $test->()} 0..$#_;
165}
166
167sub lastval (&@)
168{
169 my $test = shift;
170 my $ix;
171 for ($ix=$#_; $ix>=0; $ix--)
172 {
173 local *_ = \$_[$ix];
174 my $testval = $test->();
175 $_[$ix] = $_; # simulate $_ as alias
176 return $_ if $testval;
177 }
178 return undef;
179}
180
181sub firstval (&@)
182{
183 my $test = shift;
184 foreach (@_)
185 {
186 return $_ if $test->();
187 }
188 return undef;
189}
190
191sub pairwise(&\@\@)
192{
193 my $op = shift;
194 use vars qw/@A @B/;
195 local (*A, *B) = @_; # syms for caller's input arrays
196
197 # Localise $a, $b
198 my ($caller_a, $caller_b) = do
199 {
200 my $pkg = caller();
201 no strict 'refs';
202 \*{$pkg.'::a'}, \*{$pkg.'::b'};
203 };
204
205 my $limit = $#A > $#B? $#A : $#B; # loop iteration limit
206
207 local(*$caller_a, *$caller_b);
208 map # This map expression is also the return value.
209 {
210 # assign to $a, $b as refs to caller's array elements
211 (*$caller_a, *$caller_b) = \($A[$_], $B[$_]);
212 $op->(); # perform the transformation
213 } 0 .. $limit;
214}
215
216sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
217{
218 return each_arrayref(@_);
219}
220
221sub each_arrayref
222{
223 my @arr_list = @_; # The list of references to the arrays
224 my $index = 0; # Which one the caller will get next
225 my $max_num = 0; # Number of elements in longest array
226
227 # Get the length of the longest input array
228 foreach (@arr_list)
229 {
230 unless (ref($_) eq 'ARRAY')
231 {
232 require Carp;
233 Carp::croak "each_arrayref: argument is not an array reference\n";
234 }
235 $max_num = @$_ if @$_ > $max_num;
236 }
237
238 # Return the iterator as a closure wrt the above variables.
239 return sub
240 {
241 if (@_)
242 {
243 my $method = shift;
244 if ($method eq 'index')
245 {
246 # Return current (last fetched) index
247 return undef if $index == 0 || $index > $max_num;
248 return $index-1;
249 }
250 else
251 {
252 require Carp;
253 Carp::croak "each_array: unknown argument '$method' passed to iterator.";
254 }
255 }
256
257 return if $index >= $max_num; # No more elements to return
258 my $i = $index++;
259 return map $_->[$i], @arr_list; # Return ith elements
260 }
261}
262
263sub natatime ($@)
264{
265 my $n = shift;
266 my @list = @_;
267
268 return sub
269 {
270 return splice @list, 0, $n;
271 }
272}
273
274sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@) {
275 my $max = -1;
276 $max < $#$_ && ($max = $#$_) for @_;
277
278 map { my $ix = $_; map $_->[$ix], @_; } 0..$max;
279}
280
281sub uniq (@) {
282 my %h;
283 map { $h{$_}++ == 0 ? $_ : () } @_;
284}
285
286sub minmax (@) {
287 return if ! @_;
288 my $min = my $max = $_[0];
289
290 for (my $i = 1; $i < @_; $i += 2) {
291 if ($_[$i-1] <= $_[$i]) {
292 $min = $_[$i-1] if $min > $_[$i-1];
293 $max = $_[$i] if $max < $_[$i];
294 } else {
295 $min = $_[$i] if $min > $_[$i];
296 $max = $_[$i-1] if $max < $_[$i-1];
297 }
298 }
299
300 if (@_ & 1) {
301 my $i = $#_;
302 if ($_[$i-1] <= $_[$i]) {
303 $min = $_[$i-1] if $min > $_[$i-1];
304 $max = $_[$i] if $max < $_[$i];
305 } else {
306 $min = $_[$i] if $min > $_[$i];
307 $max = $_[$i-1] if $max < $_[$i-1];
308 }
309 }
310
311 return ($min, $max);
312}
313
314sub part(&@) {
315 my ($code, @list) = @_;
316 my @parts;
317 push @{ $parts[$code->($_)] }, $_ for @list;
318 return @parts;
319}
320
321sub _XScompiled {
322 return 0;
323}
324
325EOP
326
32716µs*first_index = \&firstidx;
32813µs*last_index = \&lastidx;
32913µs*first_value = \&firstval;
33013µs*last_value = \&lastval;
33113µs*zip = \&mesh;
332
333156µs1;
334__END__
 
# spent 43.7ms (6.43+37.3) within List::MoreUtils::all which was called 121 times, avg 361µs/call: # 38 times (1.07ms+35.2ms) by Moose::Util::MetaRole::_make_new_class at line 161 of Moose/Util/MetaRole.pm, avg 954µs/call # 34 times (4.42ms+1.93ms) by Class::MOP::Class::_check_metaclass_compatibility at line 227 of Class/MOP/Class.pm, avg 187µs/call # 25 times (354µs+0s) by Moose::Util::TypeConstraints::subtype at line 327 of Moose/Util/TypeConstraints.pm, avg 14µs/call # 24 times (583µs+142µs) by Moose::Util::TypeConstraints::subtype at line 315 of Moose/Util/TypeConstraints.pm, avg 30µs/call
sub List::MoreUtils::all; # xsub
# spent 852µs (840+12) within List::MoreUtils::any which was called 55 times, avg 15µs/call: # 42 times (629µs+0s) by Moose::Meta::Method::Accessor::Native::Writer::_is_root_type at line 110 of Moose/Meta/Method/Accessor/Native/Writer.pm, avg 15µs/call # 6 times (103µs+0s) by Class::MOP::Class:::before at line 26 of Moose/Meta/Attribute/Native/Trait.pm, avg 17µs/call # 6 times (66µs+0s) by Class::MOP::Class:::before at line 34 of Moose/Meta/Attribute/Native/Trait.pm, avg 11µs/call # once (42µs+12µs) by Moose::Util::TypeConstraints::type at line 278 of Moose/Util/TypeConstraints.pm
sub List::MoreUtils::any; # xsub
# spent 237µs within List::MoreUtils::bootstrap which was called: # once (237µs+0s) by DynaLoader::bootstrap at line 223 of DynaLoader.pm
sub List::MoreUtils::bootstrap; # xsub
# spent 7.32ms within List::MoreUtils::firstidx which was called 540 times, avg 14µs/call: # 180 times (3.26ms+0s) by Moose::Exporter::_strip_traits at line 460 of Moose/Exporter.pm, avg 18µs/call # 180 times (2.09ms+0s) by Moose::Exporter::_strip_metaclass at line 474 of Moose/Exporter.pm, avg 12µs/call # 180 times (1.98ms+0s) by Moose::Exporter::_strip_meta_name at line 486 of Moose/Exporter.pm, avg 11µs/call
sub List::MoreUtils::firstidx; # xsub
# spent 122µs within List::MoreUtils::uniq which was called 8 times, avg 15µs/call: # 7 times (88µs+0s) by Moose::Exporter::_follow_also at line 139 of Moose/Exporter.pm, avg 13µs/call # once (34µs+0s) by Markdent::Dialect::Standard::BlockParser::BEGIN@28 at line 26 of Markdent/Regexes.pm
sub List::MoreUtils::uniq; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.