From: <per...@li...> - 2006-04-18 21:50:20
|
Update of /cvsroot/perl-flat/perl-flat/lib/FLAT In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv4239/lib/FLAT Modified Files: NFA.pm PFA.pm Added Files: Symbol.pm Log Message: more working on PFA and figuring things out...added Symbol class, but nothing is implemented or in use - really just a concept right now Index: NFA.pm =================================================================== RCS file: /cvsroot/perl-flat/perl-flat/lib/FLAT/NFA.pm,v retrieving revision 1.10 retrieving revision 1.11 diff -C2 -d -r1.10 -r1.11 *** NFA.pm 1 Mar 2006 18:29:22 -0000 1.10 --- NFA.pm 18 Apr 2006 21:50:17 -0000 1.11 *************** *** 41,58 **** $result->_swallow($_) for @nfas[1 .. $#nfas]; - # my @newstate = ([ $result->get_states ]); - # for (1 .. $#nfas) { - # push @newstate, [ $result->_swallow( $nfas[$_] ) ]; - # } - - # my $newstart = $result->add_states(1); - # $result->unset_starting($result->get_states); - # $result->set_starting($newstart); - - # for my $nfa_id (0 .. $#nfas) { - # $result->set_transition( $newstart, $newstate[$nfa_id][$_], "" ) - # for $nfas[$nfa_id]->get_starting; - # } - $result; } --- 41,44 ---- Index: PFA.pm =================================================================== RCS file: /cvsroot/perl-flat/perl-flat/lib/FLAT/PFA.pm,v retrieving revision 1.8 retrieving revision 1.9 diff -C2 -d -r1.8 -r1.9 *** PFA.pm 12 Apr 2006 04:28:28 -0000 1.8 --- PFA.pm 18 Apr 2006 21:50:17 -0000 1.9 *************** *** 1,16 **** package FLAT::PFA; use strict; ! use base 'FLAT::FA'; use Carp; use FLAT::Transition; ! ! # The new way of doing things eliminated from PFA.pm of FLAT::Legacy is the ! # need to explicitly track: ! # start nodes, final nodes, symbols, and lambda & epsilon symbols, sub new { my $pkg = shift; ! my $self = $pkg->SUPER::new(@_); ! $self->{TRANS_CLASS} = "FLAT::Transition"; $self->{TIED} = []; # tracks tied nodes $self->{ACTIVE_NODES} = []; # tracks active nodes - could be label like start and final --- 1,12 ---- package FLAT::PFA; use strict; ! use base 'FLAT::NFA'; use Carp; use FLAT::Transition; ! 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 *************** *** 18,106 **** } - sub singleton { - my ($class, $char) = @_; - my $pfa = $class->new; - - if (not defined $char) { - $pfa->add_states(1); - $pfa->set_starting(0); - } elsif ($char eq "") { - $pfa->add_states(1); - $pfa->set_starting(0); - $pfa->set_accepting(0); - } else { - $pfa->add_states(2); - $pfa->set_starting(0); - $pfa->set_accepting(1); - $pfa->set_transition(0, 1, $char); - } - return $pfa; - } - - # attack of the clones - sub as_pfa { $_[0]->clone() } - sub shuffle { croak "PFA::shuffle is not yet supported"; } - sub union { - my @pfas = map { $_->as_pfa } @_; - my $result = $pfas[0]->clone; - $result->_swallow($_) for @pfas[1 .. $#pfas]; - $result; - } - - sub concat { - my @pfas = map { $_->as_pfa } @_; - - my $result = $pfas[0]->clone; - my @newstate = ([ $result->get_states ]); - my @start = $result->get_starting; - - for (1 .. $#pfas) { - push @newstate, [ $result->_swallow( $pfas[$_] ) ]; - } - - $result->unset_accepting($result->get_states); - $result->unset_starting($result->get_states); - $result->set_starting(@start); - - for my $pfa_id (1 .. $#pfas) { - for my $s1 ($pfas[$pfa_id-1]->get_accepting) { - for my $s2 ($pfas[$pfa_id]->get_starting) { - $result->set_transition( - $newstate[$pfa_id-1][$s1], - $newstate[$pfa_id][$s2], "" ); - }} - } - - $result->set_accepting( - @{$newstate[-1]}[ $pfas[-1]->get_accepting ] ); - - $result; - } - - sub kleene { - my $result = $_[0]->clone; - - my ($newstart, $newfinal) = $result->add_states(2); - - $result->set_transition($newstart, $_, "") - for $result->get_starting; - $result->unset_starting( $result->get_starting ); - $result->set_starting($newstart); - - $result->set_transition($_, $newfinal, "") - for $result->get_accepting; - $result->unset_accepting( $result->get_accepting ); - $result->set_accepting($newfinal); - - $result->set_transition($newstart, $newfinal, ""); - $result->set_transition($newfinal, $newstart, ""); - - $result; - } - sub reverse { croak "PFA::reverse is not yet supported"; --- 14,21 ---- --- NEW FILE: Symbol.pm --- # # Conceptual Experiment - not currently implemented anywhere... # package FLAT::Symbol use strict; use Carp; sub new { my ($pkg, $string, $type) = @_; bless { STRING => $string, TYPE => $type, }, $pkg; } sub as_string { return $_[0]->{STRING}; } sub get_type } return $_[0]->{TYPE}; } sub set_type { $_[0]->{TYPE} = $_[1]; } 1; ################## package FLAT::Symbol::Regular; use base 'FLAT::Symbol'; sub new { my $pkg = shift; my $self = $pkg->SUPER::new($_[0],'Regular'); return $self; } sub get_type { return 'Regular'; } sub set_type { croak("Sorry, can't change type for this symbol"); } 1; ################## package FLAT::Symbol::Special; use base 'FLAT::Symbol'; sub new { my $pkg = shift; my $self = $pkg->SUPER::new($_[0],'Special'); return $self; } sub get_type { return 'Special'; } sub set_type { croak("Sorry, can't change type for this symbol");} 1; __END__ =head1 NAME FLAT::Symbol - Base class for transition symbol =head1 SYNOPSIS A super class that is intended to provide a simple mechanism for storing a symbol that might be in conflict with another symbol in string form. TYPE is used to distinguish. Currenly this neither this, nor its current sub classes, Regular and Special, are used. =back |