######################################################################################## # # This file was generated using Parse::Eyapp version 1.21. # # Copyright © 2006, 2007, 2008, 2009, 2010, 2011, 2012 Casiano Rodriguez-Leon. # Copyright © 2017 William N. Braswell, Jr. # All Rights Reserved. # # Parse::Yapp is Copyright © 1998, 1999, 2000, 2001, Francois Desarmenien. # Parse::Yapp is Copyright © 2017 William N. Braswell, Jr. # All Rights Reserved. # # Don't edit this file, use source file 'lib/Parse/Eyapp/Treeregexp.yp' instead. # # ANY CHANGE MADE HERE WILL BE LOST ! # ######################################################################################## package Parse::Eyapp::Treeregparser; use strict; push @Parse::Eyapp::Treeregparser::ISA, 'Parse::Eyapp::Driver'; BEGIN { # This strange way to load the modules is to guarantee compatibility when # using several standalone and non-standalone Eyapp parsers require Parse::Eyapp::Driver unless Parse::Eyapp::Driver->can('YYParse'); require Parse::Eyapp::Node unless Parse::Eyapp::Node->can('hnew'); } sub unexpendedInput { defined($_) ? substr($_, (defined(pos $_) ? pos $_ : 0)) : '' } use Carp; use Data::Dumper; our $VERSION = $Parse::Eyapp::Driver::VERSION; my $debug = 0; # comment $Data::Dumper::Indent = 1; # %times: Hash indexed in the variables: stores the number of # appearances in the treereg formula my %times = (); my ($tokenbegin, $tokenend); my $filename; # Name of the input file { # closure for $numstar: support code for * treeregexes my $numstar = -1; # Number of stars in treereg formula sub new_star { $numstar++; return "W_$numstar"; } sub reset_times { %times = (); $numstar = -1; # New formula } } # treereg: IDENT '(' childlist ')' ('and' CODE)? sub new_ident_inner { my ($id, $line) = @{$_[1]}; my ($semantic) = $_[5]->children; my $node = $_[3]; $times{$id}++; $node->{id} = $id; $node->{line} = $line; $node->{semantic} = $semantic? $semantic->{attr} : undef; return (bless $node, 'Parse::Eyapp::Treeregexp::IDENT_INNER'); } # treereg: REGEXP (':' IDENT)? '(' childlist ')' ('and' CODE)? sub new_regexp_inner { my $node = $_[4]; my $line = $_[1][1]; my $id; # $W and @W are default variables for REGEXPs if ( $_[2]->children) { $id = $_[2]->child(0)->{attr}[0]; } else { $id = 'W'; } $times{$id}++; $node->{id} = $id; $node->{line} = $line; $node->{regexp} = $_[1][0]; $node->{options} = $_[1][2]; my ($semantic) = $_[6]->children; $node->{semantic} = $semantic? $semantic->{attr} : undef; return bless $node, 'Parse::Eyapp::Treeregexp::REGEXP_INNER'; } # treereg: SCALAR '(' childlist ')' ('and' CODE)? sub new_scalar_inner { my $node = $_[3]; my ($var, $line) = @{$_[1]}; $var =~ s/\$//; $times{$var}++; _SyntaxError('Repeated scalar in treereg', $_[1][1]) if $times{$var} > 1; _SyntaxError(q{Can't use $W to identify an scalar treeregexp}, $_[1][1]) if $var eq 'W'; $node->{id} = $var; $node->{line} = $line; my ($semantic) = $_[5]->children; $node->{semantic} = $semantic? $semantic->{attr} : undef; return (bless $node, 'Parse::Eyapp::Treeregexp::SCALAR_INNER'); } # treereg: : '.' '(' childlist ')' ('and' CODE)? sub new_dot_inner { my $node = $_[3]; my $line = $_[1][1]; my $var = 'W'; $times{$var}++; $node->{id} = $var; $node->{line} = $line; my ($semantic) = $_[5]->children; $node->{semantic} = $semantic? $semantic->{attr} : undef; return (bless $node, 'Parse::Eyapp::Treeregexp::SCALAR_INNER'); } # treereg: IDENT ('and' CODE)? sub new_ident_terminal { my $id = $_[1][0]; $times{$id}++; my ($semantic) = $_[2]->children; $semantic = $semantic? $semantic->{attr} : undef; return ( bless { children => [], attr => $id, semantic => $semantic }, 'Parse::Eyapp::Treeregexp::IDENT_TERMINAL' ); } # treereg: REGEXP (':' IDENT)? ('and' CODE)? sub new_regexp_terminal { # $regexp and @regexp are default variables for REGEXPs my $id; if ($_[2]->children) { $id = {$_[2]->child(0)}->{attr}[0]; } else { $id = 'W'; } $times{$id}++; my ($semantic) = $_[3]->children; $semantic = $semantic? $semantic->{attr} : undef; return bless { children => [], regexp => $_[1][0], options => $_[1][2], attr => $id, semantic => $semantic }, 'Parse::Eyapp::Treeregexp::REGEXP_TERMINAL' } # treereg: SCALAR ('and' CODE)? sub new_scalar_terminal { my $var = $_[1][0]; $var =~ s/\$//; $times{$var}++; _SyntaxError('Repeated scalar in treereg', $_[1][1]) if $times{$var} > 1; _SyntaxError(q{Can't use $W to identify an scalar treeregexp}, $_[1][1]) if $var eq 'W'; my ($semantic) = $_[2]->children; $semantic = $semantic? $semantic->{attr} : undef; return bless { children => [], attr => $var, semantic => $semantic }, 'Parse::Eyapp::Treeregexp::SCALAR_TERMINAL'; } # treereg: '.' ('and' CODE)? sub new_dot_terminal { # $W and @W are implicit variables for dots "." $times{'W'}++; my ($semantic) = $_[2]->children; $semantic = $semantic? $semantic->{attr} : undef; return bless { children => [], attr => 'W', semantic => $semantic }, 'Parse::Eyapp::Treeregexp::SCALAR_TERMINAL'; } # treereg: ARRAY sub new_array_terminal { my $var = $_[1][0]; $var =~ s/\@//; $times{$var} += 2; # awful trick so that fill_declarations works _SyntaxError( 'Repeated array in treereg', $_[1][1]) if $times{$var} > 2; _SyntaxError("Can't use $var to identify an array treeregexp", $_[1][1]) if $var =~ /^W(_\d+)?$/; return bless { children => [], attr => $var, }, 'Parse::Eyapp::Treeregexp::ARRAY_TERMINAL'; } # treereg: '*' sub new_array_star { # $wathever_#number and @wathever_#number are reserved for "*" my $var = new_star(); $times{$var} += 2; return bless { children => [], attr => $var, }, 'Parse::Eyapp::Treeregexp::ARRAY_TERMINAL'; } # Default lexical analyzer our $LEX = sub { my $self = shift; my $pos; for (${$self->input}) { m{\G(\s+)}gc and $self->tokenline($1 =~ tr{\n}{}); m{\G(and|\=\>|\(|\;|\,|\*|\.|\:|\)|\=)}gc and return ($1, $1); /\G(REGEXP)/gc and return ($1, $1); /\G(ARRAY)/gc and return ($1, $1); /\G(IDENT)/gc and return ($1, $1); /\G(SCALAR)/gc and return ($1, $1); /\G(CODE)/gc and return ($1, $1); return ('', undef) if ($_ eq '') || (defined(pos($_)) && (pos($_) >= length($_))); /\G\s*(\S+)/; my $near = substr($1,0,10); return($near, $near); # die( "Error inside the lexical analyzer near '". $near # ."'. Line: ".$self->line() # .". File: '".$self->YYFilename()."'. No match found.\n"); } } ; ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### my $warnmessage =<< "EOFWARN"; Warning!: Did you changed the \@Parse::Eyapp::Treeregparser::ISA variable inside the header section of the eyapp program? EOFWARN sub new { my($class)=shift; ref($class) and $class=ref($class); warn $warnmessage unless __PACKAGE__->isa('Parse::Eyapp::Driver'); my($self)=$class->SUPER::new( yyversion => '1.21', yyGRAMMAR => [#[productionNameAndLabel => lhs, [ rhs], bypass]] [ '_SUPERSTART' => '$start', [ 'treeregexplist', '$end' ], 0 ], [ '_STAR_LIST' => 'STAR-1', [ 'STAR-1', 'treeregexp' ], 0 ], [ '_STAR_LIST' => 'STAR-1', [ ], 0 ], [ 'treeregexplist_3' => 'treeregexplist', [ 'STAR-1' ], 0 ], [ '_PAREN' => 'PAREN-2', [ '=>', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-3', [ 'PAREN-2' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-3', [ ], 0 ], [ '_PLUS_LIST' => 'PLUS-4', [ 'PLUS-4', 'IDENT' ], 0 ], [ '_PLUS_LIST' => 'PLUS-4', [ 'IDENT' ], 0 ], [ 'treeregexp_9' => 'treeregexp', [ 'IDENT', ':', 'treereg', 'OPTIONAL-3' ], 0 ], [ 'treeregexp_10' => 'treeregexp', [ 'CODE' ], 0 ], [ 'treeregexp_11' => 'treeregexp', [ 'IDENT', '=', 'PLUS-4', ';' ], 0 ], [ 'treeregexp_12' => 'treeregexp', [ 'REGEXP' ], 0 ], [ '_PAREN' => 'PAREN-5', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-6', [ 'PAREN-5' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-6', [ ], 0 ], [ '_PAREN' => 'PAREN-7', [ ':', 'IDENT' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-8', [ 'PAREN-7' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-8', [ ], 0 ], [ '_PAREN' => 'PAREN-9', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-10', [ 'PAREN-9' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-10', [ ], 0 ], [ '_PAREN' => 'PAREN-11', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-12', [ 'PAREN-11' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-12', [ ], 0 ], [ '_PAREN' => 'PAREN-13', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-14', [ 'PAREN-13' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-14', [ ], 0 ], [ '_PAREN' => 'PAREN-15', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-16', [ 'PAREN-15' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-16', [ ], 0 ], [ '_PAREN' => 'PAREN-17', [ ':', 'IDENT' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-18', [ 'PAREN-17' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-18', [ ], 0 ], [ '_PAREN' => 'PAREN-19', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-20', [ 'PAREN-19' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-20', [ ], 0 ], [ '_PAREN' => 'PAREN-21', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-22', [ 'PAREN-21' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-22', [ ], 0 ], [ '_PAREN' => 'PAREN-23', [ 'and', 'CODE' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-24', [ 'PAREN-23' ], 0 ], [ '_OPTIONAL' => 'OPTIONAL-24', [ ], 0 ], [ 'treereg_43' => 'treereg', [ 'IDENT', '(', 'childlist', ')', 'OPTIONAL-6' ], 0 ], [ 'treereg_44' => 'treereg', [ 'REGEXP', 'OPTIONAL-8', '(', 'childlist', ')', 'OPTIONAL-10' ], 0 ], [ 'treereg_45' => 'treereg', [ 'SCALAR', '(', 'childlist', ')', 'OPTIONAL-12' ], 0 ], [ 'treereg_46' => 'treereg', [ '.', '(', 'childlist', ')', 'OPTIONAL-14' ], 0 ], [ 'treereg_47' => 'treereg', [ 'IDENT', 'OPTIONAL-16' ], 0 ], [ 'treereg_48' => 'treereg', [ 'REGEXP', 'OPTIONAL-18', 'OPTIONAL-20' ], 0 ], [ 'treereg_49' => 'treereg', [ 'SCALAR', 'OPTIONAL-22' ], 0 ], [ 'treereg_50' => 'treereg', [ '.', 'OPTIONAL-24' ], 0 ], [ 'treereg_51' => 'treereg', [ 'ARRAY' ], 0 ], [ 'treereg_52' => 'treereg', [ '*' ], 0 ], [ '_STAR_LIST' => 'STAR-25', [ 'STAR-25', ',', 'treereg' ], 0 ], [ '_STAR_LIST' => 'STAR-25', [ 'treereg' ], 0 ], [ '_STAR_LIST' => 'STAR-26', [ 'STAR-25' ], 0 ], [ '_STAR_LIST' => 'STAR-26', [ ], 0 ], [ 'childlist_57' => 'childlist', [ 'STAR-26' ], 0 ], ], yyLABELS => { '_SUPERSTART' => 0, '_STAR_LIST' => 1, '_STAR_LIST' => 2, 'treeregexplist_3' => 3, '_PAREN' => 4, '_OPTIONAL' => 5, '_OPTIONAL' => 6, '_PLUS_LIST' => 7, '_PLUS_LIST' => 8, 'treeregexp_9' => 9, 'treeregexp_10' => 10, 'treeregexp_11' => 11, 'treeregexp_12' => 12, '_PAREN' => 13, '_OPTIONAL' => 14, '_OPTIONAL' => 15, '_PAREN' => 16, '_OPTIONAL' => 17, '_OPTIONAL' => 18, '_PAREN' => 19, '_OPTIONAL' => 20, '_OPTIONAL' => 21, '_PAREN' => 22, '_OPTIONAL' => 23, '_OPTIONAL' => 24, '_PAREN' => 25, '_OPTIONAL' => 26, '_OPTIONAL' => 27, '_PAREN' => 28, '_OPTIONAL' => 29, '_OPTIONAL' => 30, '_PAREN' => 31, '_OPTIONAL' => 32, '_OPTIONAL' => 33, '_PAREN' => 34, '_OPTIONAL' => 35, '_OPTIONAL' => 36, '_PAREN' => 37, '_OPTIONAL' => 38, '_OPTIONAL' => 39, '_PAREN' => 40, '_OPTIONAL' => 41, '_OPTIONAL' => 42, 'treereg_43' => 43, 'treereg_44' => 44, 'treereg_45' => 45, 'treereg_46' => 46, 'treereg_47' => 47, 'treereg_48' => 48, 'treereg_49' => 49, 'treereg_50' => 50, 'treereg_51' => 51, 'treereg_52' => 52, '_STAR_LIST' => 53, '_STAR_LIST' => 54, '_STAR_LIST' => 55, '_STAR_LIST' => 56, 'childlist_57' => 57, }, yyTERMS => { '' => { ISSEMANTIC => 0 }, '(' => { ISSEMANTIC => 0 }, ')' => { ISSEMANTIC => 0 }, '*' => { ISSEMANTIC => 0 }, ',' => { ISSEMANTIC => 0 }, '.' => { ISSEMANTIC => 0 }, ':' => { ISSEMANTIC => 0 }, ';' => { ISSEMANTIC => 0 }, '=' => { ISSEMANTIC => 0 }, '=>' => { ISSEMANTIC => 0 }, 'and' => { ISSEMANTIC => 0 }, ARRAY => { ISSEMANTIC => 1 }, CODE => { ISSEMANTIC => 1 }, IDENT => { ISSEMANTIC => 1 }, REGEXP => { ISSEMANTIC => 1 }, SCALAR => { ISSEMANTIC => 1 }, error => { ISSEMANTIC => 0 }, }, yyFILENAME => 'lib/Parse/Eyapp/Treeregexp.yp', yystates => [ {#State 0 DEFAULT => -2, GOTOS => { 'treeregexplist' => 2, 'STAR-1' => 1 } }, {#State 1 ACTIONS => { 'REGEXP' => 5, 'IDENT' => 6, '' => -3, 'CODE' => 3 }, GOTOS => { 'treeregexp' => 4 } }, {#State 2 ACTIONS => { '' => 7 } }, {#State 3 DEFAULT => -10 }, {#State 4 DEFAULT => -1 }, {#State 5 DEFAULT => -12 }, {#State 6 ACTIONS => { "=" => 9, ":" => 8 } }, {#State 7 DEFAULT => 0 }, {#State 8 ACTIONS => { "." => 16, 'REGEXP' => 11, "*" => 13, 'ARRAY' => 14, 'IDENT' => 12, 'SCALAR' => 10 }, GOTOS => { 'treereg' => 15 } }, {#State 9 ACTIONS => { 'IDENT' => 18 }, GOTOS => { 'PLUS-4' => 17 } }, {#State 10 ACTIONS => { 'CODE' => -39, ")" => -39, "=>" => -39, 'IDENT' => -39, '' => -39, "(" => 21, "," => -39, "and" => 19, 'REGEXP' => -39 }, GOTOS => { 'PAREN-21' => 22, 'OPTIONAL-22' => 20 } }, {#State 11 ACTIONS => { '' => -33, "(" => -18, "," => -33, 'REGEXP' => -33, "and" => -33, 'CODE' => -33, ":" => 25, "=>" => -33, 'IDENT' => -33, ")" => -33 }, GOTOS => { 'OPTIONAL-8' => 24, 'PAREN-17' => 23, 'PAREN-7' => 27, 'OPTIONAL-18' => 26 } }, {#State 12 ACTIONS => { "and" => 29, 'REGEXP' => -30, "(" => 28, '' => -30, "," => -30, ")" => -30, "=>" => -30, 'IDENT' => -30, 'CODE' => -30 }, GOTOS => { 'PAREN-15' => 30, 'OPTIONAL-16' => 31 } }, {#State 13 DEFAULT => -52 }, {#State 14 DEFAULT => -51 }, {#State 15 ACTIONS => { 'REGEXP' => -6, "=>" => 33, 'IDENT' => -6, 'CODE' => -6, '' => -6 }, GOTOS => { 'PAREN-2' => 34, 'OPTIONAL-3' => 32 } }, {#State 16 ACTIONS => { 'CODE' => -42, ")" => -42, "=>" => -42, 'IDENT' => -42, '' => -42, "(" => 38, "," => -42, "and" => 35, 'REGEXP' => -42 }, GOTOS => { 'OPTIONAL-24' => 37, 'PAREN-23' => 36 } }, {#State 17 ACTIONS => { 'IDENT' => 39, ";" => 40 } }, {#State 18 DEFAULT => -8 }, {#State 19 ACTIONS => { 'CODE' => 41 } }, {#State 20 DEFAULT => -49 }, {#State 21 ACTIONS => { 'ARRAY' => 14, 'IDENT' => 12, 'SCALAR' => 10, ")" => -56, "." => 16, 'REGEXP' => 11, "*" => 13 }, GOTOS => { 'STAR-25' => 43, 'childlist' => 44, 'STAR-26' => 42, 'treereg' => 45 } }, {#State 22 DEFAULT => -38 }, {#State 23 DEFAULT => -32 }, {#State 24 ACTIONS => { "(" => 46 } }, {#State 25 ACTIONS => { 'IDENT' => 47 } }, {#State 26 ACTIONS => { '' => -36, "," => -36, 'REGEXP' => -36, "and" => 50, 'CODE' => -36, "=>" => -36, 'IDENT' => -36, ")" => -36 }, GOTOS => { 'PAREN-19' => 48, 'OPTIONAL-20' => 49 } }, {#State 27 DEFAULT => -17 }, {#State 28 ACTIONS => { 'REGEXP' => 11, "*" => 13, ")" => -56, 'SCALAR' => 10, 'IDENT' => 12, 'ARRAY' => 14, "." => 16 }, GOTOS => { 'childlist' => 51, 'STAR-25' => 43, 'STAR-26' => 42, 'treereg' => 45 } }, {#State 29 ACTIONS => { 'CODE' => 52 } }, {#State 30 DEFAULT => -29 }, {#State 31 DEFAULT => -47 }, {#State 32 DEFAULT => -9 }, {#State 33 ACTIONS => { 'CODE' => 53 } }, {#State 34 DEFAULT => -5 }, {#State 35 ACTIONS => { 'CODE' => 54 } }, {#State 36 DEFAULT => -41 }, {#State 37 DEFAULT => -50 }, {#State 38 ACTIONS => { 'ARRAY' => 14, 'IDENT' => 12, 'SCALAR' => 10, ")" => -56, "." => 16, "*" => 13, 'REGEXP' => 11 }, GOTOS => { 'treereg' => 45, 'STAR-26' => 42, 'childlist' => 55, 'STAR-25' => 43 } }, {#State 39 DEFAULT => -7 }, {#State 40 DEFAULT => -11 }, {#State 41 DEFAULT => -37 }, {#State 42 DEFAULT => -57 }, {#State 43 ACTIONS => { "," => 56, ")" => -55 } }, {#State 44 ACTIONS => { ")" => 57 } }, {#State 45 DEFAULT => -54 }, {#State 46 ACTIONS => { "." => 16, 'IDENT' => 12, 'ARRAY' => 14, 'SCALAR' => 10, ")" => -56, 'REGEXP' => 11, "*" => 13 }, GOTOS => { 'treereg' => 45, 'STAR-26' => 42, 'STAR-25' => 43, 'childlist' => 58 } }, {#State 47 ACTIONS => { "=>" => -31, 'IDENT' => -31, ")" => -31, 'CODE' => -31, 'REGEXP' => -31, "and" => -31, "(" => -16, '' => -31, "," => -31 } }, {#State 48 DEFAULT => -35 }, {#State 49 DEFAULT => -48 }, {#State 50 ACTIONS => { 'CODE' => 59 } }, {#State 51 ACTIONS => { ")" => 60 } }, {#State 52 DEFAULT => -28 }, {#State 53 DEFAULT => -4 }, {#State 54 DEFAULT => -40 }, {#State 55 ACTIONS => { ")" => 61 } }, {#State 56 ACTIONS => { 'REGEXP' => 11, 'ARRAY' => 14, "*" => 13, 'IDENT' => 12, 'SCALAR' => 10, "." => 16 }, GOTOS => { 'treereg' => 62 } }, {#State 57 ACTIONS => { 'REGEXP' => -24, "and" => 65, '' => -24, "," => -24, "=>" => -24, 'IDENT' => -24, ")" => -24, 'CODE' => -24 }, GOTOS => { 'PAREN-11' => 64, 'OPTIONAL-12' => 63 } }, {#State 58 ACTIONS => { ")" => 66 } }, {#State 59 DEFAULT => -34 }, {#State 60 ACTIONS => { 'REGEXP' => -15, "and" => 67, '' => -15, "," => -15, "=>" => -15, 'IDENT' => -15, ")" => -15, 'CODE' => -15 }, GOTOS => { 'PAREN-5' => 68, 'OPTIONAL-6' => 69 } }, {#State 61 ACTIONS => { '' => -27, "," => -27, 'REGEXP' => -27, "and" => 72, 'CODE' => -27, "=>" => -27, 'IDENT' => -27, ")" => -27 }, GOTOS => { 'PAREN-13' => 70, 'OPTIONAL-14' => 71 } }, {#State 62 DEFAULT => -53 }, {#State 63 DEFAULT => -45 }, {#State 64 DEFAULT => -23 }, {#State 65 ACTIONS => { 'CODE' => 73 } }, {#State 66 ACTIONS => { 'CODE' => -21, ")" => -21, 'IDENT' => -21, "=>" => -21, "," => -21, '' => -21, "and" => 76, 'REGEXP' => -21 }, GOTOS => { 'OPTIONAL-10' => 75, 'PAREN-9' => 74 } }, {#State 67 ACTIONS => { 'CODE' => 77 } }, {#State 68 DEFAULT => -14 }, {#State 69 DEFAULT => -43 }, {#State 70 DEFAULT => -26 }, {#State 71 DEFAULT => -46 }, {#State 72 ACTIONS => { 'CODE' => 78 } }, {#State 73 DEFAULT => -22 }, {#State 74 DEFAULT => -20 }, {#State 75 DEFAULT => -44 }, {#State 76 ACTIONS => { 'CODE' => 79 } }, {#State 77 DEFAULT => -13 }, {#State 78 DEFAULT => -25 }, {#State 79 DEFAULT => -19 } ], yyrules => [ [#Rule _SUPERSTART '$start', 2, undef ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _STAR_LIST 'STAR-1', 2, sub { goto &Parse::Eyapp::Driver::YYActionforT_TX1X2 } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _STAR_LIST 'STAR-1', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treeregexplist_3 'treeregexplist', 1, sub { $_[1]->{children} } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-2', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-3', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-3', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PLUS_LIST 'PLUS-4', 2, sub { goto &Parse::Eyapp::Driver::YYActionforT_TX1X2 } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PLUS_LIST 'PLUS-4', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treeregexp_9 'treeregexp', 4, sub { my $name = $_[1][0]; my $tree = $_[3]; my ($action) = $_[4]->children; my $self = bless { name => $name, times => [ %times ], children => [$tree, $action->{attr} ] }, 'Parse::Eyapp::Treeregexp::TREEREGEXP'; reset_times(); print Dumper($self) if $debug; $self; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treeregexp_10 'treeregexp', 1, sub { bless $_[1], 'Parse::Eyapp::Treeregexp::GLOBALCODE'; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treeregexp_11 'treeregexp', 4, sub { bless { name => $_[1], members => $_[3] }, 'Parse::Eyapp::Treeregexp::FAMILY'; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treeregexp_12 'treeregexp', 1, sub { _SyntaxError("Expected an Identifier for the treeregexp", $tokenend); } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-5', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-6', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-6', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-7', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-8', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-8', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-9', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-10', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-10', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-11', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-12', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-12', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-13', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-14', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-14', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-15', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-16', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-16', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-17', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-18', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-18', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-19', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-20', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-20', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-21', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-22', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-22', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _PAREN 'PAREN-23', 2, sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis} ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-24', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _OPTIONAL 'OPTIONAL-24', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_43 'treereg', 5, sub { goto &new_ident_inner; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_44 'treereg', 6, sub { goto &new_regexp_inner; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_45 'treereg', 5, sub { goto &new_scalar_inner; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_46 'treereg', 5, sub { goto &new_dot_inner; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_47 'treereg', 2, sub { goto &new_ident_terminal; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_48 'treereg', 3, sub { goto &new_regexp_terminal; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_49 'treereg', 2, sub { goto &new_scalar_terminal; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_50 'treereg', 2, sub { goto &new_dot_terminal; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_51 'treereg', 1, sub { goto &new_array_terminal; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule treereg_52 'treereg', 1, sub { goto &new_array_star; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _STAR_LIST 'STAR-25', 3, sub { goto &Parse::Eyapp::Driver::YYActionforT_TX1X2 } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _STAR_LIST 'STAR-25', 1, sub { goto &Parse::Eyapp::Driver::YYActionforT_single } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _STAR_LIST 'STAR-26', 1, sub { { $_[1] } # optimize } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule _STAR_LIST 'STAR-26', 0, sub { goto &Parse::Eyapp::Driver::YYActionforT_empty } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ], [#Rule childlist_57 'childlist', 1, sub { my @list = $_[1]->children(); my @New = (); my ($r, $b); my $numarrays = 0; # Merge array prefixes with its successors local $_; while (@list) { $_ = shift @list; if ($_->isa('Parse::Eyapp::Treeregexp::ARRAY_TERMINAL')) { $numarrays++; $r = shift @list; if (defined($r)) { croak "Error. Two consecutive lists are not allowed!" if $r->isa('Parse::Eyapp::Treeregexp::ARRAY_TERMINAL'); $r->{arrayprefix} = $_->{attr}; $_ = $r; } } push @New, $_; } $_[1]->{numarrays} = $numarrays; $_[1]->{children} = \@New; $_[1]; } ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### ] ], ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### yybypass => 0, yybuildingtree => 0, yyprefix => '', yyaccessors => { }, yyconflicthandlers => {} , yystateconflict => { }, @_, ); bless($self,$class); $self->make_node_classes('TERMINAL', '_OPTIONAL', '_STAR_LIST', '_PLUS_LIST', '_SUPERSTART', '_STAR_LIST', '_STAR_LIST', 'treeregexplist_3', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PLUS_LIST', '_PLUS_LIST', 'treeregexp_9', 'treeregexp_10', 'treeregexp_11', 'treeregexp_12', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', '_PAREN', '_OPTIONAL', '_OPTIONAL', 'treereg_43', 'treereg_44', 'treereg_45', 'treereg_46', 'treereg_47', 'treereg_48', 'treereg_49', 'treereg_50', 'treereg_51', 'treereg_52', '_STAR_LIST', '_STAR_LIST', '_STAR_LIST', '_STAR_LIST', 'childlist_57', ); $self; } my $input; sub _Lexer { return('', undef) unless defined($input); #Skip blanks $input=~m{\G((?: \s+ # any white space char | \#[^\n]* # Perl like comments | /\*.*?\*/ # C like comments )+)}xsgc and do { my($blanks)=$1; #Maybe At EOF pos($input) >= length($input) and return('', undef); $tokenend += $blanks =~ tr/\n//; }; $tokenbegin = $tokenend; $input=~/\G(and)/gc and return($1, [$1, $tokenbegin]); $input=~/\G([A-Za-z_][A-Za-z0-9_]*)/gc and do { return('IDENT', [$1, $tokenbegin]); }; $input=~/\G(\$[A-Za-z_][A-Za-z0-9_]*)/gc and do { return('SCALAR', [$1, $tokenbegin]); }; $input=~/\G(\@[A-Za-z_][A-Za-z0-9_]*)/gc and do { return('ARRAY', [$1, $tokenbegin]); }; $input=~m{\G/( (?:[^/\\]| # no escape or slash \\\\| # escaped escape \\/| # escaped slash \\ # escape )+? ) /([Begiomxsc]*)}xgc and do { # $x=~ s/((?:[a-zA_Z_]\w*::)*(?:[a-zA_Z_]\w*))/\\b$1\\b/g my $string = $1; my $options = $2? $2 : ''; $tokenend += $string =~ tr/\n//; # Default behavior: Each perl identifier is surrounded by \b boundaries # Use "B" option to negate this behavior $string =~ s/((?:[a-zA-Z_][a-zA-Z_0-9]*::)*(?:[a-zA-Z_][a-zA-Z_0-9]*))/\\b$1\\b/g unless $options =~ s{B}{}; # Default behavior: make "x" default option # Use X option to negate this behavior $options .= "x" unless ($options =~ m{x} or $options =~ s{X}{}); return('REGEXP', [$string, $tokenbegin, $options]); }; $input=~/\G%\{/gc and do { my($code); $input=~/\G(.*?)%}/sgc or _SyntaxError( "Unmatched %{", $tokenbegin); $code=$1; $tokenend+= $code=~tr/\n//; return('Parse::Eyapp::Treeregexp::GLOBALCODE', [$code, $tokenbegin]); }; $input=~/\G\{/gc and do { my($level,$from,$code); $from=pos($input); $level=1; while($input=~/([{}])/gc) { substr($input,pos($input)-1,1) eq '\\' #Quoted and next; $level += ($1 eq '{' ? 1 : -1) or last; } $level and _SyntaxError("Not closed open curly bracket { at $tokenbegin"); $code = substr($input,$from,pos($input)-$from-1); $tokenend+= $code=~tr/\n//; return('CODE', [$code, $tokenbegin]); }; $input=~/\G(=>)/gc and return($1, $1); #Always return something $input=~/\G(.)/sg and do { $1 eq "\n" and ++$tokenend; return ($1, [$1, $tokenbegin]); }; #At EOF return('', undef); } sub _Error { my($value)=$_[0]->YYCurval; die "Syntax Error at end of file\n" unless (defined($value) and ref($value) eq 'ARRAY'); my($what)= "input: '$$value[0]'"; _SyntaxError("Unexpected $what",$$value[1]); } sub _SyntaxError { my($message,$lineno)=@_; $message= "Error in file $filename: $message, at ". ($lineno < 0 ? "eof" : "line $lineno"). ".\n"; die $message; } #################################################################### # Purpose : Treeregexp compiler bottom end. Code generation. package Parse::Eyapp::Treeregexp; use Carp; use List::Util qw(first); use Parse::Eyapp::Base qw(compute_lines slurp_file valid_keys invalid_keys write_file); my %index; # Index of each ocurrence of a variable my $prefix; # Assume each AST node name /class is prefixed by $prefix my $severity = 0; # 0 = Don't check arity. 1 = Check arity. 2 = Check and give a warning 3 = ... croak my $allowlinenumbers = 1; # Enable/Disable line number directives #my $warninfo = "Line numbers in error messages are relative to the line where new is called.\n"; my %methods; # $method{$treeclass} = [ array of YATW objects or transformations ] my $ouputlinepattern = '##line NUM FILE # line in code by treeregexp'; sub compute_var_name { my $var = shift; my $nodename; if ($times{$var} > 1) { # node is array $nodename = $index{$var}++; $nodename = '$'."$var\[$nodename]"; } else { $nodename = '$'.$var; } return $nodename; } #################################################################### # Usage : # my $transform = Parse::Eyapp::Treeregexp->new( STRING => q{ # zero_times: TIMES(NUM($x), ., .) and { $x->{attr} == 0 } => { $_[0] = $NUM } # times_zero: TIMES(., ., NUM($x)) and { $x->{attr} == 0 } => { $_[0] = $NUM } # }, # PACKAGE => 'Transformations', # OUTPUTFILE => 'main.pm', # SEVERITY => 0, # NUMBERS => 0, # ) ; # Returns : A Parse::Eyapp::Treeregexp object # Throws : croak if STRING and INFILE are defined or if no input is provided # also if the PACKAGE isrg does not contain a valid identifier # Parameters : my %_Trnew = ( PACKAGE => 'STRING', # The package where the module will reside PREFIX => 'STRING', # prefix for all the node classes OUTPUTFILE => 'STRING', # If specified the package will be dumped to such file SYNTAX => 'BOOL', # Check perl actions syntax after generating the package SEVERITY => 'INT', # Controls the level of checking matching the number of childrens PERL5LIB => 'ARRAY', # Search path INFILE => 'STRING', # Input file containing the grammar STRING => 'STRING', # Input string containing the grammar. Incompatible with INFILE NUMBERS => 'BOOL', # Generate (or not) #line directives FIRSTLINE => 'INT', # Use it only with STRING. The linenumber where the string # containing the grammar begins ); my $validkeys = valid_keys(%_Trnew); sub new { my $class = shift; croak "Error in new_package: Use named arguments" if (@_ %2); my %arg = @_; if (defined($a = invalid_keys(\%_Trnew, \%arg))) { croak( "Parse::Eyapp::Treeregexp::new Error!: unknown argument $a. " ."Valid arguments are: $validkeys") } my $checksyntax = 1; $checksyntax = $arg{SYNTAX} if exists($arg{SYNTAX}); my ($packagename, $outputfile) = ($arg{PACKAGE}, $arg{OUTPUTFILE}); # file scope variables $filename = $arg{INFILE}; my $perl5lib = $arg{PERL5LIB} || []; #package scope variables $severity = $arg{SEVERITY}; $prefix = $arg{PREFIX} || ''; $allowlinenumbers = defined($arg{NUMBERS})?$arg{NUMBERS}:1 ; my $input_from_file = 0; $tokenbegin = $tokenend = 1; $input = $arg{STRING}; if (defined($filename)) { $input_from_file = 1; croak "STRING and INFILE parameters are mutually exclusive " if defined($input); $input = slurp_file($filename, 'trg'); } elsif (defined($input)) { # input from string my ($callerpackagename); ($callerpackagename, $filename, $tokenend) = caller; $packagename = $callerpackagename unless defined($packagename) # Perl identifier regexp and $packagename =~ /(?:[A-Za-z_][A-Za-z0-9_]*::)*[A-Za-z_][A-Za-z0-9_]*/; } else { croak "Undefined input."; } ($packagename) = $filename =~ m{(^[a-zA-Z_]\w*)} if !defined($packagename); $tokenend = $arg{FIRSTLINE} if exists($arg{FIRSTLINE}) and $arg{FIRSTLINE} =~ m{^\s*\d+}; $tokenbegin = $tokenend; croak "Bad formed package name" unless $packagename =~ m{^(?:[A-Za-z_][A-Za-z0-9_]*::)* # Perl identifier: prefix (?:[A-Za-z_][A-Za-z0-9_]*)$}x; #my ($basename) = $packagename =~ m{([a-zA-Z]\w*$)}; #$outputfile = "$basename.pm" unless defined($outputfile); my $object = bless { 'INPUT_FROM_FILE' => $input_from_file, 'PACKAGENAME' => $packagename, 'OUTPUTFILE' => $outputfile, 'CHECKSYNTAX' => $checksyntax, 'PERL5LIB' => $perl5lib, }, $class; return $object; } sub has_array_prefix { my $self = shift; return defined($self->{arrayprefix}) } { # closure with $formula $declarations and $text my $formula; my $declarations; my $text = ''; sub _generate_treereg_code { my $treereg = shift; # the node my $father = shift; my $source = shift; # Perl code describing how access this node my $order = shift; # my index in the array of children my $name = ref($treereg) || $treereg; my $aux; my $nodename; my $is_array = has_array_prefix($treereg); ($nodename, $aux) = $treereg->translate($father, $source, $order); $formula .= $aux; return if (ref($treereg) =~ m{TERMINAL$} or $is_array); # $j : index of the child in the treeregexp formula not counting arrays my $j = 0; for (@{$treereg->{children}}) { # Saving $is_array has to be done before the call to #_generate_treereg_code, since # we delete the array_prefix entry after processing node $_ # (See sub translate_array_prefix) $is_array = has_array_prefix($_); _generate_treereg_code($_, $nodename, "$nodename->child($j+\$child_index)", $j); $j++ unless $is_array; } if (my $pat = $treereg->{semantic}) { my $pattern = process_pattern($pat, $filename); $formula .= $pattern; } } sub generate_treereg_code { my $treereg = shift; $formula = ''; _generate_treereg_code($treereg, '', '$_[$child_index]', undef); } # Parameters: # $checksyntax: controls whether or not to check Perl code for syntax errors sub generate { my $self = shift; croak "Error at ".__PACKAGE__."::generate. Expected a ".__PACKAGE__." object." unless $self->isa(__PACKAGE__); my $checksyntax = $self->{'CHECKSYNTAX'} || 1; my ($input_from_file, $packagename, $outputfile) = @$self{'INPUT_FROM_FILE', 'PACKAGENAME', 'OUTPUTFILE',}; my $parser = Parse::Eyapp::Treeregparser->new(); my $t = $parser->YYParse( yylex => \&Parse::Eyapp::Treeregparser::_Lexer, yyerror => \&Parse::Eyapp::Treeregparser::_Error, yybuildingtree => 1); # Traverse the tree generating the pattern-action subroutine my ($names, @names, %family); # Names of the generated subroutines my @Transformations = @$t; for my $transform (@Transformations) { $transform->isa('Parse::Eyapp::Treeregexp::GLOBALCODE') and do { $text .= $transform->translate(); next; # iteration done }; $transform->isa('Parse::Eyapp::Treeregexp::FAMILY') and do { my ($name, @members) = ($transform->{name}[0], @{$transform->{members}{children}}); push @{$family{$name}}, @members; next; }; my ($treereg, $action) = @{$transform->{children}}; %times = @{$transform->{times}}; # global scope visible. Weakness %index = (); &fill_declarations(\$declarations); my $name = $transform->{name}; $action ||= ""; # To Do $names .= "$name "; generate_treereg_code($treereg); my @classes = $treereg->classes; push @{$methods{$_}}, $name for @classes; $text .= fill_translation_sub($name, \$declarations, \$formula, $action, $filename); } # for my $transform ... $text = fill_translation_package($filename, $packagename, \$text, $names, \%family); if ($input_from_file or defined($outputfile)) { compute_lines(\$text, $outputfile, $ouputlinepattern) if $self->{NUMBERS}; write_file($outputfile, \$text); if ($self->{CHECKSYNTAX}) { push @INC, @{$self->{PERL5LIB}}; require $outputfile; } } else { print $text if $debug; if ($self->{CHECKSYNTAX}) { push @INC, @{$self->{PERL5LIB}}; croak $@ unless eval $text; } } undef %times; undef %index; undef $tokenbegin; undef $tokenend; undef $prefix; undef $input; undef $declarations; undef $text; undef $filename; return 1; } sub translate_array_prefix { my ($self, $father, $order) = @_; my $localformula = $formula; my $arrname = $self->{arrayprefix}; delete($self->{arrayprefix}); generate_treereg_code($self); my $aux = fill_translation_array_sub($self, $arrname, $order, \$formula, $father); $formula = $localformula; return $aux; } } # closure with $formula $declarations and $text sub make_references_to_subs { $_[0] =~ s/\b([a-z_A-Z]\w*)\b/$1 => \\\&$1,/g; } sub unique { my %saw = (); my @out = grep(!$saw{$_}++, @_); return @out; } # Checks that all the transformation rules in the list have been defined sub check_existence { my $familyname = shift; my $names = shift; my $line = shift; for (@_) { croak "Error! treereg rule '$_' not defined (family '$familyname' at line $line)." unless $names =~ m/\b$_\b/; } } sub translate { my ($self, $father, $order, $translation) = @_; $translation = translate_array_prefix($self, $father, $order) if has_array_prefix($self); return $translation; } ######### Fill subroutines ########## sub linenumber { my ($linenumber, $filename) = @_; return "#line $linenumber \"$filename\"" if $allowlinenumbers; return ''; } #################################################################### # Usage : fill_translation_array_sub($self, $arrname, $order, \$formula, $father); # Purpose : translation of array atoms in treeregexps like ABC(@a, B, @c) # Returns : the text containing the sub handler and the loop # Parameters : $name: gives the name to the array and to the sub handler # $order: index of the array formula as child # $formula: declarations # $father: the father node of the array tree pattern sub fill_translation_array_sub { my ($self, $name, $order, $formula, $father, $line) = @_; chomp($$formula); my $sname = '$'.$name; # var referencing the sub my $aname = '@'.$name; # the array that will hold the nodes $line = '' unless defined($line); return <<"END_TRANSLATION_STAR_SUB"; my $sname = sub { my \$child_index = 0; $$formula $line return 1; }; # end anonymous sub $sname return 0 unless until_first_match( $father, $order, $sname, \\$aname); \$child_index += 1+$aname; END_TRANSLATION_STAR_SUB } # sub fill_translation_array_sub sub process_pattern { my ($pat, $filename) = @_; my $linenodirective = linenumber($pat->[1], $filename); my ($pattern); if (defined($pat)) { $pattern =<<"ENDOFPATTERN"; return 0 unless do $linenodirective {$pat->[0]}; ENDOFPATTERN } else { $pattern = ''; #chomp($formula); } return $pattern; } sub process_action { my ($action, $filename) = @_; my ($actiontext); if ($action) { my $line_directive = linenumber($action->[1], $filename); $actiontext = "$line_directive\n". " { $action->[0]}"; } else { $actiontext = " 1;" } return $actiontext; } sub fill_translation_sub { my ($name, $declarations, $formula, $action, $filename, $line) = @_; my ($actiontext); $line = '' unless defined($line); $actiontext = process_action($action, $filename); return <<"END_TREEREG_TRANSLATIONS"; sub $name { my \$$name = \$_[3]; # reference to the YATW pattern object $$declarations { my \$child_index = 0; $$formula } # end block of child_index $actiontext } # end of $name $line END_TREEREG_TRANSLATIONS } # end sub fill_translation_sub sub fill_declarations { my $declarations = shift; $$declarations = ''; for (keys(%times)) { $$declarations .= " my \$$_;\n", next if ($times{$_} == 1); $$declarations .= " my \@$_;\n" } } sub fill_translation_package { my ($filename, $packagename, $code, $names, $family) = @_; my $familiesdecl = ''; for (keys %$family) { my $t; my @members = map { $t = $_->{attr}; $t->[0] } @{$family->{$_}}; @members = unique(@members); my $line = $family->{$_}[0]{attr}[1]; check_existence($_, $names, $line, @members); $t = "@members"; &make_references_to_subs($t); my $line_directive = linenumber($line, $filename); $familiesdecl .= "$line_directive\n". "our \@$_ = Parse::Eyapp::YATW->buildpatterns($t);\n"; # TODO lines, etc. } my $scalar_names; ($scalar_names = $names) =~ s/\b([a-z_A-Z]\w*)\b/our \$$1,/g;; &make_references_to_subs($names); $familiesdecl .= "our \@all = ( $scalar_names) = Parse::Eyapp::YATW->buildpatterns($names);\n"; return <<"END_PACKAGE_TRANSLATIONS"; package $packagename; # This module has been generated using Parse::Eyapp::Treereg # from file $filename. Don't modify it. # Change $filename instead. # Copyright © 2006, 2007, 2008, 2009, 2010, 2011, 2012 Casiano Rodriguez-Leon. # Copyright © 2017 William N. Braswell, Jr. # All Rights Reserved. # # Parse::Yapp is Copyright © 1998, 1999, 2000, 2001, Francois Desarmenien. # Parse::Yapp is Copyright © 2017 William N. Braswell, Jr. # All Rights Reserved. # You may use it and distribute it under the terms of either # the GNU General Public License or the Artistic License, # as specified in the Perl README file. use strict; use warnings; use Carp; use Parse::Eyapp::_TreeregexpSupport qw(until_first_match checknumchildren); $familiesdecl $$code 1; END_PACKAGE_TRANSLATIONS } # end of sub fill_translation_package ######## TERMINAL classes ######### sub code_translation { my $self = shift; my $pat = $self->{semantic}; return process_pattern($pat, $filename) if $pat; return ''; } ######## Parse::Eyapp::Treeregexp::REGEXP_TERMINAL ######### sub Parse::Eyapp::Treeregexp::REGEXP_TERMINAL::translate { my ($self, $father, $source, $order) = @_; # nodename is the variable associated with the tree node i.e. # for a node NUM it may be $NUM[0] or similar my ($nodename, $aux); $nodename = '$'.$self->{attr}; my ($regexp, $options) = ($self->{regexp}, $self->{options}); $aux = translate($self, $father, $order, " return 0 unless ref($nodename = $source) =~ m{$regexp}$options;\n"); $aux .= code_translation($self); return ($nodename, $aux); } sub Parse::Eyapp::Treeregexp::REGEXP_TERMINAL::classes { my $treereg = shift; my $regexp = $treereg->{regexp}; # what if option "B" is used? my @classes; @classes = $regexp =~ m/\\b|((?:[a-zA-Z_][a-zA-Z_0-9]*::)*(?:[a-zA-Z_][a-zA-Z_0-9]*))/g; return grep {defined($_) } @classes; } ######## Parse::Eyapp::Treeregexp::SCALAR_TERMINAL ######### sub Parse::Eyapp::Treeregexp::SCALAR_TERMINAL::translate { my ($self, $father, $source, $order) = @_; my ($nodename, $aux); # Warning! not needed for scalars but for Ws (see alias) $nodename = Parse::Eyapp::Treeregexp::compute_var_name($self->{attr}); $aux = translate($self, $father, $order, " return 0 unless defined($nodename = $source);\n"); $aux .= code_translation($self); return ($nodename, $aux); } sub Parse::Eyapp::Treeregexp::SCALAR_TERMINAL::classes { my $self = shift; return ('*'); } ######## Parse::Eyapp::Treeregexp::IDENT_TERMINAL ######### sub Parse::Eyapp::Treeregexp::IDENT_TERMINAL::translate { my ($self, $father, $source, $order) = @_; my ($nodename, $aux); my $name = $self->{attr}; $nodename = Parse::Eyapp::Treeregexp::compute_var_name($self->{attr}); $aux = translate($self, $father, $order, " return 0 unless ref($nodename = $source) eq '$prefix$name';\n"); $aux .= code_translation($self); return ($nodename, $aux); } sub Parse::Eyapp::Treeregexp::IDENT_TERMINAL::classes { my $treereg = shift; my @classes = ($treereg->{attr}); return @classes; } ######## Parse::Eyapp::Treeregexp::ARRAY_TERMINAL ######### sub Parse::Eyapp::Treeregexp::ARRAY_TERMINAL::translate { my ($self, $father, $source, $order) = @_; my ($nodename, $aux); my $id = $self->{attr}; $nodename = '@'.$id; $aux = translate($self, $father, $order, " $nodename = ($father->children);\n". " $nodename = $nodename\[\$child_index+$order..\$#$id];\n" ); return ($nodename, $aux); } sub Parse::Eyapp::Treeregexp::ARRAY_TERMINAL::classes { croak "Fatal error: Parse::Eyapp::Treeregexp::ARRAY_TERMINAL::classes called from the root of a tree"; } ############### INNER classes ############### sub generate_check_numchildren { my ($self, $nodename, $severity) = @_; return '' unless $severity; my $name = $self->{id}; my $numexpected = @{$self->{children}}; my $line = $self->{line}; my $warning = " return 0 unless checknumchildren($nodename, $numexpected, $line, ". "'$filename', $self->{numarrays}, $severity);\n"; return $warning; } ############### Parse::Eyapp::Treeregexp::REGEXP_INNER ############### sub Parse::Eyapp::Treeregexp::REGEXP_INNER::translate { my ($self, $father, $source, $order) = @_; my ($nodename, $aux); my $name = $self->{id}; $nodename = Parse::Eyapp::Treeregexp::compute_var_name($name); my $warning = generate_check_numchildren($self, $nodename, $severity); my ($regexp, $options) = ($self->{regexp}, $self->{options}); # TODO #line goes here my $template = " return 0 unless ref($nodename = $source) =~ m{$regexp}$options;\n" . $warning; $aux = translate($self, $father, $order, $template); return ($nodename, $aux); } *Parse::Eyapp::Treeregexp::REGEXP_INNER::classes = \&Parse::Eyapp::Treeregexp::REGEXP_TERMINAL::classes; ############### Parse::Eyapp::Treeregexp::IDENT_INNER ############### sub Parse::Eyapp::Treeregexp::IDENT_INNER::translate { my ($self, $father, $source, $order) = @_; my ($nodename, $aux); my $name = $self->{id}; $nodename = Parse::Eyapp::Treeregexp::compute_var_name($name); my $warning = generate_check_numchildren($self, $nodename, $severity); my $template = " return 0 unless (ref($nodename = $source) eq '$prefix$name');\n" . $warning; $aux = translate($self, $father, $order, $template); return ($nodename, $aux); } sub Parse::Eyapp::Treeregexp::IDENT_INNER::classes { my $treereg = shift; my @classes = ( $treereg->{id} ); return @classes; } ############### Parse::Eyapp::Treeregexp::SCALAR_INNER ############### sub Parse::Eyapp::Treeregexp::SCALAR_INNER::translate { my ($self, $father, $source, $order) = @_; my ($nodename, $aux); my $name = $self->{id}; # Warning! not needed for scalars but for Ws $nodename = Parse::Eyapp::Treeregexp::compute_var_name($name); my $warning = generate_check_numchildren($self, $nodename, $severity); my $template = " return 0 unless defined($nodename = $source);\n" . $warning; $aux = translate($self, $father, $order, $template); return ($nodename, $aux); } *Parse::Eyapp::Treeregexp::SCALAR_INNER::classes = \&Parse::Eyapp::Treeregexp::SCALAR_TERMINAL::classes; ########## Parse::Eyapp::Treeregexp::GLOBALCODE ############# sub Parse::Eyapp::Treeregexp::GLOBALCODE::translate { my $transform = shift; my $line_directive = linenumber($transform->[1], $filename); return "$line_directive\n". "$transform->[0]\n"; }; =for None =cut ################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### 1;