Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: d7ff69fe42
Fetching contributors…

Cannot retrieve contributors at this time

13249 lines (13087 sloc) 925.513 kB
# Do not edit this file - Generated by Perlito5 9.0
package Perlito5::IO;
sub slurp {
my $source_filename = shift;
open FILE, $source_filename
or die "Cannot read $source_filename\n";
local $/ = undef;
$source = <FILE>;
close FILE;
return $source;
}
use v5.10;
package main;
undef();
package Perlito5;
package main;
undef();
package Perlito5::Match;
sub Perlito5::Match::flat {
my $self = $_[0];
(defined($self->{'capture'}) ? $self->{'capture'} : substr($self->{'str'}, $self->{'from'}, (($self->{'to'} - $self->{'from'}))))
};
1;
;
# use Perlito5::Match
;
package main;
undef();
package Perlito5::Rul;
sub Perlito5::Rul::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::constant {
my $str = shift();
my $len = length($str);
if (($str eq chr(92))) {
$str = chr(92) . chr(92)
};
if (($str eq chr(39))) {
$str = chr(92) . chr(39)
};
if ($len) {
('( ' . chr(39) . $str . chr(39) . ' eq substr( $str, $MATCH->{to}, ' . $len . ') ' . '&& ( $MATCH->{to} = ' . $len . ' + $MATCH->{to} )' . ')')
}
else {
return '1'
}
};
package Perlito5::Rul::Quantifier;
sub Perlito5::Rul::Quantifier::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Quantifier::term {
$_[0]->{'term'}
};
sub Perlito5::Rul::Quantifier::quant {
$_[0]->{'quant'}
};
sub Perlito5::Rul::Quantifier::emit_perl5 {
my $self = $_[0];
if (($self->{'quant'} eq '')) {
return $self->{'term'}->emit_perl5()
};
if (($self->{'quant'} eq '+')) {
$self->{'term'}->set_captures_to_array();
return ('(do { ' . 'my $last_match_null = 0; ' . 'my $m = $MATCH; ' . 'my $to = $MATCH->{to}; ' . 'my $count = 0; ' . 'while (' . $self->{'term'}->emit_perl5() . ' && ($last_match_null < 2)) ' . '{ ' . 'if ($to == $MATCH->{to}) { ' . '$last_match_null = $last_match_null + 1; ' . '} ' . 'else { ' . '$last_match_null = 0; ' . '}; ' . '$m = $MATCH; ' . '$to = $MATCH->{to}; ' . '$count = $count + 1; ' . '}; ' . '$MATCH = $m; ' . '$MATCH->{to} = $to; ' . '$count > 0; ' . '})')
};
if (($self->{'quant'} eq '*')) {
$self->{'term'}->set_captures_to_array();
return ('(do { ' . 'my $last_match_null = 0; ' . 'my $m = $MATCH; ' . 'my $to = $MATCH->{to}; ' . 'while (' . $self->{'term'}->emit_perl5() . ' && ($last_match_null < 2)) ' . '{ ' . 'if ($to == $MATCH->{to}) { ' . '$last_match_null = $last_match_null + 1; ' . '} ' . 'else { ' . '$last_match_null = 0; ' . '}; ' . '$m = $MATCH; ' . '$to = $MATCH->{to}; ' . '}; ' . '$MATCH = $m; ' . '$MATCH->{to} = $to; ' . '1 ' . '})')
};
if (($self->{'quant'} eq '?')) {
$self->{'term'}->set_captures_to_array();
return ('(do { ' . 'my $m = $MATCH; ' . 'if (!' . $self->{'term'}->emit_perl5() . ') ' . '{ ' . '$MATCH = $m; ' . '}; ' . '1 ' . '})')
};
die('Perlito5::Rul::Quantifier: not implemented')
};
sub Perlito5::Rul::Quantifier::set_captures_to_array {
my $self = $_[0];
$self->{'term'}->set_captures_to_array()
};
package Perlito5::Rul::Or;
sub Perlito5::Rul::Or::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Or::or_list {
$_[0]->{'or_list'}
};
sub Perlito5::Rul::Or::emit_perl5 {
my $self = $_[0];
if ((scalar(@{$self->{'or_list'}}) == 1)) {
return $self->{'or_list'}->[0]->emit_perl5()
};
('(do { ' . 'my $pos1 = $MATCH->{to}; (do { ' . join('}) || (do { $MATCH->{to} = $pos1; ', map($_->emit_perl5(), @{$self->{'or_list'}})) . '}) })')
};
sub Perlito5::Rul::Or::set_captures_to_array {
my $self = $_[0];
map($_->set_captures_to_array(), @{$self->{'or_list'}})
};
package Perlito5::Rul::Concat;
sub Perlito5::Rul::Concat::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Concat::concat {
$_[0]->{'concat'}
};
sub Perlito5::Rul::Concat::emit_perl5 {
my $self = $_[0];
if ((scalar(@{$self->{'concat'}}) == 1)) {
return $self->{'concat'}->[0]->emit_perl5()
};
('(' . join(' && ', map($_->emit_perl5(), @{$self->{'concat'}})) . ')')
};
sub Perlito5::Rul::Concat::set_captures_to_array {
my $self = $_[0];
map($_->set_captures_to_array(), @{$self->{'concat'}})
};
package Perlito5::Rul::Subrule;
sub Perlito5::Rul::Subrule::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Subrule::metasyntax {
$_[0]->{'metasyntax'}
};
sub Perlito5::Rul::Subrule::captures {
$_[0]->{'captures'}
};
sub Perlito5::Rul::Subrule::emit_perl5 {
my $self = $_[0];
my $s = $self->{'metasyntax'};
($s =~ s!\.!->!g);
my $meth = (((1 + index($self->{'metasyntax'}, '.'))) ? $s : (('$grammar->' . $self->{'metasyntax'})));
my $code;
if (($self->{'captures'} == 1)) {
$code = ('if ($m2) { $MATCH->{to} = $m2->{to}; $MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '} = $m2; 1 } else { 0 }; ')
}
else {
if (($self->{'captures'} > 1)) {
$code = ('if ($m2) { ' . '$MATCH->{to} = $m2->{to}; ' . 'if (exists $MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '}) { ' . 'push @{ $MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '} }, $m2; ' . '} ' . 'else { ' . '$MATCH->{' . chr(39) . $self->{'metasyntax'} . chr(39) . '} = [ $m2 ]; ' . '}; ' . '1 ' . '} else { 0 }; ')
}
else {
$code = 'if ($m2) { $MATCH->{to} = $m2->{to}; 1 } else { 0 }; '
}
};
('(do { ' . 'my $m2 = ' . $meth . '($str, $MATCH->{to}); ' . $code . '})')
};
sub Perlito5::Rul::Subrule::set_captures_to_array {
my $self = $_[0];
if (($self->{'captures'} > 0)) {
$self->{'captures'} = ($self->{'captures'} + 1)
}
};
package Perlito5::Rul::Constant;
sub Perlito5::Rul::Constant::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Constant::constant {
$_[0]->{'constant'}
};
sub Perlito5::Rul::Constant::emit_perl5 {
my $self = $_[0];
my $str = $self->{'constant'};
Perlito5::Rul::constant($str)
};
sub Perlito5::Rul::Constant::set_captures_to_array {
my $self = $_[0]
};
package Perlito5::Rul::Dot;
sub Perlito5::Rul::Dot::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Dot::emit_perl5 {
my $self = $_[0];
('( ' . chr(39) . chr(39) . ' ne substr( $str, $MATCH->{to}, 1 ) ' . '&& ($MATCH->{to} = 1 + $MATCH->{to})' . ')')
};
sub Perlito5::Rul::Dot::set_captures_to_array {
my $self = $_[0]
};
package Perlito5::Rul::SpecialChar;
sub Perlito5::Rul::SpecialChar::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::SpecialChar::char {
$_[0]->{'char'}
};
sub Perlito5::Rul::SpecialChar::emit_perl5 {
my $self = $_[0];
my $char = $self->{'char'};
if (($char eq 'n')) {
return Perlito5::Rul::Subrule->new('metasyntax', 'is_newline', 'captures', 0)->emit_perl5()
};
if (($char eq 'N')) {
return Perlito5::Rul::Subrule->new('metasyntax', 'not_newline', 'captures', 0)->emit_perl5()
};
if (($char eq 'd')) {
return Perlito5::Rul::Subrule->new('metasyntax', 'digit', 'captures', 0)->emit_perl5()
};
if (($char eq 's')) {
return Perlito5::Rul::Subrule->new('metasyntax', 'space', 'captures', 0)->emit_perl5()
};
if (($char eq 't')) {
return Perlito5::Rul::constant(chr(9))
};
return Perlito5::Rul::constant($char)
};
sub Perlito5::Rul::SpecialChar::set_captures_to_array {
my $self = $_[0]
};
package Perlito5::Rul::Block;
sub Perlito5::Rul::Block::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Block::closure {
$_[0]->{'closure'}
};
sub Perlito5::Rul::Block::emit_perl5 {
my $self = $_[0];
('(do { ' . '$MATCH->{str} = $str; ' . $self->{'closure'} . '; 1 })')
};
sub Perlito5::Rul::Block::set_captures_to_array {
my $self = $_[0]
};
package Perlito5::Rul::Before;
sub Perlito5::Rul::Before::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::Before::rule_exp {
$_[0]->{'rule_exp'}
};
sub Perlito5::Rul::Before::emit_perl5 {
my $self = $_[0];
('(do { ' . 'my $tmp = $MATCH; ' . '$MATCH = { ' . chr(39) . 'str' . chr(39) . ' => $str, ' . chr(39) . 'from' . chr(39) . ' => $tmp->{to}, ' . chr(39) . 'to' . chr(39) . ' => $tmp->{to} }; ' . 'my $res = ' . $self->{'rule_exp'}->emit_perl5() . '; ' . '$MATCH = $res ? $tmp : 0; ' . '})')
};
sub Perlito5::Rul::Before::set_captures_to_array {
my $self = $_[0]
};
package Perlito5::Rul::NotBefore;
sub Perlito5::Rul::NotBefore::new {
my $class = shift();
bless({@_}, $class)
};
sub Perlito5::Rul::NotBefore::rule_exp {
$_[0]->{'rule_exp'}
};
sub Perlito5::Rul::NotBefore::emit_perl5 {
my $self = $_[0];
('(do { ' . 'my $tmp = $MATCH; ' . '$MATCH = { ' . chr(39) . 'str' . chr(39) . ' => $str, ' . chr(39) . 'from' . chr(39) . ' => $tmp->{to}, ' . chr(39) . 'to' . chr(39) . ' => $tmp->{to} }; ' . 'my $res = ' . $self->{'rule_exp'}->emit_perl5() . '; ' . '$MATCH = $res ? 0 : $tmp; ' . '})')
};
sub Perlito5::Rul::NotBefore::set_captures_to_array {
my $self = $_[0]
};
1;
;
# use Perlito5::Emitter::Token
;
package main;
package Perlito5::Grammar::Precedence;
# use feature
;
sub Perlito5::Grammar::Precedence::new {
my $class = shift();
bless({@_}, $class)
};
my $Operator = {};
my $Precedence = {};
my $PrefixPrecedence = {};
my $Assoc = {};
sub Perlito5::Grammar::Precedence::is_assoc_type {
my $assoc_type = shift();
my $op_name = shift();
return $Assoc->{$assoc_type}->{$op_name}
};
sub Perlito5::Grammar::Precedence::is_fixity_type {
my $fixity_type = shift();
my $op_name = shift();
return $Operator->{$fixity_type}->{$op_name}
};
sub Perlito5::Grammar::Precedence::is_term {
my $token = shift();
(((($token->[0] eq 'term')) || (($token->[0] eq 'postfix_or_term'))) || (($token->[0] eq 'postfix')))
};
sub Perlito5::Grammar::Precedence::is_num {
(($_[0] ge '0') && ($_[0] le '9'))
};
sub Perlito5::Grammar::Precedence::is_ident_middle {
my $c = shift();
((((($c ge 'a') && ($c le 'z'))) || ((($c ge '0') && ($c le '9')))) || (($c eq '_')))
};
my @Parsed_op_chars = (2, 1);
my %Parsed_op = ('?', sub {
Perlito5::Grammar::Expression->term_ternary($_[0], $_[1])
}, '(', sub {
Perlito5::Grammar::Expression->term_paren($_[0], $_[1])
}, '[', sub {
Perlito5::Grammar::Expression->term_square($_[0], $_[1])
}, '{', sub {
Perlito5::Grammar::Expression->term_curly($_[0], $_[1])
}, '->', sub {
Perlito5::Grammar::Expression->term_arrow($_[0], $_[1])
});
my @Term_chars;
my %Term;
sub Perlito5::Grammar::Precedence::add_term {
my $name = shift();
my $param = shift();
$Term{$name} = $param;
unshift(@Term_chars, (scalar(@Term_chars) + 1)) while (@Term_chars < length($name))
};
my $End_token;
my $End_token_chars;
my %Op;
my @Op_chars = (3, 2, 1);
sub Perlito5::Grammar::Precedence::op_parse {
my $self = shift();
my $str = shift();
my $pos = shift();
my $last_is_term = shift();
for my $len (@{$End_token_chars}) {
my $term = substr($str, $pos, $len);
if (exists($End_token->{$term})) {
my $c1 = substr($str, (($pos + $len) - 1), 1);
my $c2 = substr($str, ($pos + $len), 1);
if ((!(((is_ident_middle($c1) && is_ident_middle($c2)))) && !(((($c1 eq '<') && ($c2 eq '<')))))) {
return {'str', $str, 'from', $pos, 'to', $pos, 'capture', ['end', $term]}
}
}
};
if (!($last_is_term)) {
for my $len (@Term_chars) {
my $term = substr($str, $pos, $len);
if (exists($Term{$term})) {
my $c1 = substr($str, (($pos + $len) - 1), 1);
my $c2 = substr($str, ($pos + $len), 1);
if (((is_num($c1) || !(is_ident_middle($c1))) || !(is_ident_middle($c2)))) {
my $m = $Term{$term}->($str, $pos);
return $m if $m
}
}
}
};
for my $len (@Parsed_op_chars) {
my $op = substr($str, $pos, $len);
if (exists($Parsed_op{$op})) {
my $m = $Parsed_op{$op}->($str, $pos);
return $m if $m
}
};
for my $len (@Op_chars) {
my $op = substr($str, $pos, $len);
if (exists($Op{$op})) {
my $c1 = substr($str, (($pos + $len) - 1), 1);
my $c2 = substr($str, ($pos + $len), 1);
if ((!(((is_ident_middle($c1) && is_ident_middle($c2)))) && !(((($c1 eq '&') && ($c2 eq '&')))))) {
if (((exists($Operator->{'infix'}->{$op}) && !(exists($Operator->{'prefix'}->{$op}))) && !($last_is_term))) {
}
else {
return {'str', $str, 'from', $pos, 'to', ($pos + $len), 'capture', ['op', $op]}
}
}
}
};
return Perlito5::Grammar::Bareword->term_bareword($str, $pos)
};
sub Perlito5::Grammar::Precedence::add_op {
my $fixity = shift();
my $name = shift();
my $precedence = shift();
my $param = shift();
if (!((defined($param)))) {
$param = {}
};
my $assoc = ($param->{'assoc'} || 'left');
$Operator->{$fixity}->{$name} = 1;
$Precedence->{$name} = $precedence;
$PrefixPrecedence->{$name} = $precedence if ($fixity eq 'prefix');
$Assoc->{$assoc}->{$name} = 1;
$Op{$name} = 1
};
my $prec = 100;
add_op('postfix', '.( )', $prec);
add_op('postfix', '.[ ]', $prec);
add_op('postfix', '.{ }', $prec);
add_op('postfix', '( )', $prec);
add_op('postfix', '[ ]', $prec);
add_op('postfix', 'funcall', $prec);
add_op('postfix', 'funcall_no_params', $prec);
add_op('postfix', 'methcall', $prec);
add_op('postfix', 'methcall_no_params', $prec);
add_op('postfix', 'block', $prec);
add_op('postfix', 'hash', $prec);
$prec = ($prec - 1);
add_op('prefix', '++', $prec);
add_op('prefix', '--', $prec);
add_op('postfix', '++', $prec);
add_op('postfix', '--', $prec);
$prec = ($prec - 1);
add_op('infix', '**', $prec, {'assoc', 'right'});
$prec = ($prec - 1);
add_op('prefix', chr(92), $prec);
add_op('prefix', '+', $prec);
add_op('prefix', '-', $prec);
add_op('prefix', '~', $prec);
add_op('prefix', '!', $prec);
$prec = ($prec - 1);
add_op('infix', '=~', $prec);
add_op('infix', '!~', $prec);
$prec = ($prec - 1);
add_op('infix', '*', $prec);
add_op('infix', '/', $prec);
add_op('infix', '%', $prec);
add_op('infix', 'x', $prec);
$prec = ($prec - 1);
add_op('infix', '+', $prec);
add_op('infix', '-', $prec);
add_op('infix', '.', $prec, {'assoc', 'list'});
$prec = ($prec - 1);
add_op('infix', '<<', $prec);
add_op('infix', '>>', $prec);
$prec = ($prec - 1);
add_op('prefix', $_, $prec) for ('-r', '-w', '-x', '-o', '-R', '-W', '-X', '-O', '-e', '-z', '-s', '-f', '-d', '-l', '-p', '-S', '-b', '-c', '-t', '-u', '-g', '-k', '-T', '-B', '-M', '-A', '-C');
$prec = ($prec - 1);
add_op('infix', 'lt', $prec, {'assoc', 'chain'});
add_op('infix', 'le', $prec, {'assoc', 'chain'});
add_op('infix', 'gt', $prec, {'assoc', 'chain'});
add_op('infix', 'ge', $prec, {'assoc', 'chain'});
add_op('infix', '<=', $prec, {'assoc', 'chain'});
add_op('infix', '>=', $prec, {'assoc', 'chain'});
add_op('infix', '<', $prec, {'assoc', 'chain'});
add_op('infix', '>', $prec, {'assoc', 'chain'});
$prec = ($prec - 1);
add_op('infix', '<=>', $prec);
add_op('infix', 'cmp', $prec);
add_op('infix', '==', $prec, {'assoc', 'chain'});
add_op('infix', '!=', $prec, {'assoc', 'chain'});
add_op('infix', 'ne', $prec, {'assoc', 'chain'});
add_op('infix', 'eq', $prec, {'assoc', 'chain'});
$prec = ($prec - 1);
add_op('infix', '&', $prec);
$prec = ($prec - 1);
add_op('infix', '|', $prec);
add_op('infix', '^', $prec);
$prec = ($prec - 1);
add_op('infix', '..', $prec);
add_op('infix', '...', $prec);
add_op('infix', '~~', $prec, {'assoc', 'chain'});
$prec = ($prec - 1);
add_op('infix', '&&', $prec);
$prec = ($prec - 1);
add_op('infix', '||', $prec);
add_op('infix', '//', $prec);
$prec = ($prec - 1);
add_op('ternary', '? :', $prec, {'assoc', 'right'});
$prec = ($prec - 1);
add_op('infix', '=', $prec, {'assoc', 'right'});
add_op('infix', '**=', $prec, {'assoc', 'right'});
add_op('infix', '+=', $prec, {'assoc', 'right'});
add_op('infix', '-=', $prec, {'assoc', 'right'});
add_op('infix', '*=', $prec, {'assoc', 'right'});
add_op('infix', '/=', $prec, {'assoc', 'right'});
add_op('infix', 'x=', $prec, {'assoc', 'right'});
add_op('infix', '|=', $prec, {'assoc', 'right'});
add_op('infix', '&=', $prec, {'assoc', 'right'});
add_op('infix', '.=', $prec, {'assoc', 'right'});
add_op('infix', '<<=', $prec, {'assoc', 'right'});
add_op('infix', '>>=', $prec, {'assoc', 'right'});
add_op('infix', '%=', $prec, {'assoc', 'right'});
add_op('infix', '||=', $prec, {'assoc', 'right'});
add_op('infix', '&&=', $prec, {'assoc', 'right'});
add_op('infix', '^=', $prec, {'assoc', 'right'});
add_op('infix', '//=', $prec, {'assoc', 'right'});
$prec = ($prec - 1);
add_op('infix', '=>', $prec);
$prec = ($prec - 1);
add_op('list', ',', $prec, {'assoc', 'list'});
$prec = ($prec - 1);
add_op('prefix', 'not', $prec);
$prec = ($prec - 1);
add_op('infix', 'and', $prec);
$prec = ($prec - 1);
add_op('infix', 'or', $prec);
add_op('infix', 'xor', $prec);
$prec = ($prec - 1);
add_op('infix', '*start*', $prec);
sub Perlito5::Grammar::Precedence::get_token_precedence {
my $token = $_[0];
if (($token->[0] eq 'prefix')) {
return $PrefixPrecedence->{$token->[1]}
};
return $Precedence->{$token->[1]}
};
sub Perlito5::Grammar::Precedence::precedence_parse {
my $self = shift();
my $get_token = $self->{'get_token'};
my $reduce = $self->{'reduce'};
my $last_end_token = $End_token;
my $last_end_token_chars = $End_token_chars;
$End_token = $self->{'end_token'};
$End_token_chars = $self->{'end_token_chars'};
my $op_stack = [];
my $num_stack = [];
my $last = ['op', '*start*'];
my $last_is_term = 0;
my $token = $get_token->($last_is_term);
if (($token->[0] eq 'space')) {
$token = $get_token->($last_is_term)
};
for ( ; ((defined($token)) && (($token->[0] ne 'end'))); {
} ) {
my $token_is_term = is_term($token);
if (((($token->[1] eq ',')) && (((($last->[1] eq '*start*')) || (($last->[1] eq ',')))))) {
push(@{$num_stack}, ['term', undef()])
};
if (($Operator->{'prefix'}->{$token->[1]} && (((($last->[1] eq '*start*')) || !($last_is_term))))) {
$token->[0] = 'prefix';
unshift(@{$op_stack}, $token)
}
else {
if (($Operator->{'postfix'}->{$token->[1]} && $last_is_term)) {
my $pr = $Precedence->{$token->[1]};
for ( ; (scalar(@{$op_stack}) && (($pr <= get_token_precedence($op_stack->[0])))); {
} ) {
$reduce->($op_stack, $num_stack)
};
if (($token->[0] ne 'postfix_or_term')) {
$token->[0] = 'postfix'
};
unshift(@{$op_stack}, $token);
$token_is_term = 1
}
else {
if ($token_is_term) {
if ($last_is_term) {
say('# last: ', Perlito5::Dumper::Dumper($last));
say('# token: ', Perlito5::Dumper::Dumper($token));
die('Value tokens must be separated by an operator')
};
$token->[0] = 'term';
push(@{$num_stack}, $token)
}
else {
if ($Precedence->{$token->[1]}) {
my $pr = $Precedence->{$token->[1]};
if ($Assoc->{'right'}->{$token->[1]}) {
for ( ; (scalar(@{$op_stack}) && (($pr < get_token_precedence($op_stack->[0])))); {
} ) {
$reduce->($op_stack, $num_stack)
}
}
else {
for ( ; (scalar(@{$op_stack}) && (($pr <= get_token_precedence($op_stack->[0])))); {
} ) {
$reduce->($op_stack, $num_stack)
}
};
if ($Operator->{'ternary'}->{$token->[1]}) {
$token->[0] = 'ternary'
}
else {
$token->[0] = 'infix'
};
unshift(@{$op_stack}, $token)
}
else {
die('Unknown token: ' . chr(39), $token->[1], chr(39))
}
}
}
};
$last = $token;
$last_is_term = $token_is_term;
$token = $get_token->($last_is_term);
if (($token->[0] eq 'space')) {
$token = $get_token->($last_is_term)
}
};
if ((defined($token) && (($token->[0] ne 'end')))) {
die('Unexpected end token: ', $token)
};
for ( ; scalar(@{$op_stack}); {
} ) {
$reduce->($op_stack, $num_stack)
};
$End_token = $last_end_token;
$End_token_chars = $last_end_token_chars;
return $num_stack
};
1;
;
package main;
package Perlito5::Grammar::Bareword;
# use strict
;
sub Perlito5::Grammar::Bareword::the_object {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((do {
my $pos1 = $MATCH->{'to'};
((((do {
((((do {
my $tmp = $MATCH;
$MATCH = {'str', $str, 'from', $tmp->{'to'}, 'to', $tmp->{'to'}};
my $res = ((('$' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))));
$MATCH = ($res ? $tmp : 0)
})) && ((do {
my $m2 = Perlito5::Grammar::Sigil->term_sigil($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Sigil.term_sigil'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Sigil.term_sigil'})->[1];
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((((((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Expression->curly_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.curly_parse'} = $m2;
1
}
else {
0
}
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.curly_parse'});
1
}))))
}))) || ((do {
$MATCH->{'to'} = $pos1;
((((do {
my $m2 = Perlito5::Grammar::Print->typeglob($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Print.typeglob'} = $m2;
1
}
else {
0
}
})) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Print.typeglob'});
1
}))))
})))
})));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Bareword::term_bareword {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $p = $pos;
my $m_namespace = Perlito5::Grammar->optional_namespace_before_ident($str, $p);
my $namespace = Perlito5::Match::flat($m_namespace);
$p = $m_namespace->{'to'};
my $m_name = Perlito5::Grammar->ident($str, $p);
if (!($m_name)) {
if ($namespace) {
$m_namespace->{'capture'} = ['term', Perlito5::AST::Var->new('sigil', '::', 'name', '', 'namespace', $namespace)];
return $m_namespace
};
return
};
my $name = Perlito5::Match::flat($m_name);
$p = $m_name->{'to'};
if ((substr($str, $p, 2) eq '::')) {
$m_name->{'to'} = ($p + 2);
$m_name->{'capture'} = ['term', Perlito5::AST::Var->new('sigil', '::', 'name', '', 'namespace', ($namespace . '::' . $name))];
return $m_name
};
my $full_name = $name;
$full_name = ($namespace . '::' . $name) if $namespace;
my $m = Perlito5::Grammar::Space->ws($str, $p);
if ($m) {
$p = $m->{'to'}
};
my $invocant;
my $is_subroutine_name;
my $effective_name = ((($namespace || $Perlito5::PKG_NAME)) . '::' . $name);
if (exists($Perlito5::Grammar::Print::Print{$name})) {
$invocant = undef()
}
else {
if ((exists($Perlito5::PROTO->{$effective_name}) || ((((!($namespace) || ($namespace eq 'CORE'))) && exists($Perlito5::CORE_PROTO->{('CORE::' . $name)}))))) {
$is_subroutine_name = 1;
$invocant = Perlito5::Grammar->full_ident($str, $p);
my $package = Perlito5::Match::flat($invocant);
if ($package) {
$invocant->{'capture'} = Perlito5::AST::Var->new('sigil', '::', 'name', '', 'namespace', $package);
if ((substr($str, $invocant->{'to'}, 2) eq '::')) {
$invocant->{'to'} = ($invocant->{'to'} + 2)
}
else {
if (!($Perlito5::PACKAGES->{$package})) {
$invocant = undef()
}
}
}
}
else {
$invocant = Perlito5::Grammar::Bareword->the_object($str, $p)
}
};
if ($invocant) {
$p = $invocant->{'to'};
my $arg = [];
$m = Perlito5::Grammar::Space->ws($str, $p);
$p = $m->{'to'} if $m;
if ((substr($str, $p, 2) eq '->')) {
}
else {
if ((substr($str, $p, 1) eq '(')) {
my $m = Perlito5::Grammar::Expression->term_paren($str, $p);
if ($m) {
$arg = $m->{'capture'}->[2];
$p = $m->{'to'};
$arg = Perlito5::Grammar::Expression::expand_list($arg)
}
}
else {
my $m = Perlito5::Grammar::Expression->list_parse($str, $p);
if (($m->{'capture'} ne '*undef*')) {
$arg = Perlito5::Grammar::Expression::expand_list($m->{'capture'});
$p = $m->{'to'}
}
}
};
$m_name->{'capture'} = ['term', Perlito5::AST::Call->new('method', $full_name, 'invocant', Perlito5::Match::flat($invocant), 'arguments', $arg)];
$m_name->{'to'} = $p;
return $m_name
};
if ((substr($str, $p, 2) eq '=>')) {
$m_name->{'capture'} = ['term', Perlito5::AST::Apply->new('code', $name, 'namespace', $namespace, 'arguments', [], 'bareword', 1)];
$m_name->{'to'} = $p;
return $m_name
};
if ((substr($str, $p, 2) eq '->')) {
if ($is_subroutine_name) {
$m_name->{'capture'} = ['term', Perlito5::AST::Apply->new('arguments', [], 'code', $name, 'namespace', $namespace)]
}
else {
$m_name->{'capture'} = ['term', Perlito5::AST::Proto->new('name', $full_name)]
};
$m_name->{'to'} = $p;
return $m_name
};
my $sig;
if (exists($Perlito5::PROTO->{$effective_name})) {
$sig = $Perlito5::PROTO->{$effective_name}
}
else {
if ((((!($namespace) || ($namespace eq 'CORE'))) && exists($Perlito5::CORE_PROTO->{('CORE::' . $name)}))) {
$effective_name = ('CORE::' . $name);
$sig = $Perlito5::CORE_PROTO->{$effective_name}
}
else {
$sig = undef()
}
};
my $has_paren = 0;
if (defined($sig)) {
if ((substr($sig, 0, 1) eq ';')) {
if ((substr($str, $p, 2) eq '//')) {
$m_name->{'capture'} = ['term', Perlito5::AST::Apply->new('code', $name, 'namespace', $namespace, 'arguments', [], 'bareword', 1)];
$m_name->{'to'} = $p;
return $m_name
}
};
if (($sig eq '')) {
if ((substr($str, $p, 1) eq '(')) {
($p)++;
$has_paren = 1;
my $m = Perlito5::Grammar::Space->ws($str, $p);
if ($m) {
$p = $m->{'to'}
};
if ((substr($str, $p, 1) ne ')')) {
die('syntax error near ', substr($str, $pos, 10))
};
($p)++
};
$m_name->{'capture'} = ['term', Perlito5::AST::Apply->new('code', $name, 'namespace', $namespace, 'arguments', [], 'bareword', (($has_paren == 0)))];
$m_name->{'to'} = $p;
return $m_name
};
if (((($sig eq '_') || ($sig eq '$')) || ($sig eq ';$'))) {
my $m;
my $arg;
if ((substr($str, $p, 1) eq '(')) {
$m = Perlito5::Grammar::Expression->term_paren($str, $p);
if (!($m)) {
return $m
};
$p = $m->{'to'};
$has_paren = 1;
$arg = $m->{'capture'}->[2];
$arg = Perlito5::Grammar::Expression::expand_list($arg);
my $v = shift(@{$arg});
die(('Too many arguments for ' . $name)) if @{$arg};
$arg = $v
}
else {
$m = Perlito5::Grammar::Expression->argument_parse($str, $p);
$arg = $m->{'capture'};
if (($arg eq '*undef*')) {
$arg = undef()
}
else {
if (((ref($arg) eq 'Perlito5::AST::Apply') && ($arg->{'code'} eq 'circumfix:<( )>'))) {
my $v = shift(@{$arg->{'arguments'}});
die(('Too many arguments for ' . $name)) if @{$arg->{'arguments'}};
$arg = $v
}
}
};
my @args;
if (defined($arg)) {
push(@args, $arg);
$has_paren = 1
}
else {
die(('Not enough arguments for ' . $name)) if ($sig eq '$');
push(@args, Perlito5::AST::Var->new('namespace', '', 'name', '_', 'sigil', '$')) if ($sig eq '_')
};
$m->{'capture'} = ['term', Perlito5::AST::Apply->new('code', $name, 'namespace', $namespace, 'arguments', \@args, 'bareword', (($has_paren == 0)))];
return $m
};
if (($sig eq '*')) {
}
};
if ((substr($str, $p, 1) eq '(')) {
$m = Perlito5::Grammar::Expression->term_paren($str, $p);
if (!($m)) {
return $m
};
my $arg = $m->{'capture'}->[2];
$arg = Perlito5::Grammar::Expression::expand_list($arg);
$m->{'capture'} = ['term', Perlito5::AST::Apply->new('code', $name, 'namespace', $namespace, 'arguments', $arg)];
return $m
};
my $m_list = Perlito5::Grammar::Expression->list_parse($str, $p);
my $list = $m_list->{'capture'};
if (($list ne '*undef*')) {
$m_name->{'capture'} = ['postfix_or_term', 'funcall', $namespace, $name, $list];
$m_name->{'to'} = $m_list->{'to'};
return $m_name
};
$m_name->{'capture'} = ['postfix_or_term', 'funcall_no_params', $namespace, $name];
return $m_name
};
1;
;
package main;
undef();
package Perlito5::Grammar::Attribute;
sub Perlito5::Grammar::Attribute::opt_attribute {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my @attributes;
my $ws = Perlito5::Grammar::Space->opt_ws($str, $pos);
if ((substr($str, $ws->{'to'}, 1) ne ':')) {
return {'to', $pos, 'capture', []}
};
$ws = Perlito5::Grammar::Space->opt_ws($str, ($ws->{'to'} + 1));
my $p = $ws->{'to'};
my $m = Perlito5::Grammar->ident($str, $p);
die('syntax error') if !($m);
my $to;
for ( ; 1; {
} ) {
$to = $m->{'to'};
my $delimiter = substr($str, $to, 1);
if (($delimiter eq '(')) {
my $params = Perlito5::Grammar::String->string_interpolation_parse($str, ($m->{'to'} + 1), '(', ')', 0);
die('syntax error') if !($params);
$to = $params->{'to'}
};
push(@attributes, substr($str, $p, ($to - $p)));
$ws = Perlito5::Grammar::Space->opt_ws($str, $to);
if ((substr($str, $ws->{'to'}, 1) eq ':')) {
$ws = Perlito5::Grammar::Space->opt_ws($str, ($ws->{'to'} + 1))
};
$p = $ws->{'to'};
$m = Perlito5::Grammar->ident($str, $p);
return {'to', $to, 'capture', \@attributes} if !($m)
}
};
1;
;
package main;
package Perlito5::Grammar::Statement;
my @Statement_chars;
my %Statement;
sub Perlito5::Grammar::Statement::add_statement {
my $name = shift();
my $param = shift();
$Statement{$name} = $param;
unshift(@Statement_chars, (scalar(@Statement_chars) + 1)) while (@Statement_chars < length($name))
};
Perlito5::Grammar::Statement::add_statement('...', sub {
Perlito5::Grammar::Statement->stmt_yadayada($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('package', sub {
Perlito5::Grammar::Statement->stmt_package($_[0], $_[1])
});
sub Perlito5::Grammar::Statement::stmt_yadayada {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((('...' eq substr($str, $MATCH->{'to'}, 3)) && ($MATCH->{'to'} = (3 + $MATCH->{'to'})))) && ((do {
$MATCH->{'str'} = $str;
die('Unimplemented');
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Statement::stmt_package {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((('package' eq substr($str, $MATCH->{'to'}, 7)) && ($MATCH->{'to'} = (7 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->full_ident($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.full_ident'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
(((((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((do {
$MATCH->{'str'} = $str;
my $name = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'});
$Perlito5::PACKAGES->{$name} = 1;
$Perlito5::PKG_NAME = $name;
1
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_curly($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_curly'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = Perlito5::AST::Lit::Block->new('stmts', [Perlito5::AST::Apply->new('code', 'package', 'arguments', [], 'namespace', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'})), @{$MATCH->{'Perlito5::Grammar::Expression.term_curly'}->{'capture'}->[2]}]);
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((do {
$MATCH->{'str'} = $str;
my $name = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'});
$Perlito5::PACKAGES->{$name} = 1;
$Perlito5::PKG_NAME = $name;
$MATCH->{'capture'} = Perlito5::AST::Apply->new('code', 'package', 'arguments', [], 'namespace', $name);
1
}))
})))
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Statement::exp_stmt {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
for my $len (@Statement_chars) {
my $term = substr($str, $pos, $len);
if (exists($Statement{$term})) {
my $m = $Statement{$term}->($str, $pos);
return $m if $m
}
};
return 0
};
my @Modifier_chars = (7, 6, 5, 4, 3, 2);
my %Modifier = ('if', 1, 'unless', 1, 'when', 1, 'for', 1, 'foreach', 1, 'while', 1, 'given', 1);
sub Perlito5::Grammar::Statement::statement_modifier {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $expression = $_[3];
for my $len (@Modifier_chars) {
my $term = substr($str, $pos, $len);
if (exists($Modifier{$term})) {
my $m = $self->modifier($str, ($pos + $len), $term, $expression);
return $m if $m
}
};
return 0
};
sub Perlito5::Grammar::Statement::modifier {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $modifier = $_[3];
my $expression = $_[4];
my $modifier_exp = Perlito5::Grammar::Expression->exp_parse($str, $pos);
if (!($modifier_exp)) {
die('Expected expression after ' . chr(39), Perlito5::Match::flat($modifier), chr(39))
};
if (($modifier eq 'if')) {
return {'str', $str, 'from', $pos, 'to', $modifier_exp->{'to'}, 'capture', Perlito5::AST::If->new('cond', Perlito5::Match::flat($modifier_exp), 'body', $expression)}
};
if (($modifier eq 'unless')) {
return {'str', $str, 'from', $pos, 'to', $modifier_exp->{'to'}, 'capture', Perlito5::AST::If->new('cond', Perlito5::Match::flat($modifier_exp), 'otherwise', $expression)}
};
if (($modifier eq 'when')) {
return {'str', $str, 'from', $pos, 'to', $modifier_exp->{'to'}, 'capture', Perlito5::AST::When->new('cond', Perlito5::Match::flat($modifier_exp), 'body', $expression)}
};
if (($modifier eq 'while')) {
return {'str', $str, 'from', $pos, 'to', $modifier_exp->{'to'}, 'capture', Perlito5::AST::While->new('cond', Perlito5::Match::flat($modifier_exp), 'body', $expression)}
};
if ((($modifier eq 'for') || ($modifier eq 'foreach'))) {
return {'str', $str, 'from', $pos, 'to', $modifier_exp->{'to'}, 'capture', Perlito5::AST::For->new('cond', Perlito5::Match::flat($modifier_exp), 'body', $expression)}
};
die(('Unexpected statement modifier ' . chr(39) . $modifier . chr(39)))
};
sub Perlito5::Grammar::Statement::statement_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $res = $self->exp_stmt($str, $pos);
if ($res) {
return $res
};
$res = Perlito5::Grammar::Expression->exp_parse($str, $pos);
if (!($res)) {
return
};
if ((((substr($str, $res->{'to'}, 1) eq ':') && $res->{'capture'}->isa('Perlito5::AST::Apply')) && $res->{'capture'}->{'bareword'})) {
my $label = $res->{'capture'}->{'code'};
my $ws = Perlito5::Grammar::Space->opt_ws($str, ($res->{'to'} + 1));
my $stmt = $self->statement_parse($str, $ws->{'to'});
if ($stmt) {
$stmt->{'capture'}->{'label'} = $label;
return $stmt
};
$res->{'to'} = $ws->{'to'};
$res->{'capture'} = Perlito5::AST::Apply->new('arguments', [], 'code', 'undef', 'namespace', '', 'label', $label);
return $res
};
my $modifier = $self->statement_modifier($str, $res->{'to'}, Perlito5::Match::flat($res));
my $p = ($modifier ? $modifier->{'to'} : $res->{'to'});
my $terminator = substr($str, $p, 1);
die('Number or Bareword found where operator expected') if ((($terminator ne ';') && ($terminator ne '}')) && ($terminator ne ''));
if (!($modifier)) {
return $res
};
return $modifier
};
1;
;
package main;
package Perlito5::Grammar::Expression;
# use Perlito5::Grammar::Precedence
;
# use Perlito5::Grammar::Bareword
;
# use Perlito5::Grammar::Attribute
;
# use Perlito5::Grammar::Statement
;
Perlito5::Grammar::Precedence::add_term('my', sub {
Perlito5::Grammar::Expression->term_declarator($_[0], $_[1])
});
Perlito5::Grammar::Precedence::add_term('our', sub {
Perlito5::Grammar::Expression->term_declarator($_[0], $_[1])
});
Perlito5::Grammar::Precedence::add_term('eval', sub {
Perlito5::Grammar::Expression->term_eval($_[0], $_[1])
});
Perlito5::Grammar::Precedence::add_term('state', sub {
Perlito5::Grammar::Expression->term_declarator($_[0], $_[1])
});
Perlito5::Grammar::Precedence::add_term('local', sub {
Perlito5::Grammar::Expression->term_local($_[0], $_[1])
});
Perlito5::Grammar::Precedence::add_term('return', sub {
Perlito5::Grammar::Expression->term_return($_[0], $_[1])
});
sub Perlito5::Grammar::Expression::expand_list {
my $param_list = shift();
if (((ref($param_list) eq 'Perlito5::AST::Apply') && ($param_list->code() eq 'list:<,>'))) {
my $args = [];
for my $v (@{$param_list->arguments()}) {
if (defined($v)) {
push(@{$args}, $v)
}
};
return $args
}
else {
if (($param_list eq '*undef*')) {
return []
}
else {
return [$param_list]
}
}
};
sub Perlito5::Grammar::Expression::block_or_hash {
my $o = shift();
if (defined($o->sig())) {
return $o
};
my $stmts = $o->stmts();
if ((!((defined($stmts))) || (scalar(@{$stmts}) == 0))) {
return Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', [])
};
if ((scalar(@{$stmts}) != 1)) {
return $o
};
my $stmt = $stmts->[0];
if ((ref($stmt) eq 'Perlito5::AST::Var')) {
return Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', [$stmt])
};
if ((ref($stmt) ne 'Perlito5::AST::Apply')) {
return $o
};
if (($stmt->code() eq 'infix:<=>>')) {
return Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', [$stmt])
};
if (($stmt->code() ne 'list:<,>')) {
return $o
};
return Perlito5::AST::Apply->new('code', 'circumfix:<{ }>', 'namespace', '', 'arguments', expand_list($stmt))
};
sub Perlito5::Grammar::Expression::pop_term {
my $num_stack = shift();
my $v = pop(@{$num_stack});
if ((ref($v) eq 'ARRAY')) {
if (($v->[1] eq 'methcall_no_params')) {
$v = Perlito5::AST::Call->new('invocant', undef(), 'method', $v->[2], 'arguments', []);
return $v
};
if (($v->[1] eq 'funcall_no_params')) {
$v = Perlito5::AST::Apply->new('code', $v->[3], 'namespace', $v->[2], 'arguments', [], 'bareword', 1);
return $v
};
if (($v->[1] eq 'methcall')) {
my $param_list = expand_list(($v->[3]));
$v = Perlito5::AST::Call->new('invocant', undef(), 'method', $v->[2], 'arguments', $param_list);
return $v
};
if (($v->[1] eq 'funcall')) {
my $param_list = expand_list(($v->[4]));
$v = Perlito5::AST::Apply->new('code', $v->[3], 'arguments', $param_list, 'namespace', $v->[2]);
return $v
};
if (($v->[1] eq '( )')) {
my $param_list = expand_list($v->[2]);
$v = Perlito5::AST::Apply->new('code', 'circumfix:<( )>', 'arguments', $param_list, 'namespace', '');
return $v
};
if (($v->[1] eq '[ ]')) {
my $param_list = expand_list($v->[2]);
$v = Perlito5::AST::Apply->new('code', 'circumfix:<[ ]>', 'arguments', $param_list, 'namespace', '');
return $v
};
if (($v->[1] eq 'block')) {
$v = Perlito5::AST::Lit::Block->new('stmts', $v->[2], 'sig', $v->[3]);
$v = block_or_hash($v);
return $v
};
if (($v->[1] eq '.( )')) {
$v = Perlito5::AST::Call->new('invocant', undef(), 'method', 'postcircumfix:<( )>', 'arguments', $v->[2]);
return $v
};
if (($v->[1] eq '.[ ]')) {
$v = Perlito5::AST::Index->new('obj', undef(), 'index_exp', $v->[2]);
return $v
};
if (($v->[1] eq '.{ }')) {
$v = Perlito5::AST::Lookup->new('obj', undef(), 'index_exp', $v->[2]);
return $v
};
return $v->[1]
};
return $v
};
sub Perlito5::Grammar::Expression::reduce_postfix {
my $op = shift();
my $value = shift();
my $v = $op;
if (($v->[1] eq 'methcall_no_params')) {
$v = Perlito5::AST::Call->new('invocant', $value, 'method', $v->[2], 'arguments', []);
return $v
};
if (($v->[1] eq 'funcall_no_params')) {
die('unexpected function call')
};
if (($v->[1] eq 'methcall')) {
my $param_list = expand_list($v->[3]);
$v = Perlito5::AST::Call->new('invocant', $value, 'method', $v->[2], 'arguments', $param_list);
return $v
};
if (($v->[1] eq 'funcall')) {
die('unexpected function call')
};
if (($v->[1] eq '( )')) {
my $param_list = expand_list($v->[2]);
if (((ref($value) eq 'Perlito5::AST::Apply') && !((defined($value->arguments()))))) {
$value->{'arguments'} = $param_list;
return $value
};
if (((ref($value) eq 'Perlito5::AST::Call') && !((defined($value->arguments()))))) {
$value->{'arguments'} = $param_list;
return $value
};
$v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<( )>', 'arguments', $param_list);
return $v
};
if (($v->[1] eq '[ ]')) {
$v = Perlito5::AST::Index->new('obj', $value, 'index_exp', $v->[2]);
return $v
};
if (($v->[1] eq 'block')) {
$v = Perlito5::AST::Lookup->new('obj', $value, 'index_exp', ($v->[2])->[0]);
return $v
};
if (($v->[1] eq '.( )')) {
my $param_list = expand_list($v->[2]);
$v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<( )>', 'arguments', $param_list);
return $v
};
if (($v->[1] eq '.[ ]')) {
$v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<[ ]>', 'arguments', $v->[2]);
return $v
};
if (($v->[1] eq '.{ }')) {
$v = Perlito5::AST::Call->new('invocant', $value, 'method', 'postcircumfix:<{ }>', 'arguments', $v->[2]);
return $v
};
push(@{$op}, $value);
return $op
};
my $reduce_to_ast = sub {
my $op_stack = shift();
my $num_stack = shift();
my $last_op = shift(@{$op_stack});
if (($last_op->[0] eq 'prefix')) {
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('prefix:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack)]))
}
else {
if (($last_op->[0] eq 'postfix')) {
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('postfix:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack)]))
}
else {
if (($last_op->[0] eq 'postfix_or_term')) {
push(@{$num_stack}, reduce_postfix($last_op, pop_term($num_stack)))
}
else {
if (Perlito5::Grammar::Precedence::is_assoc_type('list', $last_op->[1])) {
my $arg;
if ((scalar(@{$num_stack}) < 2)) {
my $v2 = pop_term($num_stack);
if (((ref($v2) eq 'Perlito5::AST::Apply') && ($v2->code() eq (('list:<' . $last_op->[1] . '>'))))) {
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', $v2->namespace(), 'code', $v2->code(), 'arguments', [@{$v2->arguments()}, undef()]))
}
else {
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('list:<' . $last_op->[1] . '>'), 'arguments', [$v2, undef()]))
};
return
}
else {
my $v2 = pop_term($num_stack);
$arg = [pop_term($num_stack), $v2]
};
if ((((ref($arg->[0]) eq 'Perlito5::AST::Apply') && ($last_op->[0] eq 'infix')) && (($arg->[0]->code() eq ('list:<' . $last_op->[1] . '>'))))) {
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ($arg->[0])->code(), 'arguments', [@{($arg->[0])->arguments()}, $arg->[1]]));
return
};
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('list:<' . $last_op->[1] . '>'), 'arguments', $arg))
}
else {
if (Perlito5::Grammar::Precedence::is_assoc_type('chain', $last_op->[1])) {
if ((scalar(@{$num_stack}) < 2)) {
die(('Missing value after operator ' . $last_op->[1]))
};
my $v2 = pop_term($num_stack);
my $arg = [pop_term($num_stack), $v2];
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('infix:<' . $last_op->[1] . '>'), 'arguments', $arg))
}
else {
if (($last_op->[0] eq 'ternary')) {
if ((scalar(@{$num_stack}) < 2)) {
die('Missing value after ternary operator')
};
my $v2 = pop_term($num_stack);
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('ternary:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack), $last_op->[2], $v2]))
}
else {
if ((scalar(@{$num_stack}) < 2)) {
die(('missing value after operator ' . chr(39) . $last_op->[1] . chr(39)))
};
my $v2 = pop_term($num_stack);
push(@{$num_stack}, Perlito5::AST::Apply->new('namespace', '', 'code', ('infix:<' . $last_op->[1] . '>'), 'arguments', [pop_term($num_stack), $v2]))
}
}
}
}
}
}
};
sub Perlito5::Grammar::Expression::term_arrow {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = ((((((('->' eq substr($str, $MATCH->{'to'}, 2)) && ($MATCH->{'to'} = (2 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
((((((do {
(((((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->paren_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'paren_parse'} = $m2;
1
}
else {
0
}
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', '.( )', Perlito5::Match::flat($MATCH->{'paren_parse'})];
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((((((('[' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->square_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'square_parse'} = $m2;
1
}
else {
0
}
}))) && (((']' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', '.[ ]', Perlito5::Match::flat($MATCH->{'square_parse'})];
1
}))))
}))) || ((do {
$MATCH->{'to'} = $pos1;
((((((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->curly_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'curly_parse'} = $m2;
1
}
else {
0
}
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', '.{ }', Perlito5::Match::flat($MATCH->{'curly_parse'})];
1
}))))
}))) || ((do {
$MATCH->{'to'} = $pos1;
((((((('$' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar->ident($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.ident'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
(((((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->paren_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'paren_parse'} = $m2;
1
}
else {
0
}
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', 'methcall', Perlito5::AST::Var->new('sigil', '$', 'namespace', '', 'name', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.ident'})), Perlito5::Match::flat($MATCH->{'paren_parse'})];
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', 'methcall_no_params', Perlito5::AST::Var->new('sigil', '$', 'namespace', '', 'name', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.ident'}))];
1
}))
})))
}))))
}))) || ((do {
$MATCH->{'to'} = $pos1;
(((((do {
my $m2 = Perlito5::Grammar->full_ident($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.full_ident'} = $m2;
1
}
else {
0
}
})) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
(((((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->paren_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'paren_parse'} = $m2;
1
}
else {
0
}
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', 'methcall', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'}), Perlito5::Match::flat($MATCH->{'paren_parse'})];
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', 'methcall_no_params', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.full_ident'})];
1
}))
})))
}))))
})))
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_ternary {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((('?' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->ternary5_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'ternary5_parse'} = $m2;
1
}
else {
0
}
}))) && (((':' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['op', '? :', Perlito5::Match::flat($MATCH->{'ternary5_parse'})];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_paren {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->paren_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'paren_parse'} = $m2;
1
}
else {
0
}
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', '( )', Perlito5::Match::flat($MATCH->{'paren_parse'})];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_square {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((('[' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m2 = $grammar->square_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'square_parse'} = $m2;
1
}
else {
0
}
}))) && (((']' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', '[ ]', Perlito5::Match::flat($MATCH->{'square_parse'})];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_curly {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
my $m = $MATCH;
if (!(((do {
my $m2 = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})))) {
$MATCH = $m
};
1
}))) && ((do {
my $m2 = Perlito5::Grammar->exp_stmts($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp_stmts'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m = $MATCH;
if (!(((do {
my $m2 = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})))) {
$MATCH = $m
};
1
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['postfix_or_term', 'block', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.exp_stmts'})];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::declarator {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((do {
my $pos1 = $MATCH->{'to'};
((((do {
(('my' eq substr($str, $MATCH->{'to'}, 2)) && ($MATCH->{'to'} = (2 + $MATCH->{'to'})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((('state' eq substr($str, $MATCH->{'to'}, 5)) && ($MATCH->{'to'} = (5 + $MATCH->{'to'}))))
}))) || ((do {
$MATCH->{'to'} = $pos1;
((('our' eq substr($str, $MATCH->{'to'}, 3)) && ($MATCH->{'to'} = (3 + $MATCH->{'to'}))))
})))
})));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_declarator {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((((do {
my $m2 = $grammar->declarator($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'declarator'} = $m2;
1
}
else {
0
}
})) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
(((do {
my $m2 = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((do {
my $m2 = Perlito5::Grammar->opt_type($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.opt_type'} = $m2;
1
}
else {
0
}
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
1
})))
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->var_ident($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.var_ident'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Attribute->opt_attribute($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Attribute.opt_attribute'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
my $decl = Perlito5::Match::flat($MATCH->{'declarator'});
my $type = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.opt_type'});
die(('No such class ' . $type)) if ($type && !($Perlito5::PACKAGES->{$type}));
my $var = $MATCH->{'Perlito5::Grammar.var_ident'}->{'capture'};
$MATCH->{'capture'} = ['term', Perlito5::AST::Decl->new('decl', $decl, 'type', $type, 'var', $var, 'attributes', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Attribute.opt_attribute'}))];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_local {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((('local' eq substr($str, $MATCH->{'to'}, 5)) && ($MATCH->{'to'} = (5 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->var_ident($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.var_ident'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
my $decl = 'local';
my $type = '';
$MATCH = Perlito5::Grammar::String->double_quoted_var_with_subscript($MATCH->{'Perlito5::Grammar.var_ident'});
my $var = $MATCH->{'capture'};
$MATCH->{'capture'} = ['term', Perlito5::AST::Decl->new('decl', $decl, 'type', $type, 'var', $var)];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_return {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((('return' eq substr($str, $MATCH->{'to'}, 6)) && ($MATCH->{'to'} = (6 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = $grammar->list_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'list_parse'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
my $args = Perlito5::Match::flat($MATCH->{'list_parse'});
$MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('code', 'return', 'arguments', (($args eq '*undef*') ? [] : [$args]), 'namespace', '')];
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::Expression::term_eval {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = ((((((((('eval' eq substr($str, $MATCH->{'to'}, 4)) && ($MATCH->{'to'} = (4 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $tmp = $MATCH;
$MATCH = {'str', $str, 'from', $tmp->{'to'}, 'to', $tmp->{'to'}};
my $res = ((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))));
$MATCH = ($res ? $tmp : 0)
}))) && ((do {
my $m2 = $grammar->term_curly($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'term_curly'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = ['term', Perlito5::AST::Apply->new('code', 'eval', 'arguments', [Perlito5::AST::Do->new('block', Perlito5::AST::Lit::Block->new('stmts', Perlito5::Match::flat($MATCH->{'term_curly'})->[2]))], 'namespace', '')];
1
})))));
($tmp ? $MATCH : 0)
};
my $Argument_end_token = {':', 1, ']', 1, ')', 1, '}', 1, ';', 1, ',', 1, '<', 1, '>', 1, '=', 1, '|', 1, '^', 1, '?', 1, 'or', 1, 'if', 1, '=>', 1, 'lt', 1, 'le', 1, 'gt', 1, 'ge', 1, '<=', 1, '>=', 1, '==', 1, '!=', 1, 'ne', 1, 'eq', 1, '..', 1, '~~', 1, '&&', 1, '||', 1, '+=', 1, '-=', 1, '*=', 1, '/=', 1, 'x=', 1, '|=', 1, '&=', 1, '.=', 1, '^=', 1, '%=', 1, '//', 1, 'for', 1, 'and', 1, 'xor', 1, '...', 1, '<=>', 1, 'cmp', 1, '<<=', 1, '>>=', 1, '||=', 1, '&&=', 1, '//=', 1, '**=', 1, 'when', 1, 'while', 1, 'unless', 1, 'foreach', 1};
my $Argument_end_token_chars = [7, 6, 5, 4, 3, 2, 1];
my $List_end_token = {':', 1, ']', 1, ')', 1, '}', 1, ';', 1, 'or', 1, 'if', 1, 'for', 1, 'and', 1, 'xor', 1, 'else', 1, 'when', 1, 'while', 1, 'elsif', 1, 'unless', 1, 'foreach', 1};
my $List_end_token_chars = [7, 6, 5, 4, 3, 2, 1];
my $Expr_end_token = {']', 1, ')', 1, '}', 1, ';', 1, 'if', 1, 'for', 1, 'else', 1, 'when', 1, 'while', 1, 'elsif', 1, 'unless', 1, 'foreach', 1};
my $Expr_end_token_chars = [7, 6, 5, 4, 3, 2, 1];
sub Perlito5::Grammar::Expression::argument_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $expr;
my $last_pos = $pos;
my $is_first_token = 1;
my $lexer_stack = [];
my $last_token_was_space = 1;
my $get_token = sub {
my $last_is_term = $_[0];
my $v;
if (scalar(@{$lexer_stack})) {
$v = pop(@{$lexer_stack});
if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Grammar::Precedence::is_fixity_type('prefix', $v->[1]))))) {
$v->[0] = 'end'
}
}
else {
my $m = Perlito5::Grammar::Precedence->op_parse($str, $last_pos, $last_is_term);
if ($m) {
my $spc = Perlito5::Grammar::Space->ws($str, $m->{'to'});
if ($spc) {
$m->{'to'} = $spc->{'to'}
}
};
if (!($m)) {
return ['end', '*end*']
};
$v = $m->{'capture'};
if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Grammar::Precedence::is_fixity_type('prefix', $v->[1]))))) {
$v->[0] = 'end'
};
if (($v->[0] ne 'end')) {
$last_pos = $m->{'to'}
}
};
$last_token_was_space = (($v->[0] eq 'space'));
$is_first_token = 0;
return $v
};
my $prec = Perlito5::Grammar::Precedence->new('get_token', $get_token, 'reduce', $reduce_to_ast, 'end_token', $Argument_end_token, 'end_token_chars', $Argument_end_token_chars);
my $res = $prec->precedence_parse();
if ((scalar(@{$res}) == 0)) {
return {'str', $str, 'from', $pos, 'to', $last_pos, 'capture', '*undef*'}
};
my $result = pop_term($res);
return {'str', $str, 'from', $pos, 'to', $last_pos, 'capture', $result}
};
sub Perlito5::Grammar::Expression::list_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $expr;
my $last_pos = $pos;
my $is_first_token = 1;
my $lexer_stack = [];
my $last_token_was_space = 1;
my $get_token = sub {
my $last_is_term = $_[0];
my $v;
if (scalar(@{$lexer_stack})) {
$v = pop(@{$lexer_stack});
if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Grammar::Precedence::is_fixity_type('prefix', $v->[1]))))) {
$v->[0] = 'end'
}
}
else {
my $m = Perlito5::Grammar::Precedence->op_parse($str, $last_pos, $last_is_term);
if ($m) {
my $spc = Perlito5::Grammar::Space->ws($str, $m->{'to'});
if ($spc) {
$m->{'to'} = $spc->{'to'}
}
};
if (!($m)) {
return ['end', '*end*']
};
$v = $m->{'capture'};
if ((($is_first_token && (($v->[0] eq 'op'))) && !((Perlito5::Grammar::Precedence::is_fixity_type('prefix', $v->[1]))))) {
$v->[0] = 'end'
};
if (($v->[0] ne 'end')) {
$last_pos = $m->{'to'}
}
};
$last_token_was_space = (($v->[0] eq 'space'));
$is_first_token = 0;
return $v
};
my $prec = Perlito5::Grammar::Precedence->new('get_token', $get_token, 'reduce', $reduce_to_ast, 'end_token', $List_end_token, 'end_token_chars', $List_end_token_chars);
my $res = $prec->precedence_parse();
if ((scalar(@{$res}) == 0)) {
return {'str', $str, 'from', $pos, 'to', $last_pos, 'capture', '*undef*'}
};
my $result = pop_term($res);
return {'str', $str, 'from', $pos, 'to', $last_pos, 'capture', $result}
};
sub Perlito5::Grammar::Expression::circumfix_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $delimiter = $_[3];
my $expr;
my $last_pos = $pos;
my $get_token = sub {
my $last_is_term = $_[0];
my $m = Perlito5::Grammar::Precedence->op_parse($str, $last_pos, $last_is_term);
if ($m) {
my $spc = Perlito5::Grammar::Space->ws($str, $m->{'to'});
if ($spc) {
$m->{'to'} = $spc->{'to'}
}
};
if (!($m)) {
die('Expected closing delimiter: ', $delimiter, ' near ', $last_pos)
};
my $v = $m->{'capture'};
if (($v->[0] ne 'end')) {
$last_pos = $m->{'to'}
};
return $v
};
my %delim_token;
$delim_token{$delimiter} = 1;
my $prec = Perlito5::Grammar::Precedence->new('get_token', $get_token, 'reduce', $reduce_to_ast, 'end_token', \%delim_token, 'end_token_chars', [length($delimiter)]);
my $res = $prec->precedence_parse();
$res = pop_term($res);
if (!((defined($res)))) {
$res = '*undef*'
};
return {'str', $str, 'from', $pos, 'to', $last_pos, 'capture', $res}
};
sub Perlito5::Grammar::Expression::ternary5_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
return $self->circumfix_parse($str, $pos, ':')
};
sub Perlito5::Grammar::Expression::curly_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
return $self->circumfix_parse($str, $pos, '}')
};
sub Perlito5::Grammar::Expression::square_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
return $self->circumfix_parse($str, $pos, ']')
};
sub Perlito5::Grammar::Expression::paren_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
return $self->circumfix_parse($str, $pos, ')')
};
sub Perlito5::Grammar::Expression::exp_parse {
my $self = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $expr;
my $last_pos = $pos;
my $lexer_stack = [];
my $get_token = sub {
my $last_is_term = $_[0];
my $v;
if (scalar(@{$lexer_stack})) {
$v = pop(@{$lexer_stack})
}
else {
my $m = Perlito5::Grammar::Precedence->op_parse($str, $last_pos, $last_is_term);
if ($m) {
my $spc = Perlito5::Grammar::Space->ws($str, $m->{'to'});
if ($spc) {
$m->{'to'} = $spc->{'to'}
}
};
if (!($m)) {
return ['end', '*end*']
};
$v = $m->{'capture'};
if (($v->[0] ne 'end')) {
$last_pos = $m->{'to'}
}
};
return $v
};
my $prec = Perlito5::Grammar::Precedence->new('get_token', $get_token, 'reduce', $reduce_to_ast, 'end_token', $Expr_end_token, 'end_token_chars', $Expr_end_token_chars);
my $res = $prec->precedence_parse();
if ((scalar(@{$res}) == 0)) {
return 0
};
my $result = pop_term($res);
return {'str', $str, 'from', $pos, 'to', $last_pos, 'capture', $result}
};
1;
;
# use Perlito5::Grammar::Expression
;
package main;
package Perlito5::Grammar;
# use strict
;
# use Perlito5::Grammar::Expression
;
Perlito5::Grammar::Statement::add_statement('if', sub {
Perlito5::Grammar->if($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('for', sub {
Perlito5::Grammar->for($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('foreach', sub {
Perlito5::Grammar->for($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('when', sub {
Perlito5::Grammar->when($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('while', sub {
Perlito5::Grammar->while($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('given', sub {
Perlito5::Grammar->given($_[0], $_[1])
});
Perlito5::Grammar::Statement::add_statement('unless', sub {
Perlito5::Grammar->unless($_[0], $_[1])
});
sub Perlito5::Grammar::unless {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((((('unless' eq substr($str, $MATCH->{'to'}, 6)) && ($MATCH->{'to'} = (6 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_paren($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_paren'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_curly($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_curly'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
((((((((((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((('else' eq substr($str, $MATCH->{'to'}, 4)) && ($MATCH->{'to'} = (4 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->exp_stmts($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp_stmts'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
my $body = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_curly'})->[2];
if (!(defined($body))) {
die('Missing code block in ' . chr(39) . 'if' . chr(39))
};
$MATCH->{'capture'} = Perlito5::AST::If->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_paren'})->[2], 'body', Perlito5::AST::Lit::Block->new('stmts', (Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.exp_stmts'}) || [])), 'otherwise', Perlito5::AST::Lit::Block->new('stmts', $body));
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((do {
$MATCH->{'str'} = $str;
my $body = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_curly'})->[2];
if (!(defined($body))) {
die('Missing code block in ' . chr(39) . 'unless' . chr(39))
};
$MATCH->{'capture'} = Perlito5::AST::If->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_paren'})->[2], 'body', Perlito5::AST::Lit::Block->new('stmts', []), 'otherwise', Perlito5::AST::Lit::Block->new('stmts', $body));
1
}))
})))
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::if {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((((('if' eq substr($str, $MATCH->{'to'}, 2)) && ($MATCH->{'to'} = (2 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_paren($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_paren'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_curly($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_curly'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
((((do {
((((((((((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((('else' eq substr($str, $MATCH->{'to'}, 4)) && ($MATCH->{'to'} = (4 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->exp_stmts($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp_stmts'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
$MATCH->{'str'} = $str;
my $body = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_curly'})->[2];
if (!(defined($body))) {
die('Missing code block in ' . chr(39) . 'if' . chr(39))
};
$MATCH->{'capture'} = Perlito5::AST::If->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_paren'})->[2], 'body', Perlito5::AST::Lit::Block->new('stmts', $body), 'otherwise', Perlito5::AST::Lit::Block->new('stmts', (Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.exp_stmts'}) || [])));
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((((((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((('els' eq substr($str, $MATCH->{'to'}, 3)) && ($MATCH->{'to'} = (3 + $MATCH->{'to'}))))) && ((do {
my $m2 = $grammar->if($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'if'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
my $body = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_curly'})->[2];
if (!(defined($body))) {
die('Missing code block in ' . chr(39) . 'if' . chr(39))
};
$MATCH->{'capture'} = Perlito5::AST::If->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_paren'})->[2], 'body', Perlito5::AST::Lit::Block->new('stmts', $body), 'otherwise', Perlito5::AST::Lit::Block->new('stmts', [Perlito5::Match::flat($MATCH->{'if'})]));
1
}))))
}))) || ((do {
$MATCH->{'to'} = $pos1;
((do {
$MATCH->{'str'} = $str;
my $body = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_curly'})->[2];
if (!(defined($body))) {
die('Missing code block in ' . chr(39) . 'if' . chr(39))
};
$MATCH->{'capture'} = Perlito5::AST::If->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_paren'})->[2], 'body', Perlito5::AST::Lit::Block->new('stmts', $body), 'otherwise', Perlito5::AST::Lit::Block->new('stmts', []));
1
}))
})))
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::when {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((((('when' eq substr($str, $MATCH->{'to'}, 4)) && ($MATCH->{'to'} = (4 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_paren($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_paren'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Expression->term_curly($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_curly'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
my $body = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_curly'})->[2];
if (!(defined($body))) {
die('Missing code block in ' . chr(39) . 'when' . chr(39))
};
$MATCH->{'capture'} = Perlito5::AST::When->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_paren'})->[2], 'body', Perlito5::AST::Lit::Block->new('stmts', $body));
1
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::for {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = ((((((('for' eq substr($str, $MATCH->{'to'}, 3)) && ($MATCH->{'to'} = (3 + $MATCH->{'to'})))) && ((do {
my $m = $MATCH;
if (!(((('each' eq substr($str, $MATCH->{'to'}, 4)) && ($MATCH->{'to'} = (4 + $MATCH->{'to'})))))) {
$MATCH = $m
};
1
}))) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
((((((((((((((((do {
my $m2 = Perlito5::Grammar::Space->ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
(((do {
my $m2 = Perlito5::Grammar::Expression->term_declarator($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.term_declarator'} = $m2;
1
}
else {
0
}
})) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'_tmp'} = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.term_declarator'})->[1];
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((((do {
my $m2 = Perlito5::Grammar->var_ident($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.var_ident'} = $m2;
1
}
else {
0
}
})) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'_tmp'} = Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.var_ident'});
1
}))))
})))
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Expression->paren_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.paren_parse'} = $m2;
1
}
else {
0
}
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->exp_stmts($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp_stmts'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = $grammar->opt_continue_block($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'opt_continue_block'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'capture'} = Perlito5::AST::For->new('cond', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar::Expression.paren_parse'}), 'topic', undef(), 'body', Perlito5::AST::Lit::Block->new('stmts', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.exp_stmts'}), 'sig', $MATCH->{'_tmp'}), 'continue', $MATCH->{'opt_continue_block'}->{'capture'});
1
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
((((((((((((((((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
})) && ((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Expression->exp_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.exp_parse'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $pos1 = $MATCH->{'to'};
(((do {
(((((((';' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'})))) && ((do {
$MATCH->{'str'} = $str;
$MATCH->{'c_style_for'} = 1;
1
}))) && ((do {
my $pos1 = $MATCH->{'to'};
((((do {
my $m2 = Perlito5::Grammar->exp($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp'} = $m2;
1
}
else {
0
}
})) || ((do {
$MATCH->{'to'} = $pos1;
()
}))) || ((do {
$MATCH->{'to'} = $pos1;
((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))
})))
}))) && (((';' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $pos1 = $MATCH->{'to'};
((((do {
my $m2 = Perlito5::Grammar->exp2($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp2'} = $m2;
1
}
else {
0
}
})) || ((do {
$MATCH->{'to'} = $pos1;
()
}))) || ((do {
$MATCH->{'to'} = $pos1;
((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))
})))
})))
})) || ((do {
$MATCH->{'to'} = $pos1;
1
})))
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar->exp_stmts2($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar.exp_stmts2'} = $m2;
1
}
else {
0
}
}))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('}' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((do {
my $m2 = $grammar->opt_continue_block($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'opt_continue_block'} = $m2;
1
}
else {
0
}
}))) && ((do {
$MATCH->{'str'} = $str;
my $header;
if ($MATCH->{'c_style_for'}) {
$header = [$MATCH->{'Perlito5::Grammar::Expression.exp_parse'}->{'capture'}, $MATCH->{'Perlito5::Grammar.exp'}->{'capture'}, $MATCH->{'Perlito5::Grammar.exp2'}->{'capture'}]
}
else {
$header = $MATCH->{'Perlito5::Grammar::Expression.exp_parse'}->{'capture'}
};
$MATCH->{'capture'} = Perlito5::AST::For->new('cond', $header, 'topic', undef(), 'body', Perlito5::AST::Lit::Block->new('stmts', Perlito5::Match::flat($MATCH->{'Perlito5::Grammar.exp_stmts2'}), 'sig', undef()), 'continue', $MATCH->{'opt_continue_block'}->{'capture'});
1
}))))
})))
})))));
($tmp ? $MATCH : 0)
};
sub Perlito5::Grammar::while {
my $grammar = $_[0];
my $str = $_[1];
my $pos = $_[2];
my $MATCH = {'str', $str, 'from', $pos, 'to', $pos};
my $tmp = (((((((((((((((((('while' eq substr($str, $MATCH->{'to'}, 5)) && ($MATCH->{'to'} = (5 + $MATCH->{'to'})))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('(' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Expression->paren_parse($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
$MATCH->{'Perlito5::Grammar::Expression.paren_parse'} = $m2;
1
}
else {
0
}
}))) && (((')' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {
$MATCH->{'to'} = $m2->{'to'};
1
}
else {
0
}
}))) && ((('{' eq substr($str, $MATCH->{'to'}, 1)) && ($MATCH->{'to'} = (1 + $MATCH->{'to'}))))) && ((do {
my $m2 = Perlito5::Grammar::Space->opt_ws($str, $MATCH->{'to'});
if ($m2) {