Perl 6 实现的表达式优先级和结合性解析

沙枣 发布于 2015/06/18 15:07
阅读 167
收藏 0
#!perl6

# parse expression with precedence
use v6;
use YAML;
use Use::Ast::Filter;

grammar Infix-exprs {
    rule expr { ^ <atom> [ <op> <atom> ]+? $ }
    token atom { \d+ }
    token op { < + - * / % ^ > }
}

my $table = {
    '+' => 1,
    '-' => 1,
    '*' => 2,
    '/' => 2,
    '%' => 3,
    '^' => 4,
};

my $asso = {
    '+' => 'left',
    '-' => 'left',
    '*' => 'left',
    '/' => 'left',
    '%' => 'left',
    '^' => 'right',
};

my $str-list = [
    '1 + 2 - 3',
    '1 - 2 + 3',
    '1 - 2 - 3',
    '1 + 2 * 3',
    '1 + 2 * 3 / 4',
    '1 + 2 * 3 / 4 % 5 / 6 * 7 + 8',
    '1 - 2 / 3 + 4 + 5 - 6 + 7',
    '1 ^ 2 ^ 3 ^ 4',
];

for $str-list.values -> $str {
    say '=================';
    say $str;
    my $match = Infix-exprs.subparse($str, :rule<expr>);
    my $ast = filter-ast($match);
    my $parse-ast = parse($ast, $table, $asso);
    say ast-expr($parse-ast);
}

sub parse($ast, $table, $asso) {
    if $ast.elems < 3 {
        say 'exprssion length less 3';
        exit;
    }
    if ($ast.elems % 2) == 0 {
        say 'exprssion length is odd';
        exit;
    }
    return group-ast($ast, $table, $asso);
}

sub group-ast($ast, $table, $asso) {
    return [ 'expr', $ast ] if $ast.elems == 3;
    my $index = get-max-op-index($ast, $table, $asso);
    my $ast-end = $ast.end;
    given $index {
        when 1 { 
            return group-ast(group-start($ast), $table, $asso);
        }
        when $ast-end {
            return group-ast(group-end($ast), $table, $asso);
        }
        default {
            my $group-ast = group-middle($ast, $index);
            return group-ast($group-ast, $table, $asso);
        }
    }
}

sub group-start($ast) {
    [ [ 'expr', [ $ast[0..2] ] ], $ast[3..*] ]; 
}

sub group-end($ast) {
    [ $ast[0..*-4], [ 'expr', [ $ast[*-3..*-1] ] ] ];
}

sub group-middle($ast, $index) {
    [ 
        $ast[0 .. $index-2],
        [ 'expr', [ $ast[$index-1 .. $index+1] ] ],
        $ast[$index+2 .. *-1],
    ];
}

sub get-max-op-index($ast, $table, $asso) {
    my @op-stack = $ast.grep: { $_[0] eq 'op' };
    my @op-grade = map { $table{$_[1]} }, @op-stack;
    my $max-grade = max(|@op-grade);

    my $max-op-index = @op-grade.first-index: { $_ == $max-grade };
    my $max-op = @op-stack[$max-op-index][1];
    my $op-asso = $asso{$max-op};
    if $op-asso eq 'right' {
        return $ast.last-index: {
            $_[0] eq 'op' and $_[1] eq $max-op
        }
    }
    return $ast.first-index: { 
        $_[0] eq 'op' and $_[1] eq $max-op
    };   
}

sub ast-expr($ast) {
    # if it is atom, return value
    if $ast[0] ~~ Str and $ast[0] eq 'atom' {
        return $ast[1];
    }
    if $ast.elems == 3 {
        my $op = $ast[1][1];
        my $atom-first = ast-expr($ast[0]);
        my $atom-last = ast-expr($ast[2]);
        return "($atom-first $op $atom-last)";
    } 
    if $ast.elems == 2 {
        return ast-expr($ast[1]);
    }
}



加载中
返回顶部
顶部