Perl6 で計算機

calc.p6

#use Grammar::Debugger;
#use Grammar::Tracer;
use MONKEY-SEE-NO-EVAL;


grammar Calc::Grammar {
    rule TOP { ^ <expr> $ }
    rule expr { [ <term> <op> <expr> | <term> ] }
    rule term  { [ <group> | <number> ] }
    
    rule group { '(' <expr> ')' }

    token op { '+' | '-' | '*' | '/' }
    token number { [ <decimal> | <float> | <octal> | <hex> ] }
    token decimal { '0' | <[1..9]>[<[0..9]>+]? }
    token float { <decimal> '.' <decimal> }
    token octal { '0' [ 'o' | 'O' ] <[0..7]>+ }
    token hex { '0' [ 'x' | 'X' ] <[0..9A..Fa..f]>+ }
};

# https://docs.perl6.org/routine/make
class Calc::Action {
    method TOP($/)   { make $<expr>.made }

    method group($/) { make $<expr>.made }
    method expr($/) {
        given $<op> {
            when '+' { make $<term>.made + $<expr>.made }
            when '-' { make $<term>.made - $<expr>.made }
            when '*' { make $<term>.made * $<expr>.made }
            when '/' { make $<term>.made / $<expr>.made }
            default  { make $<term>.made }
        }
    }

    method term($/)   { make $/.values[0].made }
    method number($/) { make $/.values[0].made }

    method decimal($/) { make $/.Num }
    method float($/)   { make $/.Num }
    method octal($/)   { make $/.Num }
    method hex($/)     { make $/.Num }
}



my @experssions = (
    "0",
    "1",
    "123400",
    "0.11111",
    "1234.1234",
    "0x123",
    "0o123",
    "(0)",
    "( 1 )",
    "( 123400 )",
    "(0.11111)",
    "(1234.1234)",
    "(0x123    )",
    "(     0o123)",
    "3 + 4",
    "3 / 4",
    "0.11111 + 0.11111",
    "1234.1234 / 1234.1234",
    "1 + 2 +3+    4   +5",
    "(2* 3  )",
    "(1234.1234 ) + 1234.9",
    "(1 + 2) * (1 + 3)",
    "(1) + (2) + (3) + (4) * (5)",
    "(2*(3+12))+1",
    "(1-(2+(3+(4+(5)))))",
    "(1+(2+(3+(4+(5+(6+(7+(8+(9+(10))))))))))",
    "0x123 + 0o123 + 1234.1234 * 2 / 1",
    "(0x123 + 0o123 + 1234.1234) * 2 / 1",
);

my $act = Calc::Action.new;
for @experssions -> $exp {
    Calc::Grammar.parse($exp, actions => $act);
    CATCH {
        say "exception received: $!";
    }
    my $expected;
    EVAL "\$expected = $exp;";
    my $result = $/.made.Num;
    if ($result == $expected) {
        say "OK: $exp" ~ " = " ~ $result.Str;
    } else {
        say "Bad: $exp" ~ " = " ~ $result.Str;
    }
}