examples/rules/rpn_calc.pl

   1 use v6;
   2
   3 grammar rpn_data {
   4    rule key       { <?ident> }
   5    rule value     { \N* };
   6    rule statement { <key>\h*\=\h*<value>\n* }
   7    rule config    { [\n*<statement>]* }
   8 }
   9
  10 my $data = "
  11 test1 = 1 2 +
  12 test2 = 1 2 3 + -
  13 ";
  14
  15 say "Match 1:";
  16 my $config = $data ~~ /<config>/;
  17 say match_describe( $config,0);
  18
  19 for $config<config><statement> -> $o  {
  20     say "$o<key> == $o<value> == {evaluate("$o<value>")}";
  21 }
  22
  23
  24 sub match_describe (Match $o, Num $indent) {
  25    my $desc;
  26    if @$o.elems {
  27      $desc ~= "[\n" ~ join("" , map { match_describe($_, $indent + 1) }, @$o ) ~ "{"\t" x $indent}],";
  28    }
  29    elsif %$o.keys.elems {
  30       $desc ~= "{"\t" x $indent}\{\n";
  31
  32       for keys %$o {
  33         $desc ~= "{"\t" x ($indent+1)}'$_' := { match_describe($o.{$_},$indent + 1)}\n";
  34       }
  35       $desc ~= "{"\t" x $indent}\},\n";
  36    }
  37    else {
  38       $desc ~= "'$o'";
  39    }
  40    return "$desc";
  41 }
  42
  43 # RPN calc stolen from examples/rpn/p6/RPN.pm
  44
  45 sub evaluate (Str $expr) returns Int {
  46     my @stack;
  47     for $expr.split() -> $tok {
  48         if $tok ~~ /\-? \d+/ {
  49             @stack.push($tok);
  50             next;
  51         }
  52         my $x = @stack.pop() orelse die "Stack underflow\n";
  53         my $y = @stack.pop() orelse die "Stack underflow\n";
  54
  55         # given/when is a sexy new P6 construct that can avoid
  56         # long if/elsif/else chains
  57         given $tok {
  58             when '+' { @stack.push($y + $x) }
  59             when '-' { @stack.push($y - $x) }
  60             when '*' { @stack.push($y * $x) }
  61             when '/' { @stack.push(int($y / $x)) }
  62             default  { die "Invalid token:\"$tok\"\n" }
  63         }
  64     }
  65
  66     @stack.elems == 1 or die "Invalid stack:[@stack[]]\n";
  67     return @stack[0];
  68 }