Parserについて勉強したい

Parserについて

Perl で簡単にパーザを書く - tokuhirom's blog
パーサー
再帰下降構文解析で電卓プログラムを実装する - embryo

式(expression)、項(term)、因子(factor)と呼ぶのかぁ。

BNF

http://www.klab.is.sci.toho-u.ac.jp/classes/images/6/64/CompProg20140423.pdf

Bool用Parserに変えて見る

下記のような真偽値をパースするパーサを作って見る。

1 | 1 & 0

ほぼ、元の四則演算そのものなんですが・・
＆の優先順位が｜よりも高いので、除算のところを＆にして、加算のところを|にして見ました。
あとは0の扱いに注意が必要でundefだとエラーにしました。
計算する部分も実装して見ました。

use 5.018000;

package Calc {
    use Carp ();

    sub parse {
        local $_ = $_[1];

        _parse_expr();
    }

    sub err {
        my ($msg) = @_;
        my $ret = join('',
            $_, "\n",
            (" " x pos()) . "^\n",
            $msg, "\n",
        );
        Carp::croak $ret;
    }

    sub _parse_expr {
        my @nodes;
        until (/\G\s*\z/gc) {
            my $m = _parse_add()
                or do {
                err "Syntax error";
            };
            push @nodes, $m;
        }
        return ['expr', @nodes];
    }

    sub _parse_add {
        my $mul = _parse_mul()
            or return undef;
        while (m{\G\s*(\|)}gc) {
            my $op = $1;
            my $lhs = _parse_mul()
                // die "Cannot parse mul after '$op' : " . pos();
            $mul = [$op, $mul, $lhs];
        }
        return $mul;
    }

    sub _parse_mul {
        my $node = _parse_term()
            // return undef;
        while (m{\G\s*(\&)}gc) {
            my $op = $1;
            my $lhs = _parse_term() // 
                die "Cannot parse expr after '$op' : " . pos();
            $node = [$op, $node, $lhs];
        }
        return $node;
    }

    sub _parse_term {
        if (/\G\s*([01])/gc) {
            return $1;
        } elsif (/\G\s*\(/gc) {
            my $expr = _parse_add();
            /\G\s*\)/gc
                or err "No closing paren after opening paren.";
            return $expr;
        }
        return undef;
    }

    sub execute {
        $DB::single = 1;
        my $node = $_[1][1];
        if (ref($node)) {
            return _execute($node);
        } else {
            return $node;
        }
    }

    sub _execute {
        my $node = shift;
        my $ope = $node->[0];
        my $left = $node->[1];
        my $right = $node->[2];
        if (ref($right)) {
            my $right = _execute( $right );
        }
        if ( $ope eq "&" ) {
            if ( $left == 1 && $right == 1 ) {
                return 1;
            }
            return 0;
        } else {
            if ( $left == 1 || $right == 1 ) {
                return 1;
            }
            return 0;
        }
    }
}

my $node = Calc->parse('1|1&0');
use Data::Dumper; warn Dumper($node);
warn Calc->execute($node);