File Coverage

blib/lib/List/Keywords.pm
Criterion Covered Total %
statement 51 53 96.2
branch 17 24 70.8
condition n/a
subroutine 9 9 100.0
pod 0 5 0.0
total 77 91 84.6


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.10;
7              
8 12     12   2766551 use v5.14;
  12         104  
9 12     12   63 use warnings;
  12         60  
  12         308  
10              
11 12     12   59 use Carp;
  12         24  
  12         10064  
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             sub import
132             {
133 12     12   86 shift;
134 12         35 my @syms = @_;
135              
136 12         1891 foreach ( @syms ) {
137 20 100       72 if( $_ eq ":all" ) {
138 1         5 push @syms, keys %KEYWORD_OK;
139 1         3 next;
140             }
141              
142 19 50       73 $KEYWORD_OK{$_} or croak "Unrecognised import symbol '$_'";
143              
144 19         19518 $^H{"List::Keywords/$_"}++;
145             }
146             }
147              
148             sub B::Deparse::pp_firstwhile
149             {
150 6     6 0 12564 my ($self, $op, $cx) = @_;
151             # first, any, all, none, notall
152 6         26 my $private = $op->private;
153 6 50       46 my $name =
    100          
    100          
    100          
    100          
154             ( $private == 0 ) ? "first" :
155             ( $private == 6 ) ? "none" :
156             ( $private == 9 ) ? "any" :
157             ( $private == 22 ) ? "all" :
158             ( $private == 25 ) ? "notall" :
159             "firstwhile[op_private=$private]";
160              
161             # We can't just call B::Deparse::mapop because of the possibility of `my $var`
162             # So we'll inline it here
163 6         25 my $kid = $op->first;
164 6         28 $kid = $kid->first->sibling; # skip PUSHMARK
165 6         23 my $code = $kid->first;
166 6         20 $kid = $kid->sibling;
167 6 50       33 if(B::Deparse::is_scope $code) {
168 6         1870 $code = "{" . $self->deparse($code, 0) . "} ";
169 6 100       43 if($op->targ) {
170 1         36 my $varname = $self->padname($op->targ);
171 1         11 $code = "my $varname $code";
172             }
173             }
174             else {
175 0         0 $code = $self->deparse($code, 24);
176 0 0       0 $code .= ", " if !B::Deparse::null($kid);
177             }
178 6         13 my @exprs;
179 6         49 for (; !B::Deparse::null($kid); $kid = $kid->sibling) {
180 6         616 my $expr = $self->deparse($kid, 6);
181 6 50       96 push @exprs, $expr if defined $expr;
182             }
183 6         716 return $self->maybe_parens_func($name, $code . join(" ", @exprs), $cx, 5);
184             }
185              
186             sub B::Deparse::pp_reducewhile
187             {
188 1     1 0 1689 return B::Deparse::mapop(@_, "reduce");
189             }
190              
191             sub deparse_niter
192             {
193 2     2 0 7 my ($name, $self, $op, $cx) = @_;
194 2         10 my $targ = $op->targ;
195 2         8 my $targcount = $op->private;
196              
197             # We can't just call B::Deparse::mapop because of the `my ($var)` list
198 2         8 my $kid = $op->first;
199 2         10 $kid = $kid->first->sibling; # skip PUSHMARK
200 2         8 my $block = $kid->first;
201 2         9 my @varnames = map { $self->padname($_) } $targ .. $targ + $targcount - 1;
  4         31  
202              
203 2         24 $kid = $kid->sibling;
204 2         6 my @exprs;
205 2         32 for(; !B::Deparse::null($kid); $kid = $kid->sibling) {
206 2         304 my $expr = $self->deparse($kid, 6);
207 2 50       28 push @exprs, $expr if defined $expr;
208             }
209              
210 2         520 my $code = "my (" . join(", ", @varnames) . ") {" . $self->deparse($block, 0) . "} "
211             . join(", ", @exprs);
212 2         270 return $self->maybe_parens_func($name, $code, $cx, 5);
213             }
214              
215 1     1 0 1067 sub B::Deparse::pp_ngrepwhile { deparse_niter(ngrep => @_) }
216 1     1 0 1094 sub B::Deparse::pp_nmapwhile { deparse_niter(nmap => @_) }
217              
218             =head1 KEYWORDS
219              
220             =cut
221              
222             =head2 first
223              
224             $val = first { CODE } LIST
225              
226             I
227              
228             Repeatedly calls the block of code, with C<$_> locally set to successive
229             values from the given list. Returns the value and stops at the first item to
230             make the block yield a true value. If no such item exists, returns C.
231              
232             $val = first my $var { CODE } LIST
233              
234             I
235              
236             Optionally the code block can be prefixed with a lexical variable declaration.
237             In this case, that variable will contain each value from the list, and the
238             global C<$_> will remain untouched.
239              
240             =head2 any
241              
242             $bool = any { CODE } LIST
243              
244             Repeatedly calls the block of code, with C<$_> locally set to successive
245             values from the given list. Returns true and stops at the first item to make
246             the block yield a true value. If no such item exists, returns false.
247              
248             $val = any my $var { CODE } LIST
249              
250             I
251              
252             Uses the lexical variable instead of global C<$_>, similar to L.
253              
254             =head2 all
255              
256             $bool = all { CODE } LIST
257              
258             Repeatedly calls the block of code, with C<$_> locally set to successive
259             values from the given list. Returns false and stops at the first item to make
260             the block yield a false value. If no such item exists, returns true.
261              
262             $val = all my $var { CODE } LIST
263              
264             I
265              
266             Uses the lexical variable instead of global C<$_>, similar to L.
267              
268             =head2 none
269              
270             =head2 notall
271              
272             $bool = none { CODE } LIST
273             $bool = notall { CODE } LISt
274              
275             I
276              
277             Same as L and L but with the return value inverted.
278              
279             $val = none my $var { CODE } LIST
280             $val = notall my $var { CODE } LIST
281              
282             I
283              
284             Uses the lexical variable instead of global C<$_>, similar to L.
285              
286             =cut
287              
288             =head2 reduce
289              
290             $final = reduce { CODE } INITIAL, LIST
291              
292             I
293              
294             Repeatedly calls a block of code, using the C<$a> package lexical as an
295             accumulator and setting C<$b> to each successive value from the list in turn.
296             The first value of the list sets the initial value of the accumulator, and
297             each returned result from the code block gives its new value. The final value
298             of the accumulator is returned.
299              
300             =head2 reductions
301              
302             @partials = reductions { CODE } INITIAL, LIST
303              
304             I
305              
306             Similar to C, but returns a full list of all the partial results of
307             every invocation, beginning with the initial value itself and ending with the
308             final result.
309              
310             =cut
311              
312             =head1 N-AT-A-TIME FUNCTIONS
313              
314             The following two functions are a further experiment to try out n-at-a-time
315             lexical variable support on the core C and C operators. They are
316             differently named, because keyword plugins cannot replace existing core
317             keywords, only add new ones.
318              
319             =head2 ngrep
320              
321             @values = ngrep my ($var1, $var2, ...) { CODE } LIST
322              
323             $values = ngrep my ($var1, $var2, ...) { CODE } LIST
324              
325             I
326              
327             A variation on core's C, which uses lexical variable syntax to request a
328             number of items at once. The input list is broken into bundles sized according
329             to the number of variables declared. The block of code is called in scalar
330             context with the variables set to each corresponding bundle of values, and the
331             bundles for which the block returned true are saved for the resulting list.
332              
333             In scalar context, returns the number of values that would have been present
334             in the resulting list (i.e. this is not the same as the number of times the
335             block returned true).
336              
337             =cut
338              
339             =head2 nmap
340              
341             @results = nmap my ($var1, $var2, ...) { CODE } LIST
342              
343             $results = nmap my ($var1, $var2, ...) { CODE } LIST
344              
345             I
346              
347             A variation on core's C, which uses lexical variable syntax to request a
348             number of items at once. The input list is broken into bundles sized according
349             to the number of variables declared. The block of code is called in list
350             context with the variables set to each corresponding bundle of values, and the
351             results of the block from each bundle are concatenated together to form the
352             result list.
353              
354             In scalar context, returns the number of values that would have been present
355             in the resulting list.
356              
357             =cut
358              
359             =head1 TODO
360              
361             More functions from C:
362              
363             pairfirst pairgrep pairmap
364              
365             Maybe also consider some from L.
366              
367             =head1 ACKNOWLEDGEMENTS
368              
369             With thanks to Matthew Horsfall (alh) for much assistance with performance
370             optimizations.
371              
372             =cut
373              
374             =head1 AUTHOR
375              
376             Paul Evans
377              
378             =cut
379              
380             0x55AA;