# Do not edit this file - Generated by Perlito 7.0 use v5; use utf8; use strict; use warnings; no warnings ('redefine', 'once', 'void', 'uninitialized', 'misc', 'recursion'); use Perlito::Perl5::Runtime; use Perlito::Perl5::Prelude; our $MATCH = Perlito::Match->new(); { package GLOBAL; sub new { shift; bless { @_ }, "GLOBAL" } { package Perlito::Precedence; sub new { shift; bless { @_ }, "Perlito::Precedence" } sub get_token { $_[0]->{get_token} }; sub reduce { $_[0]->{reduce} }; sub end_token { $_[0]->{end_token} }; ((my $Operator) = do { (my $Hash_a = bless {}, 'HASH'); $Hash_a }); ((my $Precedence) = do { (my $Hash_a = bless {}, 'HASH'); $Hash_a }); ((my $Assoc) = do { (my $Hash_a = bless {}, 'HASH'); $Hash_a }); ((my $Allow_space_before) = do { (my $Hash_a = bless {}, 'HASH'); $Hash_a }); sub is_assoc_type { my $assoc_type = $_[0]; my $op_name = $_[1]; return scalar ($Assoc->{$assoc_type}->{$op_name}) }; sub is_fixity_type { my $fixity_type = $_[0]; my $op_name = $_[1]; return scalar ($Operator->{$fixity_type}->{$op_name}) }; sub is_term { my $token = $_[0]; ((($token->[0] eq 'term')) || (($token->[0] eq 'postfix_or_term'))) }; sub is_ident_middle { my $c = $_[0]; (((((($c ge 'a')) && (($c le 'z')))) || (((($c ge '0')) && (($c le '9'))))) || (($c eq '_'))) }; (my $List_Op = bless [], 'ARRAY'); (my $End_token); ((my $List_Op_chars = bless [], 'ARRAY') = do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); push( @{$List_a}, 3 ); push( @{$List_a}, 2 ); push( @{$List_a}, 1 ); $List_a }); sub op_parse { my $self = $_[0]; my $str = $_[1]; my $pos = $_[2]; ((my $from) = $pos); for my $tok ( @{(($End_token))} ) { ((my $l) = Main::chars($tok, )); ((my $s) = substr($str, $pos, $l)); if (($s eq $tok)) { ((my $c1) = substr($str, (($pos + $l) - 1), 1)); ((my $c2) = substr($str, ($pos + $l), 1)); if ((is_ident_middle($c1) && ((is_ident_middle($c2) || ($c2 eq '('))))) { } else { return scalar (Perlito::Match->new(('str' => $str), ('from' => $from), ('to' => ($pos + 2)), ('bool' => 1), ('capture' => do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); push( @{$List_a}, 'end' ); push( @{$List_a}, $s ); $List_a }))) } } }; ((my $c01) = substr($str, $pos, 1)); ((my $c02) = substr($str, $pos, 2)); ((my $hyper_left) = 0); ((my $hyper_right) = 0); if (((($c01 eq chr(171))) || (($c01 eq chr(187))))) { ($hyper_left = $c01); ($pos = ($pos + 1)); ($c02 = substr($str, $pos, 2)) } else { if (((($c02 eq '<<')) || (($c02 eq '>>')))) { ($hyper_left = $c02); ($pos = ($pos + 2)); ($c02 = substr($str, $pos, 2)) } }; for my $len ( @{$List_Op_chars} ) { ((my $op) = substr($str, $pos, $len)); if (exists($List_Op->[$len]->{$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) || ($c2 eq '('))))) { } else { ($pos = ($pos + $len)); ((my $c01) = substr($str, $pos, 1)); ((my $c02) = substr($str, $pos, 2)); if (((($c01 eq chr(171))) || (($c01 eq chr(187))))) { ($hyper_right = $c01); ($pos = ($pos + 1)) } else { if (((($c02 eq '<<')) || (($c02 eq '>>')))) { ($hyper_right = $c02); ($pos = ($pos + 2)) } }; return scalar (Perlito::Match->new(('str' => $str), ('from' => $from), ('to' => $pos), ('bool' => 1), ('capture' => do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); push( @{$List_a}, 'op' ); push( @{$List_a}, $op ); push( @{$List_a}, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'hyper_left'} = $hyper_left); ($Hash_a->{'hyper_right'} = $hyper_right); $Hash_a } ); $List_a }))) } } }; return scalar (Perlito::Match->new(('bool' => 0))) }; sub add_op { my $fixity = $_[0]; my $name = $_[1]; my $precedence = $_[2]; my $param = $_[3]; if (!((defined($param)))) { ($param = do { (my $Hash_a = bless {}, 'HASH'); $Hash_a }) }; ((my $assoc) = ($param->{'assoc'} || 'left')); ($Operator->{$fixity}->{$name} = 1); ($Precedence->{$name} = $precedence); ($Assoc->{$assoc}->{$name} = 1); ($Allow_space_before->{$fixity}->{$name} = ($param->{'no_space_before'} ? 0 : 1)); ($List_Op->[Main::chars($name, )]->{$name} = 1) }; ((my $prec) = 100); add_op('postfix', '.( )', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', '.[ ]', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', '.' . chr(123) . ' ' . chr(125), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', '( )', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', '[ ]', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', 'funcall', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', 'funcall_no_params', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', 'methcall', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', 'methcall_no_params', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', 'block', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', 'hash', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); ($prec = ($prec - 1)); add_op('prefix', '++', $prec); add_op('prefix', '--', $prec); add_op('postfix', '++', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); add_op('postfix', '--', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'no_space_before'} = 1); $Hash_a }); ($prec = ($prec - 1)); add_op('infix', '**', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); ($prec = ($prec - 1)); add_op('prefix', '+', $prec); add_op('prefix', '-', $prec); add_op('prefix', chr(36), $prec); add_op('prefix', chr(64), $prec); add_op('prefix', chr(37), $prec); add_op('prefix', chr(33), $prec); add_op('prefix', chr(63), $prec); ($prec = ($prec - 1)); add_op('infix', '*', $prec); add_op('infix', chr(47), $prec); ($prec = ($prec - 1)); add_op('infix', '+', $prec); add_op('infix', '-', $prec); ($prec = ($prec - 1)); add_op('infix', 'x', $prec); add_op('infix', 'xx', $prec); ($prec = ($prec - 1)); add_op('infix', chr(126), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'list'); $Hash_a }); add_op('prefix', chr(126), $prec); ($prec = ($prec - 1)); add_op('infix', chr(38), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'list'); $Hash_a }); add_op('prefix', chr(38), $prec); ($prec = ($prec - 1)); add_op('infix', chr(124), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'list'); $Hash_a }); add_op('prefix', chr(124), $prec); ($prec = ($prec - 1)); add_op('infix', '<' . chr(61) . '>', $prec); add_op('infix', 'leg', $prec); add_op('infix', 'cmp', $prec); add_op('infix', 'does', $prec); add_op('infix', 'but', $prec); add_op('infix', '..', $prec); add_op('infix', chr(94) . '..', $prec); add_op('infix', '..' . chr(94), $prec); add_op('infix', chr(94) . '..' . chr(94), $prec); ($prec = ($prec - 1)); add_op('infix', chr(61) . chr(61) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', 'ne', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', 'eq', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', 'lt', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', 'le', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', 'gt', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', 'ge', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', '<' . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', '>' . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', chr(61) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', chr(33) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', '<', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', '>', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); add_op('infix', chr(126) . chr(126), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'chain'); $Hash_a }); ($prec = ($prec - 1)); add_op('infix', chr(38) . chr(38), $prec); ($prec = ($prec - 1)); add_op('infix', chr(124) . chr(124), $prec); add_op('infix', chr(47) . chr(47), $prec); ($prec = ($prec - 1)); add_op('ternary', chr(63) . chr(63) . ' ' . chr(33) . chr(33), $prec); ($prec = ($prec - 1)); add_op('infix', chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', ':' . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(124) . chr(124) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(38) . chr(38) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(124) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(38) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(47) . chr(47) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', '+' . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', '-' . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', '*' . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(47) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); add_op('infix', chr(126) . chr(61), $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'right'); $Hash_a }); ($prec = ($prec - 1)); add_op('prefix', 'not', $prec); ($prec = ($prec - 1)); add_op('infix', chr(61) . '>', $prec); ($prec = ($prec - 1)); add_op('list', ',', $prec, do { (my $Hash_a = bless {}, 'HASH'); ($Hash_a->{'assoc'} = 'list'); $Hash_a }); ($prec = ($prec - 1)); add_op('infix', 'and', $prec); ($prec = ($prec - 1)); add_op('infix', 'or', $prec); ($prec = ($prec - 1)); add_op('infix', '*start*', $prec); sub precedence_parse { my $self = $_[0]; ((my $get_token) = $self->get_token()); ((my $reduce) = $self->reduce()); ((my $last_end_token) = $End_token); ($End_token = $self->end_token()); ((my $op_stack) = do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); $List_a }); ((my $num_stack) = do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); $List_a }); ((my $last) = do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); push( @{$List_a}, 'op' ); push( @{$List_a}, '*start*' ); $List_a }); ((my $last_has_space) = 0); ((my $token) = $get_token->()); if ((($token->[0]) eq 'space')) { ($token = $get_token->()) }; for ( ; ((defined($token)) && (($token->[0] ne 'end'))); ) { if (((($token->[1] eq ',')) && (((($last->[1] eq '*start*')) || (($last->[1] eq ',')))))) { push( @{$num_stack}, do { (my $List_a = bless [], 'ARRAY'); (my $List_v = bless [], 'ARRAY'); push( @{$List_a}, 'term' ); push( @{$List_a}, undef() ); $List_a } ) }; if (($Operator->{'prefix'}->{$token->[1]} && (((($last->[1] eq '*start*')) || !((is_term($last))))))) { ($token->[0] = 'prefix'); unshift( @{$op_stack}, $token ) } else { if ((($Operator->{'postfix'}->{$token->[1]} && is_term($last)) && (($Allow_space_before->{'postfix'}->{$token->[1]} || !(($last_has_space)))))) { ((my $pr) = $Precedence->{$token->[1]}); for ( ; (scalar( @{$op_stack} ) && (($pr <= $Precedence->{($op_stack->[0])->[1]}))); ) { $reduce->($op_stack, $num_stack) }; if ((($token->[0]) ne 'postfix_or_term')) { ($token->[0] = 'postfix') }; unshift( @{$op_stack}, $token ) } else { if ((((($token->[1] eq 'block')) && is_term($last)) && $last_has_space)) { for ( ; scalar( @{$op_stack} ); ) { $reduce->($op_stack, $num_stack) }; push( @{$num_stack}, $token ); ($End_token = $last_end_token); return scalar ($num_stack) } else { if (is_term($token)) { if (is_term($last)) { Main::say((chr(35) . ' last: '), Main::perl($last, )); Main::say((chr(35) . ' token: '), Main::perl($token, )); Main::say((chr(35) . ' space: '), $last_has_space); 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 < $Precedence->{($op_stack->[0])->[1]}))); ) { $reduce->($op_stack, $num_stack) } } else { for ( ; (scalar( @{$op_stack} ) && (($pr <= $Precedence->{($op_stack->[0])->[1]}))); ) { $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); ($token = $get_token->()); if (($token->[0] eq 'space')) { ($token = $get_token->()); ($last_has_space = 1) } else { ($last_has_space = 0) } }; if ((defined($token) && (($token->[0] ne 'end')))) { die(('Unexpected end token: '), Main::perl($token, )) }; for ( ; scalar( @{$op_stack} ); ) { $reduce->($op_stack, $num_stack) }; ($End_token = $last_end_token); return scalar ($num_stack) } } } 1;