Array based replacement for PloverHash.pl

PloverArray.pl

use strict;
use warnings;


do 'PloverOO.pl';

package NFA;

# The NFA object is simply an arrayref.
# The starting state is index 0, the final state
# is one past the end.

# Whenever we push a new element onto the end,
# we can assume that whenever the previous part of the NFA
# succeeds, it will transition to our new element.

# Elements of the arrayref are hashrefs; each hashref
# has keys which are length-one strings, or '', which
# represents the lambda transitions.  Values are always
# arrayrefs of states, which are integers.

sub CONCAT::push_NFA {
	my ($self, $so_far) = @_;
	$_->push_NFA($so_far) for @{$self}[ 0 .. $#$self-1 ];
	return $self->[-1]->push_NFA($so_far);
}

sub PLUS::push_NFA {
	my ($self, $so_far) = @_;
	my $start = @$so_far;
	my @e = $self->[0]->push_NFA( $so_far );
	for my $e ( @e ) {
		next if grep $_ == $start, @$e;
		push @$e, $start;
	}
	@e;
}

sub STAR::push_NFA {
	my ($self, $so_far) = @_;
	my $start = @$so_far;
	my @e = PLUS::push_NFA( $self, $so_far );
	my $first = ($so_far->[$start]{''} ||= []);
	unless( grep $_ == $first, @e ) {
		push @$first, scalar @$so_far;
		unshift @e, $first;
	}
	@e;
}

sub LITERAL::push_NFA {
	my ($self, $so_far) = @_;
	my %t;
	push @$so_far, \%t;
	$t{$self->[0]} = [ scalar @$so_far ];
	values %t;
}

sub CLASS::d::push_NFA {
	my ($self, $so_far) = @_;
	my %t;
	push @$so_far, \%t;
	$t{$_} = [ scalar @$so_far ] for 0 .. 9;
	values %t;
}

# If our regex is a|b|c, then the parse tree will be:
# bless [bless ['a'], LITERAL, bless ['b'], LITERAL, bless ['c'], LITERAL], ALTERN.
# The transition tables produced should be:
# { 'a' => [3], '' => [1, 2] }, { 'b' => [3] }, { 'c' => [3] }.
# If the regex is a|bc|d, the tables should be:
# { 'a' => [4], '' => [1, 3] }, { 'b' => [2] }, { 'c' => [4] }, { 'd' => [4] }.

sub ALTERN::push_NFA {
	my ($self, $so_far) = @_;
	my (@s, @e0, @end_groups, $end);
	for my $altern ( @$self ) {
		push @s, scalar @$so_far;
		@end_groups = $altern->push_NFA( $so_far );
		$end = @$so_far;
		last if @s == @$self;
		for my $table ( @end_groups ) {
			@$table = grep $end != $_, @$table;
		}
		push @e0, @end_groups;
	}
	my $start = shift @s;
	if( $so_far->[$start]{''} ) {
		my %seen;
		@seen{ @{$so_far->[$start]{''}} } = ();
		@s = grep !exists $seen{$_}, @s;
	}
	push @{$so_far->[$start]{''}}, @s;
	for my $table ( @e0 ) {
		next if grep $end == $_, @$table;
		push @$table, $end;
	}
	return @e0, @end_groups;
}

sub new {
	my ($class, $tree) = @_;
	my @self;
	$tree->push_NFA(\@self);
	bless \@self, $class;
}

sub start_state {
	return 0;
}

sub is_end_state {
	my ($self, $state) = @_;
	return $state == @$self;
}

sub transitions_for_symbol {
	my ($self, $state, $symbol) = @_;
	my $s = $self->[$state] or return;
	my $n = $s->{$symbol} or return;
	@$n;
}

if( !caller ) {
	NFA->self_test;
	#NFA->self_test_two;
	exit 0;
}

1;

__END__