Benchmark results for a simple infix arithmetic expression calculator implemented in Perl 5's Parse::RecDescent, Regexp::Grammars, and Perl 6's Rakudo

arith.p6

#!/usr/bin/env perl6

use v6;

# time: 12.1s ~ 12.5s
# mem: 180MB

my grammar Arith {
    rule TOP {
        | <.ws> <expr> { make $<expr>.made }
        | { self.panic("Bad expression") }
    }

    rule expr {
        | <term> + % <add-op>   { self.do_calc($/, $<term>, $<add-op>) }
        | { self.panic("Bad expression") }
    }

    token add-op {
        | < + - >
        #| { self.panic($/, "Bad addition/substraction operator") }
    }

    rule term {
        | <factor> + % <mul-op>  { make self.do_calc($/, $<factor>, $<mul-op>) }
        | { self.panic($/, "Bad term") }
    }

    token mul-op {
        | < * / >
        #| { self.panic($/, "Bad multiplication/division operator") }
    }

    rule factor {
        | <atom> + % '^'
            {
                make [**] map { $_.made }, @<atom>;
            }
        | { self.panic($/, "Bad factor") }
    }

    rule atom {
        | <number> { make +$<number> }
        | '(' ~ ')' <expr> { make $<expr>.made }
        | { self.panic($/, "Bad atom") }
    }

    rule number {
        <.sign> ? <.pos-num>
        | { self.panic($/, "Bad number") }
    }

    token sign { < + - > }
    token pos-num {
        | <.digit>+ [ \. <digit>+ ]?
        | \. <.digit>+
        | { self.panic($/, "Bad number") }
    }

    method do_calc($/, $operands, $operators) {
        my $res = $operands[0].made;
        my $n = $operands.elems;
        loop (my $i = 1; $i < $n; $i++) {
            my $op = $operators[$i - 1];
            my $num = $operands[$i].made;

            given $op {
                when '+' { $res += $num; }
                when '-' { $res -= $num; }
                when '*' { $res *= $num; }
                default {  # when '/'
                    $res /= $num;
                }
            }
        }
        make $res;
    }

    method panic($/, $msg) {
        my $c = $/.CURSOR;
        my $pos := $c.pos;
        die "$msg found at pos $pos";
    }
}

