P6: Rule and RPN calc

[eric256]

Hello everyone,

I decided to play around with pugs (perl6) and rules to see what neet things they could do. One of the cool things they do is create a match object with named rules being inserted into a hash so they could be accessed via the rule name. Err thats kinda a complicated way to say it, but the result is pretty nifty. I couldn't think of much to do with it offhand, well i couldn't think of much that *I* could do, so I made it read in data of the form "key = value\n" and then evaluate the values as RPN, printing out the results. Along the way I ended up building a describe_match function to print out the match in a usefull manner. So i'll shut up and show the code, perl 6 dark lords please feel free to fix it up!

#!/usr/bin/pugs
use v6;

grammar rpn_data {
   rule key       { <?ident> }
   rule value     { \N* };
   rule statement { <key>\h*=\h*<value>\n* }
   rule config    { [\n*<statement>]* }
}

my $data = "
test1 = 1 2 +
test2 = 1 2 3 + -
";

say "Match 1:";
my $config = $data ~~ /<config>/;
say match_describe( $config,0);

for $config<config><statement> -> $o  {
    say "$o<key> == $o<value> == {evaluate("$o<value>")}";
}




sub match_describe (Match $o, Num $indent) {
   my $desc;
   if ( @$o.elems ){
     $desc ~= "[\n" ~ join("" , map { match_describe($_, $indent + 1) 
+} @$o ) ~ "{"\t" x $indent}],";
   } elsif (  %$o.keys.elems ) {
      $desc ~= "{"\t" x $indent}\{\n";
      
      for (keys %$o) {
        $desc ~= "{"\t" x ($indent+1)}'$_' := { match_describe($o.{$_}
+,$indent + 1)}\n";
      }  
      $desc ~= "{"\t" x $indent}\},\n";
   } else  {
      $desc ~= "'$o'";
   }
   return "$desc";
}

# RPN calc stolen from examples/rpn/p6/RPN.pm

sub evaluate (Str $expr) returns Int {
    my @stack;
    for ($expr.split()) -> $tok {
        if $tok ~~ /-? \d+/ {
            @stack.push($tok);
            next;
        }
        my $x = @stack.pop() err die "Stack underflow\n";
        my $y = @stack.pop() err die "Stack underflow\n";

        # given/when is a sexy new P6 construct that can avoid
        # long if/elsif/else chains
        given $tok {
            when '+' { @stack.push($y + $x) }
            when '-' { @stack.push($y - $x) }
            when '*' { @stack.push($y * $x) }
            when '/' { @stack.push(int($y / $x)) }
            default  { die "Invalid token:\"$tok\"\n" }
        }
    }

    @stack.elems == 1 or die "Invalid stack:[@stack[]]\n";
    return @stack[0];
}

This code now lives in the pugs example directory under rules.

For those without access here is the output:

1;0 eric256@feather:~/tests$ pugs rpn_calc.p6
Match 1:
{
        'config' :=     {
                'statement' := [
                        {
                                'key' := 'test1'
                                'value' := '1 2 + '
                        },
                        {
                                'key' := 'test2'
                                'value' := '1 2 3 + - '
                        },
                ],
        },

},

test1 == 1 2 +  == 3
test2 == 1 2 3 + -  == -4

[ayrnieu]

When I gave up:

#! /usr/bin/env perl
use v6;

my %operators =
  ( '+' => sub { [+] @_ },
    '-' => sub { [-] @_ },
    '*' => sub { [*] @_ },
    '/' => sub { [/] @_ },
  );

grammar rpn_data {
  rule value      { -?\d+ }
  rule operator   { <[+*/\-]> }
  rule expression { }
}

sub rpn_eval (Str $e) returns Num {
  my @stack;
#  die "Invalid RPN: $e" unless $e ~~ /<expression>/;
  for $e.split() -> $tok {
    if $tok ~~ /<value> / { @stack.push($tok); next }
    @stack.push(%operators{$tok}(reverse @stack.pop, @stack.pop));
  }
  @stack[0]
}

say rpn_eval($_) while $_ = =<>

For the most part, writing this was very exciting -- for the first time I delved into the perl6 rules stuff and tried to use it, and from this I now see how I would've solved this problem -- with code blocks after matches to neatly fail if I discovered improper RPN, or even with a modified %operators in the operator rule that evaluated the RPN as it was parsed.

And yet, this was disappointing: none of what I wanted to do was implemented in pugs.

Still, I've now a much better idea of what I've to look forward to. Thanks.

Update: in case anyone asks, there are no checks for overflow/underflow or such in my rpn_eval because I expected to have already verified that the RPN wouldn't have such problems. No point in uglyifying this test code with such checks when I discover that I momentarily can't. With time, I'll have this as the core of a real implementation.

[eric256]

And yet, this was disappointing: none of what I wanted to do was implemented in pugs.

Yea that is a pretty normal issue. On the other hand, if its lacking in pugs you can always work on getting it implemented. I've done that with a couple of things, and written tests to help push development of yet other things. I too wanted to eval the RPN as it was evaluated, but that just wasn't in the cards....yet. It will be cool when this is all finished. I know it often feels like pugs isn't actualy getting anywhere, but in the 6 months i've been following it, there have been huge steps forward and there are some very exciting things happening now that promise to bring it even farther in the next six months. Thanks for the alternate solution, i'm thinking about some combination of the two but i think i need something more interesting than RPN to work on now!

Please post any ideas for other examples to add to the example directory!

[Anonymous Monk]

Also: Tales from writing a RPN evaluator in Perl 5, Perl 6 and Haskell