Can I check if a loop's scope is entered for the first time?

[LanX]

For an iterator to work in Perl one needs to initialize it properly

use strict;
use warnings;
use Data::Dump qw/pp dd/;

for my $limit (reverse 1..5) {
    for ( my $iter = countdown($limit); $iter->(my $a) ; ) {
        print "$a: ";
    }
    print "\n";
    
}

sub countdown{
    my $val = shift;

    my $iter = sub {
        if ($val--) {
            $_[0]=$val;
            return 1;
        }
        return;                         # stop iteration
    };

    return $iter;

}

4: 3: 2: 1: 0: 
3: 2: 1: 0: 
2: 1: 0: 
1: 0: 
0:

(I used c-style for here for clarity*)

But I'd rather like to stay DRY and to write something like

while ( countdown $limit => my $a ) {
    ....
}

Where countdown can elaborate if the loop is (re)entered and does the init step automatically.

NB: Other languages have this feature for so called iterator objects.

I'm wondering if this could be tricked into Perl without XS wizardy °...

Approaches ...

• I tried %^H , but this seems to be a compile time effect only.
• Blessing a DESTROY method to \$a doesn't help, because it's triggered for all iterations not only the first.
• I was thinking to use PadWalker to inject a var with a DESTROY hook into closed_over , but I doubt this has a chance to work.
• UPDATE: Well with Keyword::Simple I could define a new loop keyword which expands into for(;;;)
• UPDATE: there is some magic connected to the diamond operator <$obj> which can be overloaded, but you can't use it with functions because the syntax is convoluted with file-glob.

IDEAS?

*) please note that while(CODE){} and for(;CODE;){} have the same effect.

°) many issues could be solved like this...

update

The countdown iterator was used for demonstration only, I now plenty of ways to countdown. Iterators are a general issue.

[LanX]

FWIW this "works" somehow, but lacks the elegance of the "while solution" approach...

Please note that now, one can have more than just one loop var, like a "pointy block" in Perl6.

The cheat is that $a has to be global here to work under strict.*

Using my $a wouldn't work, because the scope only starts after the statements semicolon, and the body-sub is defined before.

use strict;
use warnings;
use Data::Dump qw/pp dd/;


sub iter (&$;@) {
    my $gen = shift;
    my $body = pop;

    for (my $it = $gen->(@_) ; $it->(@_); ) {
        $body->();
    }
}


for my $limit (reverse 1..5) {

    iter { countdown($limit) } $a => sub  {
        print "$a: ";
    };

    print "\n";
}



sub countdown{
    my $val = shift;

    my $it = sub {
        if ($val--) {
            $_[0]=$val;
            return 1;
        }
        return;                         # stop iteration
    };

    return $it;

}

4: 3: 2: 1: 0: 
3: 2: 1: 0: 
2: 1: 0: 
1: 0: 
0:

update

Renamed loop to iter ... the loop construct in Perl6 is another beast, and wanted to avoid confusion.

*) remember $a and $b are global to allow sort to work.

[Perlbotics]

The approached which partly worked for me was to run the while() loop as

while( countdown( $limit )->( my $x ) ) {
 # do something with $x
}

and to use caller() within countdown() (or a wrapper) to generate a key into a hash of cached iterators. On first call the iterator was created and cached. On any other iteration, the cached iterator was looked up. An exhausted iterator removed itself from the chache (hint: stringified code reference).

This worked, but the iterator code had to be modified to remove the cached entry for self which is an additional dependency/coupling. Furthermore last left the loop keeping the iterator intact, so it continued when the while() statement was visited again. This could be fixed by explicitly removing the cashed iterator at the end of the loop (greetings to all those forgotten C/C++ delete() statements). Binding it to an object (new/destroy) is no improvement compared to the usual procedure (code below).

From my point of view, this led to too much complexity just to avoid typing:

my $it = countdown( $limit );
while( $it->( my $x ) ) {
 # do something with $x
}

It would be nice if Perl's loop-keywords would also recognise an Iterator::* object and would treat it as expected... (internally rewriting it C-style, whatever).

May other monks succeed where I have failed ;-)

Update: Answering your question:

Can I check if a loop's scope is entered for the first time?

