[Perl-flat-cvs-notify] SF.net SVN: perl-flat: [66] trunk/perl-flat/lib/FLAT

[<per...@li...>]

Revision: 66
Author:   estrabd
Date:     2006-05-05 11:55:09 -0700 (Fri, 05 May 2006)
ViewCVS:  http://svn.sourceforge.net/perl-flat/?rev=66&view=rev

Log Message:
-----------
PRE->to_pfa is now at a state ready for testing!  Once I have verified that it is working correctly, I will move on to PFA->NFA

Modified Paths:
--------------
    trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
    trunk/perl-flat/lib/FLAT/PFA.pm
    trunk/perl-flat/lib/FLAT/Regex/WithExtraOps.pm
Modified: trunk/perl-flat/dev-scripts/pregex-to-pfa.pl
===================================================================
--- trunk/perl-flat/dev-scripts/pregex-to-pfa.pl	2006-04-26 16:32:41 UTC (rev 65)
+++ trunk/perl-flat/dev-scripts/pregex-to-pfa.pl	2006-05-05 18:55:09 UTC (rev 66)
@@ -4,11 +4,12 @@
 use lib qw(../lib);
 use FLAT::Regex::WithExtraOps;
 use Data::Dumper;
+use FLAT::PFA;
 
 # This is mainly my test script for FLAT::FA::PFA.pm
 
-my $PRE = FLAT::Regex::WithExtraOps->new('(ab+c*)&(a+b)*');
+my $PRE = FLAT::Regex::WithExtraOps->new('(a&b&c)*([cat]&[dog])');
 
 my $PFA = $PRE->as_pfa();
 
-print $PRE->as_string;
+print Dumper($PFA);

Modified: trunk/perl-flat/lib/FLAT/PFA.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/PFA.pm	2006-04-26 16:32:41 UTC (rev 65)
+++ trunk/perl-flat/lib/FLAT/PFA.pm	2006-05-05 18:55:09 UTC (rev 66)
@@ -20,8 +20,6 @@
 sub new {
     my $pkg = shift;
     my $self = $pkg->SUPER::new(@_); # <-- SUPER is FLAT::NFA
-    $self->{TIED} = [];              # tracks tied nodes
-    $self->{ACTIVE_NODES} = [];      # tracks active nodes - could be label like start and final
     $self->{LAMBDA} = '#lambda';     # special lambda symbol - used internally
     return $self;
 }
@@ -30,7 +28,6 @@
 sub singleton {
     my ($class, $char) = @_;
     my $pfa = $class->new;
-    
     if (not defined $char) {
         $pfa->add_states(1);
         $pfa->set_starting(0);
@@ -66,13 +63,26 @@
 
 # will implement the joining of two PFAs with lambda transitions
 sub shuffle {
-  croak "PFA::shuffle is not yet supported";
-  # can't use _swallow, but might be able to use a modifed version of it...
-  # look at FLAT::Legacy
+    my @pfas = map { $_->as_pfa } @_;
+    my $result = $pfas[0]->clone;
+    $result->_swallow($_) for @pfas[1 .. $#pfas];
+    my ($newstart, $newfinal) = $result->add_states(2);
+    my @starting = $result->get_starting;
+    my @accepting = $result->get_accepting;
+    $result->unset_starting(@starting);
+    $result->unset_accepting(@accepting);  
+    $result->set_starting($newstart);
+    $result->set_accepting($newfinal);
+    foreach (@starting) {
+      $result->set_transition($newstart,$_,$result->get_lambda());
+    }
+    foreach (@accepting) {
+      $result->set_transition($_,$newfinal,$result->get_lambda());    
+    }
+    return $result;
 }
 
-<<<<<<< PFA.pm
-# joins two PFAs in a union (or)
+# joins two PFAs in a union (or) - no change from NFA
 sub union {
     my @pfas = map { $_->as_pfa } @_;
     my $result = $pfas[0]->clone;
@@ -80,7 +90,7 @@
     $result;
 }
 
-# joins two PFAs via concatenation
+# joins two PFAs via concatenation  - no change from NFA
 sub concat {
     my @pfas = map { $_->as_pfa } @_;
     
@@ -111,7 +121,7 @@
     $result;
 }
 
-# forms closure around a the given PFA
+# forms closure around a the given PFA  - no change from NFA
 sub kleene {
     my $result = $_[0]->clone;
     
@@ -133,10 +143,22 @@
     $result;
 }
 
-# reversal should be like the transpose of the nodal transitoin
-# matrix, but I still have to make sure 
+
+# reverse  - no change from NFA
 sub reverse {
-   croak "PFA::reverse is not yet supported";
+    my $self = $_[0]->clone;
+    $self->_transpose;
+    
+    my @start = $self->get_starting;
+    my @final = $self->get_accepting;
+    
+    $self->unset_accepting( $self->get_states );
+    $self->unset_starting( $self->get_states );
+    
+    $self->set_accepting( @start );
+    $self->set_starting( @final );
+    
+    $self;
 }
 
 1;

Modified: trunk/perl-flat/lib/FLAT/Regex/WithExtraOps.pm
===================================================================
--- trunk/perl-flat/lib/FLAT/Regex/WithExtraOps.pm	2006-04-26 16:32:41 UTC (rev 65)
+++ trunk/perl-flat/lib/FLAT/Regex/WithExtraOps.pm	2006-05-05 18:55:09 UTC (rev 66)
@@ -79,14 +79,16 @@
     $pkg->new( @{ $item[1] } );
 }
 
-# Implement
 sub as_pfa {
     my $self = shift;
+    my @parts = map { $_->as_pfa } $self->members;
+    $parts[0]->shuffle( @parts[1..$#parts] );
 }
 
 # Implement?
 sub reverse {
     my $self = shift;
+    croak "Not implemented for shuffled regexes";
 }
 
 sub is_empty {


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.