initial commit

1 files changed, 282 insertions, 0 deletions

diff --git a/lib/FLAT/Regex/Op.pm b/lib/FLAT/Regex/Op.pm
new file mode 100644
index 0000000..76e796c
--- /dev/null
+++ b/lib/FLAT/Regex/Op.pm
@@ -0,0 +1,282 @@
+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 base '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 base '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 base '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 base '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;