File Coverage

blib/lib/Parse/Eyapp/Treeregexp.pm
Criterion Covered Total %
statement 532 585 90.9
branch 136 208 65.3
condition 16 29 55.1
subroutine 104 124 83.8
pod 0 19 0.0
total 788 965 81.6


line stmt bran cond sub pod time code
1             ########################################################################################
2             #
3             # This file was generated using Parse::Eyapp version 1.21.
4             #
5             # Copyright © 2006, 2007, 2008, 2009, 2010, 2011, 2012 Casiano Rodriguez-Leon.
6             # Copyright © 2017 William N. Braswell, Jr.
7             # All Rights Reserved.
8             #
9             # Parse::Yapp is Copyright © 1998, 1999, 2000, 2001, Francois Desarmenien.
10             # Parse::Yapp is Copyright © 2017 William N. Braswell, Jr.
11             # All Rights Reserved.
12             #
13             # Don't edit this file, use source file 'lib/Parse/Eyapp/Treeregexp.yp' instead.
14             #
15             # ANY CHANGE MADE HERE WILL BE LOST !
16             #
17             ########################################################################################
18             package Parse::Eyapp::Treeregparser;
19 36     36   50349 use strict;
  36         89  
  36         2393  
20              
21             push @Parse::Eyapp::Treeregparser::ISA, 'Parse::Eyapp::Driver';
22              
23              
24              
25              
26             BEGIN {
27             # This strange way to load the modules is to guarantee compatibility when
28             # using several standalone and non-standalone Eyapp parsers
29              
30 36 50   36   365 require Parse::Eyapp::Driver unless Parse::Eyapp::Driver->can('YYParse');
31 36 50       1895 require Parse::Eyapp::Node unless Parse::Eyapp::Node->can('hnew');
32             }
33            
34              
35 0 0   0   0 sub unexpendedInput { defined($_) ? substr($_, (defined(pos $_) ? pos $_ : 0)) : '' }
    0          
36              
37              
38 36     36   214 use Carp;
  36         85  
  36         1908  
39 36     36   226 use Data::Dumper;
  36         89  
  36         141847  