my $input = (@*ARGS[0] // slurp);

try Arith.parse($input);
if $! {
    say "Parse failed: ", $!.message;

} elsif $/ {
    say "Result: ", $();

} else {
    say "Parse failed.";
}

Benchmark Results for perl 5.16

This is perl 5, version 16, subversion 3 (v5.16.3) built for darwin-2level

This is perl6 version 2015.02-44-g546000b built on MoarVM version 2015.02-6-gb1640b8

=== Perl 5 eval
Result: -1.37457373040596e+25

real	0m0.013s
user	0m0.006s
sys	0m0.002s

=== Perl 5 Regexp::Grammars
Result: -1.37457373040596e+25

real	0m1.635s
user	0m1.377s
sys	0m0.245s

=== Perl 5 Parse::RecDescent
precompiling parser...
Result: -1.37457373040596e+25

real	0m2.446s
user	0m2.436s
sys	0m0.007s

=== Perl 6 Rakudo
Result: -1.37457373040596e+25

real	0m6.497s
user	0m6.290s
sys	0m0.198s

Benchmark Results for perl 5.18

This is perl 5, version 18, subversion 4 (v5.18.4) built for darwin-2level

This is perl6 version 2015.02-44-g546000b built on MoarVM version 2015.02-6-gb1640b8

=== Perl 5 eval
Result: -1.37457373040596e+25

real	0m0.012s
user	0m0.004s
sys	0m0.002s

=== Perl 5 Regexp::Grammars
Result: -1.37457373040596e+25

real	0m1.759s
user	0m1.475s
sys	0m0.265s

=== Perl 5 Parse::RecDescent
precompiling parser...
Result: -1.37457373040596e+25

real	0m2.451s
user	0m2.442s
sys	0m0.008s

=== Perl 6 Rakudo
Result: -1.37457373040596e+25

real	0m6.408s
user	0m6.192s
sys	0m0.209s

Benchmark Results for perl 5.20

This is perl 5, version 20, subversion 2 (v5.20.2) built for darwin-2level

This is perl6 version 2015.02-44-g546000b built on MoarVM version 2015.02-6-gb1640b8

=== Perl 5 eval
Result: -1.37457373040596e+25

real	0m0.008s
user	0m0.004s
sys	0m0.002s

=== Perl 5 Regexp::Grammars
Result: -1.37457373040596e+25

real	0m1.517s
user	0m1.267s
sys	0m0.241s

=== Perl 5 Parse::RecDescent
precompiling parser...
Result: -1.37457373040596e+25

real	0m1.459s
user	0m1.448s
sys	0m0.009s

=== Perl 6 Rakudo
Result: -1.37457373040596e+25

real	0m6.600s
user	0m6.382s
sys	0m0.207s

gen-input-data.pl

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;

my $count = shift // 1024 * 5;
my $maxnum = 10000;
my @operators = qw( + - * / );

sub gen_num () {
    my $n = rand($maxnum * 2) - $maxnum;
    my $res = rand 2 > 0 ? $n : int $n;
    if ($res < 0) {
        print "($res)";
    } else {
        print $res;
    }
}

sub gen_space () {
    print " " x (int rand 3 == 0);
}

sub gen_op () {
    print $operators[int rand scalar @operators];
}

gen_space();
gen_num();
gen_space();

for (my $i = 0; $i < $count; $i++) {
    gen_space();
    gen_op();
    gen_space();
    gen_num();
}

PRD.pl

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;

use List::Util ();
use Parse::RecDescent;

# time: 3.8s
# mem: 18MB

my $grammar = <<'_EOC_';
    expr: <leftop: term add_op term>
        {
            my $list = $item[1];
            my $i = 0;
            my $n = @$list;
            my $sum = $list->[$i++];
            while ($i < $n) {
                my $op = $list->[$i++];
                my $term = $list->[$i++];
                if ($op eq '+') {
                    $sum += $term;
                } else {
                    $sum -= $term;
                }
            }
            $return = $sum;
        }

    add_op: /[+-]/

    term: <leftop: factor mul_op factor>
        {
            my $list = $item[1];
            my $i = 0;
            my $n = @$list;
            my $sum = $list->[$i++];
            while ($i < $n) {
                my $op = $list->[$i++];
                my $atom = $list->[$i++];
                if ($op eq '*') {
                    $sum *= $atom;
                } else {
                    $sum /= $atom;
                }
            }
            $return = $sum;
        }

    mul_op: /[*\/]/

    factor: <rightop: atom '^' atom>
        {
            $return = List::Util::reduce { $b ** $a } reverse @{ $item[1] }
        }

    atom: number
        | '(' <commit> expr ')'  { $return = $item{expr}; }
        | <error?> <reject>

    number: /[-+]?\d+(?:\.\d+)?/
_EOC_

#$::RD_HINT = 1;

eval {
    require PRD_Calc;
};
if ($@) {
    warn "precompiling parser...\n";
    Parse::RecDescent->Precompile($grammar, "PRD_Calc");  # alas.
    require PRD_Calc;
}

my $parser = PRD_Calc->new or die "failed to instantiate PRD_Calc!\n";

my $text = shift // <>;
my $res = $parser->expr($text);
if ($res) {
    say "Result: $res";

} else {
    die "Failed to parse text.";
}

RG.pl

#!/usr/bin/env perl

use 5.010;
use strict;
use warnings;

use List::Util ();
#use Data::Dumper;

my $parser = do {
    use Regexp::Grammars;

    qr{
        <nocontext:>
        <expr>

        <rule: expr>
            <[term]>+ % <[add_op]>
            #<minimize:>
            <MATCH= (?{
                my $operands = $MATCH{term};
                my $operators = $MATCH{add_op};
                my $n = @$operands;
                my $sum = $operands->[0];
                for (my $i = 1; $i < $n; $i++) {
                    my $op = $operators->[$i - 1];
                    my $term = $operands->[$i];
                    if ($op eq '+') {
                        $sum += $term;
                    } else {
                        $sum -= $term;
                    }
                }
                $sum;
            })>

        <token: add_op>
            [-+]

        <rule: term>
            <[factor]>+ % <[mul_op]>
            #<minimize:>
            <MATCH= (?{
                my $operands = $MATCH{factor};
                my $operators = $MATCH{mul_op};
                my $n = @$operands;
                my $sum = $operands->[0];
                for (my $i = 1; $i < $n; $i++) {
                    my $op = $operators->[$i - 1];
                    my $factor = $operands->[$i];
                    if ($op eq '*') {
                        $sum *= $factor;
                    } else {
                        $sum /= $factor;
                    }
                }
                $sum;
            })>

        <token: mul_op>
            [*/]

        <rule: factor>
            <[atom]>+ % \^
            #<minimize:>
            <MATCH= (?{
                my $list = $MATCH{atom};
                #warn Dumper($list);
                List::Util::reduce { $b ** $a } reverse @{ $MATCH{atom} }
            })>

        <rule: atom>
              <MATCH=number>
            | \( <MATCH=expr> \)

        <token: number>
            [-+]? \d+ (?:\.\d+)?
    }
};

my $text = shift // <>;

if ($text =~ $parser) {
    say "Result: $/{expr}";

} else {
    say {*STDERR} $_ for @!;
}