File Coverage

blib/lib/Logic/Expr/Parser.pm

Criterion	Covered	Total	%
statement	25	25	100.0
branch	6	6	100.0
condition	3	3	100.0
subroutine	9	9	100.0
pod	2	2	100.0
total	45	45	100.0

# -*- Perl -*-
#
# a parser for logic expressions

package Logic::Expr::Parser;
our $VERSION = '0.02';
use Logic::Expr ':all';
use base 'Parser::MGC';    # 0.21 or higher required

# LE_NOT is handled outside the scope of this pair of variables
our %le_map = (
    '&'  => LE_AND,
    '|'  => LE_OR,
    'v'  => LE_OR,
    '->' => LE_COND,
    '==' => LE_BICOND,
);
our $le_regex = qr/->|==|[&|v]/;

sub on_parse_end { Logic::Expr->new( expr => $_[1] ) }

sub parse
{
    my ($self) = @_;
    my $first = $self->_parse_term;
    my ( $operator, $second );
    $self->maybe(
        sub {
            $operator = $le_map{ $self->expect($le_regex) };
            $second   = $self->_parse_term;
        }
    );
    defined $operator ? [ $operator, $first, $second ] : $first;
}

sub _parse_term
{
    my ($self) = @_;
    my $neg    = $self->maybe( sub { $self->expect(qr/!+|~+/) } );
    my $term   = $self->any_of(
        sub { $self->scope_of( "(", \&parse, ")" ) },
        sub {
            my $atom = $self->expect(qr/[A-Z]+/);
            unless ( exists $Logic::Expr::atoms{$atom} ) {
                push @Logic::Expr::bools, TRUE;
                $Logic::Expr::atoms{$atom} = \$Logic::Expr::bools[-1];
            }
            $Logic::Expr::atoms{$atom};
        },
    );
    # simplify !!!X to !X and !!X to X
    ( defined $neg and length($neg) & 1 ) ? [ LE_NOT, $term ] : $term;
}

1;
__END__