File Coverage

blib/lib/List/Keywords.pm
Criterion Covered Total %
statement 55 57 96.4
branch 17 24 70.8
condition n/a
subroutine 13 13 100.0
pod 0 6 0.0
total 85 100 85.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2021-2023 -- leonerd@leonerd.org.uk
5              
6             package List::Keywords 0.11;
7              
8 12     12   2897592 use v5.14;
  12         133  
9 12     12   81 use warnings;
  12         43  
  12         305  
10              
11 12     12   71 use Carp;
  12         25  
  12         12351  
12              
13             require XSLoader;
14             XSLoader::load( __PACKAGE__, our $VERSION );
15              
16             =head1 NAME
17              
18             C - a selection of list utility keywords
19              
20             =head1 SYNOPSIS
21              
22             use List::Keywords 'any';
23              
24             my @boxes = ...;
25              
26             if( any { $_->size > 100 } @boxes ) {
27             say "There are some large boxes here";
28             }
29              
30             =head1 DESCRIPTION
31              
32             This module provides keywords that behave (almost) identically to familiar
33             functions from L, but implemented as keyword plugins instead of
34             functions. As a result these run more efficiently, especially in small code
35             cases.
36              
37             =head2 Blocks vs Anonymous Subs
38              
39             In the description above the word "almost" refers to the fact that as this
40             module provides true keywords, the code blocks to them can be parsed as true
41             blocks rather than anonymous functions. As a result, both C and
42             C will behave rather differently here.
43              
44             For example,
45              
46             use List::Keywords 'any';
47              
48             sub func {
49             any { say "My caller is ", caller; return "ret" } 1, 2, 3;
50             say "This is never printed";
51             }
52              
53             Here, the C will see C as its caller, and the C
54             statement makes the entire containing function return, so the second line is
55             never printed. The same example written using C will instead print
56             the C function as being the caller, before making just that
57             one item return the value, then the message on the second line is printed as
58             normal.
59              
60             In regular operation where the code is just performing some test on each item,
61             and does not make use of C or C, this should not cause any
62             noticable differences.
63              
64             =head2 Lexical Variable Syntax
65              
66             Newly added in I many of the functions in this module support a
67             new syntax idea that may be added to Perl core eventually, whereby a lexical
68             variable can be declared before the code block. In that case, this lexical
69             variable takes the place of the global C<$_> for the purpose of carrying
70             values from the input list.
71              
72             This syntax is currently under discussion for Perl's C and C
73             blocks, and may be added in a future release of Perl.
74              
75             L
76              
77             =head2 Aliasing and Modification
78              
79             Each time the block code is executed, the global C<$_> or the lexical variable
80             being used is aliased to an element of the input list (in the same way as it
81             would be for perl's C or C loops, for example). If the block
82             attempts to modify the value of this variable, such modifications are visible
83             in the input list. You almost certainly want to avoid doing this.
84              
85             For example:
86              
87             my @numbers = ...;
88             my $x = first my $x { $x++ > 10 } @numbers;
89              
90             This will modify values in the C<@numbers> array, but due to the short-circuit
91             nature of C, will only have modified values up to the selected element
92             by the time it returns. This will likely confuse later uses of the input
93             array.
94              
95             Additionally, the result of C is also aliased to the input list, much
96             as it is for core perl's C. This may mean that values passed in to other
97             functions have an ability to mutate at a distance.
98              
99             For example:
100              
101             func( first { ... } @numbers );
102              
103             Here, the invoked C may be able to modify the C<@numbers> array, for
104             example by modifying its own C<@_> array.
105              
106             =head2 Performance
107              
108             The following example demonstrates a simple case and shows how the performance
109             differs.
110              
111             my @nums = (1 .. 100);
112              
113             my $ret = any { $_ > 50 } @nums;
114              
115             When run for 5 seconds each, the following results were obtained on my
116             machine:
117              
118             List::Util::any 648083/s
119             List::Keyword/any 816135/s
120              
121             The C version here ran 26% faster.
122              
123             =cut
124              
125             my %KEYWORD_OK = map { $_ => 1 } qw(
126             first any all none notall
127             reduce reductions
128             ngrep nmap
129             );
130              
131 19     19   17994 sub import { shift->apply( sub { $^H{ $_[0] }++ }, @_ ) }
  12     12   169  
132 1     1   2010 sub unimport { shift->apply( sub { delete $^H{ $_[0] } }, @_ ) }
  1     1   13  
133              
134             sub apply
135             {
136 13     13 0 65 shift;
137 13         47 my ( $cb, @syms ) = @_;
138              
139 13         1987 foreach ( @syms ) {
140 21 100       89 if( $_ eq ":all" ) {
141 1         6 push @syms, keys %KEYWORD_OK;
142 1         3 next;
143             }
144              
145 20 50       94 $KEYWORD_OK{$_} or croak "Unrecognised import symbol '$_'";
146              
147 20         69 $cb->( "List::Keywords/$_" );
148             }
149             }
150              
151             sub B::Deparse::pp_firstwhile
152             {
153 6     6 0 13521 my ($self, $op, $cx) = @_;
154             # first, any, all, none, notall
155 6         26 my $private = $op->private;
156 6 50       46 my $name =
    100          
    100          
    100          
    100          
157             ( $private == 0 ) ? "first" :
158             ( $private == 6 ) ? "none" :
159             ( $private == 9 ) ? "any" :
160             ( $private == 22 ) ? "all" :
161             ( $private == 25 ) ? "notall" :
162             "firstwhile[op_private=$private]";
163              
164             # We can't just call B::Deparse::mapop because of the possibility of `my $var`
165             # So we'll inline it here
166 6         25 my $kid = $op->first;
167 6         30 $kid = $kid->first->sibling; # skip PUSHMARK
168 6         19 my $code = $kid->first;
169 6         18 $kid = $kid->sibling;
170 6 50       39 if(B::Deparse::is_scope $code) {
171 6         1906 $code = "{" . $self->deparse($code, 0) . "} ";
172 6 100       47 if($op->targ) {
173 1         17 my $varname = $self->padname($op->targ);
174 1         5 $code = "my $varname $code";
175             }
176             }
177             else {
178 0         0 $code = $self->deparse($code, 24);
179 0 0       0 $code .= ", " if !B::Deparse::null($kid);
180             }
181 6         30 my @exprs;
182 6         50 for (; !B::Deparse::null($kid); $kid = $kid->sibling) {
183 6         650 my $expr = $self->deparse($kid, 6);
184 6 50       82 push @exprs, $expr if defined $expr;
185             }
186 6         712 return $self->maybe_parens_func($name, $code . join(" ", @exprs), $cx, 5);
187             }
188              
189             sub B::Deparse::pp_reducewhile
190             {
191 1     1 0 1713 return B::Deparse::mapop(@_, "reduce");
192             }
193              
194             sub deparse_niter
195             {
196 2     2 0 8 my ($name, $self, $op, $cx) = @_;
197 2         8 my $targ = $op->targ;
198 2         8 my $targcount = $op->private;
199              
200             # We can't just call B::Deparse::mapop because of the `my ($var)` list
201 2         11 my $kid = $op->first;
202 2         11 $kid = $kid->first->sibling; # skip PUSHMARK
203 2         9 my $block = $kid->first;
204 2         7 my @varnames = map { $self->padname($_) } $targ .. $targ + $targcount - 1;
  4         32  
205              
206 2         11 $kid = $kid->sibling;
207 2         5 my @exprs;
208 2         16 for(; !B::Deparse::null($kid); $kid = $kid->sibling) {
209 2         351 my $expr = $self->deparse($kid, 6);
210 2 50       43 push @exprs, $expr if defined $expr;
211             }
212              
213 2         547 my $code = "my (" . join(", ", @varnames) . ") {" . $self->deparse($block, 0) . "} "
214             . join(", ", @exprs);
215 2         278 return $self->maybe_parens_func($name, $code, $cx, 5);
216             }
217              
218 1     1 0 1119 sub B::Deparse::pp_ngrepwhile { deparse_niter(ngrep => @_) }
219 1     1 0 1082 sub B::Deparse::pp_nmapwhile { deparse_niter(nmap => @_) }
220              
221             =head1 KEYWORDS
222              
223             =cut
224              
225             =head2 first
226              
227             $val = first { CODE } LIST
228              
229             I
230              
231             Repeatedly calls the block of code, with C<$_> locally set to successive
232             values from the given list. Returns the value and stops at the first item to
233             make the block yield a true value. If no such item exists, returns C.
234              
235             $val = first my $var { CODE } LIST
236              
237             I
238              
239             Optionally the code block can be prefixed with a lexical variable declaration.
240             In this case, that variable will contain each value from the list, and the
241             global C<$_> will remain untouched.
242              
243             =head2 any
244              
245             $bool = any { CODE } LIST
246              
247             Repeatedly calls the block of code, with C<$_> locally set to successive
248             values from the given list. Returns true and stops at the first item to make
249             the block yield a true value. If no such item exists, returns false.
250              
251             $val = any my $var { CODE } LIST
252              
253             I
254              
255             Uses the lexical variable instead of global C<$_>, similar to L.
256              
257             =head2 all
258              
259             $bool = all { CODE } LIST
260              
261             Repeatedly calls the block of code, with C<$_> locally set to successive
262             values from the given list. Returns false and stops at the first item to make
263             the block yield a false value. If no such item exists, returns true.
264              
265             $val = all my $var { CODE } LIST
266              
267             I
268              
269             Uses the lexical variable instead of global C<$_>, similar to L.
270              
271             =head2 none
272              
273             =head2 notall
274              
275             $bool = none { CODE } LIST
276             $bool = notall { CODE } LISt
277              
278             I
279              
280             Same as L and L but with the return value inverted.
281              
282             $val = none my $var { CODE } LIST
283             $val = notall my $var { CODE } LIST
284              
285             I
286              
287             Uses the lexical variable instead of global C<$_>, similar to L.
288              
289             =cut
290              
291             =head2 reduce
292              
293             $final = reduce { CODE } INITIAL, LIST
294              
295             I
296              
297             Repeatedly calls a block of code, using the C<$a> package lexical as an
298             accumulator and setting C<$b> to each successive value from the list in turn.
299             The first value of the list sets the initial value of the accumulator, and
300             each returned result from the code block gives its new value. The final value
301             of the accumulator is returned.
302              
303             =head2 reductions
304              
305             @partials = reductions { CODE } INITIAL, LIST
306              
307             I
308              
309             Similar to C, but returns a full list of all the partial results of
310             every invocation, beginning with the initial value itself and ending with the
311             final result.
312              
313             =cut
314              
315             =head1 N-AT-A-TIME FUNCTIONS
316              
317             The following two functions are a further experiment to try out n-at-a-time
318             lexical variable support on the core C and C operators. They are
319             differently named, because keyword plugins cannot replace existing core
320             keywords, only add new ones.
321              
322             =head2 ngrep
323              
324             @values = ngrep my ($var1, $var2, ...) { CODE } LIST
325              
326             $values = ngrep my ($var1, $var2, ...) { CODE } LIST
327              
328             I
329              
330             A variation on core's C, which uses lexical variable syntax to request a
331             number of items at once. The input list is broken into bundles sized according
332             to the number of variables declared. The block of code is called in scalar
333             context with the variables set to each corresponding bundle of values, and the
334             bundles for which the block returned true are saved for the resulting list.
335              
336             In scalar context, returns the number of values that would have been present
337             in the resulting list (i.e. this is not the same as the number of times the
338             block returned true).
339              
340             =cut
341              
342             =head2 nmap
343              
344             @results = nmap my ($var1, $var2, ...) { CODE } LIST
345              
346             $results = nmap my ($var1, $var2, ...) { CODE } LIST
347              
348             I
349              
350             A variation on core's C, which uses lexical variable syntax to request a
351             number of items at once. The input list is broken into bundles sized according
352             to the number of variables declared. The block of code is called in list
353             context with the variables set to each corresponding bundle of values, and the
354             results of the block from each bundle are concatenated together to form the
355             result list.
356              
357             In scalar context, returns the number of values that would have been present
358             in the resulting list.
359              
360             =cut
361              
362             =head1 TODO
363              
364             More functions from C:
365              
366             pairfirst pairgrep pairmap
367              
368             Maybe also consider some from L.
369              
370             =head1 ACKNOWLEDGEMENTS
371              
372             With thanks to Matthew Horsfall (alh) for much assistance with performance
373             optimizations.
374              
375             =cut
376              
377             =head1 AUTHOR
378              
379             Paul Evans
380              
381             =cut
382              
383             0x55AA;