http://qs321.pair.com?node_id=1214137


in reply to Re^4: Can I check if a loop's scope is entered for the first time? (Devel::Callsite)
in thread Can I check if a loop's scope is entered for the first time?

I think it's likely this technique would also work for you.

In fact, more than just likely...

sub from (&$) {
    use Devel::Callsite qw< callsite context >;
    use Scope::Upper    qw< reap UP >;

    my ($iterator_source) = @_;

    # Uniquely identify this call, according to its lexical context...
    my $ID = callsite() . context();

    # Install the iterator...
    state %iterator_for;
    $iterator_for{$ID} //= $iterator_source->();

    # Install destructor for iterator at end of caller's block...
    reap { delete $iterator_for{$ID} } UP UP;

    # Iterate...
    return $iterator_for{$ID}->($_[1]);
}


for my $limit (reverse 1..5) {
    while ( from{countdown($limit)} 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;

}

[download]
  • Comment on Re^5: Can I check if a loop's scope is entered for the first time? (Devel::Callsite)
  • Download Code

Replies are listed 'Best First'.
Re^6: Can I check if a loop's scope is entered for the first time? (Devel::Callsite)
by TheDamian (Vicar) on May 07, 2018 at 13:58 UTC

    What the heck...I just uploaded another new release of Var::Pairs
    (version 0.004000), which lets you write this:

    use Var::Pairs;

sub countdown {
    my $n = shift;

    return sub {
        return if $n < 0;  # Indicates iterator exhausted
        return $n--;       # Next value iterated
    }
}

for my $limit (reverse 1..5) {
    while (my ($a) = each_value countdown($limit)) {
        print $a, ':';
    }
    say q{};
}

    [download]

    ...which is very close to what you wanted, I believe.

    (And, yes, the each_value() subroutine is doing a lot of very hard paddling
    under the surface to correctly ignore all those repeated calls to countdown($limit)
    in the while loop. ;-)

    And, obviously, it would be far more efficient to write the iteration: 
    for my $limit (reverse 1..5) {
    my $iter = countdown($limit);
    while (my ($a) = each_value $iter) {
        print $a, ':';
    }
    say q{};
}

    [download]

    Damian

[reply]
[d/l]
[select]
      Hi Damian,

      > And, obviously, it would be far more efficient to write the iteration:

      Indeed. :-/ But it seems to work. :)

      Many thanks and sorry for the slow communication, but job is very demanding at the moment.

      ( I should have checked CPAN for "scope" and I'm not a big fan of XS dependencies but after I saw that dave_the_m is one of the maintainers, it might be canonical. ;-)

      I'll certainly have a closer look into it and will come back to it later... :)

      Cheers Rolf
      (addicted to the Perl Programming Language and ☆☆☆☆ :)
      Wikisyntax for the Monastery

[reply]

      Wouldn't it be better to wrap the hard paddle? 

          sub each_value (&);
    ...
    while (my ($a) = each_value {countdown($limit)}) {
        print $a, ':';
    }

      [download]

[reply]
[d/l]

        No question. It would definitely be better.

        Unfortunately, there's no way to give each_value() a prototype
        that allows it to also take a thunky block as an argument...in addition
        to all the other argument types (hash, array, reference) it currently takes.

        The current declaration is:

            sub each_value (+) {...}

        [download]

        but, to be able to accept a block it would require:

            sub each_value (&) {...}

        [download]

        and there's no prototype marker than allows both. :-(

        Damian

[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom