In Perl 6 you will be able to do this:

sub ($x) {
   return unless $x > 0; 
   $x.say; 
   &SUB.($x - 1);
}
[download]

use Scalar::Util qw(weaken);

{
  my ($sub, $sub1);
  $sub1 = $sub = sub {
    my $num = shift;
    return $num + $sub->($num-1) if $num >0;
    return 0;
  }
  weaken($sub);
  my $num = $sub->(5);
  print "$num\n";
}
[download]

Eg to create an recursive factorial subroutine:

#!/usr/bin/perl

use strict;

my $sub = do {
    my $this_sub;

    $this_sub = sub {
    my $factor = int(shift);
    return $factor > 1
        ? &$this_sub($factor-1) * $factor
        : 1;
    };

};

print "factorial of 7 is ".&$sub(7)."\n";
[download]

my @factorials = map {&{
    my $this_sub;

    $this_sub = sub {
    my $factor = int(shift);
    return $factor > 1
        ? &$this_sub($factor-1) * $factor
        : 1;
    }}($_)} (3,5,7,9);

print "factorials: @factorials\n";
[download]

"What's wrong storing a reference to an anonymous inner sub in an anonymous outer closure?"

It's a recursive, i.e. leaking, reference.

It's a recursive, i.e. leaking, reference.

Hmm... probably safer to keep the reference on the call stack, thus releasing it on exit.

For example, adopting the convention that the reference is always passed as the first parameter:

my @factorials = map {

    $_[0] ||= sub {
        my $factor = pop;

        return $factor > 1
            ? &{$_[0]}($_[0],$factor-1) * $factor
            : 1;
    };

    &{$_[0]}($_[0],$_)} (3,5,7,9);
[download]

..or..

sub make_call {
    goto $_[0];
}

my @factorials = map {

    make_call (sub {
        my $factor = $_[1];
    
        return $factor > 1
            ? make_call($_[0], $factor-1) * $factor
            : 1;
    }, $_);

} (3,5,7,9);
[download]

#!/usr/bin/perl -w
use strict;

print "5! = ", 
    Y(sub{ my ($proc, $n) = @_;
           ($n < 2) ? 1 : $n * $proc->($proc,$n-1) }, 5), "\n";

sub Y { my ($p, $x) = @_;
        $p->($p,$x);     }
[download]

No.

(Now if you had asked how to get a reference to the current subroutine, even if it's anonymous and without modifying the external code, there are ways to do that.)

How would one do that? I'm curious.

OK, I found a way, but you won't like it! :-)
Use $DB::sub->() but you have to run it under the perl debuger (perl -d):


sub { print 'A'; $DB::sub->() }->();
[download]

Ted Young

($$<<$$=>$$<=>$$<=$$>>$$) always returns 1. :-)

I'd write a little very scary, very hairy XS code. I don't know which of three or four approaches would work best, but I'd start by poking around PL_curcop.

No.

That's too bad, too. I've occasionally wanted something like that myself.

What semantics should that have, do you think? A magical local variable which points to the current block? [Added]: Or extend redo to apply to code blocks?

The J language has something like that, a magical operator called $: which always refers to the innermost verb it is used at.

However, I don't like that, and don't think it would be a good idea for perl. I'd rather like something like (one form of) the let macro in scheme. The equivalent to this would be something like this in perl: the hypothetical let NAME { BODY } ARGS could be equivalent to do { my sub NAME { BODY }; NAME(ARGS); }, where you can call NAME in the BODY too. Except we'd need a different name instead of let.

Update: redo wouldn't help. That only works if you have tail recursion. Redo doesn't return.

the whole point is not to name the beast. I like the idea of a $thingy :

(sub {... $thingy->(...) ... )->(args);
[download]

would suit me just fine. Oh well. I can live without it.
Thanks again.

No. A code reference is the only way to use an anonymous subroutine.

Here's an example of a recursive anonymous sub from a code I wrote earlier:

        # WRONG
        ...
        my $traverse;
        $traverse = sub {
                my(@c, $c, @m); 
                @c = $_[0];
                while (@c) {
                        $c = pop @c;
                        for (@{$member{$c}}) 
                                { push @m, $_; }
                        for (@{$child{$c}}) 
                                { push @c, $_; }
                }
                @m;
        };
        for (keys(%cut)) {
                my @m = &$traverse($_);
                my @m0 = grep { !$poison{$_} } @m;
                my @m1 = grep { $poison{$_} } @m;
                print "( ", jointab(@m0), "@ ", jointab(@m1), ")\n";
        }
        ...
[download]

Update: as jdporter has noticed, this example isn't recursive. It uses a stack. I was mislead by the name "traverse". Sorry.

well the answers came even before I was able to update the original very incomplete post (first posting syndrome I guess). Many thanks to all.