40              
41             our $VERSION = $Parse::Eyapp::Driver::VERSION;
42              
43             my $debug = 0; # comment
44             $Data::Dumper::Indent = 1;
45              
46             # %times: Hash indexed in the variables: stores the number of
47             # appearances in the treereg formula
48             my %times = ();
49             my ($tokenbegin, $tokenend);
50             my $filename; # Name of the input file
51              
52             { # closure for $numstar: support code for * treeregexes
53              
54             my $numstar = -1; # Number of stars in treereg formula
55              
56             sub new_star {
57 2     2   5 $numstar++;
58 2         6 return "W_$numstar";
59             }
60              
61             sub reset_times {
62 51     51   164 %times = ();
63 51         127 $numstar = -1; # New formula
64             }
65             }
66              
67             # treereg: IDENT '(' childlist ')' ('and' CODE)?
68             sub new_ident_inner {
69 82     82   177 my ($id, $line) = @{$_[1]};
  82         250  
70 82         327 my ($semantic) = $_[5]->children;
71 82         181 my $node = $_[3];
72              
73 82         235 $times{$id}++;
74              
75 82         238 $node->{id} = $id;
76 82         196 $node->{line} = $line;
77 82 100       246 $node->{semantic} = $semantic? $semantic->{attr} : undef;
78 82         322 return (bless $node, 'Parse::Eyapp::Treeregexp::IDENT_INNER');
79             }
80              
81             # treereg: REGEXP (':' IDENT)? '(' childlist ')' ('and' CODE)?
82             sub new_regexp_inner {
83 11     11   36 my $node = $_[4];
84 11         37 my $line = $_[1][1];
85              
86 11         26 my $id;
87              
88             # $W and @W are default variables for REGEXPs
89 11 100       84 if ( $_[2]->children) {
90 4         51 $id = $_[2]->child(0)->{attr}[0];
91             }
92             else {
93 7         22 $id = 'W';
94             }
95 11         49 $times{$id}++;
96              
97 11         36 $node->{id} = $id;
98 11         32 $node->{line} = $line;
99 11         40 $node->{regexp} = $_[1][0];
100 11         42 $node->{options} = $_[1][2];
101              
102 11         59 my ($semantic) = $_[6]->children;
103 11 50       57 $node->{semantic} = $semantic? $semantic->{attr} : undef;
104 11         88 return bless $node, 'Parse::Eyapp::Treeregexp::REGEXP_INNER';
105             }
106              
107             # treereg: SCALAR '(' childlist ')' ('and' CODE)?
108             sub new_scalar_inner {
109 2     2   6 my $node = $_[3];
110 2         4 my ($var, $line) = @{$_[1]};
  2         6  
111 2         8 $var =~ s/\$//;
112              
113 2         6 $times{$var}++;
114 2 50       8 _SyntaxError('Repeated scalar in treereg', $_[1][1]) if $times{$var} > 1;
115 2 50       7 _SyntaxError(q{Can't use $W to identify an scalar treeregexp}, $_[1][1]) if $var eq 'W';
116              
117 2         5 $node->{id} = $var;
118 2         4 $node->{line} = $line;
119 2         7 my ($semantic) = $_[5]->children;
120 2 50       7 $node->{semantic} = $semantic? $semantic->{attr} : undef;
121 2         10 return (bless $node, 'Parse::Eyapp::Treeregexp::SCALAR_INNER');
122             }
123              
124             # treereg: : '.' '(' childlist ')' ('and' CODE)?
125             sub new_dot_inner {
126 1     1   3 my $node = $_[3];
127 1         2 my $line = $_[1][1];
128 1         3 my $var = 'W';
129              
130 1         2 $times{$var}++;
131              
132 1         3 $node->{id} = $var;
133 1         2 $node->{line} = $line;
134 1         4 my ($semantic) = $_[5]->children;
135 1 50       4 $node->{semantic} = $semantic? $semantic->{attr} : undef;
136              
137 1         6 return (bless $node, 'Parse::Eyapp::Treeregexp::SCALAR_INNER');
138             }
139              
140             # treereg: IDENT ('and' CODE)?
141             sub new_ident_terminal {
142 24     24   70 my $id = $_[1][0];
143 24         58 $times{$id}++;
144            
145 24         157 my ($semantic) = $_[2]->children;
146 24 100       89 $semantic = $semantic? $semantic->{attr} : undef;
147            
148             return (
149 24         153 bless { children => [], attr => $id, semantic => $semantic }, 'Parse::Eyapp::Treeregexp::IDENT_TERMINAL'
150             );
151             }
152              
153             # treereg: REGEXP (':' IDENT)? ('and' CODE)?
154             sub new_regexp_terminal {
155             # $regexp and @regexp are default variables for REGEXPs
156 1     1   2 my $id;
157 1 50       8 if ($_[2]->children) {
158 0         0 $id = {$_[2]->child(0)}->{attr}[0];
159             }
160             else {
161 1         6 $id = 'W';
162             }
163 1         4 $times{$id}++;
164              
165 1         4 my ($semantic) = $_[3]->children;
166 1 50       3 $semantic = $semantic? $semantic->{attr} : undef;
167              
168 1         10 return bless {
169             children => [],
170             regexp => $_[1][0],
171             options => $_[1][2],
172             attr => $id,
173             semantic => $semantic
174             }, 'Parse::Eyapp::Treeregexp::REGEXP_TERMINAL'
175             }
176              
177             # treereg: SCALAR ('and' CODE)?
178             sub new_scalar_terminal {
179 50     50   132 my $var = $_[1][0];
180 50         218 $var =~ s/\$//;
181 50         174 $times{$var}++;
182 50 50       185 _SyntaxError('Repeated scalar in treereg', $_[1][1]) if $times{$var} > 1;
183 50 50       154 _SyntaxError(q{Can't use $W to identify an scalar treeregexp}, $_[1][1]) if $var eq 'W';
184              
185 50         268 my ($semantic) = $_[2]->children;
186 50 50       150 $semantic = $semantic? $semantic->{attr} : undef;
187              
188 50         350 return bless {
189             children => [],
190             attr => $var,
191             semantic => $semantic
192             }, 'Parse::Eyapp::Treeregexp::SCALAR_TERMINAL';
193             }
194              
195             # treereg: '.' ('and' CODE)?
196             sub new_dot_terminal {
197             # $W and @W are implicit variables for dots "."
198 23     23   58 $times{'W'}++;
199              
200 23         87 my ($semantic) = $_[2]->children;
201 23 50       101 $semantic = $semantic? $semantic->{attr} : undef;
202              
203 23         140 return bless {
204             children => [],
205             attr => 'W',
206             semantic => $semantic
207             }, 'Parse::Eyapp::Treeregexp::SCALAR_TERMINAL';
208             }
209              
210             # treereg: ARRAY
211             sub new_array_terminal {
212 33     33   83 my $var = $_[1][0];
213 33         140 $var =~ s/\@//;
214              
215 33         102 $times{$var} += 2; # awful trick so that fill_declarations works
216 33 50       112 _SyntaxError( 'Repeated array in treereg', $_[1][1]) if $times{$var} > 2;
217 33 50       114 _SyntaxError("Can't use $var to identify an array treeregexp", $_[1][1]) if $var =~ /^W(_\d+)?$/;
218              
219 33         185 return bless {
220             children => [],
221             attr => $var,
222             }, 'Parse::Eyapp::Treeregexp::ARRAY_TERMINAL';
223             }
224              
225             # treereg: '*'
226             sub new_array_star {
227             # $wathever_#number and @wathever_#number are reserved for "*"
228 2     2   7 my $var = new_star();
229 2         31 $times{$var} += 2;
230              
231 2         15 return bless {
232             children => [],
233             attr => $var,
234             }, 'Parse::Eyapp::Treeregexp::ARRAY_TERMINAL';
235             }
236              
237              
238             # Default lexical analyzer
239             our $LEX = sub {
240             my $self = shift;
241             my $pos;
242              
243             for (${$self->input}) {
244            
245              
246             m{\G(\s+)}gc and $self->tokenline($1 =~ tr{\n}{});
247              
248             m{\G(and|\=\>|\(|\;|\,|\*|\.|\:|\)|\=)}gc and return ($1, $1);
249              
250             /\G(REGEXP)/gc and return ($1, $1);
251             /\G(ARRAY)/gc and return ($1, $1);
252             /\G(IDENT)/gc and return ($1, $1);
253             /\G(SCALAR)/gc and return ($1, $1);
254             /\G(CODE)/gc and return ($1, $1);
255              
256              
257             return ('', undef) if ($_ eq '') || (defined(pos($_)) && (pos($_) >= length($_)));
258             /\G\s*(\S+)/;
259             my $near = substr($1,0,10);
260              
261             return($near, $near);
262              
263             # die( "Error inside the lexical analyzer near '". $near
264             # ."'. Line: ".$self->line()
265             # .". File: '".$self->YYFilename()."'. No match found.\n");
266             }
267             }
268             ;
269              
270              
271             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
272              
273             my $warnmessage =<< "EOFWARN";
274             Warning!: Did you changed the \@Parse::Eyapp::Treeregparser::ISA variable inside the header section of the eyapp program?
275             EOFWARN
276              
277             sub new {
278 27     27   84 my($class)=shift;
279 27 50       115 ref($class) and $class=ref($class);
280              
281 27 50       225 warn $warnmessage unless __PACKAGE__->isa('Parse::Eyapp::Driver');
282             my($self)=$class->SUPER::new(
283             yyversion => '1.21',
284             yyGRAMMAR =>
285             [#[productionNameAndLabel => lhs, [ rhs], bypass]]
286             [ '_SUPERSTART' => '$start', [ 'treeregexplist', '$end' ], 0 ],
287             [ '_STAR_LIST' => 'STAR-1', [ 'STAR-1', 'treeregexp' ], 0 ],
288             [ '_STAR_LIST' => 'STAR-1', [ ], 0 ],
289             [ 'treeregexplist_3' => 'treeregexplist', [ 'STAR-1' ], 0 ],
290             [ '_PAREN' => 'PAREN-2', [ '=>', 'CODE' ], 0 ],
291             [ '_OPTIONAL' => 'OPTIONAL-3', [ 'PAREN-2' ], 0 ],
292             [ '_OPTIONAL' => 'OPTIONAL-3', [ ], 0 ],
293             [ '_PLUS_LIST' => 'PLUS-4', [ 'PLUS-4', 'IDENT' ], 0 ],
294             [ '_PLUS_LIST' => 'PLUS-4', [ 'IDENT' ], 0 ],
295             [ 'treeregexp_9' => 'treeregexp', [ 'IDENT', ':', 'treereg', 'OPTIONAL-3' ], 0 ],
296             [ 'treeregexp_10' => 'treeregexp', [ 'CODE' ], 0 ],
297             [ 'treeregexp_11' => 'treeregexp', [ 'IDENT', '=', 'PLUS-4', ';' ], 0 ],
298             [ 'treeregexp_12' => 'treeregexp', [ 'REGEXP' ], 0 ],
299             [ '_PAREN' => 'PAREN-5', [ 'and', 'CODE' ], 0 ],
300             [ '_OPTIONAL' => 'OPTIONAL-6', [ 'PAREN-5' ], 0 ],
301             [ '_OPTIONAL' => 'OPTIONAL-6', [ ], 0 ],
302             [ '_PAREN' => 'PAREN-7', [ ':', 'IDENT' ], 0 ],
303             [ '_OPTIONAL' => 'OPTIONAL-8', [ 'PAREN-7' ], 0 ],
304             [ '_OPTIONAL' => 'OPTIONAL-8', [ ], 0 ],
305             [ '_PAREN' => 'PAREN-9', [ 'and', 'CODE' ], 0 ],
306             [ '_OPTIONAL' => 'OPTIONAL-10', [ 'PAREN-9' ], 0 ],
307             [ '_OPTIONAL' => 'OPTIONAL-10', [ ], 0 ],
308             [ '_PAREN' => 'PAREN-11', [ 'and', 'CODE' ], 0 ],
309             [ '_OPTIONAL' => 'OPTIONAL-12', [ 'PAREN-11' ], 0 ],
310             [ '_OPTIONAL' => 'OPTIONAL-12', [ ], 0 ],
311             [ '_PAREN' => 'PAREN-13', [ 'and', 'CODE' ], 0 ],
312             [ '_OPTIONAL' => 'OPTIONAL-14', [ 'PAREN-13' ], 0 ],
313             [ '_OPTIONAL' => 'OPTIONAL-14', [ ], 0 ],
314             [ '_PAREN' => 'PAREN-15', [ 'and', 'CODE' ], 0 ],
315             [ '_OPTIONAL' => 'OPTIONAL-16', [ 'PAREN-15' ], 0 ],
316             [ '_OPTIONAL' => 'OPTIONAL-16', [ ], 0 ],
317             [ '_PAREN' => 'PAREN-17', [ ':', 'IDENT' ], 0 ],
318             [ '_OPTIONAL' => 'OPTIONAL-18', [ 'PAREN-17' ], 0 ],
319             [ '_OPTIONAL' => 'OPTIONAL-18', [ ], 0 ],
320             [ '_PAREN' => 'PAREN-19', [ 'and', 'CODE' ], 0 ],
321             [ '_OPTIONAL' => 'OPTIONAL-20', [ 'PAREN-19' ], 0 ],
322             [ '_OPTIONAL' => 'OPTIONAL-20', [ ], 0 ],
323             [ '_PAREN' => 'PAREN-21', [ 'and', 'CODE' ], 0 ],
324             [ '_OPTIONAL' => 'OPTIONAL-22', [ 'PAREN-21' ], 0 ],
325             [ '_OPTIONAL' => 'OPTIONAL-22', [ ], 0 ],
326             [ '_PAREN' => 'PAREN-23', [ 'and', 'CODE' ], 0 ],
327             [ '_OPTIONAL' => 'OPTIONAL-24', [ 'PAREN-23' ], 0 ],
328             [ '_OPTIONAL' => 'OPTIONAL-24', [ ], 0 ],
329             [ 'treereg_43' => 'treereg', [ 'IDENT', '(', 'childlist', ')', 'OPTIONAL-6' ], 0 ],
330             [ 'treereg_44' => 'treereg', [ 'REGEXP', 'OPTIONAL-8', '(', 'childlist', ')', 'OPTIONAL-10' ], 0 ],
331             [ 'treereg_45' => 'treereg', [ 'SCALAR', '(', 'childlist', ')', 'OPTIONAL-12' ], 0 ],
332             [ 'treereg_46' => 'treereg', [ '.', '(', 'childlist', ')', 'OPTIONAL-14' ], 0 ],
333             [ 'treereg_47' => 'treereg', [ 'IDENT', 'OPTIONAL-16' ], 0 ],
334             [ 'treereg_48' => 'treereg', [ 'REGEXP', 'OPTIONAL-18', 'OPTIONAL-20' ], 0 ],
335             [ 'treereg_49' => 'treereg', [ 'SCALAR', 'OPTIONAL-22' ], 0 ],
336             [ 'treereg_50' => 'treereg', [ '.', 'OPTIONAL-24' ], 0 ],
337             [ 'treereg_51' => 'treereg', [ 'ARRAY' ], 0 ],
338             [ 'treereg_52' => 'treereg', [ '*' ], 0 ],
339             [ '_STAR_LIST' => 'STAR-25', [ 'STAR-25', ',', 'treereg' ], 0 ],
340             [ '_STAR_LIST' => 'STAR-25', [ 'treereg' ], 0 ],
341             [ '_STAR_LIST' => 'STAR-26', [ 'STAR-25' ], 0 ],
342             [ '_STAR_LIST' => 'STAR-26', [ ], 0 ],
343             [ 'childlist_57' => 'childlist', [ 'STAR-26' ], 0 ],
344             ],
345             yyLABELS =>
346             {
347             '_SUPERSTART' => 0,
348             '_STAR_LIST' => 1,
349             '_STAR_LIST' => 2,
350             'treeregexplist_3' => 3,
351             '_PAREN' => 4,
352             '_OPTIONAL' => 5,
353             '_OPTIONAL' => 6,
354             '_PLUS_LIST' => 7,
355             '_PLUS_LIST' => 8,
356             'treeregexp_9' => 9,
357             'treeregexp_10' => 10,
358             'treeregexp_11' => 11,
359             'treeregexp_12' => 12,
360             '_PAREN' => 13,
361             '_OPTIONAL' => 14,
362             '_OPTIONAL' => 15,
363             '_PAREN' => 16,
364             '_OPTIONAL' => 17,
365             '_OPTIONAL' => 18,
366             '_PAREN' => 19,
367             '_OPTIONAL' => 20,
368             '_OPTIONAL' => 21,
369             '_PAREN' => 22,
370             '_OPTIONAL' => 23,
371             '_OPTIONAL' => 24,
372             '_PAREN' => 25,
373             '_OPTIONAL' => 26,
374             '_OPTIONAL' => 27,
375             '_PAREN' => 28,
376             '_OPTIONAL' => 29,
377             '_OPTIONAL' => 30,
378             '_PAREN' => 31,
379             '_OPTIONAL' => 32,
380             '_OPTIONAL' => 33,
381             '_PAREN' => 34,
382             '_OPTIONAL' => 35,
383             '_OPTIONAL' => 36,
384             '_PAREN' => 37,
385             '_OPTIONAL' => 38,
386             '_OPTIONAL' => 39,
387             '_PAREN' => 40,
388             '_OPTIONAL' => 41,
389             '_OPTIONAL' => 42,
390             'treereg_43' => 43,
391             'treereg_44' => 44,
392             'treereg_45' => 45,
393             'treereg_46' => 46,
394             'treereg_47' => 47,
395             'treereg_48' => 48,
396             'treereg_49' => 49,
397             'treereg_50' => 50,
398             'treereg_51' => 51,
399             'treereg_52' => 52,
400             '_STAR_LIST' => 53,
401             '_STAR_LIST' => 54,
402             '_STAR_LIST' => 55,
403             '_STAR_LIST' => 56,
404             'childlist_57' => 57,
405             },
406             yyTERMS =>
407             { '' => { ISSEMANTIC => 0 },
408             '(' => { ISSEMANTIC => 0 },
409             ')' => { ISSEMANTIC => 0 },
410             '*' => { ISSEMANTIC => 0 },
411             ',' => { ISSEMANTIC => 0 },
412             '.' => { ISSEMANTIC => 0 },
413             ':' => { ISSEMANTIC => 0 },
414             ';' => { ISSEMANTIC => 0 },
415             '=' => { ISSEMANTIC => 0 },
416             '=>' => { ISSEMANTIC => 0 },
417             'and' => { ISSEMANTIC => 0 },
418             ARRAY => { ISSEMANTIC => 1 },
419             CODE => { ISSEMANTIC => 1 },
420             IDENT => { ISSEMANTIC => 1 },
421             REGEXP => { ISSEMANTIC => 1 },
422             SCALAR => { ISSEMANTIC => 1 },
423             error => { ISSEMANTIC => 0 },
424             },
425             yyFILENAME => 'lib/Parse/Eyapp/Treeregexp.yp',
426             yystates =>
427             [
428             {#State 0
429             DEFAULT => -2,
430             GOTOS => {
431             'treeregexplist' => 2,
432             'STAR-1' => 1
433             }
434             },
435             {#State 1
436             ACTIONS => {
437             'REGEXP' => 5,
438             'IDENT' => 6,
439             '' => -3,
440             'CODE' => 3
441             },
442             GOTOS => {
443             'treeregexp' => 4
444             }
445             },
446             {#State 2
447             ACTIONS => {
448             '' => 7
449             }
450             },
451             {#State 3
452             DEFAULT => -10
453             },
454             {#State 4
455             DEFAULT => -1
456             },
457             {#State 5
458             DEFAULT => -12
459             },
460             {#State 6
461             ACTIONS => {
462             "=" => 9,
463             ":" => 8
464             }
465             },
466             {#State 7
467             DEFAULT => 0
468             },
469             {#State 8
470             ACTIONS => {
471             "." => 16,
472             'REGEXP' => 11,
473             "*" => 13,
474             'ARRAY' => 14,
475             'IDENT' => 12,
476             'SCALAR' => 10
477             },
478             GOTOS => {
479             'treereg' => 15
480             }
481             },
482             {#State 9
483             ACTIONS => {
484             'IDENT' => 18
485             },
486             GOTOS => {
487             'PLUS-4' => 17
488             }
489             },
490             {#State 10
491             ACTIONS => {
492             'CODE' => -39,
493             ")" => -39,
494             "=>" => -39,
495             'IDENT' => -39,
496             '' => -39,
497             "(" => 21,
498             "," => -39,
499             "and" => 19,
500             'REGEXP' => -39
501             },
502             GOTOS => {
503             'PAREN-21' => 22,
504             'OPTIONAL-22' => 20
505             }
506             },
507             {#State 11
508             ACTIONS => {
509             '' => -33,
510             "(" => -18,
511             "," => -33,
512             'REGEXP' => -33,
513             "and" => -33,
514             'CODE' => -33,
515             ":" => 25,
516             "=>" => -33,
517             'IDENT' => -33,
518             ")" => -33
519             },
520             GOTOS => {
521             'OPTIONAL-8' => 24,
522             'PAREN-17' => 23,
523             'PAREN-7' => 27,
524             'OPTIONAL-18' => 26
525             }
526             },
527             {#State 12
528             ACTIONS => {
529             "and" => 29,
530             'REGEXP' => -30,
531             "(" => 28,
532             '' => -30,
533             "," => -30,
534             ")" => -30,
535             "=>" => -30,
536             'IDENT' => -30,
537             'CODE' => -30
538             },
539             GOTOS => {
540             'PAREN-15' => 30,
541             'OPTIONAL-16' => 31
542             }
543             },
544             {#State 13
545             DEFAULT => -52
546             },
547             {#State 14
548             DEFAULT => -51
549             },
550             {#State 15
551             ACTIONS => {
552             'REGEXP' => -6,
553             "=>" => 33,
554             'IDENT' => -6,
555             'CODE' => -6,
556             '' => -6
557             },
558             GOTOS => {
559             'PAREN-2' => 34,
560             'OPTIONAL-3' => 32
561             }
562             },
563             {#State 16
564             ACTIONS => {
565             'CODE' => -42,
566             ")" => -42,
567             "=>" => -42,
568             'IDENT' => -42,
569             '' => -42,
570             "(" => 38,
571             "," => -42,
572             "and" => 35,
573             'REGEXP' => -42
574             },
575             GOTOS => {
576             'OPTIONAL-24' => 37,
577             'PAREN-23' => 36
578             }
579             },
580             {#State 17
581             ACTIONS => {
582             'IDENT' => 39,
583             ";" => 40
584             }
585             },
586             {#State 18
587             DEFAULT => -8
588             },
589             {#State 19
590             ACTIONS => {
591             'CODE' => 41
592             }
593             },
594             {#State 20
595             DEFAULT => -49
596             },
597             {#State 21
598             ACTIONS => {
599             'ARRAY' => 14,
600             'IDENT' => 12,
601             'SCALAR' => 10,
602             ")" => -56,
603             "." => 16,
604             'REGEXP' => 11,
605             "*" => 13
606             },
607             GOTOS => {
608             'STAR-25' => 43,
609             'childlist' => 44,
610             'STAR-26' => 42,
611             'treereg' => 45
612             }
613             },
614             {#State 22
615             DEFAULT => -38
616             },
617             {#State 23
618             DEFAULT => -32
619             },
620             {#State 24
621             ACTIONS => {
622             "(" => 46
623             }
624             },
625             {#State 25
626             ACTIONS => {
627             'IDENT' => 47
628             }
629             },
630             {#State 26
631             ACTIONS => {
632             '' => -36,
633             "," => -36,
634             'REGEXP' => -36,
635             "and" => 50,
636             'CODE' => -36,
637             "=>" => -36,
638             'IDENT' => -36,
639             ")" => -36
640             },
641             GOTOS => {
642             'PAREN-19' => 48,
643             'OPTIONAL-20' => 49
644             }
645             },
646             {#State 27
647             DEFAULT => -17
648             },
649             {#State 28
650             ACTIONS => {
651             'REGEXP' => 11,
652             "*" => 13,
653             ")" => -56,
654             'SCALAR' => 10,
655             'IDENT' => 12,
656             'ARRAY' => 14,
657             "." => 16
658             },
659             GOTOS => {
660             'childlist' => 51,
661             'STAR-25' => 43,
662             'STAR-26' => 42,
663             'treereg' => 45
664             }
665             },
666             {#State 29
667             ACTIONS => {
668             'CODE' => 52
669             }
670             },
671             {#State 30
672             DEFAULT => -29
673             },
674             {#State 31
675             DEFAULT => -47
676             },
677             {#State 32
678             DEFAULT => -9
679             },
680             {#State 33
681             ACTIONS => {
682             'CODE' => 53
683             }
684             },
685             {#State 34
686             DEFAULT => -5
687             },
688             {#State 35
689             ACTIONS => {
690             'CODE' => 54
691             }
692             },
693             {#State 36
694             DEFAULT => -41
695             },
696             {#State 37
697             DEFAULT => -50
698             },
699             {#State 38
700             ACTIONS => {
701             'ARRAY' => 14,
702             'IDENT' => 12,
703             'SCALAR' => 10,
704             ")" => -56,
705             "." => 16,
706             "*" => 13,
707             'REGEXP' => 11
708             },
709             GOTOS => {
710             'treereg' => 45,
711             'STAR-26' => 42,
712             'childlist' => 55,
713             'STAR-25' => 43
714             }
715             },
716             {#State 39
717             DEFAULT => -7
718             },
719             {#State 40
720             DEFAULT => -11
721             },
722             {#State 41
723             DEFAULT => -37
724             },
725             {#State 42
726             DEFAULT => -57
727             },
728             {#State 43
729             ACTIONS => {
730             "," => 56,
731             ")" => -55
732             }
733             },
734             {#State 44
735             ACTIONS => {
736             ")" => 57
737             }
738             },
739             {#State 45
740             DEFAULT => -54
741             },
742             {#State 46
743             ACTIONS => {
744             "." => 16,
745             'IDENT' => 12,
746             'ARRAY' => 14,
747             'SCALAR' => 10,
748             ")" => -56,
749             'REGEXP' => 11,
750             "*" => 13
751             },
752             GOTOS => {
753             'treereg' => 45,
754             'STAR-26' => 42,
755             'STAR-25' => 43,
756             'childlist' => 58
757             }
758             },
759             {#State 47
760             ACTIONS => {
761             "=>" => -31,
762             'IDENT' => -31,
763             ")" => -31,
764             'CODE' => -31,
765             'REGEXP' => -31,
766             "and" => -31,
767             "(" => -16,
768             '' => -31,
769             "," => -31
770             }
771             },
772             {#State 48
773             DEFAULT => -35
774             },
775             {#State 49
776             DEFAULT => -48
777             },
778             {#State 50
779             ACTIONS => {
780             'CODE' => 59
781             }
782             },
783             {#State 51
784             ACTIONS => {
785             ")" => 60
786             }
787             },
788             {#State 52
789             DEFAULT => -28
790             },
791             {#State 53
792             DEFAULT => -4
793             },
794             {#State 54
795             DEFAULT => -40
796             },
797             {#State 55
798             ACTIONS => {
799             ")" => 61
800             }
801             },
802             {#State 56
803             ACTIONS => {
804             'REGEXP' => 11,
805             'ARRAY' => 14,
806             "*" => 13,
807             'IDENT' => 12,
808             'SCALAR' => 10,
809             "." => 16
810             },
811             GOTOS => {
812             'treereg' => 62
813             }
814             },
815             {#State 57
816             ACTIONS => {
817             'REGEXP' => -24,
818             "and" => 65,
819             '' => -24,
820             "," => -24,
821             "=>" => -24,
822             'IDENT' => -24,
823             ")" => -24,
824             'CODE' => -24
825             },
826             GOTOS => {
827             'PAREN-11' => 64,
828             'OPTIONAL-12' => 63
829             }
830             },
831             {#State 58
832             ACTIONS => {
833             ")" => 66
834             }
835             },
836             {#State 59
837             DEFAULT => -34
838             },
839             {#State 60
840             ACTIONS => {
841             'REGEXP' => -15,
842             "and" => 67,
843             '' => -15,
844             "," => -15,
845             "=>" => -15,
846             'IDENT' => -15,
847             ")" => -15,
848             'CODE' => -15
849             },
850             GOTOS => {
851             'PAREN-5' => 68,
852             'OPTIONAL-6' => 69
853             }
854             },
855             {#State 61
856             ACTIONS => {
857             '' => -27,
858             "," => -27,
859             'REGEXP' => -27,
860             "and" => 72,
861             'CODE' => -27,
862             "=>" => -27,
863             'IDENT' => -27,
864             ")" => -27
865             },
866             GOTOS => {
867             'PAREN-13' => 70,
868             'OPTIONAL-14' => 71
869             }
870             },
871             {#State 62
872             DEFAULT => -53
873             },
874             {#State 63
875             DEFAULT => -45
876             },
877             {#State 64
878             DEFAULT => -23
879             },
880             {#State 65
881             ACTIONS => {
882             'CODE' => 73
883             }
884             },
885             {#State 66
886             ACTIONS => {
887             'CODE' => -21,
888             ")" => -21,
889             'IDENT' => -21,
890             "=>" => -21,
891             "," => -21,
892             '' => -21,
893             "and" => 76,
894             'REGEXP' => -21
895             },
896             GOTOS => {
897             'OPTIONAL-10' => 75,
898             'PAREN-9' => 74
899             }
900             },
901             {#State 67
902             ACTIONS => {
903             'CODE' => 77
904             }
905             },
906             {#State 68
907             DEFAULT => -14
908             },
909             {#State 69
910             DEFAULT => -43
911             },
912             {#State 70
913             DEFAULT => -26
914             },
915             {#State 71
916             DEFAULT => -46
917             },
918             {#State 72
919             ACTIONS => {
920             'CODE' => 78
921             }
922             },
923             {#State 73
924             DEFAULT => -22
925             },
926             {#State 74
927             DEFAULT => -20
928             },
929             {#State 75
930             DEFAULT => -44
931             },
932             {#State 76
933             ACTIONS => {
934             'CODE' => 79
935             }
936             },
937             {#State 77
938             DEFAULT => -13
939             },
940             {#State 78
941             DEFAULT => -25
942             },
943             {#State 79
944             DEFAULT => -19
945             }
946             ],
947             yyrules =>
948             [
949             [#Rule _SUPERSTART
950             '$start', 2, undef
951             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
952             ],
953             [#Rule _STAR_LIST
954             'STAR-1', 2,
955 63     63   246 sub { goto &Parse::Eyapp::Driver::YYActionforT_TX1X2 }
956             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
957             ],
958             [#Rule _STAR_LIST
959             'STAR-1', 0,
960 27     27   138 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
961             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
962             ],
963             [#Rule treeregexplist_3
964             'treeregexplist', 1,
965 27     27   95 sub { $_[1]->{children} }
966             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
967             ],
968             [#Rule _PAREN
969             'PAREN-2', 2,
970 47     47   208 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
971             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
972             ],
973             [#Rule _OPTIONAL
974             'OPTIONAL-3', 1,
975 47     47   208 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
976             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
977             ],
978             [#Rule _OPTIONAL
979             'OPTIONAL-3', 0,
980 4     4   13 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
981             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
982             ],
983             [#Rule _PLUS_LIST
984             'PLUS-4', 2,
985 5     5   23 sub { goto &Parse::Eyapp::Driver::YYActionforT_TX1X2 }
986             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
987             ],
988             [#Rule _PLUS_LIST
989             'PLUS-4', 1,
990 3     3   14 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
991             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
992             ],
993             [#Rule treeregexp_9
994             'treeregexp', 4,
995             sub {
996 51     51   146 my $name = $_[1][0];
997 51         127 my $tree = $_[3];
998 51         215 my ($action) = $_[4]->children;
999             my $self = bless {
1000             name => $name,
1001             times => [ %times ],
1002 51         641 children => [$tree, $action->{attr} ]
1003             }, 'Parse::Eyapp::Treeregexp::TREEREGEXP';
1004 51         265 reset_times();
1005 51 50       163 print Dumper($self) if $debug;
1006 51         163 $self;
1007             }
1008             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1009             ],
1010             [#Rule treeregexp_10
1011             'treeregexp', 1,
1012 9     9   63 sub { bless $_[1], 'Parse::Eyapp::Treeregexp::GLOBALCODE'; }
1013             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1014             ],
1015             [#Rule treeregexp_11
1016             'treeregexp', 4,
1017 3     3   34 sub { bless { name => $_[1], members => $_[3] }, 'Parse::Eyapp::Treeregexp::FAMILY'; }
1018             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1019             ],
1020             [#Rule treeregexp_12
1021             'treeregexp', 1,
1022             sub {
1023 0     0   0 _SyntaxError("Expected an Identifier for the treeregexp", $tokenend);
1024             }
1025             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1026             ],
1027             [#Rule _PAREN
1028             'PAREN-5', 2,
1029 10     10   50 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1030             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1031             ],
1032             [#Rule _OPTIONAL
1033             'OPTIONAL-6', 1,
1034 10     10   59 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1035             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1036             ],
1037             [#Rule _OPTIONAL
1038             'OPTIONAL-6', 0,
1039 72     72   314 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1040             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1041             ],
1042             [#Rule _PAREN
1043             'PAREN-7', 2,
1044 4     4   22 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1045             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1046             ],
1047             [#Rule _OPTIONAL
1048             'OPTIONAL-8', 1,
1049 4     4   22 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1050             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1051             ],
1052             [#Rule _OPTIONAL
1053             'OPTIONAL-8', 0,
1054 7     7   31 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1055             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1056             ],
1057             [#Rule _PAREN
1058             'PAREN-9', 2,
1059 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1060             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1061             ],
1062             [#Rule _OPTIONAL
1063             'OPTIONAL-10', 1,
1064 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1065             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1066             ],
1067             [#Rule _OPTIONAL
1068             'OPTIONAL-10', 0,
1069 11     11   60 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1070             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1071             ],
1072             [#Rule _PAREN
1073             'PAREN-11', 2,
1074 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1075             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1076             ],
1077             [#Rule _OPTIONAL
1078             'OPTIONAL-12', 1,
1079 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1080             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1081             ],
1082             [#Rule _OPTIONAL
1083             'OPTIONAL-12', 0,
1084 2     2   7 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1085             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1086             ],
1087             [#Rule _PAREN
1088             'PAREN-13', 2,
1089 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1090             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1091             ],
1092             [#Rule _OPTIONAL
1093             'OPTIONAL-14', 1,
1094 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1095             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1096             ],
1097             [#Rule _OPTIONAL
1098             'OPTIONAL-14', 0,
1099 1     1   4 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1100             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1101             ],
1102             [#Rule _PAREN
1103             'PAREN-15', 2,
1104 4     4   14 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1105             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1106             ],
1107             [#Rule _OPTIONAL
1108             'OPTIONAL-16', 1,
1109 4     4   17 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1110             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1111             ],
1112             [#Rule _OPTIONAL
1113             'OPTIONAL-16', 0,
1114 20     20   87 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1115             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1116             ],
1117             [#Rule _PAREN
1118             'PAREN-17', 2,
1119 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1120             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1121             ],
1122             [#Rule _OPTIONAL
1123             'OPTIONAL-18', 1,
1124 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1125             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1126             ],
1127             [#Rule _OPTIONAL
1128             'OPTIONAL-18', 0,
1129 1     1   4 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1130             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1131             ],
1132             [#Rule _PAREN
1133             'PAREN-19', 2,
1134 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1135             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1136             ],
1137             [#Rule _OPTIONAL
1138             'OPTIONAL-20', 1,
1139 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1140             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1141             ],
1142             [#Rule _OPTIONAL
1143             'OPTIONAL-20', 0,
1144 1     1   4 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1145             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1146             ],
1147             [#Rule _PAREN
1148             'PAREN-21', 2,
1149 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1150             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1151             ],
1152             [#Rule _OPTIONAL
1153             'OPTIONAL-22', 1,
1154 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1155             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1156             ],
1157             [#Rule _OPTIONAL
1158             'OPTIONAL-22', 0,
1159 50     50   201 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1160             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1161             ],
1162             [#Rule _PAREN
1163             'PAREN-23', 2,
1164 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforParenthesis}
1165             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1166             ],
1167             [#Rule _OPTIONAL
1168             'OPTIONAL-24', 1,
1169 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1170             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1171             ],
1172             [#Rule _OPTIONAL
1173             'OPTIONAL-24', 0,
1174 23     23   98 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1175             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1176             ],
1177             [#Rule treereg_43
1178             'treereg', 5,
1179             sub {
1180 82     82   324 goto &new_ident_inner;
1181             }
1182             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1183             ],
1184             [#Rule treereg_44
1185             'treereg', 6,
1186             sub {
1187 11     11   59 goto &new_regexp_inner;
1188             }
1189             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1190             ],
1191             [#Rule treereg_45
1192             'treereg', 5,
1193             sub {
1194 2     2   7 goto &new_scalar_inner;
1195             }
1196             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1197             ],
1198             [#Rule treereg_46
1199             'treereg', 5,
1200             sub {
1201 1     1   4 goto &new_dot_inner;
1202             }
1203             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1204             ],
1205             [#Rule treereg_47
1206             'treereg', 2,
1207             sub {
1208 24     24   99 goto &new_ident_terminal;
1209             }
1210             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1211             ],
1212             [#Rule treereg_48
1213             'treereg', 3,
1214             sub {
1215 1     1   4 goto &new_regexp_terminal;
1216             }
1217             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1218             ],
1219             [#Rule treereg_49
1220             'treereg', 2,
1221             sub {
1222 50     50   217 goto &new_scalar_terminal;
1223             }
1224             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1225             ],
1226             [#Rule treereg_50
1227             'treereg', 2,
1228             sub {
1229 23     23   89 goto &new_dot_terminal;
1230             }
1231             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1232             ],
1233             [#Rule treereg_51
1234             'treereg', 1,
1235             sub {
1236 33     33   123 goto &new_array_terminal;
1237             }
1238             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1239             ],
1240             [#Rule treereg_52
1241             'treereg', 1,
1242             sub {
1243 2     2   9 goto &new_array_star;
1244             }
1245             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1246             ],
1247             [#Rule _STAR_LIST
1248             'STAR-25', 3,
1249 82     82   326 sub { goto &Parse::Eyapp::Driver::YYActionforT_TX1X2 }
1250             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1251             ],
1252             [#Rule _STAR_LIST
1253             'STAR-25', 1,
1254 96     96   363 sub { goto &Parse::Eyapp::Driver::YYActionforT_single }
1255             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1256             ],
1257             [#Rule _STAR_LIST
1258             'STAR-26', 1,
1259 96     96   199 sub { { $_[1] } # optimize
  96         254  
1260             }
1261             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1262             ],
1263             [#Rule _STAR_LIST
1264             'STAR-26', 0,
1265 0     0   0 sub { goto &Parse::Eyapp::Driver::YYActionforT_empty }
1266             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1267             ],
1268             [#Rule childlist_57
1269             'childlist', 1,
1270             sub {
1271 96     96   1182 my @list = $_[1]->children();
1272 96         262 my @New = ();
1273 96         188 my ($r, $b);
1274 96         186 my $numarrays = 0;
1275              
1276             # Merge array prefixes with its successors
1277 96         172 local $_;
1278 96         289 while (@list) {
1279 162         316 $_ = shift @list;
1280 162 100       991 if ($_->isa('Parse::Eyapp::Treeregexp::ARRAY_TERMINAL')) {
1281 35         64 $numarrays++;
1282 35         66 $r = shift @list;
1283 35 100       107 if (defined($r)) {
1284 16 50       114 croak "Error. Two consecutive lists are not allowed!" if $r->isa('Parse::Eyapp::Treeregexp::ARRAY_TERMINAL');
1285 16         81 $r->{arrayprefix} = $_->{attr};
1286 16         44 $_ = $r;
1287             }
1288             }
1289 162         491 push @New, $_;
1290             }
1291 96         257 $_[1]->{numarrays} = $numarrays;
1292 96         226 $_[1]->{children} = \@New;
1293 96         384 $_[1];
1294             }
1295             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1296 27         9243 ]
1297             ],
1298             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
1299             yybypass => 0,
1300             yybuildingtree => 0,
1301             yyprefix => '',
1302             yyaccessors => {
1303             },
1304             yyconflicthandlers => {}
1305             ,
1306             yystateconflict => { },
1307             @_,
1308             );
1309 27         280 bless($self,$class);
1310              
1311 27         347 $self->make_node_classes('TERMINAL', '_OPTIONAL', '_STAR_LIST', '_PLUS_LIST',
1312             '_SUPERSTART',
1313             '_STAR_LIST',
1314             '_STAR_LIST',
1315             'treeregexplist_3',
1316             '_PAREN',
1317             '_OPTIONAL',
1318             '_OPTIONAL',
1319             '_PLUS_LIST',
1320             '_PLUS_LIST',
1321             'treeregexp_9',
1322             'treeregexp_10',
1323             'treeregexp_11',
1324             'treeregexp_12',
1325             '_PAREN',
1326             '_OPTIONAL',
1327             '_OPTIONAL',
1328             '_PAREN',
1329             '_OPTIONAL',
1330             '_OPTIONAL',
1331             '_PAREN',
1332             '_OPTIONAL',
1333             '_OPTIONAL',
1334             '_PAREN',
1335             '_OPTIONAL',
1336             '_OPTIONAL',
1337             '_PAREN',
1338             '_OPTIONAL',
1339             '_OPTIONAL',
1340             '_PAREN',
1341             '_OPTIONAL',
1342             '_OPTIONAL',
1343             '_PAREN',
1344             '_OPTIONAL',
1345             '_OPTIONAL',
1346             '_PAREN',
1347             '_OPTIONAL',
1348             '_OPTIONAL',
1349             '_PAREN',
1350             '_OPTIONAL',
1351             '_OPTIONAL',
1352             '_PAREN',
1353             '_OPTIONAL',
1354             '_OPTIONAL',
1355             'treereg_43',
1356             'treereg_44',
1357             'treereg_45',
1358             'treereg_46',
1359             'treereg_47',
1360             'treereg_48',
1361             'treereg_49',
1362             'treereg_50',
1363             'treereg_51',
1364             'treereg_52',
1365             '_STAR_LIST',
1366             '_STAR_LIST',
1367             '_STAR_LIST',
1368             '_STAR_LIST',
1369             'childlist_57', );
1370 27         72 $self;
1371             }
1372              
1373              
1374              
1375             my $input;
1376              
1377             sub _Lexer {
1378              
1379 788 50   788   1906 return('', undef) unless defined($input);
1380              
1381             #Skip blanks
1382             $input=~m{\G((?:
1383             \s+ # any white space char
1384             | \#[^\n]* # Perl like comments
1385             | /\*.*?\*/ # C like comments
1386             )+)}xsgc
1387 788 100       3675 and do {
1388 383         1088 my($blanks)=$1;
1389              
1390             #Maybe At EOF
1391 383 100       1092 pos($input) >= length($input)
1392             and return('', undef);
1393 356         796 $tokenend += $blanks =~ tr/\n//;
1394             };
1395            
1396 761         1370 $tokenbegin = $tokenend;
1397              
1398 761 100       2012 $input=~/\G(and)/gc
1399             and return($1, [$1, $tokenbegin]);
1400              
1401             $input=~/\G([A-Za-z_][A-Za-z0-9_]*)/gc
1402 747 100       2060 and do {
1403 172         770 return('IDENT', [$1, $tokenbegin]);
1404             };
1405              
1406             $input=~/\G(\$[A-Za-z_][A-Za-z0-9_]*)/gc
1407 575 100       1454 and do {
1408 52         245 return('SCALAR', [$1, $tokenbegin]);
1409             };
1410              
1411             $input=~/\G(\@[A-Za-z_][A-Za-z0-9_]*)/gc
1412 523 100       1254 and do {
1413 33         149 return('ARRAY', [$1, $tokenbegin]);
1414             };
1415             $input=~m{\G/(
1416             (?:[^/\\]| # no escape or slash
1417             \\\\| # escaped escape
1418             \\/| # escaped slash
1419             \\ # escape
1420             )+?
1421             )
1422             /([Begiomxsc]*)}xgc
1423 490 100       1510 and do {
1424             # $x=~ s/((?:[a-zA_Z_]\w*::)*(?:[a-zA_Z_]\w*))/\\b$1\\b/g
1425 12         49 my $string = $1;
1426 12 100       63 my $options = $2? $2 : '';
1427 12         37 $tokenend += $string =~ tr/\n//;
1428              
1429             # Default behavior: Each perl identifier is surrounded by \b boundaries
1430             # Use "B" option to negate this behavior
1431 12 50       176 $string =~ s/((?:[a-zA-Z_][a-zA-Z_0-9]*::)*(?:[a-zA-Z_][a-zA-Z_0-9]*))/\\b$1\\b/g
1432             unless $options =~ s{B}{};
1433              
1434             # Default behavior: make "x" default option
1435             # Use X option to negate this behavior
1436 12 50 33     119 $options .= "x" unless ($options =~ m{x} or $options =~ s{X}{});
1437              
1438 12         73 return('REGEXP', [$string, $tokenbegin, $options]);
1439             };
1440             $input=~/\G%\{/gc
1441 478 50       1142 and do {
1442 0         0 my($code);
1443              
1444 0 0       0 $input=~/\G(.*?)%}/sgc
1445             or _SyntaxError( "Unmatched %{", $tokenbegin);
1446              
1447 0         0 $code=$1;
1448 0         0 $tokenend+= $code=~tr/\n//;
1449 0         0 return('Parse::Eyapp::Treeregexp::GLOBALCODE', [$code, $tokenbegin]);
1450             };
1451              
1452             $input=~/\G\{/gc
1453 478 100       1240 and do {
1454 70         172 my($level,$from,$code);
1455              
1456 70         163 $from=pos($input);
1457              
1458 70         148 $level=1;
1459 70         337 while($input=~/([{}])/gc) {
1460 272 50       839 substr($input,pos($input)-1,1) eq '\\' #Quoted
1461             and next;
1462 272 100       1199 $level += ($1 eq '{' ? 1 : -1)
    100          
1463             or last;
1464             }
1465             $level
1466 70 50       232 and _SyntaxError("Not closed open curly bracket { at $tokenbegin");
1467 70         231 $code = substr($input,$from,pos($input)-$from-1);
1468 70         159 $tokenend+= $code=~tr/\n//;
1469 70         330 return('CODE', [$code, $tokenbegin]);
1470             };
1471              
1472 408 100       1171 $input=~/\G(=>)/gc
1473             and return($1, $1);
1474              
1475             #Always return something
1476             $input=~/\G(.)/sg
1477 361 50       1077 and do {
1478 361 50       1108 $1 eq "\n" and ++$tokenend;
1479 361         1660 return ($1, [$1, $tokenbegin]);
1480             };
1481             #At EOF
1482 0         0 return('', undef);
1483             }
1484              
1485             sub _Error {
1486 0     0   0 my($value)=$_[0]->YYCurval;
1487              
1488 0 0 0     0 die "Syntax Error at end of file\n" unless (defined($value) and ref($value) eq 'ARRAY');
1489 0         0 my($what)= "input: '$$value[0]'";
1490              
1491 0         0 _SyntaxError("Unexpected $what",$$value[1]);
1492             }
1493              
1494             sub _SyntaxError {
1495 0     0   0 my($message,$lineno)=@_;
1496              
1497 0 0       0 $message= "Error in file $filename: $message, at ".
1498             ($lineno < 0 ? "eof" : "line $lineno").
1499             ".\n";
1500              
1501 0         0 die $message;
1502             }
1503              
1504             ####################################################################
1505             # Purpose : Treeregexp compiler bottom end. Code generation.
1506              
1507             package Parse::Eyapp::Treeregexp;
1508 36     36   381 use Carp;
  36         92  
  36         2148  
1509 36     36   224 use List::Util qw(first);
  36         82  
  36         1941  
1510 36     36   237 use Parse::Eyapp::Base qw(compute_lines slurp_file valid_keys invalid_keys write_file);
  36         92  
  36         99572  
1511              
1512             my %index; # Index of each ocurrence of a variable
1513             my $prefix; # Assume each AST node name /class is prefixed by $prefix
1514             my $severity = 0; # 0 = Don't check arity. 1 = Check arity. 2 = Check and give a warning 3 = ... croak
1515             my $allowlinenumbers = 1; # Enable/Disable line number directives
1516             #my $warninfo = "Line numbers in error messages are relative to the line where new is called.\n";
1517             my %methods; # $method{$treeclass} = [ array of YATW objects or transformations ]
1518             my $ouputlinepattern = '##line NUM FILE # line in code by treeregexp';
1519              
1520             sub compute_var_name {
1521 209     209 0 368 my $var = shift;
1522              
1523 209         336 my $nodename;
1524 209 100       570 if ($times{$var} > 1) { # node is array
1525 40         99 $nodename = $index{$var}++;
1526 40         111 $nodename = '$'."$var\[$nodename]";
1527             }
1528             else {
1529 169         323 $nodename = '$'.$var;
1530             }
1531 209         472 return $nodename;
1532             }
1533              
1534             ####################################################################
1535             # Usage :
1536             # my $transform = Parse::Eyapp::Treeregexp->new( STRING => q{
1537             # zero_times: TIMES(NUM($x), ., .) and { $x->{attr} == 0 } => { $_[0] = $NUM }
1538             # times_zero: TIMES(., ., NUM($x)) and { $x->{attr} == 0 } => { $_[0] = $NUM }
1539             # },
1540             # PACKAGE => 'Transformations',
1541             # OUTPUTFILE => 'main.pm',
1542             # SEVERITY => 0,
1543             # NUMBERS => 0,
1544             # ) ;
1545             # Returns : A Parse::Eyapp::Treeregexp object
1546             # Throws : croak if STRING and INFILE are defined or if no input is provided
1547             # also if the PACKAGE isrg does not contain a valid identifier
1548             # Parameters :
1549             my %_Trnew = (
1550             PACKAGE => 'STRING', # The package where the module will reside
1551             PREFIX => 'STRING', # prefix for all the node classes
1552             OUTPUTFILE => 'STRING', # If specified the package will be dumped to such file
1553             SYNTAX => 'BOOL', # Check perl actions syntax after generating the package
1554             SEVERITY => 'INT', # Controls the level of checking matching the number of childrens
1555             PERL5LIB => 'ARRAY', # Search path
1556             INFILE => 'STRING', # Input file containing the grammar
1557             STRING => 'STRING', # Input string containing the grammar. Incompatible with INFILE
1558             NUMBERS => 'BOOL', # Generate (or not) #line directives
1559             FIRSTLINE => 'INT', # Use it only with STRING. The linenumber where the string
1560             # containing the grammar begins
1561             );
1562             my $validkeys = valid_keys(%_Trnew);
1563              
1564             sub new {
1565 30     30 0 10982 my $class = shift;
1566 30 50       162 croak "Error in new_package: Use named arguments" if (@_ %2);
1567 30         174 my %arg = @_;
1568              
1569 30 50       210 if (defined($a = invalid_keys(\%_Trnew, \%arg))) {
1570 0         0 croak( "Parse::Eyapp::Treeregexp::new Error!: unknown argument $a. "
1571             ."Valid arguments are: $validkeys")
1572             }
1573 30         154 my $checksyntax = 1;
1574 30 50       149 $checksyntax = $arg{SYNTAX} if exists($arg{SYNTAX});
1575              
1576 30         113 my ($packagename, $outputfile) = ($arg{PACKAGE}, $arg{OUTPUTFILE});
1577              
1578             # file scope variables
1579 30         79 $filename = $arg{INFILE};
1580            
1581 30   50     230 my $perl5lib = $arg{PERL5LIB} || [];
1582              
1583             #package scope variables
1584 30         81 $severity = $arg{SEVERITY};
1585 30   100     183 $prefix = $arg{PREFIX} || '';
1586 30 100       140 $allowlinenumbers = defined($arg{NUMBERS})?$arg{NUMBERS}:1 ;
1587              
1588 30         77 my $input_from_file = 0;
1589 30         72 $tokenbegin = $tokenend = 1;
1590              
1591 30         83 $input = $arg{STRING};
1592 30 50       165 if (defined($filename)) {
    50          
1593 0         0 $input_from_file = 1;
1594 0 0       0 croak "STRING and INFILE parameters are mutually exclusive " if defined($input);
1595 0         0 $input = slurp_file($filename, 'trg');
1596             }
1597             elsif (defined($input)) { # input from string
1598 30         76 my ($callerpackagename);
1599 30         148 ($callerpackagename, $filename, $tokenend) = caller;
1600              
1601 30 100 66     210 $packagename = $callerpackagename
1602             unless defined($packagename) # Perl identifier regexp
1603             and $packagename =~ /(?:[A-Za-z_][A-Za-z0-9_]*::)*[A-Za-z_][A-Za-z0-9_]*/;
1604              
1605             }
1606             else {
1607 0         0 croak "Undefined input.";
1608             }
1609 30 50       122 ($packagename) = $filename =~ m{(^[a-zA-Z_]\w*)} if !defined($packagename);
1610 30 100 66     241 $tokenend = $arg{FIRSTLINE} if exists($arg{FIRSTLINE}) and $arg{FIRSTLINE} =~ m{^\s*\d+};
1611 30         81 $tokenbegin = $tokenend;
1612 30 50       258 croak "Bad formed package name"
1613             unless $packagename =~ m{^(?:[A-Za-z_][A-Za-z0-9_]*::)* # Perl identifier: prefix
1614             (?:[A-Za-z_][A-Za-z0-9_]*)$}x;
1615              
1616              
1617             #my ($basename) = $packagename =~ m{([a-zA-Z]\w*$)};
1618             #$outputfile = "$basename.pm" unless defined($outputfile);
1619              
1620 30         215 my $object = bless {
1621             'INPUT_FROM_FILE' => $input_from_file,
1622             'PACKAGENAME' => $packagename,
1623             'OUTPUTFILE' => $outputfile,
1624             'CHECKSYNTAX' => $checksyntax,
1625             'PERL5LIB' => $perl5lib,
1626             }, $class;
1627 30         161 return $object;
1628             }
1629              
1630             sub has_array_prefix {
1631 620     620 0 1031 my $self = shift;
1632              
1633             return defined($self->{arrayprefix})
1634 620         1838 }
1635              
1636             { # closure with $formula $declarations and $text
1637              
1638             my $formula;
1639             my $declarations;
1640             my $text = '';
1641              
1642             sub _generate_treereg_code {
1643 229     229   427 my $treereg = shift; # the node
1644 229         435 my $father = shift;
1645 229         448 my $source = shift; # Perl code describing how access this node
1646 229         383 my $order = shift; # my index in the array of children
1647              
1648 229   33     599 my $name = ref($treereg) || $treereg;
1649 229         406 my $aux;
1650             my $nodename;
1651 229         579 my $is_array = has_array_prefix($treereg);
1652              
1653 229         810 ($nodename, $aux) = $treereg->translate($father, $source, $order);
1654 229         575 $formula .= $aux;
1655 229 100 100     1231 return if (ref($treereg) =~ m{TERMINAL$} or $is_array);
1656              
1657             # $j : index of the child in the treeregexp formula not counting arrays
1658 96         190 my $j = 0;
1659 96         174 for (@{$treereg->{children}}) {
  96         257  
1660              
1661             # Saving $is_array has to be done before the call to
1662             #_generate_treereg_code, since
1663             # we delete the array_prefix entry after processing node $_
1664             # (See sub translate_array_prefix)
1665 162         364 $is_array = has_array_prefix($_);
1666 162         747 _generate_treereg_code($_, $nodename, "$nodename->child($j+\$child_index)", $j);
1667 162 100       523 $j++ unless $is_array;
1668             }
1669 96 100       356 if (my $pat = $treereg->{semantic}) {
1670 10         34 my $pattern = process_pattern($pat, $filename);
1671 10         31 $formula .= $pattern;
1672             }
1673             }
1674              
1675             sub generate_treereg_code {
1676 67     67 0 135 my $treereg = shift;
1677              
1678 67         134 $formula = '';
1679 67         251 _generate_treereg_code($treereg, '', '$_[$child_index]', undef);
1680             }
1681            
1682             # Parameters:
1683             # $checksyntax: controls whether or not to check Perl code for syntax errors
1684             sub generate {
1685 27     27 0 157 my $self = shift;
1686 27 50       231 croak "Error at ".__PACKAGE__."::generate. Expected a ".__PACKAGE__." object."
1687             unless $self->isa(__PACKAGE__);
1688 27   50     182 my $checksyntax = $self->{'CHECKSYNTAX'} || 1;
1689             my ($input_from_file, $packagename, $outputfile)
1690 27         111 = @$self{'INPUT_FROM_FILE', 'PACKAGENAME', 'OUTPUTFILE',};
1691              
1692 27         213 my $parser = Parse::Eyapp::Treeregparser->new();
1693 27         226 my $t = $parser->YYParse( yylex => \&Parse::Eyapp::Treeregparser::_Lexer,
1694             yyerror => \&Parse::Eyapp::Treeregparser::_Error,
1695             yybuildingtree => 1);
1696              
1697             # Traverse the tree generating the pattern-action subroutine
1698 27         91 my ($names, @names, %family); # Names of the generated subroutines
1699 27         98 my @Transformations = @$t;
1700 27         93 for my $transform (@Transformations) {
1701             $transform->isa('Parse::Eyapp::Treeregexp::GLOBALCODE')
1702 63 100       577 and do {
1703 9         46 $text .= $transform->translate();
1704 9         29 next; # iteration done
1705             };
1706              
1707             $transform->isa('Parse::Eyapp::Treeregexp::FAMILY')
1708 54 100       331 and do {
1709 3         10 my ($name, @members) = ($transform->{name}[0], @{$transform->{members}{children}});
  3         16  
1710 3         7 push @{$family{$name}}, @members;
  3         13  
1711 3         11 next;
1712             };
1713 51         122 my ($treereg, $action) = @{$transform->{children}};
  51         170  
1714              
1715 51         108 %times = @{$transform->{times}}; # global scope visible. Weakness
  51         220  
1716 51         144 %index = ();
1717 51         230 &fill_declarations(\$declarations);
1718              
1719 51         139 my $name = $transform->{name};
1720              
1721 51   100     192 $action ||= ""; # To Do
1722 51         149 $names .= "$name ";
1723 51         233 generate_treereg_code($treereg);
1724 51         174 my @classes = $treereg->classes;
1725 51         148 push @{$methods{$_}}, $name for @classes;
  79         276  
1726              
1727 51         256 $text .= fill_translation_sub($name, \$declarations, \$formula, $action, $filename);
1728             } # for my $transform ...
1729              
1730 27         134 $text = fill_translation_package($filename, $packagename, \$text, $names, \%family);
1731              
1732 27 50 33     237 if ($input_from_file or defined($outputfile)) {
1733 0 0       0 compute_lines(\$text, $outputfile, $ouputlinepattern) if $self->{NUMBERS};
1734 0         0 write_file($outputfile, \$text);
1735 0 0       0 if ($self->{CHECKSYNTAX}) {
1736 0         0 push @INC, @{$self->{PERL5LIB}};
  0         0  
1737 0         0 require $outputfile;
1738             }
1739             }
1740             else {
1741 27 50       135 print $text if $debug;
1742 27 50       129 if ($self->{CHECKSYNTAX}) {
1743 27         75 push @INC, @{$self->{PERL5LIB}};
  27         86  
1744 27 50   27   245 croak $@ unless eval $text;
  27 100   27   56  
  27 100   27   771  
  27 100   27   143  
  27 100   691   61  
  27 100   70   1058  
  27 50   65   151  
  27 100   52   74  
  27 50   35   2152  
  27 50   52   14770  
  27 50       87  
  27 100       10046  
  27 50       2840  
  691 50       1496  
  691 50       3018  
  510 100       489  
  567 100       1375  
  413 100       961  
  420 50       2936  
  360 50       654  
  290 0       421  
  304 0       650  
  264         483  
  137         216  
  199         1334  
  109         627  
  82         1090  
  98         974  
  39         219  
  28         136  
  22         76  
  19         88  
  57         143  
  55         483  
  52         0  
  52         0  
  52         72  
  52         76  
  52         199  
  1         4  
  1         4  
  1         5  
  1         6  
  1         3  
  1         6  
  0         0  
  0         0  
  35         74  
  35         100  
  87         120  
  87         192  
  87         45  
  87         51  
  87         136  
  54         76  
  54         83  
  54         258  
  5         16  
  4         12  
  4         12  
  4         14  
  52         106  
  52         148  
  52         0  
  52         0  
  52         74  
  52         75  
  52         202  
  1         4  
  0            
  0            
  0            
  0            
  0            
  0            
  0            
1745             }
1746             }
1747              
1748 27         428 undef %times;
1749 27         73 undef %index;
1750 27         87 undef $tokenbegin;
1751 27         62 undef $tokenend;
1752 27         820 undef $prefix;
1753 27         72 undef $input;
1754 27         62 undef $declarations;
1755 27         63 undef $text;
1756 27         66 undef $filename;
1757 27         5014 return 1;
1758             }
1759              
1760             sub translate_array_prefix {
1761 16     16 0 57 my ($self, $father, $order) = @_;
1762              
1763 16         37 my $localformula = $formula;
1764            
1765 16         39 my $arrname = $self->{arrayprefix};
1766 16         42 delete($self->{arrayprefix});
1767 16         114 generate_treereg_code($self);
1768 16         70 my $aux = fill_translation_array_sub($self, $arrname, $order, \$formula, $father);
1769            
1770 16         40 $formula = $localformula;
1771              
1772 16         39 return $aux;
1773             }
1774              
1775             } # closure with $formula $declarations and $text
1776              
1777             sub make_references_to_subs {
1778 30     30 0 278 $_[0] =~ s/\b([a-z_A-Z]\w*)\b/$1 => \\\&$1,/g;
1779             }
1780              
1781             sub unique {
1782 3     3 0 9 my %saw = ();
1783 3         19 my @out = grep(!$saw{$_}++, @_);
1784 3         13 return @out;
1785             }
1786              
1787             # Checks that all the transformation rules in the list have been defined
1788             sub check_existence {
1789 3     3 0 19 my $familyname = shift;
1790 3         7 my $names = shift;
1791 3         18 my $line = shift;
1792              
1793 3         10 for (@_) {
1794 8 50       132 croak "Error! treereg rule '$_' not defined (family '$familyname' at line $line)."
1795             unless $names =~ m/\b$_\b/;
1796             }
1797             }
1798              
1799             sub translate {
1800 229     229 0 535 my ($self, $father, $order, $translation) = @_;
1801              
1802 229 100       461 $translation = translate_array_prefix($self, $father, $order) if has_array_prefix($self);
1803 229         566 return $translation;
1804             }
1805              
1806             ######### Fill subroutines ##########
1807              
1808             sub linenumber {
1809 73     73 0 175 my ($linenumber, $filename) = @_;
1810              
1811 73 100       378 return "#line $linenumber \"$filename\"" if $allowlinenumbers;
1812 14         25 return '';
1813             }
1814              
1815             ####################################################################
1816             # Usage : fill_translation_array_sub($self, $arrname, $order, \$formula, $father);
1817             # Purpose : translation of array atoms in treeregexps like ABC(@a, B, @c)
1818             # Returns : the text containing the sub handler and the loop
1819             # Parameters : $name: gives the name to the array and to the sub handler
1820             # $order: index of the array formula as child
1821             # $formula: declarations
1822             # $father: the father node of the array tree pattern
1823              
1824             sub fill_translation_array_sub {
1825 16     16 0 63 my ($self, $name, $order, $formula, $father, $line) = @_;
1826            
1827 16         54 chomp($$formula);
1828 16         53 my $sname = '$'.$name; # var referencing the sub
1829 16         37 my $aname = '@'.$name; # the array that will hold the nodes
1830 16 50       71 $line = '' unless defined($line);
1831              
1832 16         122 return <<"END_TRANSLATION_STAR_SUB";
1833             my $sname = sub {
1834             my \$child_index = 0;
1835             $$formula
1836             $line
1837             return 1;
1838             }; # end anonymous sub $sname
1839              
1840             return 0 unless until_first_match(
1841             $father, $order, $sname, \\$aname);
1842             \$child_index += 1+$aname;
1843             END_TRANSLATION_STAR_SUB
1844             } # sub fill_translation_array_sub
1845              
1846             sub process_pattern {
1847 14     14 0 43 my ($pat, $filename) = @_;
1848            
1849 14         45 my $linenodirective = linenumber($pat->[1], $filename);
1850 14         37 my ($pattern);
1851 14 50       49 if (defined($pat)) {
1852 14         55 $pattern =<<"ENDOFPATTERN";
1853             return 0 unless do
1854             $linenodirective
1855             {$pat->[0]};
1856             ENDOFPATTERN
1857             }
1858             else {
1859 0         0 $pattern = '';
1860             #chomp($formula);
1861             }
1862 14         41 return $pattern;
1863             }
1864              
1865             sub process_action {
1866 51     51 0 134 my ($action, $filename) = @_;
1867              
1868 51         104 my ($actiontext);
1869              
1870 51 100       171 if ($action) {
1871 47         179 my $line_directive = linenumber($action->[1], $filename);
1872 47         204 $actiontext = "$line_directive\n".
1873             " { $action->[0]}";
1874             }
1875             else {
1876 4         6 $actiontext = " 1;"
1877             }
1878 51         144 return $actiontext;
1879             }
1880              
1881             sub fill_translation_sub {
1882 51     51 0 165 my ($name, $declarations, $formula, $action, $filename, $line) = @_;
1883 51         94 my ($actiontext);
1884              
1885 51 50       189 $line = '' unless defined($line);
1886 51         179 $actiontext = process_action($action, $filename);
1887              
1888 51         525 return <<"END_TREEREG_TRANSLATIONS";
1889              
1890             sub $name {
1891             my \$$name = \$_[3]; # reference to the YATW pattern object
1892             $$declarations
1893             {
1894             my \$child_index = 0;
1895              
1896             $$formula
1897             } # end block of child_index
1898             $actiontext
1899              
1900             } # end of $name
1901             $line
1902             END_TREEREG_TRANSLATIONS
1903             } # end sub fill_translation_sub
1904              
1905             sub fill_declarations {
1906 51     51 0 127 my $declarations = shift;
1907              
1908 51         130 $$declarations = '';
1909 51         190 for (keys(%times)) {
1910 209 100       697 $$declarations .= " my \$$_;\n", next if ($times{$_} == 1);
1911 55         182 $$declarations .= " my \@$_;\n"
1912             }
1913             }
1914              
1915             sub fill_translation_package {
1916 27     27 0 107 my ($filename, $packagename, $code, $names, $family) = @_;
1917 27         69 my $familiesdecl = '';
1918              
1919 27         116 for (keys %$family) {
1920 3         7 my $t;
1921 3         7 my @members = map { $t = $_->{attr}; $t->[0] } @{$family->{$_}};
  8         19  
  8         23  
  3         10  
1922 3         14 @members = unique(@members);
1923 3         10 my $line = $family->{$_}[0]{attr}[1];
1924 3         15 check_existence($_, $names, $line, @members);
1925 3         15 $t = "@members";
1926 3         15 &make_references_to_subs($t);
1927 3         11 my $line_directive = linenumber($line, $filename);
1928 3         20 $familiesdecl .= "$line_directive\n".
1929             "our \@$_ = Parse::Eyapp::YATW->buildpatterns($t);\n"; # TODO lines, etc.
1930             }
1931              
1932 27         214 my $scalar_names;
1933 27         358 ($scalar_names = $names) =~ s/\b([a-z_A-Z]\w*)\b/our \$$1,/g;;
1934 27         144 &make_references_to_subs($names);
1935 27         145 $familiesdecl .= "our \@all = ( $scalar_names) = Parse::Eyapp::YATW->buildpatterns($names);\n";
1936              
1937 27         324 return <<"END_PACKAGE_TRANSLATIONS";
1938             package $packagename;
1939              
1940             # This module has been generated using Parse::Eyapp::Treereg
1941             # from file $filename. Don't modify it.
1942             # Change $filename instead.
1943             # Copyright © 2006, 2007, 2008, 2009, 2010, 2011, 2012 Casiano Rodriguez-Leon.
1944             # Copyright © 2017 William N. Braswell, Jr.
1945             # All Rights Reserved.
1946             #
1947             # Parse::Yapp is Copyright © 1998, 1999, 2000, 2001, Francois Desarmenien.
1948             # Parse::Yapp is Copyright © 2017 William N. Braswell, Jr.
1949             # All Rights Reserved.
1950             # You may use it and distribute it under the terms of either
1951             # the GNU General Public License or the Artistic License,
1952             # as specified in the Perl README file.
1953              
1954             use strict;
1955             use warnings;
1956             use Carp;
1957             use Parse::Eyapp::_TreeregexpSupport qw(until_first_match checknumchildren);
1958              
1959             $familiesdecl
1960             $$code
1961             1;
1962              
1963             END_PACKAGE_TRANSLATIONS
1964             } # end of sub fill_translation_package
1965              
1966             ######## TERMINAL classes #########
1967             sub code_translation {
1968 107     107 0 201 my $self = shift;
1969              
1970 107         204 my $pat = $self->{semantic};
1971 107 100       309 return process_pattern($pat, $filename) if $pat;
1972 103         257 return '';
1973             }
1974              
1975             ######## Parse::Eyapp::Treeregexp::REGEXP_TERMINAL #########
1976              
1977             sub Parse::Eyapp::Treeregexp::REGEXP_TERMINAL::translate {
1978 1     1   4 my ($self, $father, $source, $order) = @_;
1979              
1980             # nodename is the variable associated with the tree node i.e.
1981             # for a node NUM it may be $NUM[0] or similar
1982 1         2 my ($nodename, $aux);
1983 1         3 $nodename = '$'.$self->{attr};
1984            
1985 1         3 my ($regexp, $options) = ($self->{regexp}, $self->{options});
1986 1         7 $aux = translate($self, $father, $order,
1987             " return 0 unless ref($nodename = $source) =~ m{$regexp}$options;\n");
1988 1         3 $aux .= code_translation($self);
1989 1         4 return ($nodename, $aux);
1990             }
1991              
1992             sub Parse::Eyapp::Treeregexp::REGEXP_TERMINAL::classes {
1993 12     12   49 my $treereg = shift;
1994              
1995 12         43 my $regexp = $treereg->{regexp};
1996              
1997             # what if option "B" is used?
1998 12         29 my @classes;
1999 12         178 @classes = $regexp =~ m/\\b|((?:[a-zA-Z_][a-zA-Z_0-9]*::)*(?:[a-zA-Z_][a-zA-Z_0-9]*))/g;
2000 12         52 return grep {defined($_) } @classes;
  120         282  
2001             }
2002              
2003             ######## Parse::Eyapp::Treeregexp::SCALAR_TERMINAL #########
2004              
2005             sub Parse::Eyapp::Treeregexp::SCALAR_TERMINAL::translate {
2006 73     73   192 my ($self, $father, $source, $order) = @_;
2007              
2008 73         132 my ($nodename, $aux);
2009              
2010             # Warning! not needed for scalars but for Ws (see alias)
2011 73         176 $nodename = Parse::Eyapp::Treeregexp::compute_var_name($self->{attr});
2012 73         250 $aux = translate($self, $father, $order,
2013             " return 0 unless defined($nodename = $source);\n");
2014              
2015 73         188 $aux .= code_translation($self);
2016 73         201 return ($nodename, $aux);
2017             }
2018              
2019             sub Parse::Eyapp::Treeregexp::SCALAR_TERMINAL::classes {
2020 3     3   8 my $self = shift;
2021              
2022 3         11 return ('*');
2023             }
2024              
2025             ######## Parse::Eyapp::Treeregexp::IDENT_TERMINAL #########
2026             sub Parse::Eyapp::Treeregexp::IDENT_TERMINAL::translate {
2027 33     33   89 my ($self, $father, $source, $order) = @_;
2028              
2029 33         62 my ($nodename, $aux);
2030 33         62 my $name = $self->{attr};
2031 33         90 $nodename = Parse::Eyapp::Treeregexp::compute_var_name($self->{attr});
2032 33         173 $aux = translate($self, $father, $order,
2033             " return 0 unless ref($nodename = $source) eq '$prefix$name';\n");
2034 33         206 $aux .= code_translation($self);
2035 33         90 return ($nodename, $aux);
2036             }
2037              
2038             sub Parse::Eyapp::Treeregexp::IDENT_TERMINAL::classes {
2039 8     8   19 my $treereg = shift;
2040              
2041 8         24 my @classes = ($treereg->{attr});
2042 8         21 return @classes;
2043             }
2044              
2045             ######## Parse::Eyapp::Treeregexp::ARRAY_TERMINAL #########
2046             sub Parse::Eyapp::Treeregexp::ARRAY_TERMINAL::translate {
2047 19     19   68 my ($self, $father, $source, $order) = @_;
2048              
2049 19         50 my ($nodename, $aux);
2050 19         53 my $id = $self->{attr};
2051 19         47 $nodename = '@'.$id;
2052 19         125 $aux = translate($self, $father, $order,
2053             " $nodename = ($father->children);\n".
2054             " $nodename = $nodename\[\$child_index+$order..\$#$id];\n"
2055             );
2056 19         55 return ($nodename, $aux);
2057             }
2058              
2059             sub Parse::Eyapp::Treeregexp::ARRAY_TERMINAL::classes {
2060 0     0   0 croak "Fatal error: Parse::Eyapp::Treeregexp::ARRAY_TERMINAL::classes called from the root of a tree";
2061             }
2062              
2063             ############### INNER classes ###############
2064             sub generate_check_numchildren {
2065 103     103 0 256 my ($self, $nodename, $severity) = @_;
2066              
2067 103 100       362 return '' unless $severity;
2068              
2069 4         8 my $name = $self->{id};
2070 4         6 my $numexpected = @{$self->{children}};
  4         10  
2071 4         7 my $line = $self->{line};
2072              
2073 4         22 my $warning = " return 0 unless checknumchildren($nodename, $numexpected, $line, ".
2074             "'$filename', $self->{numarrays}, $severity);\n";
2075 4         9 return $warning;
2076             }
2077              
2078             ############### Parse::Eyapp::Treeregexp::REGEXP_INNER ###############
2079              
2080             sub Parse::Eyapp::Treeregexp::REGEXP_INNER::translate {
2081 11     11   58 my ($self, $father, $source, $order) = @_;
2082              
2083 11         31 my ($nodename, $aux);
2084              
2085 11         38 my $name = $self->{id};
2086 11         51 $nodename = Parse::Eyapp::Treeregexp::compute_var_name($name);
2087              
2088 11         164 my $warning = generate_check_numchildren($self, $nodename, $severity);
2089              
2090 11         51 my ($regexp, $options) = ($self->{regexp}, $self->{options});
2091              
2092             # TODO #line goes here
2093 11         68 my $template = " return 0 unless ref($nodename = $source) =~ m{$regexp}$options;\n"
2094             . $warning;
2095 11         52 $aux = translate($self, $father, $order, $template);
2096 11         43 return ($nodename, $aux);
2097             }
2098              
2099             *Parse::Eyapp::Treeregexp::REGEXP_INNER::classes = \&Parse::Eyapp::Treeregexp::REGEXP_TERMINAL::classes;
2100            
2101             ############### Parse::Eyapp::Treeregexp::IDENT_INNER ###############
2102              
2103             sub Parse::Eyapp::Treeregexp::IDENT_INNER::translate {
2104 89     89   236 my ($self, $father, $source, $order) = @_;
2105              
2106 89         159 my ($nodename, $aux);
2107              
2108 89         209 my $name = $self->{id};
2109 89         218 $nodename = Parse::Eyapp::Treeregexp::compute_var_name($name);
2110              
2111 89         230 my $warning = generate_check_numchildren($self, $nodename, $severity);
2112              
2113 89         324 my $template = " return 0 unless (ref($nodename = $source) eq '$prefix$name');\n"
2114             . $warning;
2115 89         290 $aux = translate($self, $father, $order, $template);
2116 89         246 return ($nodename, $aux);
2117             }
2118              
2119             sub Parse::Eyapp::Treeregexp::IDENT_INNER::classes {
2120 28     28   69 my $treereg = shift;
2121              
2122 28         93 my @classes = ( $treereg->{id} );
2123 28         105 return @classes;
2124             }
2125              
2126             ############### Parse::Eyapp::Treeregexp::SCALAR_INNER ###############
2127              
2128             sub Parse::Eyapp::Treeregexp::SCALAR_INNER::translate {
2129 3     3   10 my ($self, $father, $source, $order) = @_;
2130              
2131 3         6 my ($nodename, $aux);
2132              
2133 3         6 my $name = $self->{id};
2134              
2135             # Warning! not needed for scalars but for Ws
2136 3         15 $nodename = Parse::Eyapp::Treeregexp::compute_var_name($name);
2137              
2138 3         16 my $warning = generate_check_numchildren($self, $nodename, $severity);
2139              
2140 3         12 my $template = " return 0 unless defined($nodename = $source);\n"
2141             . $warning;
2142 3         14 $aux = translate($self, $father, $order, $template);
2143 3         10 return ($nodename, $aux);
2144             }
2145              
2146             *Parse::Eyapp::Treeregexp::SCALAR_INNER::classes = \&Parse::Eyapp::Treeregexp::SCALAR_TERMINAL::classes;
2147              
2148             ########## Parse::Eyapp::Treeregexp::GLOBALCODE #############
2149              
2150             sub Parse::Eyapp::Treeregexp::GLOBALCODE::translate {
2151 9     9   22 my $transform = shift;
2152              
2153 9         56 my $line_directive = linenumber($transform->[1], $filename);
2154 9         68 return "$line_directive\n".
2155             "$transform->[0]\n";
2156             };
2157              
2158              
2159              
2160             =for None
2161              
2162             =cut
2163              
2164              
2165             ################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################
2166              
2167              
2168              
2169             1;