mysterious * in front of nested sub

Question

What is exact function/purpose of * in front of _fact and how it can be equivalently written?

sub fact {
   my ($n) = @_;

   local *_fact = sub {
       my ($n, $prod) = @_;
       return $prod if $n == 0;
       return _fact($n-1, $n*$prod);
   };

   return _fact($n, 1);
}

fact($n);

Answer 1

Check typeglob aliases

Example above should be written using anonymous subroutine/closure:

sub fact {
   my ($n) = @_;

   my $_fact;
   $_fact = sub {
       my ($n, $prod) = @_;
       return $prod if $n == 0;
       return __SUB__->($n-1, $n*$prod);
   };

   return $_fact->($n, 1);
}

Answer 2

It's so called typeglob and is used to create table aliases. See perldoc reference for more info .

Answer 3

It appears that this is a funky attempt at creating a closure by assigning a code reference to the typeglob named _fact and then calling it pseudo-recursively. (note: a typeglob is the container for all variables with a particular name).

A virtually equivalent (and much more standard) way to write this would be:

sub fact {
   my ($n) = @_;

   my $_fact;

   $fact = sub { .... }; # Assigning code-ref to scalar variable.

   return $_fact->($n, 1); # Note the arrow syntax to deref the code-ref
}

...but, as was kindly pointed out, that has a memory leak in it... so, I say just dump the closure altogether and write it like so:

sub fact {
   my($n,$prod) = @_;

   return((defined $prod) ? (($n == 0) ? $prod : fact($n-1, $n * $prod)) : fact($n,1));
}

(remember, the only thing worse than infinite recursion is... infinite recursion)

Answer 4

Ideally, the author of the function would have liked to use

sub fact {
   my ($n) = @_;

   my $_fact; $_fact = sub {
       my ($n, $prod) = @_;
       return $prod if $n == 0;
       return $_fact->($n-1, $n*$prod);
   };

   return $_fact->($n, 1);
}

Unfortunately, that has a memory leak. The anon sub has a reference to $_fact, which holds a reference to the anonymous sub. $_fact would need to be cleared to break the reference on exit.

sub fact {
   my ($n) = @_;

   my $_fact;
   $_fact = sub {
       my ($n, $prod) = @_;
       return $prod if $n == 0;
       return $_fact->($n-1, $n*$prod);
   };

   my $rv;
   my $e = eval { $rv = $_fact->($n, 1); 1 } ? undef : ($@ || 'Unknown');
   $_fact = undef;
   die $e if $e
   return $rv;       
}

But that's UGLY! One way to avoid the problem is using a Y combinator. A much simpler way to avoid the problem is to store the code reference in a package variable instead of a lexical variable (since only lexical variables are captured by subs). This is what the code you posted does. Keep in mind that

*_fact = sub { ...  };

is basically a run-time version of

sub _fact { ... }

Both assign the sub to CODE slot of symbol _fact.

That said, 5.16 introduced a better fix:

use feature qw( current_sub );

sub fact {
   my ($n) = @_;

   my $_fact = sub {
       my ($n, $prod) = @_;
       return $prod if $n == 0;
       return __SUB__->($n-1, $n*$prod);
   };

   return $_fact->($n, 1);
}