gistfile1.pl

#!/opt/local/bin/perl -w
use strict;

our($fac0, $fac1, $fac2); #keep "use strict" happy

my $num = shift;

#Take 0
#Everyone's first implementation of factorial (except using function 
#pointers instead of functions). Get used to function pointers; I'll be using
#them throughout this exercise.
$fac0 = sub{
   my $n = shift;

   if($n == 0){
      1;
   }
   else{
      $fac0->($n-1) * $n;
   }
};
print "Take 0: ", $num, "! = ", $fac0->($num), "\n";

#Take 1
#Iterative factorial
$fac1 = sub{
   my ($n, $acc) = @_;
   if($n == 0){
      $acc;
   }
   else{
      $fac1->($n-1, $acc * $n);
   }
};

print "Take 1: ", $num, "! = ", $fac1->($num, 1), "\n";

#Take 2
#Iterative factorial, curried
$fac2 = sub{
   my $n = shift;
   sub{
      my $acc = shift;
      if($n == 0){
         $acc;
      }
      else{
         $fac2->($n-1)->($acc * $n);
      }
   }
};

print "Take 2: ", $num, "! = ", $fac2->($num)->(1), "\n";

#Okay, we've had some practice currying. Now back to the non-iterative
#factorial method...

#Take 3
#Non-iterative factorial with function as first param
my $fac3 = sub{
   my $me = shift;
   my $n  = shift;

   if($n == 0){
      1;
   }
   else{
      $me->($me, $n-1) * $n;
   }
};

print "Take 3: ", $num, "! = ", $fac3->($fac3, $num), "\n";

#Take 4
#Non-iterative factorial with function param curried
my $fac4 = sub{
   my $me = shift;
   sub{
      my $n = shift;
      if($n == 0){
         1;
      }
      else{
         $me->($me)->($n-1) * $n;
      }
   }
};

print "Take 4: ", $num, "! = ", $fac4->($fac4)->($num), "\n";

#Take 5
#Same as above but with the if/else abstracted into a separate function
my $fac5 = sub{
   my $me = shift;
   sub{
      my $n = shift;

      my $f = sub{
         my ($me, $n) = @_;
         
         if($n == 0){
            1;
         }
         else{
            $me->($me)->($n-1) * $n;
         }
      };

      $f->($me, $n);
   }
};

print "Take 5: ", $num, "! = ", $fac5->($fac5)->($num), "\n";

#Take 6
#Same as above except curried
my $fac6 = sub{
   my $me = shift;
   sub{
      my $n = shift;

      my $f = sub{
         my $meme = shift;
         
         sub{
            my $m = shift;
            if($m == 0){
               1;
            }
            else{
               $meme->($m-1) * $m;
            }
         }
      };

      $f->($me->($me))->($n);
   }
};

print "Take 6: ", $num, "! = ", $fac6->($fac6)->($num), "\n";

#Take 7
#Same as above except pull out the inner function $f...
my $f = sub{
   my $meme = shift;
         
   sub{
      my $m = shift;
      if($m == 0){
         1;
      }
      else{
         $meme->($m-1) * $m;
      }
   }
};

# ... and call it explicitly from the outer function
my $g = sub{
   my $me = shift;
   sub{
      my $n = shift;
      $f->($me->($me))->($n);
   }
};

print "Take 7: ", $num, "! = ", $g->($g)->($num), "\n";

#And, finally, the y-combinator, an abstraction of $g from above. That is, a function
#that builds a function like $g using a paramater passed to it (instead of counting on $f
#to be defined somewhere else)

my $y = sub{
   my $f = shift;
   my $g = sub{
      my $h = shift;
      sub{
         my $n = shift;
         $f->($h->($h))->($n);
      }
   };
   $g->($g);
};

#call y with an anonymous non-recursive function!
print "Take 8: ", $num, "! = ", $y->(sub{my $f=shift; sub{my $n=shift; ($n==0)?1:$n*$f->($n-1) } })->($num), "\n";

#Or, create a named non-recursive function that doesn't need to know its name (because it "apparently" doesn't recurse)
my $yfac = sub{
   my $f = shift;
   sub{
      my $n = shift;
      ($n==0)?1:$n*$f->($n-1);
   }
};

print "Take 9: ", $num, "! = ", $y->($yfac)->($num), "\n";

#But the really sick part is that you don't even need to give 'y' a name!
print "Take 10: ", $num, "! = ",
   sub{
      my $f = shift;
      my $g = sub{
         my $h = shift;
         sub{
            my $n = shift;
            $f->($h->($h))->($n);
         }
      };
      $g->($g);
   }->(
      sub{
         my $f = shift;
         sub{
            my $n = shift;
            ($n==0)?1:$n*$f->($n-1);
         }
      }
   )->($num), "\n";


#And, the final answer: the y combinator in action sovling my problem

my $input = "/C=US/O=foobar/OU=baz/OU=xyz/OU=People/CN=Smith Bob A xyz123";
$input =~ s/^\///;

print 
   join ", ",
   $y->( 
      sub{ 
         my $f = shift; 
         sub { 
            my $x=shift @{$_[0]}; 
            $x?( $f->($_[0]), $x):() 
         } 
      } 
   )->([split(/\//, $input)]);

print "\n";

#And, of course, the version where there are NO named functions (i.e. y is not even named)

my $input = "/C=US/O=foobar/OU=baz/OU=xyz/OU=People/CN=Smith Bob A xyz123";
$input =~ s/^\///;

print 
   join ", ",
   sub{
      my $f = shift;
      my $g = sub{
         my $h = shift;
         sub{
            my $n = shift;
            $f->($h->($h))->($n);
         }
      };
      $g->($g);
   }->( 
      sub{ 
         my $f = shift; 
         sub { 
            my $x=shift @{$_[0]}; 
            $x?( $f->($_[0]), $x):() 
         } 
      } 
   )->([split(/\//, $input)]);

print "\n";