• the archives
  • huri.net
    •

    Reverse Polish Calculator in Perl 6

    post date: 2009-03-03 16:58

    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.