File Coverage

blib/lib/Parse/FSM/Parser.pm

Criterion	Covered	Total	%
statement	125	142	88.0
branch	22	24	91.6
condition			n/a
subroutine	27	43	62.7
pod	1	19	5.2
total	175	228	76.7

# $Id: FSM.pm,v 1.10 2013/07/27 00:34:39 Paulo Exp $
# Parser generated by Parse::FSM

package # hide from CPAN indexer
  Parse::FSM::Parser;

use strict;
use warnings;

use Parse::FSM::Driver; our @ISA = ('Parse::FSM::Driver');


use Data::Dump 'dump';
use Text::Balanced 'extract_quotelike', 'extract_codeblock';

my $uid = 1;



my $start_state = 2;
my @state_table = (
	# [0]
	{ _lst_code1 => 45, _lst_element1 => 21, _lst_epilog1 => 6,
	  _lst_prolog1 => 1, _lst_quantifier1 => 35, _lst_sentence1 => 17,
	  _lst_sentence2 => 15, _lst_sentence3 => 40, _lst_sentence4 => 38,
	  _lst_statement1 => 3, action => 46, code => 53, code_unbraced => 11,
	  directive => 47, element => 25, epilog => 10, name => 51,
	  program => 2, prolog => 9, quantifier => 44, rule => 13,
	  sentence => 23, statement => 12, subrule => 34, subrule_name => 37,
	  token => 52, },

	# [1] _lst_prolog1 :
	{ CODE => [ 9, \&_act__lst_prolog11 ],
	  __else__ => \&_act__lst_prolog11, },

	# [2] program :
	{ CODE => [ 1, 5 ], __else__ => [ 1, 5 ], },

	# [3] _lst_statement1 :
	{ " [ 12, 4 ], NAME => [ 12, 4 ], },

	# [4] _lst_statement1 : [statement]
	{ " [ 12, 4 ], NAME => [ 12, 4 ],
	  __else__ => \&_act__lst_prolog11, },

	# [5] program : [_lst_prolog1]
	{ " [ 3, 7 ], NAME => [ 3, 7 ], },

	# [6] _lst_epilog1 :
	{ CODE => [ 10, \&_act__lst_prolog11 ],
	  __else__ => \&_act__lst_prolog11, },

	# [7] program : [_lst_prolog1] [_lst_statement1]
	{ CODE => [ 6, 8 ], __else__ => [ 6, 8 ], },

	# [8] program : [_lst_prolog1] [_lst_statement1] [_lst_epilog1]
	{ "" => \&_act_program1, },

	# [9] prolog :
	{ CODE => [ 11, \&_act_prolog1 ], },

	# [10] epilog :
	{ CODE => [ 11, \&_act_epilog1 ], },

	# [11] code_unbraced :
	{ CODE => [ 53, \&_act_code_unbraced1 ], },

	# [12] statement :
	{ " [ 47, \&_act_program1 ], NAME => [ 13, \&_act_program1 ], },

	# [13] rule :
	{ NAME => [ 51, 14 ], },

	# [14] rule : [name]
	{ ":" => 19, },

	# [15] _lst_sentence2 :
	{ "|" => 16, },

	# [16] _lst_sentence2 : "|"
	{ "(" => [ 23, \&_act__lst_sentence21 ],
	  " [ 23, \&_act__lst_sentence21 ],
	  " [ 23, \&_act__lst_sentence21 ],
	  NAME => [ 23, \&_act__lst_sentence21 ],
	  TOKEN => [ 23, \&_act__lst_sentence21 ], },

	# [17] _lst_sentence1 :
	{ "(" => [ 23, 18 ], " [ 23, 18 ], " [ 23, 18 ],
	  NAME => [ 23, 18 ], TOKEN => [ 23, 18 ], },

	# [18] _lst_sentence1 : [sentence]
	{ __else__ => \&_act__lst_prolog11, "|" => [ 15, 18 ], },

	# [19] rule : [name] ":"
	{ "(" => [ 17, 20 ], " [ 17, 20 ], " [ 17, 20 ],
	  NAME => [ 17, 20 ], TOKEN => [ 17, 20 ], },

	# [20] rule : [name] ":" [_lst_sentence1]
	{ ";" => \&_act_rule1, },

	# [21] _lst_element1 :
	{ "(" => [ 25, 22 ], " [ 25, 22 ], " [ 25, 22 ],
	  NAME => [ 25, 22 ], TOKEN => [ 25, 22 ], },

	# [22] _lst_element1 : [element]
	{ "(" => [ 25, 22 ], " [ 25, 22 ], " [ 25, 22 ],
	  NAME => [ 25, 22 ], TOKEN => [ 25, 22 ],
	  __else__ => \&_act__lst_prolog11, },

	# [23] sentence :
	{ "(" => [ 21, 24 ], " [ 21, 24 ], " [ 21, 24 ],
	  NAME => [ 21, 24 ], TOKEN => [ 21, 24 ], },

	# [24] sentence : [_lst_element1]
	{ CODE => [ 46, \&_act_sentence1 ],
	  __else__ => [ 46, \&_act_sentence1 ], },

	# [25] element :
	{ "(" => [ 34, \&_act_element1 ], " 26, " 27,
	  NAME => [ 34, \&_act_element1 ], TOKEN => [ 52, \&_act_element1 ], },

	# [26] element : "
	{ ">" => \&_act_element2, },

	# [27] element : "
	{ ":" => 28, },

	# [28] element : "
	{ "(" => [ 37, 29 ], NAME => [ 37, 29 ], },

	# [29] element : "
	{ "(" => [ 37, 32 ], NAME => [ 37, 32 ], TOKEN => [ 52, 30 ], },

	# [30] element : "
	{ "(" => [ 37, 31 ], NAME => [ 37, 31 ], },

	# [31] element : "
	{ ">" => \&_act_element3, },

	# [32] element : "
	{ "(" => [ 37, 33 ], NAME => [ 37, 33 ], },

	# [33] element : "
	{ ">" => \&_act_element4, },

	# [34] subrule :
	{ "(" => [ 37, 36 ], NAME => [ 37, 36 ], },

	# [35] _lst_quantifier1 :
	{ "*" => [ 44, \&_act__lst_prolog11 ],
	  "+" => [ 44, \&_act__lst_prolog11 ],
	  "<+" => [ 44, \&_act__lst_prolog11 ],
	  "?" => [ 44, \&_act__lst_prolog11 ],
	  __else__ => \&_act__lst_prolog11, },

	# [36] subrule : [subrule_name]
	{ "*" => [ 35, \&_act_subrule1 ], "+" => [ 35, \&_act_subrule1 ],
	  "<+" => [ 35, \&_act_subrule1 ], "?" => [ 35, \&_act_subrule1 ],
	  __else__ => [ 35, \&_act_subrule1 ], },

	# [37] subrule_name :
	{ "(" => 42, NAME => [ 51, \&_act_element1 ], },

	# [38] _lst_sentence4 :
	{ "|" => 39, },

	# [39] _lst_sentence4 : "|"
	{ "(" => [ 23, \&_act__lst_sentence21 ],
	  " [ 23, \&_act__lst_sentence21 ],
	  " [ 23, \&_act__lst_sentence21 ],
	  NAME => [ 23, \&_act__lst_sentence21 ],
	  TOKEN => [ 23, \&_act__lst_sentence21 ], },

	# [40] _lst_sentence3 :
	{ "(" => [ 23, 41 ], " [ 23, 41 ], " [ 23, 41 ],
	  NAME => [ 23, 41 ], TOKEN => [ 23, 41 ], },

	# [41] _lst_sentence3 : [sentence]
	{ __else__ => \&_act__lst_prolog11, "|" => [ 38, 41 ], },

	# [42] subrule_name : "("
	{ "(" => [ 40, 43 ], " [ 40, 43 ], " [ 40, 43 ],
	  NAME => [ 40, 43 ], TOKEN => [ 40, 43 ], },

	# [43] subrule_name : "(" [_lst_sentence3]
	{ ")" => \&_act_subrule_name1, },

	# [44] quantifier :
	{ "*" => \&_act_quantifier1, "+" => \&_act_quantifier1,
	  "<+" => \&_act_quantifier2, "?" => \&_act_quantifier1, },

	# [45] _lst_code1 :
	{ CODE => [ 53, \&_act__lst_prolog11 ],
	  __else__ => \&_act__lst_prolog11, },

	# [46] action :
	{ CODE => [ 45, \&_act_action1 ], __else__ => [ 45, \&_act_action1 ], },

	# [47] directive :
	{ " 48, },

	# [48] directive : "
	{ ":" => 49, },

	# [49] directive : "
	{ NAME => [ 51, 50 ], },

	# [50] directive : "
	{ ">" => \&_act_directive1, },

	# [51] name :
	{ NAME => \&_act_quantifier1, },

	# [52] token :
	{ TOKEN => \&_act_quantifier1, },

	# [53] code :
	{ CODE => \&_act_quantifier1, },

);

# _lst_prolog1 : [prolog]?
# _lst_statement1 : [statement] [statement]*
# _lst_epilog1 : [epilog]?
# _lst_sentence1 : [sentence] [_lst_sentence2]*
# _lst_element1 : [element] [element]*
# _lst_quantifier1 : [quantifier]?
# _lst_sentence3 : [sentence] [_lst_sentence4]*
# _lst_code1 : [code]?
sub _act__lst_prolog11 {
	my($self, @item) = @_;
	return \@item
}

# _lst_sentence2 : "|" [sentence]
# _lst_sentence4 : "|" [sentence]
sub _act__lst_sentence21 {
	my($self, @item) = @_;
	return $item[1]
}

# action : [_lst_code1]
sub _act_action1 {
	my($self, @item) = @_;
	if (@{$item[0]}) {			# code block supplied
	return $item[0][0];
				}
				else {						# default action
	return q{{
				if (@item == 1) {	# special case: one element
					return $item[0];	# drop one array level
				}
				else {
					return \@item;
				}
			}};
				}
}

# code_unbraced : [code]
sub _act_code_unbraced1 {
	my($self, @item) = @_;
	my $code = $item[0];
	$code =~ s/\A\s*{//;	# remove start ...
	$code =~ s/}\s*\z//;	# ... and end braces
	return $code;
}

# directive : ""
sub _act_directive1 {
	my($self, @item) = @_;
	my $name = $item[2];
	$self->fsm->start_rule($name);
	return;
}

# element : [token]
# element : [subrule]
# subrule_name : [name]
sub _act_element1 {
	my($self, @item) = @_;
	return $item[0]
}

# element : ""
sub _act_element2 {
	my($self, @item) = @_;
	return ""
}

# element : ""
sub _act_element3 {
	my($self, @item) = @_;
	my $operand1  = $item[2];
	my $operator  = $item[3];
	my $operand2  = $item[4];
	my $name      = "_anon".($uid++);
	my $name_opt  = "_anon".($uid++);

	# create rule for repetion of (operator operand2)
	$self->fsm->add_rule($name_opt,
						$operator, "[$operand2]",
						'{return [$item[0][0], $item[1]]}');

	# create rule for : operand1 (opt_rule)*
	$self->fsm->add_rule($name,
						"[$operand1]", "[$name_opt]*",
						q{{
							my @ret = ($item[0]);
							for (@{$item[1]}) {
								push @ret, @$_;
							}
							return \@ret;
						}});

	# return rule name
	return "[$name]";
}

# element : ""
sub _act_element4 {
	my($self, @item) = @_;
	my $operand1  = $item[2];
	my $operator  = $item[3];
	my $operand2  = $item[4];
	my $name      = "_anon".($uid++);
	my $name_opt  = "_anon".($uid++);

	# create rule for repetion of (operator operand2)
	$self->fsm->add_rule($name_opt,
						"[$operator]", "[$operand2]",
						'{return [$item[0], $item[1]]}');

	# create rule for : operand1 (opt_rule)*
	$self->fsm->add_rule($name,
						"[$operand1]", "[$name_opt]*",
						q{{
							my @ret = ($item[0]);
							for (@{$item[1]}) {
								push @ret, @$_;
							}
							return \@ret;
						}});

	# return rule name
	return "[$name]";
}

# epilog : [code_unbraced]
sub _act_epilog1 {
	my($self, @item) = @_;
	my $code = $item[0];
	$self->fsm->epilog($code);
	return;
}

# program : [_lst_prolog1] [_lst_statement1] [_lst_epilog1] ""
# statement : [rule]
# statement : [directive]
sub _act_program1 {
}

# prolog : [code_unbraced]
sub _act_prolog1 {
	my($self, @item) = @_;
	my $code = $item[0];
	$self->fsm->prolog($code);
	return;
}

# quantifier : "?"
# quantifier : "*"
# quantifier : "+"
# name : "NAME"
# token : "TOKEN"
# code : "CODE"
sub _act_quantifier1 {
	my($self, @item) = @_;
	return $item[0][1]
}

# quantifier : "<+"
sub _act_quantifier2 {
	my($self, @item) = @_;
	return "<+$item[0][1]>"
}

# rule : [name] ":" [_lst_sentence1] ";"
sub _act_rule1 {
	my($self, @item) = @_;
	my $name = $item[0];
	my $sentences = $item[2];
	for my $sentence (@$sentences) {
		$self->fsm->add_rule($name, @$sentence);
	}
	return;
}

# sentence : [_lst_element1] [action]
sub _act_sentence1 {
	my($self, @item) = @_;
	my $elements = $item[0];
	my $action   = $item[1];
	return [@$elements, $action];
}

# subrule : [subrule_name] [_lst_quantifier1]
sub _act_subrule1 {
	my($self, @item) = @_;
	my $name  = $item[0];
	my $quant = $item[1];
	my $ret = "[$name]";
	$ret .= $quant->[0] if @$quant;
	return $ret;
}

# subrule_name : "(" [_lst_sentence3] ")"
sub _act_subrule_name1 {
	my($self, @item) = @_;
	my $name = "_anon".($uid++);
	my $sentences = $item[1];
	for my $sentence (@$sentences) {
		$self->fsm->add_rule($name, @$sentence);
	}
	return $name;
}

sub parse_code          { return shift->_parse(53) }
sub parse_program       { return shift->_parse(2) }
sub parse_element       { return shift->_parse(25) }
sub parse_subrule       { return shift->_parse(34) }
sub parse_prolog        { return shift->_parse(9) }
sub parse_statement     { return shift->_parse(12) }
sub parse_subrule_name  { return shift->_parse(37) }
sub parse_quantifier    { return shift->_parse(44) }
sub parse_name          { return shift->_parse(51) }
sub parse_rule          { return shift->_parse(13) }
sub parse_sentence      { return shift->_parse(23) }
sub parse_action        { return shift->_parse(46) }
sub parse_code_unbraced { return shift->_parse(11) }
sub parse_directive     { return shift->_parse(47) }
sub parse_token         { return shift->_parse(52) }
sub parse_epilog        { return shift->_parse(10) }


sub new {
	my($class, %args) = @_;
	return $class->SUPER::new(
				_state_table	=> \@state_table,
				_start_state	=> $start_state,
				%args,
	);
}


# access the FSM object
sub fsm { return shift->user->{fsm} }

# read the given input string
sub from {
	my($self, $line) = @_;

	$self->input(sub {
		for ($line) {
			/\G(?:\s+|#.*)+/gc;		# skip blanks and comments

			/\G([a-z]\w*)/gci and do {
				return [NAME => $1];
			};
			/\G(?=["'])/gc and do {
				my $start_pos = pos();
				my($quoted_string, $rest) = extract_quotelike($_);
				if (defined $quoted_string) {
					my $token = eval($quoted_string); ## no critic
					if (! $@) {
						pos() = length() - length($rest);
						return [TOKEN => $token];
					}
				}

				# could not parse quoted string, die
				$rest = substr($_, $start_pos, 100);
				die "Cannot parse quoted string at ", dump($rest), "\n";
			};
			/\G(?=[{])/gc and do {
				my $start_pos = pos();
				my($code_block, $rest) = extract_codeblock($_);
				if (defined $code_block) {
					pos() = length() - length($rest);
					return [CODE => $code_block];
				}

				# could not parse quoted string, die
				$rest = substr($_, $start_pos, 100);
				die "Cannot parse code block at ", dump($rest), "\n";
			};
			/\G(%\w+)/gc and do {					# directives
				return [$1 => $1];
			};
			/\G(<\+)\s*([^>\s]+)\s*>/gc and do {	# list quantifier
				return [$1 => $2];					# ['<+' => ',']
			};
			/\G(<\w+)/gc and do {					# directive
				return [$1 => $1];					# [' '
			};
			/\G(.)/gc and do {
				return [$1 => $1];
			};
			return;	# end of input
		}
	});
	return;
}



1;