File Coverage

blib/lib/Logic/Expr/Parser.pm

Criterion	Covered	Total	%
statement	29	29	100.0
branch	6	6	100.0
condition	3	3	100.0
subroutine	10	10	100.0
pod	4	4	100.0
total	52	52	100.0

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

package Logic::Expr::Parser;
our $VERSION = '0.01';
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_start
{
    my ($self) = @_;
    # hopefully these never conflict with Parser::MGC internals
    @$self{qw(_atoms _bools)} = ( {}, [] );
}

sub on_parse_end
{
    my ( $self, $tree ) = @_;
    Logic::Expr->new(
        atoms => $self->{_atoms},
        bools => $self->{_bools},
        expr  => $tree
    );
}

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 $self->{_atoms}->{$atom} ) {
                push @{ $self->{_bools} }, TRUE;
                $self->{_atoms}->{$atom} = \$self->{_bools}->[-1];
            }
            $self->{_atoms}->{$atom};
        },
    );
    # simplify !!!X to !X and !!X to X
    ( defined $neg and length($neg) & 1 ) ? [ LE_NOT, $term ] : $term;
}

1;
__END__