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];
}
[download]

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
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.