File Coverage

blib/lib/FLAT/Regex/Op.pm

Criterion	Covered	Total	%
statement	131	143	91.6
branch	36	46	78.2
condition			n/a
subroutine	44	49	89.8
pod	0	2	0.0
total	211	240	87.9

package FLAT::Regex::Op;
use strict;

sub new {
    my $pkg = shift;
    ## flatten alike operations, i.e, "a+(b+c)" into "a+b+c"
    my @flat = map {UNIVERSAL::isa($_, $pkg) ? $_->members : $_} @_;

    bless \@flat, $pkg;
}

sub members {
    my $self = shift;
    wantarray ? @$self[0 .. $#$self] : $self->[0];
}

#################################
#### regex operators / components

package FLAT::Regex::Op::atomic;
use parent 'FLAT::Regex::Op';

sub as_string {
    my $t = $_[0]->members;

    return "#" if not defined $t;
    return $t =~ /^\w$/
        ? $t
        : "[$t]";
}

sub as_perl_regex {
    my $r = $_[0]->members;

    return "(?!)" if not defined $r;

    $r = quotemeta $r;
    return $r =~ /^\w$/ ? $r : "(?:$r)";
}

sub as_nfa {
    FLAT::NFA->singleton($_[0]->members);
}

sub as_pfa {
    FLAT::PFA->singleton($_[0]->members);
}

sub from_parse {
    my ($pkg, @item) = @_;
    my $i = $item[1];

    return $pkg->new("")    if $i eq "[]";
    return $pkg->new(undef) if $i eq "#";

    $i =~ s/^\[|\]$//g;

    return $pkg->new($i);
}

sub reverse {
    $_[0];
}

sub is_empty {
    not defined $_[0]->members;
}

sub has_nonempty_string {
    my $self = shift;
    defined $self->members and length $self->members;
}

sub is_finite {
    1
}

##############################
package FLAT::Regex::Op::star;
use parent 'FLAT::Regex::Op';

sub parse_spec {"%s '*'"}
sub precedence {30}

sub as_string {
    my ($self, $prec) = @_;
    my $result = $self->members->as_string($self->precedence) . "*";
    return $prec > $self->precedence ? "($result)" : $result;
}

sub as_perl_regex {
    my ($self, $prec) = @_;
    my $result = $self->members->as_perl_regex($self->precedence) . "*";
    return $prec > $self->precedence ? "(?:$result)" : $result;
}

sub as_nfa {
    my $self = shift;
    $self->members->as_nfa->kleene;
}

sub as_pfa {
    my $self = shift;
    $self->members->as_pfa->kleene;
}

sub from_parse {
    my ($pkg, @item) = @_;
    $pkg->new($item[1]);
}

sub reverse {
    my $self = shift;
    my $op   = $self->members->reverse;
    __PACKAGE__->new($op);
}

sub is_empty {
    0
}

sub has_nonempty_string {
    $_[0]->members->has_nonempty_string;
}

sub is_finite {
    !$_[0]->members->has_nonempty_string;
}

################################
package FLAT::Regex::Op::concat;
use parent 'FLAT::Regex::Op';

sub parse_spec {"%s(2..)";}
sub precedence {20}

sub as_string {
    my ($self, $prec) = @_;
    my $result = join "", map {$_->as_string($self->precedence)} $self->members;
    return $prec > $self->precedence ? "($result)" : $result;
}

sub as_perl_regex {
    my ($self, $prec) = @_;
    my $result = join "", map {$_->as_perl_regex($self->precedence)} $self->members;
    return $prec > $self->precedence ? "(?:$result)" : $result;
}

sub as_nfa {
    my $self = shift;
    my @parts = map {$_->as_nfa} $self->members;
    $parts[0]->concat(@parts[1 .. $#parts]);
}

sub as_pfa {
    my $self = shift;
    my @parts = map {$_->as_pfa} $self->members;
    $parts[0]->concat(@parts[1 .. $#parts]);
}

sub from_parse {
    my ($pkg, @item) = @_;
    $pkg->new(@{$item[1]});
}

## note: "reverse" conflicts with perl builtin
sub reverse {
    my $self = shift;
    my @ops = CORE::reverse map {$_->reverse} $self->members;
    __PACKAGE__->new(@ops);
}

sub is_empty {
    my $self    = shift;
    my @members = $self->members;
    for (@members) {
        return 1 if $_->is_empty;
    }
    return 0;
}

sub has_nonempty_string {
    my $self = shift;
    return 0 if $self->is_empty;

    my @members = $self->members;
    for (@members) {
        return 1 if $_->has_nonempty_string;
    }
    return 0;
}

sub is_finite {
    my $self = shift;
    return 1 if $self->is_empty;

    my @members = $self->members;
    for (@members) {
        return 0 if not $_->is_finite;
    }
    return 1;
}

#############################
package FLAT::Regex::Op::alt;
use parent 'FLAT::Regex::Op';

sub parse_spec {"%s(2.. /[+|]/)"}
sub precedence {10}

sub as_string {
    my ($self, $prec) = @_;
    my $result = join "+", map {$_->as_string($self->precedence)} $self->members;
    return $prec > $self->precedence ? "($result)" : $result;
}

sub as_perl_regex {
    my ($self, $prec) = @_;
    my $result = join "|", map {$_->as_perl_regex($self->precedence)} $self->members;
    return $prec > $self->precedence ? "(?:$result)" : $result;
}

sub as_nfa {
    my $self = shift;
    my @parts = map {$_->as_nfa} $self->members;
    $parts[0]->union(@parts[1 .. $#parts]);
}

sub as_pfa {
    my $self = shift;
    my @parts = map {$_->as_pfa} $self->members;
    $parts[0]->union(@parts[1 .. $#parts]);
}

sub from_parse {
    my ($pkg, @item) = @_;
    $pkg->new(@{$item[1]});
}

sub reverse {
    my $self = shift;
    my @ops = map {$_->reverse} $self->members;
    __PACKAGE__->new(@ops);
}

sub is_empty {
    my $self    = shift;
    my @members = $self->members;
    for (@members) {
        return 0 if not $_->is_empty;
    }
    return 1;
}

sub has_nonempty_string {
    my $self    = shift;
    my @members = $self->members;
    for (@members) {
        return 1 if $_->has_nonempty_string;
    }
    return 0;
}

sub is_finite {
    my $self    = shift;
    my @members = $self->members;
    for (@members) {
        return 0 if not $_->is_finite;
    }
    return 1;
}
1;