← Index
NYTProf Performance Profile   « line view »
For ./v1.pl
  Run on Wed Sep 18 20:26:04 2019
Reported on Wed Sep 18 20:29:11 2019

Filename/usr/lib/x86_64-linux-gnu/perl5/5.26/List/Util.pm
StatementsExecuted 15 statements in 1.19ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
11121µs25µsList::Util::::BEGIN@9 List::Util::BEGIN@9
11110µs17µsList::Util::::BEGIN@10 List::Util::BEGIN@10
1119µs25µsList::Util::::BEGIN@31 List::Util::BEGIN@31
0000s0sList::Util::_Pair::::keyList::Util::_Pair::key
0000s0sList::Util::_Pair::::valueList::Util::_Pair::value
0000s0sList::Util::::import List::Util::import
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# Copyright (c) 1997-2009 Graham Barr <gbarr@pobox.com>. All rights reserved.
2# This program is free software; you can redistribute it and/or
3# modify it under the same terms as Perl itself.
4#
5# Maintained since 2013 by Paul Evans <leonerd@leonerd.org.uk>
6
7package List::Util;
8
9238µs229µs
# spent 25µs (21+4) within List::Util::BEGIN@9 which was called: # once (21µs+4µs) by Function::Parameters::BEGIN@7 at line 9
use strict;
# spent 25µs making 1 call to List::Util::BEGIN@9 # spent 4µs making 1 call to strict::import
102152µs224µs
# spent 17µs (10+7) within List::Util::BEGIN@10 which was called: # once (10µs+7µs) by Function::Parameters::BEGIN@7 at line 10
use warnings;
# spent 17µs making 1 call to List::Util::BEGIN@10 # spent 7µs making 1 call to warnings::import
111600nsrequire Exporter;
12
13112µsour @ISA = qw(Exporter);
1413µsour @EXPORT_OK = qw(
15 all any first min max minstr maxstr none notall product reduce sum sum0 shuffle uniq uniqnum uniqstr
16 head tail pairs unpairs pairkeys pairvalues pairmap pairgrep pairfirst
17);
181500nsour $VERSION = "1.50";
191200nsour $XS_VERSION = $VERSION;
20130µs$VERSION = eval $VERSION;
# spent 4µs executing statements in string eval
21
221400nsrequire XSLoader;
231310µs1300µsXSLoader::load('List::Util', $XS_VERSION);
# spent 300µs making 1 call to XSLoader::load
24
25sub import
26{
27 my $pkg = caller;
28
29 # (RT88848) Touch the caller's $a and $b, to avoid the warning of
30 # Name "main::a" used only once: possible typo" warning
312629µs240µs
# spent 25µs (9+16) within List::Util::BEGIN@31 which was called: # once (9µs+16µs) by Function::Parameters::BEGIN@7 at line 31
no strict 'refs';
# spent 25µs making 1 call to List::Util::BEGIN@31 # spent 16µs making 1 call to strict::unimport
32 ${"${pkg}::a"} = ${"${pkg}::a"};
33 ${"${pkg}::b"} = ${"${pkg}::b"};
34
35 goto &Exporter::import;
36}
37
38# For objects returned by pairs()
39sub List::Util::_Pair::key { shift->[0] }
40sub List::Util::_Pair::value { shift->[1] }
41
42=head1 NAME
43
44List::Util - A selection of general-utility list subroutines
45
46=head1 SYNOPSIS
47
48 use List::Util qw(
49 reduce any all none notall first
50
51 max maxstr min minstr product sum sum0
52
53 pairs unpairs pairkeys pairvalues pairfirst pairgrep pairmap
54
55 shuffle uniq uniqnum uniqstr
56 );
57
58=head1 DESCRIPTION
59
60C<List::Util> contains a selection of subroutines that people have expressed
61would be nice to have in the perl core, but the usage would not really be high
62enough to warrant the use of a keyword, and the size so small such that being
63individual extensions would be wasteful.
64
65By default C<List::Util> does not export any subroutines.
66
67=cut
68
69=head1 LIST-REDUCTION FUNCTIONS
70
71The following set of functions all reduce a list down to a single value.
72
73=cut
74
75=head2 reduce
76
77 $result = reduce { BLOCK } @list
78
79Reduces C<@list> by calling C<BLOCK> in a scalar context multiple times,
80setting C<$a> and C<$b> each time. The first call will be with C<$a> and C<$b>
81set to the first two elements of the list, subsequent calls will be done by
82setting C<$a> to the result of the previous call and C<$b> to the next element
83in the list.
84
85Returns the result of the last call to the C<BLOCK>. If C<@list> is empty then
86C<undef> is returned. If C<@list> only contains one element then that element
87is returned and C<BLOCK> is not executed.
88
89The following examples all demonstrate how C<reduce> could be used to implement
90the other list-reduction functions in this module. (They are not in fact
91implemented like this, but instead in a more efficient manner in individual C
92functions).
93
94 $foo = reduce { defined($a) ? $a :
95 $code->(local $_ = $b) ? $b :
96 undef } undef, @list # first
97
98 $foo = reduce { $a > $b ? $a : $b } 1..10 # max
99 $foo = reduce { $a gt $b ? $a : $b } 'A'..'Z' # maxstr
100 $foo = reduce { $a < $b ? $a : $b } 1..10 # min
101 $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
102 $foo = reduce { $a + $b } 1 .. 10 # sum
103 $foo = reduce { $a . $b } @bar # concat
104
105 $foo = reduce { $a || $code->(local $_ = $b) } 0, @bar # any
106 $foo = reduce { $a && $code->(local $_ = $b) } 1, @bar # all
107 $foo = reduce { $a && !$code->(local $_ = $b) } 1, @bar # none
108 $foo = reduce { $a || !$code->(local $_ = $b) } 0, @bar # notall
109 # Note that these implementations do not fully short-circuit
110
111If your algorithm requires that C<reduce> produce an identity value, then make
112sure that you always pass that identity value as the first argument to prevent
113C<undef> being returned
114
115 $foo = reduce { $a + $b } 0, @values; # sum with 0 identity value
116
117The above example code blocks also suggest how to use C<reduce> to build a
118more efficient combined version of one of these basic functions and a C<map>
119block. For example, to find the total length of all the strings in a list,
120we could use
121
122 $total = sum map { length } @strings;
123
124However, this produces a list of temporary integer values as long as the
125original list of strings, only to reduce it down to a single value again. We
126can compute the same result more efficiently by using C<reduce> with a code
127block that accumulates lengths by writing this instead as:
128
129 $total = reduce { $a + length $b } 0, @strings
130
131The remaining list-reduction functions are all specialisations of this generic
132idea.
133
134=head2 any
135
136 my $bool = any { BLOCK } @list;
137
138I<Since version 1.33.>
139
140Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
141of C<@list> in turn. C<any> returns true if any element makes the C<BLOCK>
142return a true value. If C<BLOCK> never returns true or C<@list> was empty then
143it returns false.
144
145Many cases of using C<grep> in a conditional can be written using C<any>
146instead, as it can short-circuit after the first true result.
147
148 if( any { length > 10 } @strings ) {
149 # at least one string has more than 10 characters
150 }
151
152Note: Due to XS issues the block passed may be able to access the outer @_
153directly. This is not intentional and will break under debugger.
154
155=head2 all
156
157 my $bool = all { BLOCK } @list;
158
159I<Since version 1.33.>
160
161Similar to L</any>, except that it requires all elements of the C<@list> to
162make the C<BLOCK> return true. If any element returns false, then it returns
163false. If the C<BLOCK> never returns false or the C<@list> was empty then it
164returns true.
165
166Note: Due to XS issues the block passed may be able to access the outer @_
167directly. This is not intentional and will break under debugger.
168
169=head2 none
170
171=head2 notall
172
173 my $bool = none { BLOCK } @list;
174
175 my $bool = notall { BLOCK } @list;
176
177I<Since version 1.33.>
178
179Similar to L</any> and L</all>, but with the return sense inverted. C<none>
180returns true only if no value in the C<@list> causes the C<BLOCK> to return
181true, and C<notall> returns true only if not all of the values do.
182
183Note: Due to XS issues the block passed may be able to access the outer @_
184directly. This is not intentional and will break under debugger.
185
186=head2 first
187
188 my $val = first { BLOCK } @list;
189
190Similar to C<grep> in that it evaluates C<BLOCK> setting C<$_> to each element
191of C<@list> in turn. C<first> returns the first element where the result from
192C<BLOCK> is a true value. If C<BLOCK> never returns true or C<@list> was empty
193then C<undef> is returned.
194
195 $foo = first { defined($_) } @list # first defined value in @list
196 $foo = first { $_ > $value } @list # first value in @list which
197 # is greater than $value
198
199=head2 max
200
201 my $num = max @list;
202
203Returns the entry in the list with the highest numerical value. If the list is
204empty then C<undef> is returned.
205
206 $foo = max 1..10 # 10
207 $foo = max 3,9,12 # 12
208 $foo = max @bar, @baz # whatever
209
210=head2 maxstr
211
212 my $str = maxstr @list;
213
214Similar to L</max>, but treats all the entries in the list as strings and
215returns the highest string as defined by the C<gt> operator. If the list is
216empty then C<undef> is returned.
217
218 $foo = maxstr 'A'..'Z' # 'Z'
219 $foo = maxstr "hello","world" # "world"
220 $foo = maxstr @bar, @baz # whatever
221
222=head2 min
223
224 my $num = min @list;
225
226Similar to L</max> but returns the entry in the list with the lowest numerical
227value. If the list is empty then C<undef> is returned.
228
229 $foo = min 1..10 # 1
230 $foo = min 3,9,12 # 3
231 $foo = min @bar, @baz # whatever
232
233=head2 minstr
234
235 my $str = minstr @list;
236
237Similar to L</min>, but treats all the entries in the list as strings and
238returns the lowest string as defined by the C<lt> operator. If the list is
239empty then C<undef> is returned.
240
241 $foo = minstr 'A'..'Z' # 'A'
242 $foo = minstr "hello","world" # "hello"
243 $foo = minstr @bar, @baz # whatever
244
245=head2 product
246
247 my $num = product @list;
248
249I<Since version 1.35.>
250
251Returns the numerical product of all the elements in C<@list>. If C<@list> is
252empty then C<1> is returned.
253
254 $foo = product 1..10 # 3628800
255 $foo = product 3,9,12 # 324
256
257=head2 sum
258
259 my $num_or_undef = sum @list;
260
261Returns the numerical sum of all the elements in C<@list>. For backwards
262compatibility, if C<@list> is empty then C<undef> is returned.
263
264 $foo = sum 1..10 # 55
265 $foo = sum 3,9,12 # 24
266 $foo = sum @bar, @baz # whatever
267
268=head2 sum0
269
270 my $num = sum0 @list;
271
272I<Since version 1.26.>
273
274Similar to L</sum>, except this returns 0 when given an empty list, rather
275than C<undef>.
276
277=cut
278
279=head1 KEY/VALUE PAIR LIST FUNCTIONS
280
281The following set of functions, all inspired by L<List::Pairwise>, consume an
282even-sized list of pairs. The pairs may be key/value associations from a hash,
283or just a list of values. The functions will all preserve the original ordering
284of the pairs, and will not be confused by multiple pairs having the same "key"
285value - nor even do they require that the first of each pair be a plain string.
286
287B<NOTE>: At the time of writing, the following C<pair*> functions that take a
288block do not modify the value of C<$_> within the block, and instead operate
289using the C<$a> and C<$b> globals instead. This has turned out to be a poor
290design, as it precludes the ability to provide a C<pairsort> function. Better
291would be to pass pair-like objects as 2-element array references in C<$_>, in
292a style similar to the return value of the C<pairs> function. At some future
293version this behaviour may be added.
294
295Until then, users are alerted B<NOT> to rely on the value of C<$_> remaining
296unmodified between the outside and the inside of the control block. In
297particular, the following example is B<UNSAFE>:
298
299 my @kvlist = ...
300
301 foreach (qw( some keys here )) {
302 my @items = pairgrep { $a eq $_ } @kvlist;
303 ...
304 }
305
306Instead, write this using a lexical variable:
307
308 foreach my $key (qw( some keys here )) {
309 my @items = pairgrep { $a eq $key } @kvlist;
310 ...
311 }
312
313=cut
314
315=head2 pairs
316
317 my @pairs = pairs @kvlist;
318
319I<Since version 1.29.>
320
321A convenient shortcut to operating on even-sized lists of pairs, this function
322returns a list of C<ARRAY> references, each containing two items from the
323given list. It is a more efficient version of
324
325 @pairs = pairmap { [ $a, $b ] } @kvlist
326
327It is most convenient to use in a C<foreach> loop, for example:
328
329 foreach my $pair ( pairs @kvlist ) {
330 my ( $key, $value ) = @$pair;
331 ...
332 }
333
334Since version C<1.39> these C<ARRAY> references are blessed objects,
335recognising the two methods C<key> and C<value>. The following code is
336equivalent:
337
338 foreach my $pair ( pairs @kvlist ) {
339 my $key = $pair->key;
340 my $value = $pair->value;
341 ...
342 }
343
344=head2 unpairs
345
346 my @kvlist = unpairs @pairs
347
348I<Since version 1.42.>
349
350The inverse function to C<pairs>; this function takes a list of C<ARRAY>
351references containing two elements each, and returns a flattened list of the
352two values from each of the pairs, in order. This is notionally equivalent to
353
354 my @kvlist = map { @{$_}[0,1] } @pairs
355
356except that it is implemented more efficiently internally. Specifically, for
357any input item it will extract exactly two values for the output list; using
358C<undef> if the input array references are short.
359
360Between C<pairs> and C<unpairs>, a higher-order list function can be used to
361operate on the pairs as single scalars; such as the following near-equivalents
362of the other C<pair*> higher-order functions:
363
364 @kvlist = unpairs grep { FUNC } pairs @kvlist
365 # Like pairgrep, but takes $_ instead of $a and $b
366
367 @kvlist = unpairs map { FUNC } pairs @kvlist
368 # Like pairmap, but takes $_ instead of $a and $b
369
370Note however that these versions will not behave as nicely in scalar context.
371
372Finally, this technique can be used to implement a sort on a keyvalue pair
373list; e.g.:
374
375 @kvlist = unpairs sort { $a->key cmp $b->key } pairs @kvlist
376
377=head2 pairkeys
378
379 my @keys = pairkeys @kvlist;
380
381I<Since version 1.29.>
382
383A convenient shortcut to operating on even-sized lists of pairs, this function
384returns a list of the the first values of each of the pairs in the given list.
385It is a more efficient version of
386
387 @keys = pairmap { $a } @kvlist
388
389=head2 pairvalues
390
391 my @values = pairvalues @kvlist;
392
393I<Since version 1.29.>
394
395A convenient shortcut to operating on even-sized lists of pairs, this function
396returns a list of the the second values of each of the pairs in the given list.
397It is a more efficient version of
398
399 @values = pairmap { $b } @kvlist
400
401=head2 pairgrep
402
403 my @kvlist = pairgrep { BLOCK } @kvlist;
404
405 my $count = pairgrep { BLOCK } @kvlist;
406
407I<Since version 1.29.>
408
409Similar to perl's C<grep> keyword, but interprets the given list as an
410even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
411context, with C<$a> and C<$b> set to successive pairs of values from the
412C<@kvlist>.
413
414Returns an even-sized list of those pairs for which the C<BLOCK> returned true
415in list context, or the count of the B<number of pairs> in scalar context.
416(Note, therefore, in scalar context that it returns a number half the size of
417the count of items it would have returned in list context).
418
419 @subset = pairgrep { $a =~ m/^[[:upper:]]+$/ } @kvlist
420
421As with C<grep> aliasing C<$_> to list elements, C<pairgrep> aliases C<$a> and
422C<$b> to elements of the given list. Any modifications of it by the code block
423will be visible to the caller.
424
425=head2 pairfirst
426
427 my ( $key, $val ) = pairfirst { BLOCK } @kvlist;
428
429 my $found = pairfirst { BLOCK } @kvlist;
430
431I<Since version 1.30.>
432
433Similar to the L</first> function, but interprets the given list as an
434even-sized list of pairs. It invokes the C<BLOCK> multiple times, in scalar
435context, with C<$a> and C<$b> set to successive pairs of values from the
436C<@kvlist>.
437
438Returns the first pair of values from the list for which the C<BLOCK> returned
439true in list context, or an empty list of no such pair was found. In scalar
440context it returns a simple boolean value, rather than either the key or the
441value found.
442
443 ( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist
444
445As with C<grep> aliasing C<$_> to list elements, C<pairfirst> aliases C<$a> and
446C<$b> to elements of the given list. Any modifications of it by the code block
447will be visible to the caller.
448
449=head2 pairmap
450
451 my @list = pairmap { BLOCK } @kvlist;
452
453 my $count = pairmap { BLOCK } @kvlist;
454
455I<Since version 1.29.>
456
457Similar to perl's C<map> keyword, but interprets the given list as an
458even-sized list of pairs. It invokes the C<BLOCK> multiple times, in list
459context, with C<$a> and C<$b> set to successive pairs of values from the
460C<@kvlist>.
461
462Returns the concatenation of all the values returned by the C<BLOCK> in list
463context, or the count of the number of items that would have been returned in
464scalar context.
465
466 @result = pairmap { "The key $a has value $b" } @kvlist
467
468As with C<map> aliasing C<$_> to list elements, C<pairmap> aliases C<$a> and
469C<$b> to elements of the given list. Any modifications of it by the code block
470will be visible to the caller.
471
472See L</KNOWN BUGS> for a known-bug with C<pairmap>, and a workaround.
473
474=cut
475
476=head1 OTHER FUNCTIONS
477
478=cut
479
480=head2 shuffle
481
482 my @values = shuffle @values;
483
484Returns the values of the input in a random order
485
486 @cards = shuffle 0..51 # 0..51 in a random order
487
488=head2 uniq
489
490 my @subset = uniq @values
491
492I<Since version 1.45.>
493
494Filters a list of values to remove subsequent duplicates, as judged by a
495DWIM-ish string equality or C<undef> test. Preserves the order of unique
496elements, and retains the first value of any duplicate set.
497
498 my $count = uniq @values
499
500In scalar context, returns the number of elements that would have been
501returned as a list.
502
503The C<undef> value is treated by this function as distinct from the empty
504string, and no warning will be produced. It is left as-is in the returned
505list. Subsequent C<undef> values are still considered identical to the first,
506and will be removed.
507
508=head2 uniqnum
509
510 my @subset = uniqnum @values
511
512I<Since version 1.44.>
513
514Filters a list of values to remove subsequent duplicates, as judged by a
515numerical equality test. Preserves the order of unique elements, and retains
516the first value of any duplicate set.
517
518 my $count = uniqnum @values
519
520In scalar context, returns the number of elements that would have been
521returned as a list.
522
523Note that C<undef> is treated much as other numerical operations treat it; it
524compares equal to zero but additionally produces a warning if such warnings
525are enabled (C<use warnings 'uninitialized';>). In addition, an C<undef> in
526the returned list is coerced into a numerical zero, so that the entire list of
527values returned by C<uniqnum> are well-behaved as numbers.
528
529Note also that multiple IEEE C<NaN> values are treated as duplicates of
530each other, regardless of any differences in their payloads, and despite
531the fact that C<< 0+'NaN' == 0+'NaN' >> yields false.
532
533=head2 uniqstr
534
535 my @subset = uniqstr @values
536
537I<Since version 1.45.>
538
539Filters a list of values to remove subsequent duplicates, as judged by a
540string equality test. Preserves the order of unique elements, and retains the
541first value of any duplicate set.
542
543 my $count = uniqstr @values
544
545In scalar context, returns the number of elements that would have been
546returned as a list.
547
548Note that C<undef> is treated much as other string operations treat it; it
549compares equal to the empty string but additionally produces a warning if such
550warnings are enabled (C<use warnings 'uninitialized';>). In addition, an
551C<undef> in the returned list is coerced into an empty string, so that the
552entire list of values returned by C<uniqstr> are well-behaved as strings.
553
554=cut
555
556=head2 head
557
558 my @values = head $size, @list;
559
560Returns the first C<$size> elements from C<@list>. If C<$size> is negative, returns
561all but the last C<$size> elements from C<@list>.
562
563 @result = head 2, qw( foo bar baz );
564 # foo, bar
565
566 @result = head -2, qw( foo bar baz );
567 # foo
568
569=head2 tail
570
571 my @values = tail $size, @list;
572
573Returns the last C<$size> elements from C<@list>. If C<$size> is negative, returns
574all but the first C<$size> elements from C<@list>.
575
576 @result = tail 2, qw( foo bar baz );
577 # bar, baz
578
579 @result = tail -2, qw( foo bar baz );
580 # baz
581
582=head1 KNOWN BUGS
583
584=head2 RT #95409
585
586L<https://rt.cpan.org/Ticket/Display.html?id=95409>
587
588If the block of code given to L</pairmap> contains lexical variables that are
589captured by a returned closure, and the closure is executed after the block
590has been re-used for the next iteration, these lexicals will not see the
591correct values. For example:
592
593 my @subs = pairmap {
594 my $var = "$a is $b";
595 sub { print "$var\n" };
596 } one => 1, two => 2, three => 3;
597
598 $_->() for @subs;
599
600Will incorrectly print
601
602 three is 3
603 three is 3
604 three is 3
605
606This is due to the performance optimisation of using C<MULTICALL> for the code
607block, which means that fresh SVs do not get allocated for each call to the
608block. Instead, the same SV is re-assigned for each iteration, and all the
609closures will share the value seen on the final iteration.
610
611To work around this bug, surround the code with a second set of braces. This
612creates an inner block that defeats the C<MULTICALL> logic, and does get fresh
613SVs allocated each time:
614
615 my @subs = pairmap {
616 {
617 my $var = "$a is $b";
618 sub { print "$var\n"; }
619 }
620 } one => 1, two => 2, three => 3;
621
622This bug only affects closures that are generated by the block but used
623afterwards. Lexical variables that are only used during the lifetime of the
624block's execution will take their individual values for each invocation, as
625normal.
626
627=head2 uniqnum() on oversized bignums
628
629Due to the way that C<uniqnum()> compares numbers, it cannot distinguish
630differences between bignums (especially bigints) that are too large to fit in
631the native platform types. For example,
632
633 my $x = Math::BigInt->new( "1" x 100 );
634 my $y = $x + 1;
635
636 say for uniqnum( $x, $y );
637
638Will print just the value of C<$x>, believing that C<$y> is a numerically-
639equivalent value. This bug does not affect C<uniqstr()>, which will correctly
640observe that the two values stringify to different strings.
641
642=head1 SUGGESTED ADDITIONS
643
644The following are additions that have been requested, but I have been reluctant
645to add due to them being very simple to implement in perl
646
647 # How many elements are true
648
649 sub true { scalar grep { $_ } @_ }
650
651 # How many elements are false
652
653 sub false { scalar grep { !$_ } @_ }
654
655=head1 SEE ALSO
656
657L<Scalar::Util>, L<List::MoreUtils>
658
659=head1 COPYRIGHT
660
661Copyright (c) 1997-2007 Graham Barr <gbarr@pobox.com>. All rights reserved.
662This program is free software; you can redistribute it and/or
663modify it under the same terms as Perl itself.
664
665Recent additions and current maintenance by
666Paul Evans, <leonerd@leonerd.org.uk>.
667
668=cut
669
670113µs1;