• for the very first time: yes
• initially for any succeeding visit: don't know (probably not in the general case w/o adding extra code)

[LanX]

Thanks, but remember I warned you in the CB! :)

> It would be nice if Perl's loop-keywords would also recognise an Iterator::* object and would treat it as expected... (internally rewriting it C-style, whatever).

I doubt this can be retro fitted without bracking backwards comaptibility.

You'd need a new keyword, like iter for my goal, this could actually be implemented with pluggable keywords.

Please note that you can already overload the diamond operator of a class to make the object an iterator (like a filehandle does)

This should work:

while ( my $next = <$obj> ) {
    ...
}

but letting a generator init an iterator once wouldn't

while ( my $next = <generator($limit)> ) {
    ...
}

because the diamond operator magically decides to become a file-glob here.

[TheDamian]

You might also find it useful to take a look at how Var::Pairs implements its each_kv() and each_pair() iterators.
That technique could easily be generalized to any handle kind of user-defined iterator, not just the standard hash and array iterators.

Damian

[LanX]

Thanks Damian, but I'm afraid this is not solving my problem, just another one. *

From what I see in the sources of Var::Pairs are you binding a cycling iterator to the call place with the help of Devel::Callsite .

This is just a more secure way of using line and file from caller .

But this will only work well if you always finish the loop without exiting in the middle, since you are only initializing once by the first entry and letting the iteration starting new after a full loop.

What I'm looking for is to re-init the iterator when it is re-entered again. Hence to safely use last and return or other loop exits.

Consider this example showing that your iterators are not reset after breaking the loop.

use warnings;
use strict;
use feature 'say';

use Var::Pairs;

my %hash;
@hash{"a".."d"} =1..4;


sub till {
    my $goal = shift;
    
    while (my $next = each_pair %hash) {
        say $next->key, ' had the value ', $next->value;
        last if $next->key  eq $goal;
    }
    say "-"x10 . "exit"; 
}

till("a");
till("a");
till("a");
till("a");

/usr/bin/perl -w /home/lanx/pm/t_var_pairs.pl 
a had the value 1
----------exit
d had the value 4
b had the value 2
c had the value 3
----------exit
a had the value 1
----------exit
d had the value 4
b had the value 2
c had the value 3
----------exit

Compilation finished at Sun May  6 21:54:21

update

NB: each has of course the same (and more) limitations.

*) There are different kinds of iterators, please correct me if I'm missing a way to apply this to my kind of iterators ...

[TheDamian]

Apologies, Rolf. I misunderstood the actual problem.
And, yes, it is an issue with Var::Pairs too.
And, yes, I will now look at solving it. ;-)

Damian

[LanX]

FWIW I tried feature state with no avail. (the idea was to return a tied iterator)

But this only works for the first initialization, test() is never called again

use strict;
use warnings;
use Data::Dump qw/pp dd/;
use feature 'state';

my $x = 0;
sub test { warn ++$x; return $x }

for my $a (1..3) {
    print "\n---\n";
    while (state $z = test() ) {
        print "$a:$z\n";
        last unless  $a--;
    }
}

1 at d:/Users/lanx/pm/state_loop.pl line 7.

---
1:1
0:1

---
2:1
1:1
0:1

---
3:1
2:1
1:1
0:1

[Veltro]

Hi, was experimenting with your code, couldn't solve it but here are my 2 cents.

use strict ;
use warnings ;
use Data::Dumper ;

my @limit = (reverse 1..5) ;
my $limit = { _l => \@limit } ;
bless ( $limit, 'limit' ) ;
sub countdown {
    my $val = shift ;
    my $iter = sub {
        if ( $val-- ) {
            $_[0] = $val ;
            return 1 ;
        }
        return ;
    } ;
    return $iter ;
}
while ( my $iter = $limit->Next( *countdown ) ) {
    while ( $iter->( my $a ) ) {
        print "$a: " ;
    }
    print "\n" ;
}

package limit ;
use strict ;
use warnings ;
use Data::Dumper ;
sub Next {
    my $this = shift ;
    if ( @{$this->{_l}} ) {
        return $_[0]->( shift @{$this->{_l}} ) ;
    }
    return ;
} ;