And now one for those who say Perl 6 isn't the coolest thing since sliced bread. I've been reading the Perl blogosphere, and found a couple of posts that show off some what happens when you convert an advanced Perl 5 program into Perl 6. The results are definitely amazing.

Here is the Perl 5 version:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
#!/usr/bin/perl
use strict;
use warnings;

my $op_dispatch_table = {
   '+' => sub {
      my ($stack) = @_;
      push @$stack, pop(@$stack) + pop(@$stack);
   },
   '-' => sub {
      my ($stack) = @_;
      my $s = pop(@$stack);
      push @$stack, pop(@$stack) - $s;
   },
   '*' => sub {
      my ($stack) = @_;
      push @$stack, pop(@$stack) * pop(@$stack);
   },
   '/' => sub {
      my ($stack) = @_;
      my $s = pop(@$stack);
      push @$stack, pop(@$stack) / $s;
   },
   'sqrt' => sub {
      my $stack = shift;
      push @$stack, sqrt(pop(@$stack));
   },
};

my $result = evaluate($op_dispatch_table, $ARGV[0]);

print "Result: $result\n";
sub evaluate {
   my $odt = shift;
   my @stack;
   my ($expr) = @_;
   my @tokens = split /\s+/, $expr;
   for my $token (@tokens) {
      if ($token =~ /\d+$/) {
         push @stack, $token;
      } else {
         if (my $fn = $odt->{$token}) {
            $fn->(\@stack);
         } else {
            die "Unrecognized token '$token'; aborting";
         }
      }

   }
  return pop(@stack);
}

And here is the fully optmized Perl 6 version:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
my %op_dispatch_table = {
    '+'    => { .push(.pop + .pop)  },
    '-'    => { .push(.pop R- .pop) },
    '*'    => { .push(.pop * .pop)  },
    '/'    => { .push(.pop R/ .pop) },
    'sqrt' => { .push(.pop.sqrt)    },
};

sub evaluate (%odt, $expr) {
    my @stack;
    my @tokens = $expr.split(/\s+/);
    for @tokens {
        when /\d+/     { @stack.push($_); }
        when ?%odt{$_} { %odt{$_}(@stack); }
        default        { die "Unrecognized token '$_'; aborting"; }
    }
    @stack.pop;
}

say "Result: { evaluate(%op_dispatch_table, @*ARGS[0]) }";

Quite a difference eh? Anyway, I'd recommend reading the original post by fREW Schmidt, the reply and optimization post by pmichaud, and the follow up post by fREW.

Perl 6 might not solve world hunger, but it is the coolest thing since sliced bread.

Changelog

Mar 03, 2009
Last update prior to importation to GreyNoise.
Mar 03, 2009
Initial version.