← Index
NYTProf Performance Profile   « line view »
For /Users/timbo/perl5/perlbrew/perls/perl-5.18.2/bin/perlcritic
  Run on Sat Mar 19 22:12:22 2016
Reported on Sat Mar 19 22:14:10 2016

Filename/Users/timbo/perl5/perlbrew/perls/perl-5.18.2/lib/site_perl/5.18.2/darwin-2level/List/MoreUtils/PP.pm
StatementsExecuted 12 statements in 2.01ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11115µs15µsList::MoreUtils::PP::::BEGIN@3List::MoreUtils::PP::BEGIN@3
11110µs14µsList::MoreUtils::PP::::BEGIN@5List::MoreUtils::PP::BEGIN@5
1118µs39µsList::MoreUtils::PP::::BEGIN@327List::MoreUtils::PP::BEGIN@327
1117µs17µsList::MoreUtils::PP::::BEGIN@334List::MoreUtils::PP::BEGIN@334
1116µs18µsList::MoreUtils::PP::::BEGIN@4List::MoreUtils::PP::BEGIN@4
0000s0sList::MoreUtils::PP::::_XScompiledList::MoreUtils::PP::_XScompiled
0000s0sList::MoreUtils::PP::::__ANON__[:261]List::MoreUtils::PP::__ANON__[:261]
0000s0sList::MoreUtils::PP::::__ANON__[:396]List::MoreUtils::PP::__ANON__[:396]
0000s0sList::MoreUtils::PP::::__ANON__[:405]List::MoreUtils::PP::__ANON__[:405]
0000s0sList::MoreUtils::PP::::afterList::MoreUtils::PP::after
0000s0sList::MoreUtils::PP::::after_inclList::MoreUtils::PP::after_incl
0000s0sList::MoreUtils::PP::::allList::MoreUtils::PP::all
0000s0sList::MoreUtils::PP::::all_uList::MoreUtils::PP::all_u
0000s0sList::MoreUtils::PP::::anyList::MoreUtils::PP::any
0000s0sList::MoreUtils::PP::::any_uList::MoreUtils::PP::any_u
0000s0sList::MoreUtils::PP::::applyList::MoreUtils::PP::apply
0000s0sList::MoreUtils::PP::::beforeList::MoreUtils::PP::before
0000s0sList::MoreUtils::PP::::before_inclList::MoreUtils::PP::before_incl
0000s0sList::MoreUtils::PP::::bsearchList::MoreUtils::PP::bsearch
0000s0sList::MoreUtils::PP::::bsearchidxList::MoreUtils::PP::bsearchidx
0000s0sList::MoreUtils::PP::::each_arrayList::MoreUtils::PP::each_array
0000s0sList::MoreUtils::PP::::each_arrayrefList::MoreUtils::PP::each_arrayref
0000s0sList::MoreUtils::PP::::falseList::MoreUtils::PP::false
0000s0sList::MoreUtils::PP::::firstidxList::MoreUtils::PP::firstidx
0000s0sList::MoreUtils::PP::::firstresList::MoreUtils::PP::firstres
0000s0sList::MoreUtils::PP::::firstvalList::MoreUtils::PP::firstval
0000s0sList::MoreUtils::PP::::indexesList::MoreUtils::PP::indexes
0000s0sList::MoreUtils::PP::::insert_afterList::MoreUtils::PP::insert_after
0000s0sList::MoreUtils::PP::::insert_after_stringList::MoreUtils::PP::insert_after_string
0000s0sList::MoreUtils::PP::::lastidxList::MoreUtils::PP::lastidx
0000s0sList::MoreUtils::PP::::lastresList::MoreUtils::PP::lastres
0000s0sList::MoreUtils::PP::::lastvalList::MoreUtils::PP::lastval
0000s0sList::MoreUtils::PP::::meshList::MoreUtils::PP::mesh
0000s0sList::MoreUtils::PP::::minmaxList::MoreUtils::PP::minmax
0000s0sList::MoreUtils::PP::::natatimeList::MoreUtils::PP::natatime
0000s0sList::MoreUtils::PP::::noneList::MoreUtils::PP::none
0000s0sList::MoreUtils::PP::::none_uList::MoreUtils::PP::none_u
0000s0sList::MoreUtils::PP::::notallList::MoreUtils::PP::notall
0000s0sList::MoreUtils::PP::::notall_uList::MoreUtils::PP::notall_u
0000s0sList::MoreUtils::PP::::nsort_byList::MoreUtils::PP::nsort_by
0000s0sList::MoreUtils::PP::::oneList::MoreUtils::PP::one
0000s0sList::MoreUtils::PP::::one_uList::MoreUtils::PP::one_u
0000s0sList::MoreUtils::PP::::onlyidxList::MoreUtils::PP::onlyidx
0000s0sList::MoreUtils::PP::::onlyresList::MoreUtils::PP::onlyres
0000s0sList::MoreUtils::PP::::onlyvalList::MoreUtils::PP::onlyval
0000s0sList::MoreUtils::PP::::pairwiseList::MoreUtils::PP::pairwise
0000s0sList::MoreUtils::PP::::partList::MoreUtils::PP::part
0000s0sList::MoreUtils::PP::::singletonList::MoreUtils::PP::singleton
0000s0sList::MoreUtils::PP::::sort_byList::MoreUtils::PP::sort_by
0000s0sList::MoreUtils::PP::::trueList::MoreUtils::PP::true
0000s0sList::MoreUtils::PP::::uniqList::MoreUtils::PP::uniq
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::PP;
2
3244µs115µs
# spent 15µs within List::MoreUtils::PP::BEGIN@3 which was called: # once (15µs+0s) by List::MoreUtils::XS::BEGIN@1 at line 3
use 5.006;
# spent 15µs making 1 call to List::MoreUtils::PP::BEGIN@3
4222µs230µs
# spent 18µs (6+12) within List::MoreUtils::PP::BEGIN@4 which was called: # once (6µs+12µs) by List::MoreUtils::XS::BEGIN@1 at line 4
use strict;
# spent 18µs making 1 call to List::MoreUtils::PP::BEGIN@4 # spent 12µs making 1 call to strict::import
521.08ms218µs
# spent 14µs (10+4) within List::MoreUtils::PP::BEGIN@5 which was called: # once (10µs+4µs) by List::MoreUtils::XS::BEGIN@1 at line 5
use warnings;
# spent 14µs making 1 call to List::MoreUtils::PP::BEGIN@5 # spent 4µs making 1 call to warnings::import
6
71600nsour $VERSION = '0.408';
8
9=pod
10
11=head1 NAME
12
13List::MoreUtils::PP - Provide List::MoreUtils pure Perl implementation
14
15=head1 SYNOPSIS
16
17 BEGIN { $ENV{LIST_MOREUTILS_PP} = 1; }
18 use List::MoreUtils qw(:all);
19
20=cut
21
22sub any (&@)
23{
24 my $f = shift;
25 foreach (@_)
26 {
27 return 1 if $f->();
28 }
29 return 0;
30}
31
32sub all (&@)
33{
34 my $f = shift;
35 foreach (@_)
36 {
37 return 0 unless $f->();
38 }
39 return 1;
40}
41
42sub none (&@)
43{
44 my $f = shift;
45 foreach (@_)
46 {
47 return 0 if $f->();
48 }
49 return 1;
50}
51
52sub notall (&@)
53{
54 my $f = shift;
55 foreach (@_)
56 {
57 return 1 unless $f->();
58 }
59 return 0;
60}
61
62sub one (&@)
63{
64 my $f = shift;
65 my $found = 0;
66 foreach (@_)
67 {
68 $f->() and $found++ and return 0;
69 }
70 $found;
71}
72
73sub any_u (&@)
74{
75 my $f = shift;
76 return if !@_;
77 $f->() and return 1 foreach (@_);
78 return 0;
79}
80
81sub all_u (&@)
82{
83 my $f = shift;
84 return if !@_;
85 $f->() or return 0 foreach (@_);
86 return 1;
87}
88
89sub none_u (&@)
90{
91 my $f = shift;
92 return if !@_;
93 $f->() and return 0 foreach (@_);
94 return 1;
95}
96
97sub notall_u (&@)
98{
99 my $f = shift;
100 return if !@_;
101 $f->() or return 1 foreach (@_);
102 return 0;
103}
104
105sub one_u (&@)
106{
107 my $f = shift;
108 return if !@_;
109 my $found = 0;
110 foreach (@_)
111 {
112 $f->() and $found++ and return 0;
113 }
114 $found;
115}
116
117sub true (&@)
118{
119 my $f = shift;
120 my $count = 0;
121 $f->() and ++$count foreach (@_);
122 return $count;
123}
124
125sub false (&@)
126{
127 my $f = shift;
128 my $count = 0;
129 $f->() or ++$count foreach (@_);
130 return $count;
131}
132
133sub firstidx (&@)
134{
135 my $f = shift;
136 foreach my $i ( 0 .. $#_ )
137 {
138 local *_ = \$_[$i];
139 return $i if $f->();
140 }
141 return -1;
142}
143
144sub firstval (&@)
145{
146 my $test = shift;
147 foreach (@_)
148 {
149 return $_ if $test->();
150 }
151 return undef;
152}
153
154sub firstres (&@)
155{
156 my $test = shift;
157 foreach (@_)
158 {
159 my $testval = $test->();
160 $testval and return $testval;
161 }
162 return undef;
163}
164
165sub onlyidx (&@)
166{
167 my $f = shift;
168 my $found;
169 foreach my $i ( 0 .. $#_ )
170 {
171 local *_ = \$_[$i];
172 $f->() or next;
173 defined $found and return -1;
174 $found = $i;
175 }
176 return defined $found ? $found : -1;
177}
178
179sub onlyval (&@)
180{
181 my $test = shift;
182 my $result = undef;
183 my $found = 0;
184 foreach (@_)
185 {
186 $test->() or next;
187 $result = $_;
188 $found++ and return undef;
189 }
190 return $result;
191}
192
193sub onlyres (&@)
194{
195 my $test = shift;
196 my $result = undef;
197 my $found = 0;
198 foreach (@_)
199 {
200 my $rv = $test->() or next;
201 $result = $rv;
202 $found++ and return undef;
203 }
204 return $found ? $result : undef;
205}
206
207sub lastidx (&@)
208{
209 my $f = shift;
210 foreach my $i ( reverse 0 .. $#_ )
211 {
212 local *_ = \$_[$i];
213 return $i if $f->();
214 }
215 return -1;
216}
217
218sub lastval (&@)
219{
220 my $test = shift;
221 my $ix;
222 for ( $ix = $#_; $ix >= 0; $ix-- )
223 {
224 local *_ = \$_[$ix];
225 my $testval = $test->();
226
227 # Simulate $_ as alias
228 $_[$ix] = $_;
229 return $_ if $testval;
230 }
231 return undef;
232}
233
234sub lastres (&@)
235{
236 my $test = shift;
237 my $ix;
238 for ( $ix = $#_; $ix >= 0; $ix-- )
239 {
240 local *_ = \$_[$ix];
241 my $testval = $test->();
242
243 # Simulate $_ as alias
244 $_[$ix] = $_;
245 return $testval if $testval;
246 }
247 return undef;
248}
249
250sub insert_after (&$\@)
251{
252 my ( $f, $val, $list ) = @_;
253 my $c = &firstidx( $f, @$list );
254 @$list = ( @{$list}[ 0 .. $c ], $val, @{$list}[ $c + 1 .. $#$list ], ) and return 1 if $c != -1;
255 return 0;
256}
257
258sub insert_after_string ($$\@)
259{
260 my ( $string, $val, $list ) = @_;
261 my $c = firstidx { defined $_ and $string eq $_ } @$list;
262 @$list = ( @{$list}[ 0 .. $c ], $val, @{$list}[ $c + 1 .. $#$list ], ) and return 1 if $c != -1;
263 return 0;
264}
265
266sub apply (&@)
267{
268 my $action = shift;
269 &$action foreach my @values = @_;
270 wantarray ? @values : $values[-1];
271}
272
273sub after (&@)
274{
275 my $test = shift;
276 my $started;
277 my $lag;
278 grep $started ||= do
279 {
280 my $x = $lag;
281 $lag = $test->();
282 $x;
283 }, @_;
284}
285
286sub after_incl (&@)
287{
288 my $test = shift;
289 my $started;
290 grep $started ||= $test->(), @_;
291}
292
293sub before (&@)
294{
295 my $test = shift;
296 my $more = 1;
297 grep $more &&= !$test->(), @_;
298}
299
300sub before_incl (&@)
301{
302 my $test = shift;
303 my $more = 1;
304 my $lag = 1;
305 grep $more &&= do
306 {
307 my $x = $lag;
308 $lag = !$test->();
309 $x;
310 }, @_;
311}
312
313sub indexes (&@)
314{
315 my $test = shift;
316 grep {
317 local *_ = \$_[$_];
318 $test->()
319 } 0 .. $#_;
320}
321
322sub pairwise (&\@\@)
323{
324 my $op = shift;
325
326 # Symbols for caller's input arrays
327245µs269µs
# spent 39µs (8+31) within List::MoreUtils::PP::BEGIN@327 which was called: # once (8µs+31µs) by List::MoreUtils::XS::BEGIN@1 at line 327
use vars qw{ @A @B };
# spent 39µs making 1 call to List::MoreUtils::PP::BEGIN@327 # spent 31µs making 1 call to vars::import
328 local ( *A, *B ) = @_;
329
330 # Localise $a, $b
331 my ( $caller_a, $caller_b ) = do
332 {
333 my $pkg = caller();
3342812µs228µs
# spent 17µs (7+10) within List::MoreUtils::PP::BEGIN@334 which was called: # once (7µs+10µs) by List::MoreUtils::XS::BEGIN@1 at line 334
no strict 'refs';
# spent 17µs making 1 call to List::MoreUtils::PP::BEGIN@334 # spent 10µs making 1 call to strict::unimport
335 \*{ $pkg . '::a' }, \*{ $pkg . '::b' };
336 };
337
338 # Loop iteration limit
339 my $limit = $#A > $#B ? $#A : $#B;
340
341 # This map expression is also the return value
342 local ( *$caller_a, *$caller_b );
343 map {
344 # Assign to $a, $b as refs to caller's array elements
345 ( *$caller_a, *$caller_b ) = \( $A[$_], $B[$_] );
346
347 # Perform the transformation
348 $op->();
349 } 0 .. $limit;
350}
351
352sub each_array (\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
353{
354 return each_arrayref(@_);
355}
356
357sub each_arrayref
358{
359 my @list = @_; # The list of references to the arrays
360 my $index = 0; # Which one the caller will get next
361 my $max = 0; # Number of elements in longest array
362
363 # Get the length of the longest input array
364 foreach (@list)
365 {
366 unless ( ref $_ eq 'ARRAY' )
367 {
368 require Carp;
369 Carp::croak("each_arrayref: argument is not an array reference\n");
370 }
371 $max = @$_ if @$_ > $max;
372 }
373
374 # Return the iterator as a closure wrt the above variables.
375 return sub {
376 if (@_)
377 {
378 my $method = shift;
379 unless ( $method eq 'index' )
380 {
381 require Carp;
382 Carp::croak("each_array: unknown argument '$method' passed to iterator.");
383 }
384
385 # Return current (last fetched) index
386 return undef if $index == 0 || $index > $max;
387 return $index - 1;
388 }
389
390 # No more elements to return
391 return if $index >= $max;
392 my $i = $index++;
393
394 # Return ith elements
395 return map $_->[$i], @list;
396 }
397}
398
399sub natatime ($@)
400{
401 my $n = shift;
402 my @list = @_;
403 return sub {
404 return splice @list, 0, $n;
405 }
406}
407
408sub mesh (\@\@;\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@\@)
409{
410 my $max = -1;
411 $max < $#$_ && ( $max = $#$_ ) foreach @_;
412 map {
413 my $ix = $_;
414 map $_->[$ix], @_;
415 } 0 .. $max;
416}
417
418sub uniq (@)
419{
420 my %seen = ();
421 my $k;
422 my $seen_undef;
423 grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_;
424}
425
426sub singleton (@)
427{
428 my %seen = ();
429 my $k;
430 my $seen_undef;
431 grep { 1 == ( defined $_ ? $seen{ $k = $_ } : $seen_undef ) }
432 grep { defined $_ ? not $seen{ $k = $_ }++ : not $seen_undef++ } @_;
433}
434
435sub minmax (@)
436{
437 return unless @_;
438 my $min = my $max = $_[0];
439
440 for ( my $i = 1; $i < @_; $i += 2 )
441 {
442 if ( $_[ $i - 1 ] <= $_[$i] )
443 {
444 $min = $_[ $i - 1 ] if $min > $_[ $i - 1 ];
445 $max = $_[$i] if $max < $_[$i];
446 }
447 else
448 {
449 $min = $_[$i] if $min > $_[$i];
450 $max = $_[ $i - 1 ] if $max < $_[ $i - 1 ];
451 }
452 }
453
454 if ( @_ & 1 )
455 {
456 my $i = $#_;
457 if ( $_[ $i - 1 ] <= $_[$i] )
458 {
459 $min = $_[ $i - 1 ] if $min > $_[ $i - 1 ];
460 $max = $_[$i] if $max < $_[$i];
461 }
462 else
463 {
464 $min = $_[$i] if $min > $_[$i];
465 $max = $_[ $i - 1 ] if $max < $_[ $i - 1 ];
466 }
467 }
468
469 return ( $min, $max );
470}
471
472sub part (&@)
473{
474 my ( $code, @list ) = @_;
475 my @parts;
476 push @{ $parts[ $code->($_) ] }, $_ foreach @list;
477 return @parts;
478}
479
480sub bsearch(&@)
481{
482 my $code = shift;
483
484 my $rc;
485 my $i = 0;
486 my $j = @_;
487 do
488 {
489 my $k = int( ( $i + $j ) / 2 );
490
491 $k >= @_ and return;
492
493 local *_ = \$_[$k];
494 $rc = $code->();
495
496 $rc == 0
497 and return wantarray ? $_ : 1;
498
499 if ( $rc < 0 )
500 {
501 $i = $k + 1;
502 }
503 else
504 {
505 $j = $k - 1;
506 }
507 } until $i > $j;
508
509 return;
510}
511
512sub bsearchidx(&@)
513{
514 my $code = shift;
515
516 my $rc;
517 my $i = 0;
518 my $j = @_;
519 do
520 {
521 my $k = int( ( $i + $j ) / 2 );
522
523 $k >= @_ and return -1;
524
525 local *_ = \$_[$k];
526 $rc = $code->();
527
528 $rc == 0 and return $k;
529
530 if ( $rc < 0 )
531 {
532 $i = $k + 1;
533 }
534 else
535 {
536 $j = $k - 1;
537 }
538 } until $i > $j;
539
540 return -1;
541}
542
543sub sort_by(&@)
544{
545 my ( $code, @list ) = @_;
546 return map { $_->[0] }
547 sort { $a->[1] cmp $b->[1] }
548 map { [ $_, scalar( $code->() ) ] } @list;
549}
550
551sub nsort_by(&@)
552{
553 my ( $code, @list ) = @_;
554 return map { $_->[0] }
555 sort { $a->[1] <=> $b->[1] }
556 map { [ $_, scalar( $code->() ) ] } @list;
557}
558
559sub _XScompiled { 0 }
560
561=head1 SEE ALSO
562
563L<List::Util>
564
565=head1 AUTHOR
566
567Jens Rehsack E<lt>rehsack AT cpan.orgE<gt>
568
569Adam Kennedy E<lt>adamk@cpan.orgE<gt>
570
571Tassilo von Parseval E<lt>tassilo.von.parseval@rwth-aachen.deE<gt>
572
573=head1 COPYRIGHT AND LICENSE
574
575Some parts copyright 2011 Aaron Crane.
576
577Copyright 2004 - 2010 by Tassilo von Parseval
578
579Copyright 2013 - 2015 by Jens Rehsack
580
581This library is free software; you can redistribute it and/or modify
582it under the same terms as Perl itself, either Perl version 5.8.4 or,
583at your option, any later version of Perl 5 you may have available.
584
585=cut
586
58712µs1;
Report produced by the NYTProf 6.01 Perl profiler, developed by Tim Bunce and Adam Kaplan.