FAST
view release on metacpan or search on metacpan
lib/FAST/List/Gen.pm view on Meta::CPAN
package FAST::List::Gen;
use warnings;
use strict;
use Carp;
use Symbol qw/delete_package/;
use Scalar::Util qw/reftype weaken openhandle blessed/;
our @list_util;
use List::Util
@list_util = qw/first max maxstr min minstr reduce shuffle sum/;
our @EXPORT = qw/mapn by every range gen cap filter cache apply
zip min max reduce glob iterate list/;
our %EXPORT_TAGS = (
base => \@EXPORT,
'List::Util' => \@list_util,
map {s/==//g; s/#.*//g;
/:(\w+)\s+(.+)/s ? ($1 => [split /\s+/ => $2]) : ()
} split /\n{2,}/ => q(
:utility mapn by every apply min max reduce mapab
mapkey d deref slide curse remove
:source range glob makegen list array vecgen repeat file
:modify gen cache expand contract collect slice flip overlay
test recursive sequence scan scan_stream == scanS
cartesian transpose stream strict
:zip zip zipgen tuples zipwith zipwithab unzip unzipn
zipmax zipgenmax zipwithmax
:iterate iterate
iterate_multi == iterateM
iterate_stream == iterateS
iterate_multi_stream == iterateMS
:gather gather
gather_stream == gatherS
gather_multi == gatherM
gather_multi_stream == gatherMS
:mutable mutable done done_if done_unless
:filter filter
filter_stream == filterS
filter_ # non-lookahead version
:while take_while == While
take_until == Until
while_ until_ # non-lookahead versions
drop_while drop_until
:numeric primes
:deprecated genzip
));
our @EXPORT_OK = keys %{{map {$_ => 1} map @$_, values %EXPORT_TAGS}};
$EXPORT_TAGS{all} = \@EXPORT_OK;
BEGIN {
require Exporter;
require overload;
require B;
*FAST::List::Generator:: = *FAST::List::Gen::;
}
sub import {
if (@_ == 2 and !$_[1] || $_[1] eq '*') {
lib/FAST/List/Gen.pm view on Meta::CPAN
($xs, $ys) = ($ys, $xs) if $flip;
$xs->$method($ys)
}
} split /\s+/, shift}},
'+' => sub {
my ($x, $y, $flip) = @_;
($x, $y) = ($y, $x) if $flip;
FAST::List::Gen::sequence($x, $y);
},
(map {
(my $op = $_) =~ s/neg/-/;
$_ => sub {$_[0]->hyper($op)}
} qw (neg ! ~)),
do {
my %unary = map {
(my $op = $_) =~ s/^u//i;
$_ => (eval (m/(..)(.)/?"sub {$1\$_[0]$2}":"sub {$op \$_[0]}") or die $@)
} qw (! ~ \ @{} ${} %{} &{} *{} U- U+ u- u+);
map {
my $op = $_;
$op => sub {
my ($x, $y, $flip) = @_;
if (my $code = $unary{$y}) {
return $x->hyper($code);
}
($x, $y) = ($y, $x) if $flip;
bless [$x, $op, $y] => 'FAST::List::Gen::Hyper';
}
} qw (<< >>)
};
#END {defined &$_ and print "$_\n"
# for sort {lc $a cmp lc $b} keys %FAST::List::Gen::erator::}
my $l2g = \&FAST::List::Gen::list;
sub new {
goto &_new if $STRICT;
bless $_[1] => 'FAST::List::Gen::era::tor'}
{package
FAST::List::Gen::era::tor;
our @ISA = 'FAST::List::Gen::erator';
my $force = sub {FAST::List::Gen::erator->_new($_[0])};
tie my @by, 'FAST::List::Gen::By', 2, [1..10];
my $by = FAST::List::Gen::erator->_new(\@by);
no strict 'refs';
for my $proxy (grep /[a-z]/, keys %{ref($by).'::'}) {
*$proxy = $proxy eq 'index'
? sub :lvalue {&$force->index}
: sub {goto & {&$force->can($proxy)}}
}
sub DESTROY {}
}
{
my %code_ok = map {ref, 1} sub {}, qr {};
my $croak_msg = 'not supported in dwim generator code dereference';
sub _new {
package FAST::List::Gen;
my ($class, $gen) = @_;
my $src = tied @$gen;
weaken $gen;
my ($fetch, $fsize) = $src->closures;
my $index = ($src->can('index') or sub {0})->();
my $size = $fsize->();
my $mutable = $src->mutable;
if($mutable) {
$src->tail_size($size)
}
my $dwim_code_strings = $DWIM_CODE_STRINGS;
my $overload = sub {
if (@_ == 0) {
ref $index
? $$index < $size ? $fetch->(undef, $$index ) : ()
: $index < $size ? $fetch->(undef, $index++) : ()
}
elsif (@_ == 1) {
if (looks_like_number($_[0])) {$fetch->(undef, $_[0])}
elsif (ref $_[0]) {
if (isagen($_[0])) {slice($gen, $_[0])}
elsif ($code_ok{ref $_[0]}) {
$gen->map($_[0])
}
elsif (ref $_[0] eq 'REF' && $code_ok{ref ${$_[0]}}
or $dwim_code_strings && ref $_[0] eq 'SCALAR'
) {
$gen->grep(${$_[0]})
}
else {croak "reference '$_[0]' $croak_msg"}
}
elsif (canglob($_[0])) {slice($gen, $_[0])}
elsif ($dwim_code_strings) { $gen->map ($_[0])}
else {croak "value '$_[0]' $croak_msg"}
}
else {unshift @_, $gen; goto &{$gen->can('slice')}}
};
curse {
-bless => $gen,
_overloader => sub {
eval qq {
package @{[ref $_[0]]};
use overload fallback => 1, '&{}' => sub {\$overload},
'<>' => \\&next;
local *DESTROY;
bless []; 1
} or croak "overloading failed: $@";
$overload
},
size => $fsize,
get => $fetch,
slice => sub {shift;
@_ == 1 and (isagen($_[0]) or canglob($_[0]))
and return slice($gen, $_[0]);
if ($mutable) {
my @ret;
for my $i (@_) {
$i < $size or next;
my @x = \($fetch->(undef, $i));
$i < $size or next;
push @ret, @x;
}
wantarray ? map $$_ => @ret
lib/FAST/List/Gen.pm view on Meta::CPAN
$source = $src->can('FETCH');
$size = $src->fsize;
$mutable = $src->mutable;
$src->tail_size($size) if $mutable;
}
curse {
FETCH => sub {
my $i = $_[1];
while ($i > $#list) {
$iter++ >= $size
and croak "too many iterations requested: ".
"$iter. index $i out of bounds [0 .. @{[$size - 1]}]";
local *_ = $from ? $list[-1] :
$source ? \$source->(undef, scalar @list) :
\scalar @list;
eval {push @list, map {ref eq 'FAST::List::Gen::Thunk' ? \$$_->() : \$_} $code->(); 1}
or catch_done and do {
if (ref $@) {
push @list, map {ref eq 'FAST::List::Gen::Thunk' ? \$$_->() : \$_} @{$@};
$size = @list;
$$_ = $size for @tails;
$when_done->();
return ${$list[$i < $#list ? $i : $#list]};
} else {
$iter--;
$size = @list;
$$_ = $size for @tails;
$when_done->();
return
}
}
}
if ($size < @list) {
$size = @list;
$$_ = $size for @tails;
}
elsif ($mutable) {
$$_ = $size for @tails;
}
${$list[$i]}
},
fsize => sub {$size},
cached => sub {\@list},
set_size => sub {
$size = int $_[1];
$$_ = $size for @tails;
$when_done->() if $size == @list
},
_resize => sub {
$size += $_[1] if $size < 9**9**9;
$$_ = $size for @tails;
$iter += $_[1];
},
_when_done => sub :lvalue {$when_done},
from => sub {
croak "can not call ->from on started iterator"
if @list or $from++;
push @list, @_ > 1 ? \@_[1..$#_] : \FAST::List::Gen::Iterate::Default->new;
},
tail_size => sub {
push @tails, \$_[1]; weaken $tails[-1];
},
} => $class
},
purge => sub {Carp::croak 'can not purge iterative generator'},
load => sub {push @{$_[0]->cached}, \@_[1..$#_]},
PUSH => sub {
my $self = shift;
$self->_resize(0+@_);
push @{$self->cached}, \(@_)
},
UNSHIFT => sub {
my $self = shift;
$self->_resize(0+@_);
unshift @{$self->cached}, \(@_)
},
POP => sub {
my $self = shift;
return unless $self->fsize > 0;
$self->_resize(-1);
${pop @{$self->cached}}
},
SHIFT => sub {
my $self = shift;
return unless $self->fsize > 0;
$self->_resize(-1);
${shift @{$self->cached}}
},
SPLICE => sub {
my $self = shift;
my $list = $self->cached;
my $size = $self->fsize;
my @ret =
@_ == 0 ? splice @$list :
@_ == 1 ? splice @$list, shift :
@_ == 2 ? splice @$list, shift, shift :
splice @$list, shift, shift, \(@_) ;
$self->_resize(@$list - $size);
map {$$_} @ret
};
=item iterate_multi_stream C< {CODE} [LIMIT] >
C< iterate_multi_stream > is a version of C< iterate_multi > that does not cache
the generated values. because of this, access to the returned generator must be
monotonically increasing (such as repeated calls to C<< $gen->next >>).
keyword modification of a stream iterator (with C<push>, C<shift>, ...) is not
supported.
=cut
sub iterate_multi_stream (&;$) {
tiegen Iterate_Multi_Stream => @_, 9**9**9
}
BEGIN {*iterateMS = *iterate_multi_stream}
mutable_gen Iterate_Multi_Stream => sub {
my ($class, $code, $size) = @_;
my ($pos, $when_done ) = (0, sub {});
my ($from, @last, @tails, $source, $mutable);
lib/FAST/List/Gen.pm view on Meta::CPAN
$mutable = $size->is_mutable;
$size = $size->size;
}
curse {
FETCH => sub {
my $i = $_[1];
$i < $pos and croak "non-monotone access of iterate multi stream, idx($i) < pos($pos)";
while ($i >= $pos) {
$pos >= $size and croak "too many iterations requested: ".
"$pos. index $i out of bounds [0 .. @{[$size - 1]}]";
if ($i == $pos and @last) {
$pos++;
last
}
if (@last) {
shift @last;
$pos++;
next;
}
local *_ = $from ? $from :
$source ? \$source->(undef, $pos) :
\$pos;
eval {push @last, map {ref eq 'FAST::List::Gen::Thunk' ? \$$_->() : \$_} $code->(); 1}
or catch_done and do {
if (ref $@) {
push @last, map {ref eq 'FAST::List::Gen::Thunk' ? \$$_->() : \$_} @{$@};
$size = $pos;
$$_ = $size for @tails;
$when_done->();
return ${shift @last};
} else {
$size = $pos;
$$_ = $size for @tails;
$when_done->();
return
}
};
$from = $last[-1] if $from;
$pos++
}
if ($mutable) {
$$_ = $size for @tails
}
${shift @last};
},
fsize => sub {$size},
index => sub {\$pos},
set_size => sub {
$size = int $_[1];
$$_ = $size for @tails;
$when_done->();
},
_when_done => sub :lvalue {$when_done},
from => sub {
croak "can not call ->from on started iterator"
if @last or $from;
push @last, @_ > 1 ? \@_[1..$#_] : \FAST::List::Gen::Iterate::Default->new;
$from = $last[-1];
},
tail_size => sub {
push @tails, \$_[1]; weaken $tails[-1];
},
} => $class
},
purge => sub {Carp::croak 'can not purge iterative generator'};
=item gather C< {CODE} [LIMIT] >
C< gather > returns a generator that is created iteratively. rather than
returning a value, you call C< take($return_value) > within the C< CODE >
block. note that since perl5 does not have continuations, C< take(...) > does
not pause execution of the block. rather, it stores the return value, the
block finishes, and then the generator returns the stored value.
you can not import the C< take(...) > function from this module.
C< take(...) > will be installed automatically into your namespace during
the execution of the C< CODE > block. because of this, you must always call
C< take(...) > with parenthesis. C< take > returns its argument unchanged.
gather implicitly caches its values, this allows random access normally not
possible with an iterative algorithm. the algorithm in C< iterate > is a
bit cleaner here, but C< gather > is slower than C< iterate >, so benchmark
if speed is a concern
my $fib = do {
my ($x, $y) = (0, 1);
gather {
($x, $y) = ($y, take($x) + $y)
}
};
a non-cached version C< gather_stream > is also available, see C< iterate_stream >
=cut
sub gather (&;$) {
my $code = shift;
my $take = $code->$cv_local('take');
unshift @_, sub {
my $ret;
no warnings 'redefine';
local *$take = sub {$ret = $_[0]};
$code->();
$ret
};
goto &iterate
}
sub gather_stream (&;$) {
local *iterate = *iterate_stream;
&gather
}
BEGIN {*gatherS = *gather_stream}
=item gather_multi C< {CODE} [LIMIT] >
the same as C< gather > except you can C< take(...) > multiple times, and each
can take a list. C< gather_multi_stream > is also available.
=cut
lib/FAST/List/Gen.pm view on Meta::CPAN
)
) \s*
\.{3} \s*
([\d\*]+ | )
$/xs
or croak "parse error: $_";
$end = '9**9**9' if $end eq '' or $end eq '*';
$pre ||= '';
my $self;
if ($pre) {
$pre =~ s/,\s*$//g;
$pre = 'prefix '->$eval($pragma."[do {$pre}]");
}
my $i = 1;
my $from;
if ($block) {
$block =~ s'\b(?:\$\^_|(?<!\$)_)\b'$_'g;
for (sort keys %{{$block =~ /((\$\^\w+))/g}}) {
$block =~ s/\Q$_/\$fetch->(undef, \$_ - $i)/g;
$i++;
}
$self = $block;
}
else {
$star =~ s'\b(?<!\$)_\b'$_'g;
$star =~ s/(?<=[\*\w\]\}\)])\s*\*\*(?=\s*\S)/{#exp#}/g;
$i = $star =~ s{
\* (?= \s* ( \*{1,2} \s* \S
| [-+%.\/\)\]\};,]
| $
| \{\#.+?\#\}
)
)} '{*}'gx;
$star =~ s/\{#exp#\}/**/g;
if ($i == 1 and $star !~ /\$_(?:\b|$)/) {
$star =~ s/\Q{*}\E(?=\W|$)/\$_/g;
$star =~ s/\Q{*}/\$_ /g;
$from = 1;
} else {
$star =~ s/\Q{*}/'$fetch->(undef, $_ - '.$i--.')'/ge
}
$self = $star
}
$self = "FAST::List::Gen::iterate {package $pkg; $pragma$self} $end";
'iterate'->$say_eval($self) if $SAY_EVAL or DEBUG;
my $say = $self =~ /(?:\b|^)say(?:\b|$)/
? "use feature 'say';"
: '';
my $fetch;
$self = (eval $say.$self
or Carp::croak "iterate error: $@\n$say$self\n");
return $self->from(@$pre) if $from and $pre;
$self->load(@$pre) if $pre and @$pre;
$fetch = tied(@$self)->can('FETCH');
weaken $fetch;
$self
}}
=item FAST::List::Gen C< ... >
the subroutine C< Gen > in the package C< List:: > is a dwimmy function that
produces a generator from a variety of sources. since C< FAST::List::Gen > is a fully
qualified name, it is available from all packages without the need to import it.
if given only one argument, the following table describes what is done:
array ref: FAST::List::Gen \@array ~~ makegen @array
code ref: FAST::List::Gen sub {$_**2} ~~ <0..>->map(sub {$_**2})
scalar ref: FAST::List::Gen \'*2' ~~ <0..>->map('*2')
glob string: FAST::List::Gen '1.. by 2' ~~ <1.. by 2>
glob string: FAST::List::Gen '0, 1, *+*' ~~ <0, 1, *+*...>
file handle: FAST::List::Gen $fh ~~ file $fh
if the argument does not match the table, or the method is given more than one
argument, the list is converted to a generator with C< list(...) >
FAST::List::Gen(1, 2, 3)->map('2**')->say; # 2 4 8
since it results in longer code than any of the equivalent constructs, it is
mostly for if you have not imported anything: C< use FAST::List::Gen (); >
=cut
sub FAST::List::Gen {
do {
if (@_ == 0) {'FAST::List::Gen'}
elsif (@_ == 1) {
if (ref $_[0]) {
if (ref $_[0] eq 'ARRAY' ) {&makegen}
elsif (ref $_[0] eq 'CODE' ) {&range(0, 9**9**9)->map($_[0])}
elsif (ref $_[0] eq 'SCALAR') {&range(0, 9**9**9)->map(${$_[0]})}
elsif (isagen $_[0] ) {$_[0]->copy}
elsif (openhandle $_[0] ) {&file}
}
elsif ($_[0] =~ /.[.]{2,3}/) {&glob}
elsif ($_[0] =~ /\*/) {&glob($_[0].'...')}
}
} or &list
}
BEGIN {*FAST::List::Generator = *FAST::List::Gen}
=item vecgen C< [BITS] [SIZE] [DATA] >
C< vecgen > wraps a bit vector in a generator. BITS defaults to 8. SIZE
defaults to infinite. DATA defaults to an empty string.
cells of the generator can be assigned to using array dereferencing:
my $vec = vecgen;
$$vec[3] = 5;
or with the C<< ->set(...) >> method:
lib/FAST/List/Gen.pm view on Meta::CPAN
say "@$filter[5 .. 10]"; # reads the source range up to element 23
# prints 11 13 15 17 19 21
say $#$filter; # reports 88, closer but still wrong
$filter->apply; # reads remaining elements from the source
say $#$filter; # 49 as it should be
note: C< filter > now reads one element past the last element accessed, this
allows filters to behave properly when dereferenced in a foreach loop (without
having to call C<< ->apply >>). if you prefer the old behavior, set
C< $FAST::List::Gen::LOOKAHEAD = 0 > or use C< filter_ ... >
=cut
sub filter (&;$$$) {
goto &filter_stream if $STREAM;
tiegen Filter => shift, tied @{&dwim}
}
mutable_gen Filter => sub {
my ($class, $check, $source) = @_;
my ($fetch, $fsize) = $source->closures;
my ($size, $src_size) = ($fsize->()) x 2;
if ($source->mutable) {
$source->tail_size($src_size)
}
my $when_done = sub {};
my ($pos, @list, @tails) = 0;
my $lookahead = $LOOKAHEAD || 0;
curse {
FETCH => sub {
my $i = $_[1];
unless ($i < $size) {
croak "filter index '$i' out of range [0 .. ".($size - 1).']';
}
local *_;
while ($#list < $i + $lookahead) {
if ($pos < $src_size) {
*_ = \$fetch->(undef, $pos);
if ($pos < $src_size and $check->()) {
push @list, \$_;
}
$pos++
}
else {
$size = @list;
$$_ = $size for @tails;
$when_done->();
$i <= $#list ? last : return
}
}
$size = $pos < $src_size
? @list + ($src_size - $pos)
: @list;
$$_ = $size for @tails;
${ $list[$i] }
},
fsize => sub {$size},
tail_size => sub {push @tails, \$_[1]; weaken $tails[-1]},
source => sub {$source},
_when_done => sub :lvalue {$when_done},
} => $class
};
sub filter_ (&;$$$) {
local $LOOKAHEAD;
&filter
}
=item filter_stream C< {CODE} ... >
as C< filter > runs, it builds up a cache of the elements that pass the filter.
this enables efficient random access in the returned generator. sometimes this
caching behavior causes certain algorithms to use too much memory.
C< filter_stream > is a version of C< filter > that does not maintain a cache.
normally, access to C< *_stream > iterators must be monotonically increasing
since their source can only produce values in one direction. filtering is a
reversible algorithm, and subsequently filter streams are able to rewind
themselves to any previous index. however, unlike C< filter >, the
C< filter_stream > generator must test previously tested elements to rewind.
things probably wont end well if the test code is non-deterministic or if the
source values are changing.
when used as a method, it can be spelled C<< $gen->filter_stream(...) >> or
C<< $gen->grep_stream(...) >>
=cut
sub filter_stream (&;$$$) {
tiegen Filter_Stream => shift, tied @{&dwim}
}
BEGIN {*filterS = *filter_stream}
mutable_gen Filter_Stream => sub {
my ($class, $code, $src) = @_;
my ($when_done, @tails ) = sub {};
my $rewind = sub {};
my $idx = 0;
my $fetch = $src->can('FETCH');
my $size =
my $src_size = $src->fsize;
$src->tail_size($src_size) if $src->mutable;
my @window;
my $pos = 0;
my $index = 0;
my ($next, $prev) = do {
no warnings 'exiting';
sub {
while ($pos < $src_size) {
*_ = \$fetch->(undef, $pos);
$pos < $src_size or last;
$pos++;
if (&$code) {
$idx++;
$pos = $src_size if $pos > $src_size;
return $_
}
lib/FAST/List/Gen.pm view on Meta::CPAN
return $_
}
}
$index = $idx = $pos = 0;
last outer
}
};
my $last;
curse {
FETCH =>
($LOOKAHEAD and ! $src->can('index')
|| $src->isa($class))
? sub {
my ($want, $ret) = $_[1];
outer: {
local *_;
if ($idx > $want) {
while ($idx > $want) {
undef $ret;
$ret = $prev->();
$index--;
}
}
else {
my $end = $want + 1;
while ($idx <= $end) {
$ret = $last;
undef $last;
$last = $next->();
$index++;
}
}
}
for ($src_size - $pos + $idx) {
if ($size > $_) {
$size = $_;
$size = $idx if $pos == $src_size;
$$_ = $size for @tails;
}
}
defined $ret ? $ret : ()
}
: sub {
my ($want, $ret) = $_[1];
outer: {
local *_;
if ($idx > $want) {$ret = $prev->() while $idx > $want}
elsif ($idx == $want) {$ret = $next->() }
elsif ($idx < $want) {$ret = $next->() while $idx <= $want}
}
$index = $idx;
for ($src_size - $pos + $idx) {
if ($size > $_) {
$size = $_;
$$_ = $size for @tails;
}
}
defined $ret ? $ret : ()
},
fsize => sub {$size},
tail_size => sub {push @tails, \$_[1]; &weaken($tails[-1])},
_when_done => sub :lvalue {$when_done},
rewind => $rewind,
index => sub {\$index},
} => $class;
};
=item While C<< {CODE} GENERATOR >>
=item Until C<< {CODE} GENERATOR >>
C<< While / ->while(...) >> returns a new generator that will end when its
passed in subroutine returns false. the C< until > pair ends when the subroutine
returns true.
if C< $FAST::List::Gen::LOOKAHEAD > is true (the default), each reads one element past
its requested element, and saves this value only until the next call for
efficiency, no other values are saved. each supports random access, but is
optimized for sequential access.
these functions have all of the caveats of C< filter >, should be considered
experimental, and may change in future versions. the generator returned should
only be dereferenced in a C< foreach > loop, otherwise, just like a C< filter >
perl will expand it to the wrong size.
the generator will return undef the first time an access is made and the check
code indicates it is past the end.
the generator will throw an error if accessed beyond its dynamically found limit
subsequent times.
my $pow = While {$_ < 20} gen {$_**2};
<0..>->map('**2')->while('< 20')
say for @$pow;
prints:
0
1
4
9
16
in general, it is faster to write it this way:
my $pow = gen {$_**2};
$gen->do(sub {
last if $_ > 20;
say;
});
=cut
sub While (&$) {
my ($code, $source) = @_;
isagen $source
or croak '$_[1] to While must be a generator';
tiegen While => tied @$source, $code
}
sub Until (&$) {
my ($code, $source) = @_;
isagen $source
or croak '$_[1] to Until must be a generator';
tiegen While => tied @$source, sub {not &$code}
}
sub while_ (&$) {local $LOOKAHEAD; &While}
sub until_ (&$) {local $LOOKAHEAD; &Until}
BEGIN {
*take_while = *While;
*take_until = *Until;
}
sub drop_while (&$) {$_[1]->drop_while($_[0])}
sub drop_until (&$) {$_[1]->drop_until($_[0])}
mutable_gen While => sub {
my ($class, $source, $check) = @_;
my ($fetch, $fsize) = $source->closures;
my ($size, $src_size) = ($fsize->()) x 2;
if ($source->mutable) {
$source->tail_size($src_size)
}
my $lookahead = $LOOKAHEAD;
my (@next, @tails) = -1;
my $when_done = sub {};
my $done = sub {
$size = $_[0];
$$_ = $size for @tails;
$when_done->();
@next = -1;
return
};
curse {
FETCH => sub {
my $i = $_[1];
unless ($i < $size) {
croak "while/until: index '$i' past end '".($size - 1)."'"
}
if ($i < $src_size) {
local *_ = $i == $next[0] ? $next[1] : \$fetch->(undef, $i);
return $done->($i) unless $i < $src_size and $check->();
if ($lookahead and $i + 1 < $src_size) {
local *_ = \$fetch->(undef, $i + 1);
if ($i + 1 < $src_size and $check->()) {
@next = ($i + 1, \$_)
}
else {
$done->($i + 1)
}
}
return $_
}
else {
$done->($src_size)
}
},
fsize => sub {$size},
tail_size => sub {push @tails, \$_[1]; weaken $tails[-1]},
source => sub {$source},
_when_done => sub :lvalue {$when_done},
} => $class
};
=item mutable C< GENERATOR >
=item C<< $gen->mutable >>
C< mutable > takes a single fixed size (immutable) generator, such as those
produced by C< gen > and converts it into a variable size (mutable) generator,
such as those returned by C< filter >.
as with filter, it is important to not use full array dereferencing (C< @$gen >)
with mutable generators, since perl will expand the generator to the wrong size.
to access all of the elements, use the C<< $gen->all >> method, or call
C<< $gen->apply >> before C< @$gen >. using a slice C< @$gen[5 .. 10] > is
always ok, and does not require calling C<< ->apply >>.
mutable generators respond to the C< FAST::List::Gen::Done > exception, which can be
produced with either C< done >, C< done_if >, or C< done_unless >. when the
exception is caught, it causes the generator to set its size, and it also
triggers any C<< ->when_done >> actions.
my $gen = mutable gen {done if $_ > 5; $_**2};
say $gen->size; # inf
say $gen->str; # 0 1 4 9 16 25
say $gen->size; # 6
generators returned from C< mutable > have a C<< ->set_size(int) >> method
that will set the generator's size and then trigger any
C<< ->when_done(sub{...}) >> methods.
=cut
sub mutable {
tiegen Mutable => tied @{isagen $_[0] or croak "var takes a generator"}
}
generator Mutable => sub {
my ($class, $source ) = @_;
my ($fetch, $fsize ) = $source->closures;
my ($when_done, $size) = sub {};
curse {
FETCH => sub {
defined $size and $_[1] >= $size
and croak "index $_[1] out of bounds [0 .. ${\($size - 1)}";
my $ret = eval {cap($fetch->(undef, $_[1]))}
or catch_done and ref $@ ? do {
my $val = $@;
$size = $_[1] + 1;
$when_done->();
return wantarray ? @$val : pop @$val
} : do {
$size = $_[1];
$when_done->();
return
};
( run in 2.379 seconds using v1.01-cache-2.11-cpan-99c4e6809bf )