'Scalar-List-Utils' => {
'MAINTAINER' => 'gbarr',
- 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.29.tar.gz',
+ 'DISTRIBUTION' => 'PEVANS/Scalar-List-Utils-1.30.tar.gz',
# Note that perl uses its own version of Makefile.PL
'FILES' => q[cpan/List-Util],
+1.30 -- Mon Aug 05 13:09 UTC 2012
+
+ * Added pairfirst
+ * Added MULTICALL implementations to pairmap/pairgrep/pairfirst
+ * Fix declaration-after-code for C99-challenged compilers
+ * Documentation updates to List::Util
+
1.29 -- Thu Aug 01 13:40 UTC 2013
* Bugfix to pairmap/pairgrep when stack moves beneath them during operation
XSRETURN_UNDEF;
}
+#endif
+
+void
+pairfirst(block,...)
+ SV * block
+PROTOTYPE: &@
+PPCODE:
+{
+ GV *agv,*bgv,*gv;
+ HV *stash;
+ CV *cv = sv_2cv(block, &stash, &gv, 0);
+ I32 ret_gimme = GIMME_V;
+ int argi = 1; // "shift" the block
+
+ agv = gv_fetchpv("a", GV_ADD, SVt_PV);
+ bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
+ SAVESPTR(GvSV(agv));
+ SAVESPTR(GvSV(bgv));
+#ifdef dMULTICALL
+ if(!CvISXSUB(cv)) {
+ // Since MULTICALL is about to move it
+ SV **stack = PL_stack_base + ax;
+
+ dMULTICALL;
+ I32 gimme = G_SCALAR;
+
+ PUSH_MULTICALL(cv);
+ for(; argi < items; argi += 2) {
+ SV *a = GvSV(agv) = stack[argi];
+ SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
+
+ MULTICALL;
+
+ if(!SvTRUEx(*PL_stack_sp))
+ continue;
+
+ POP_MULTICALL;
+ if(ret_gimme == G_ARRAY) {
+ ST(0) = sv_mortalcopy(a);
+ ST(1) = sv_mortalcopy(b);
+ XSRETURN(2);
+ }
+ else
+ XSRETURN_YES;
+ }
+ POP_MULTICALL;
+ XSRETURN(0);
+ }
+ else
+#endif
+ {
+ for(; argi < items; argi += 2) {
+ dSP;
+ SV *a = GvSV(agv) = ST(argi);
+ SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
+
+ PUSHMARK(SP);
+ call_sv((SV*)cv, G_SCALAR);
+
+ SPAGAIN;
+
+ if(!SvTRUEx(*PL_stack_sp))
+ continue;
+
+ if(ret_gimme == G_ARRAY) {
+ ST(0) = sv_mortalcopy(a);
+ ST(1) = sv_mortalcopy(b);
+ XSRETURN(2);
+ }
+ else
+ XSRETURN_YES;
+ }
+ }
+
+ XSRETURN(0);
+}
+
void
pairgrep(block,...)
SV * block
GV *agv,*bgv,*gv;
HV *stash;
CV *cv = sv_2cv(block, &stash, &gv, 0);
+ I32 ret_gimme = GIMME_V;
/* This function never returns more than it consumed in arguments. So we
* can build the results "live", behind the arguments
bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
SAVESPTR(GvSV(agv));
SAVESPTR(GvSV(bgv));
+#ifdef dMULTICALL
+ if(!CvISXSUB(cv)) {
+ // Since MULTICALL is about to move it
+ SV **stack = PL_stack_base + ax;
+ int i;
+
+ dMULTICALL;
+ I32 gimme = G_SCALAR;
+
+ PUSH_MULTICALL(cv);
+ for(; argi < items; argi += 2) {
+ SV *a = GvSV(agv) = stack[argi];
+ SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
+ MULTICALL;
+
+ if(SvTRUEx(*PL_stack_sp)) {
+ if(ret_gimme == G_ARRAY) {
+ // We can't mortalise yet or they'd be mortal too early
+ stack[reti++] = newSVsv(a);
+ stack[reti++] = newSVsv(b);
+ }
+ else if(ret_gimme == G_SCALAR)
+ reti++;
+ }
+ }
+ POP_MULTICALL;
+
+ if(ret_gimme == G_ARRAY)
+ for(i = 0; i < reti; i++)
+ sv_2mortal(stack[i]);
+ }
+ else
+#endif
{
for(; argi < items; argi += 2) {
dSP;
SPAGAIN;
- if (SvTRUEx(*PL_stack_sp)) {
- if(GIMME_V == G_ARRAY) {
+ if(SvTRUEx(*PL_stack_sp)) {
+ if(ret_gimme == G_ARRAY) {
ST(reti++) = sv_mortalcopy(a);
ST(reti++) = sv_mortalcopy(b);
}
- else if(GIMME_V == G_SCALAR)
+ else if(ret_gimme == G_SCALAR)
reti++;
}
}
}
- if(GIMME_V == G_ARRAY)
+ if(ret_gimme == G_ARRAY)
XSRETURN(reti);
- else if(GIMME_V == G_SCALAR) {
+ else if(ret_gimme == G_SCALAR) {
ST(0) = newSViv(reti);
XSRETURN(1);
}
HV *stash;
CV *cv = sv_2cv(block, &stash, &gv, 0);
SV **args_copy = NULL;
+ I32 ret_gimme = GIMME_V;
int argi = 1; // "shift" the block
int reti = 0;
bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
SAVESPTR(GvSV(agv));
SAVESPTR(GvSV(bgv));
+#ifdef dMULTICALL
+ if(!CvISXSUB(cv)) {
+ // Since MULTICALL is about to move it
+ SV **stack = PL_stack_base + ax;
+ I32 ret_gimme = GIMME_V;
+ int i;
- {
+ dMULTICALL;
+ I32 gimme = G_ARRAY;
+
+ PUSH_MULTICALL(cv);
for(; argi < items; argi += 2) {
- dSP;
- SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
+ SV *a = GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
SV *b = GvSV(bgv) = argi < items-1 ?
- (args_copy ? args_copy[argi+1] : ST(argi+1)) :
+ (args_copy ? args_copy[argi+1] : stack[argi+1]) :
&PL_sv_undef;
+ int count;
- PUSHMARK(SP);
- int count = call_sv((SV*)cv, G_ARRAY);
-
- SPAGAIN;
+ MULTICALL;
+ count = PL_stack_sp - PL_stack_base;
if(count > 2 && !args_copy) {
/* We can't return more than 2 results for a given input pair
Newx(args_copy, n_args, SV *);
SAVEFREEPV(args_copy);
- Copy(&ST(argi), args_copy, n_args, SV *);
+ Copy(stack + argi, args_copy, n_args, SV *);
argi = 0;
items = n_args;
}
+ for(i = 0; i < count; i++)
+ stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]);
+ }
+ POP_MULTICALL;
+
+ if(ret_gimme == G_ARRAY)
+ for(i = 0; i < reti; i++)
+ sv_2mortal(stack[i]);
+ }
+ else
+#endif
+ {
+ for(; argi < items; argi += 2) {
+ dSP;
+ SV *a = GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
+ SV *b = GvSV(bgv) = argi < items-1 ?
+ (args_copy ? args_copy[argi+1] : ST(argi+1)) :
+ &PL_sv_undef;
+ int count;
int i;
+
+ PUSHMARK(SP);
+ count = call_sv((SV*)cv, G_ARRAY);
+
+ SPAGAIN;
+
+ if(count > 2 && !args_copy) {
+ int n_args = items - argi;
+ Newx(args_copy, n_args, SV *);
+ SAVEFREEPV(args_copy);
+
+ Copy(&ST(argi), args_copy, n_args, SV *);
+
+ argi = 0;
+ items = n_args;
+ }
+
for(i = 0; i < count; i++)
ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
XSRETURN(reti);
}
-#endif
-
void
pairs(...)
PROTOTYPE: @
require Exporter;
our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle pairmap pairgrep pairs pairkeys pairvalues);
-our $VERSION = "1.29";
+our @EXPORT_OK = qw(first min max minstr maxstr reduce sum sum0 shuffle pairmap pairgrep pairfirst pairs pairkeys pairvalues);
+our $VERSION = "1.30";
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
not really be high enough to warrant the use of a keyword, and the size
so small such that being individual extensions would be wasteful.
-By default C<List::Util> does not export any subroutines. The
-subroutines defined are
+By default C<List::Util> does not export any subroutines.
-=over 4
+=cut
+
+=head1 LIST-REDUCTION FUNCTIONS
+
+The following set of functions all reduce a list down to a single value.
+
+=cut
+
+=head2 reduce BLOCK LIST
+
+Reduces LIST by calling BLOCK, in a scalar context, multiple times,
+setting C<$a> and C<$b> each time. The first call will be with C<$a>
+and C<$b> set to the first two elements of the list, subsequent
+calls will be done by setting C<$a> to the result of the previous
+call and C<$b> to the next element in the list.
+
+Returns the result of the last call to BLOCK. If LIST is empty then
+C<undef> is returned. If LIST only contains one element then that
+element is returned and BLOCK is not executed.
-=item first BLOCK LIST
+ $foo = reduce { $a < $b ? $a : $b } 1..10 # min
+ $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
+ $foo = reduce { $a + $b } 1 .. 10 # sum
+ $foo = reduce { $a . $b } @bar # concat
+
+If your algorithm requires that C<reduce> produce an identity value, then
+make sure that you always pass that identity value as the first argument to prevent
+C<undef> being returned
+
+ $foo = reduce { $a + $b } 0, @values; # sum with 0 identity value
+
+The remaining list-reduction functions are all specialisations of this
+generic idea.
+
+=head2 first BLOCK LIST
Similar to C<grep> in that it evaluates BLOCK setting C<$_> to each element
of LIST in turn. C<first> returns the first element where the result from
for example wanted() could be defined() which would return the first
defined value in @list
-=item max LIST
+=head2 max LIST
Returns the entry in the list with the highest numerical value. If the
list is empty then C<undef> is returned.
$foo = reduce { $a > $b ? $a : $b } 1..10
-=item maxstr LIST
+=head2 maxstr LIST
Similar to C<max>, but treats all the entries in the list as strings
and returns the highest string as defined by the C<gt> operator.
$foo = reduce { $a gt $b ? $a : $b } 'A'..'Z'
-=item min LIST
+=head2 min LIST
Similar to C<max> but returns the entry in the list with the lowest
numerical value. If the list is empty then C<undef> is returned.
$foo = reduce { $a < $b ? $a : $b } 1..10
-=item minstr LIST
+=head2 minstr LIST
Similar to C<min>, but treats all the entries in the list as strings
and returns the lowest string as defined by the C<lt> operator.
$foo = reduce { $a lt $b ? $a : $b } 'A'..'Z'
-=item pairgrep BLOCK KVLIST
+=head2 sum LIST
+
+Returns the sum of all the elements in LIST. If LIST is empty then
+C<undef> is returned.
+
+ $foo = sum 1..10 # 55
+ $foo = sum 3,9,12 # 24
+ $foo = sum @bar, @baz # whatever
+
+This function could be implemented using C<reduce> like this
+
+ $foo = reduce { $a + $b } 1..10
+
+=head2 sum0 LIST
+
+Similar to C<sum>, except this returns 0 when given an empty list, rather
+than C<undef>.
+
+=cut
+
+=head1 KEY/VALUE PAIR LIST FUNCTIONS
+
+The following set of functions, all inspired by L<List::Pairwise>, consume
+an even-sized list of pairs. The pairs may be key/value associations from a
+hash, or just a list of values. The functions will all preserve the original
+ordering of the pairs, and will not be confused by multiple pairs having the
+same "key" value - nor even do they require that the first of each pair be a
+plain string.
+
+=cut
+
+=head2 pairgrep BLOCK KVLIST
Similar to perl's C<grep> keyword, but interprets the given list as an
even-sized list of pairs. It invokes the BLOCK multiple times, in scalar
given list. Any modifications of it by the code block will be visible to
the caller.
-=item pairmap BLOCK KVLIST
+=head2 pairfirst BLOCK KVLIST
+
+Similar to the C<first> function, but interprets the given list as an
+even-sized list of pairs. It invokes the BLOCK multiple times, in scalar
+context, with C<$a> and C<$b> set to successive pairs of values from the
+KVLIST.
+
+Returns the first pair of values from the list for which the BLOCK returned
+true in list context, or an empty list of no such pair was found. In scalar
+context it returns a simple boolean value, rather than either the key or the
+value found.
+
+ ( $key, $value ) = pairfirst { $a =~ m/^[[:upper:]]+$/ } @kvlist
+
+Similar to C<grep>, C<pairfirst> aliases C<$a> and C<$b> to elements of the
+given list. Any modifications of it by the code block will be visible to
+the caller.
+
+=head2 pairmap BLOCK KVLIST
Similar to perl's C<map> keyword, but interprets the given list as an
even-sized list of pairs. It invokes the BLOCK multiple times, in list
given list. Any modifications of it by the code block will be visible to
the caller.
-=item pairs KVLIST
+=head2 pairs KVLIST
A convenient shortcut to operating on even-sized lists of pairs, this
function returns a list of ARRAY references, each containing two items from
...
}
-=item pairkeys KVLIST
+=head2 pairkeys KVLIST
A convenient shortcut to operating on even-sized lists of pairs, this
function returns a list of the the first values of each of the pairs in
pairmap { $a } KVLIST
-=item pairvalues KVLIST
+=head2 pairvalues KVLIST
A convenient shortcut to operating on even-sized lists of pairs, this
function returns a list of the the second values of each of the pairs in
pairmap { $b } KVLIST
-=item reduce BLOCK LIST
-
-Reduces LIST by calling BLOCK, in a scalar context, multiple times,
-setting C<$a> and C<$b> each time. The first call will be with C<$a>
-and C<$b> set to the first two elements of the list, subsequent
-calls will be done by setting C<$a> to the result of the previous
-call and C<$b> to the next element in the list.
-
-Returns the result of the last call to BLOCK. If LIST is empty then
-C<undef> is returned. If LIST only contains one element then that
-element is returned and BLOCK is not executed.
+=cut
- $foo = reduce { $a < $b ? $a : $b } 1..10 # min
- $foo = reduce { $a lt $b ? $a : $b } 'aa'..'zz' # minstr
- $foo = reduce { $a + $b } 1 .. 10 # sum
- $foo = reduce { $a . $b } @bar # concat
+=head1 OTHER FUNCTIONS
-If your algorithm requires that C<reduce> produce an identity value, then
-make sure that you always pass that identity value as the first argument to prevent
-C<undef> being returned
-
- $foo = reduce { $a + $b } 0, @values; # sum with 0 identity value
+=cut
-=item shuffle LIST
+=head2 shuffle LIST
Returns the elements of LIST in a random order
@cards = shuffle 0..51 # 0..51 in a random order
-=item sum LIST
-
-Returns the sum of all the elements in LIST. If LIST is empty then
-C<undef> is returned.
-
- $foo = sum 1..10 # 55
- $foo = sum 3,9,12 # 24
- $foo = sum @bar, @baz # whatever
-
-This function could be implemented using C<reduce> like this
-
- $foo = reduce { $a + $b } 1..10
-
-If your algorithm requires that C<sum> produce an identity of 0, then
-make sure that you always pass C<0> as the first argument to prevent
-C<undef> being returned
-
- $foo = sum 0, @values;
-
-=item sum0 LIST
-
-Similar to C<sum>, except this returns 0 when given an empty list, rather
-than C<undef>.
-
-=back
+=cut
=head1 KNOWN BUGS
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
+Recent additions and current maintenance by
+Paul Evans, <leonerd@leonerd.org.uk>.
+
=cut
use strict;
use List::Util;
-our $VERSION = "1.29"; # FIXUP
+our $VERSION = "1.30"; # FIXUP
$VERSION = eval $VERSION; # FIXUP
1;
tainted
weaken
);
-our $VERSION = "1.29";
+our $VERSION = "1.30";
$VERSION = eval $VERSION;
our @EXPORT_FAIL;
#!./perl
use strict;
-use Test::More tests => 13;
-use List::Util qw(pairgrep pairmap pairs pairkeys pairvalues);
+use Test::More tests => 17;
+use List::Util qw(pairgrep pairfirst pairmap pairs pairkeys pairvalues);
is_deeply( [ pairgrep { $b % 2 } one => 1, two => 2, three => 3 ],
[ one => 1, three => 3 ],
is_deeply( \@kvlist, [ one => 2, two => 3 ], 'pairgrep aliases elements' );
}
+is_deeply( [ pairfirst { length $a == 5 } one => 1, two => 2, three => 3 ],
+ [ three => 3 ],
+ 'pairfirst list' );
+
+is_deeply( [ pairfirst { length $a == 4 } one => 1, two => 2, three => 3 ],
+ [],
+ 'pairfirst list empty' );
+
+is( scalar( pairfirst { length $a == 5 } one => 1, two => 2, three => 3 ),
+ 1,
+ 'pairfirst scalar true' );
+
+ok( !scalar( pairfirst { length $a == 4 } one => 1, two => 2, three => 3 ),
+ 'pairfirst scalar false' );
+
is_deeply( [ pairmap { uc $a => $b } one => 1, two => 2, three => 3 ],
[ ONE => 1, TWO => 2, THREE => 3 ],
'pairmap list' );
=item *
-L<List::Util> has been upgraded from version 1.27 to 1.29
+L<List::Util> has been upgraded from version 1.27 to 1.30
-L<List::Util> now includes C<pairgrep>, C<pairmap>, C<pairs>, C<pairkeys>
-and C<pairvalues> functions that operate on even-sized lists of pairs.
+L<List::Util> now includes C<pairgrep>, C<pairmap>, C<pairs>, C<pairkeys>,
+C<pairvalues> and C<pairfirst> functions that operate on even-sized lists of
+pairs.
=item *
https://perl5.git.perl.org / perl5.git / commitdiff