line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# Module Parse::Eyapp::Output |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# This module is based on Francois Desarmenien Parse::Yapp distribution |
5
|
|
|
|
|
|
|
# (c) Parse::Yapp Copyright 1998-2001 Francois Desarmenien, all rights reserved. |
6
|
|
|
|
|
|
|
# (c) Parse::Eyapp Copyright 2006-2008 Casiano Rodriguez-Leon, all rights reserved. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package Parse::Eyapp::Output; |
10
|
61
|
|
|
61
|
|
346
|
use strict; |
|
61
|
|
|
|
|
120
|
|
|
61
|
|
|
|
|
6668
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our @ISA=qw ( Parse::Eyapp::Lalr ); |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
require 5.004; |
15
|
|
|
|
|
|
|
|
16
|
61
|
|
|
61
|
|
44658
|
use Parse::Eyapp::Base qw(compute_lines); |
|
61
|
|
|
|
|
707
|
|
|
61
|
|
|
|
|
9304
|
|
17
|
61
|
|
|
61
|
|
68185
|
use Parse::Eyapp::Lalr; |
|
61
|
|
|
|
|
253
|
|
|
61
|
|
|
|
|
3437
|
|
18
|
61
|
|
|
61
|
|
421
|
use Parse::Eyapp::Driver; |
|
61
|
|
|
|
|
129
|
|
|
61
|
|
|
|
|
1693
|
|
19
|
61
|
|
|
61
|
|
441
|
use Parse::Eyapp::Node; # required to have access to $Parse::Eyapp::Node::FILENAME |
|
61
|
|
|
|
|
144
|
|
|
61
|
|
|
|
|
2893
|
|
20
|
61
|
|
|
61
|
|
376
|
use File::Basename; |
|
61
|
|
|
|
|
127
|
|
|
61
|
|
|
|
|
10419
|
|
21
|
|
|
|
|
|
|
#use Data::Dumper; |
22
|
61
|
|
|
61
|
|
396
|
use List::Util qw(first); |
|
61
|
|
|
|
|
167
|
|
|
61
|
|
|
|
|
4478
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
61
|
|
|
61
|
|
460
|
use Carp; |
|
61
|
|
|
|
|
131
|
|
|
61
|
|
|
|
|
204603
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
# Remove tokens that not appear in the right hand side |
28
|
|
|
|
|
|
|
# of any production |
29
|
|
|
|
|
|
|
# Check if not quote tokens aren't defined |
30
|
|
|
|
|
|
|
sub deleteNotUsedTokens { |
31
|
54
|
|
|
54
|
0
|
184
|
my ($self, $term, $termDef) = @_; |
32
|
|
|
|
|
|
|
|
33
|
54
|
|
|
|
|
189
|
my $rules = $self->{GRAMMAR}{RULES}; |
34
|
54
|
|
|
|
|
158
|
my @usedSymbols = map { @{$_->[1]} } @$rules; |
|
691
|
|
|
|
|
731
|
|
|
691
|
|
|
|
|
2619
|
|
35
|
54
|
|
|
|
|
471
|
my %usedSymbols; |
36
|
54
|
|
|
|
|
671
|
@usedSymbols{@usedSymbols} = (); |
37
|
|
|
|
|
|
|
|
38
|
54
|
|
|
|
|
123
|
for (@{$self->{GRAMMAR}{DUMMY}}) { |
|
54
|
|
|
|
|
302
|
|
39
|
0
|
|
|
|
|
0
|
delete $usedSymbols{$_}; |
40
|
0
|
|
|
|
|
0
|
delete $termDef->{$_}; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
|
43
|
54
|
|
|
|
|
274
|
for my $token (keys %$term) { |
44
|
514
|
100
|
|
|
|
1357
|
delete $term->{$token} unless exists $usedSymbols{$token}; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# Emit a warning if exists a non '' token in %usedSymbols that is not in %termdef |
48
|
54
|
50
|
33
|
|
|
1370
|
if ($self->{GRAMMAR}{STRICT} && %$termDef) { |
49
|
0
|
|
|
|
|
0
|
my @undefined = grep { ! exists $termDef->{$_} } grep { m{^[^']} } keys %$term; |
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
50
|
0
|
0
|
|
|
|
0
|
if (@undefined) { |
51
|
0
|
|
|
|
|
0
|
@undefined = map { "Warning: may be you forgot to define token '$_'?: %token $_ = /someRegExp/" } @undefined; |
|
0
|
|
|
|
|
0
|
|
52
|
|
|
|
|
|
|
|
53
|
0
|
|
|
|
|
0
|
local $" = "\n"; |
54
|
0
|
|
|
|
|
0
|
warn "@undefined\n"; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
# builds a trivial lexer |
60
|
|
|
|
|
|
|
sub makeLexer { |
61
|
54
|
|
|
54
|
0
|
165
|
my $self = shift; |
62
|
|
|
|
|
|
|
|
63
|
54
|
|
|
|
|
151
|
my $WHITES = 'm{\G(\s+)}gc and $self->tokenline($1 =~ tr{\n}{})'; |
64
|
54
|
|
|
|
|
212
|
my $w = $self->{GRAMMAR}{WHITES}[0]; |
65
|
54
|
50
|
|
|
|
311
|
if (defined $w) { |
66
|
|
|
|
|
|
|
# if CODE then literally |
67
|
0
|
0
|
|
|
|
0
|
if ($self->{GRAMMAR}{WHITES}[2] eq 'CODE') { |
68
|
0
|
|
|
|
|
0
|
$WHITES = $w; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
else { |
71
|
0
|
|
|
|
|
0
|
$w =~ s{^/}{/\\G}; |
72
|
0
|
|
|
|
|
0
|
$WHITES = $w.'gc and $self->tokenline($1 =~ tr{\n}{})'; |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
54
|
50
|
|
|
|
301
|
my $INCREMENTAL = defined($self->{GRAMMAR}{INCREMENTAL}) ? _incrementalLexerText() : ''; |
77
|
|
|
|
|
|
|
|
78
|
54
|
|
|
|
|
127
|
my %term = %{$self->{GRAMMAR}{TERM}}; |
|
54
|
|
|
|
|
693
|
|
79
|
54
|
|
|
|
|
849
|
delete $term{"\c@"}; |
80
|
54
|
|
|
|
|
135
|
delete $term{'error'}; |
81
|
|
|
|
|
|
|
|
82
|
54
|
|
|
|
|
289
|
my %termdef = %{$self->{GRAMMAR}{TERMDEF}}; |
|
54
|
|
|
|
|
293
|
|
83
|
|
|
|
|
|
|
|
84
|
54
|
|
|
|
|
672
|
$self->deleteNotUsedTokens(\%term, \%termdef); |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# remove from %term the tokens that were explictly defined |
88
|
54
|
|
|
|
|
204
|
my @index = grep { !(exists $termdef{$_}) } keys %term; |
|
478
|
|
|
|
|
936
|
|
89
|
54
|
|
|
|
|
182
|
%term = map { ($_, $term{$_}) } @index; |
|
402
|
|
|
|
|
872
|
|
90
|
|
|
|
|
|
|
|
91
|
54
|
|
|
|
|
265
|
my @term = map { s/'$//; s/^'//; $_ } keys %term; |
|
402
|
|
|
|
|
1297
|
|
|
402
|
|
|
|
|
1098
|
|
|
402
|
|
|
|
|
909
|
|
92
|
|
|
|
|
|
|
|
93
|
54
|
|
|
|
|
433
|
@term = sort { length($b) <=> length($a) } @term; |
|
920
|
|
|
|
|
1119
|
|
94
|
54
|
|
|
|
|
153
|
@term = map { quotemeta } @term; |
|
402
|
|
|
|
|
1043
|
|
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# Keep escape characters as \n \r, etc. |
97
|
54
|
|
|
|
|
1259
|
@term = map { s/\\\\(.)/\\$1/g; $_ } @term; |
|
402
|
|
|
|
|
474
|
|
|
402
|
|
|
|
|
818
|
|
98
|
|
|
|
|
|
|
|
99
|
54
|
|
|
|
|
188
|
my $TERM = ''; |
100
|
54
|
100
|
|
|
|
370
|
if (@term) { |
101
|
42
|
|
|
|
|
264
|
$TERM = join '|', @term; |
102
|
42
|
|
|
|
|
276
|
$TERM = "\\G($TERM)"; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# Translate defined tokens |
106
|
|
|
|
|
|
|
# sort by line number |
107
|
54
|
|
|
|
|
268
|
my @termdef = sort { $termdef{$a}->[1] <=> $termdef{$b}->[1] } keys %termdef; |
|
151
|
|
|
|
|
297
|
|
108
|
|
|
|
|
|
|
|
109
|
54
|
|
|
|
|
159
|
my $DEFINEDTOKENS = ''; |
110
|
54
|
|
|
|
|
170
|
for my $t (@termdef) { |
111
|
76
|
50
|
|
|
|
527
|
if ($termdef{$t}[2] eq 'REGEXP') { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
112
|
0
|
|
|
|
|
0
|
my $reg = $termdef{$t}[0]; |
113
|
0
|
|
|
|
|
0
|
$reg =~ s{^/}{/\\G}; # add \G at the begining of the regexp |
114
|
0
|
|
|
|
|
0
|
$DEFINEDTOKENS .= << "EORT"; |
115
|
|
|
|
|
|
|
${reg}gc and return ('$t', \$1); |
116
|
|
|
|
|
|
|
EORT |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
elsif ($termdef{$t}[2] eq 'CONTEXTUAL_REGEXP') { |
119
|
0
|
|
|
|
|
0
|
my $reg = $termdef{$t}[0]; |
120
|
0
|
|
|
|
|
0
|
$reg =~ s{^/}{/\\G}; # add \G at the begining of the regexp |
121
|
0
|
|
|
|
|
0
|
$DEFINEDTOKENS .= << "EORT"; |
122
|
|
|
|
|
|
|
\$self->expects('$t') and ${reg}gc and return ('$t', \$1); |
123
|
|
|
|
|
|
|
EORT |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
elsif ($termdef{$t}[2] eq 'CONTEXTUAL_REGEXP_MATCH') { |
126
|
0
|
|
|
|
|
0
|
my $reg = $termdef{$t}[0]; |
127
|
0
|
|
|
|
|
0
|
my $parser = $termdef{$t}[3][0]; |
128
|
0
|
|
|
|
|
0
|
$reg =~ s{^/}{/\\G}; # add \G at the begining of the regexp |
129
|
0
|
|
|
|
|
0
|
$DEFINEDTOKENS .= << "EORT"; |
130
|
|
|
|
|
|
|
\$pos = pos(); |
131
|
|
|
|
|
|
|
if (${reg}gc) { |
132
|
|
|
|
|
|
|
if (\$self->expects('$t')) { |
133
|
|
|
|
|
|
|
my \$oldselfpos = \$self->{POS}; |
134
|
|
|
|
|
|
|
\$self->{POS} = pos(); |
135
|
|
|
|
|
|
|
if (\$self->YYPreParse('$parser')) { |
136
|
|
|
|
|
|
|
\$self->{POS} = \$oldselfpos; |
137
|
|
|
|
|
|
|
return ('$t', \$1); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
else { |
140
|
|
|
|
|
|
|
\$self->{POS} = \$oldselfpos; |
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
pos(\$_) = \$pos; |
145
|
|
|
|
|
|
|
EORT |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
elsif ($termdef{$t}[2] eq 'CONTEXTUAL_REGEXP_NOMATCH') { |
148
|
0
|
|
|
|
|
0
|
my $reg = $termdef{$t}[0]; |
149
|
0
|
|
|
|
|
0
|
my $parser = $termdef{$t}[3][0]; |
150
|
0
|
|
|
|
|
0
|
$reg =~ s{^/}{/\\G}; # add \G at the begining of the regexp |
151
|
|
|
|
|
|
|
# factorize, factorize!!!! ohh!!!! |
152
|
0
|
|
|
|
|
0
|
$DEFINEDTOKENS .= << "EORT"; |
153
|
|
|
|
|
|
|
\$pos = pos(); |
154
|
|
|
|
|
|
|
if (${reg}gc) { |
155
|
|
|
|
|
|
|
if (\$self->expects('$t')) { |
156
|
|
|
|
|
|
|
my \$oldselfpos = \$self->{POS}; |
157
|
|
|
|
|
|
|
\$self->{POS} = pos(); |
158
|
|
|
|
|
|
|
if (!\$self->YYPreParse('$parser')) { |
159
|
|
|
|
|
|
|
\$self->{POS} = \$oldselfpos; |
160
|
|
|
|
|
|
|
return ('$t', \$1); |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
else { |
163
|
|
|
|
|
|
|
\$self->{POS} = \$oldselfpos; |
164
|
|
|
|
|
|
|
} |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
pos(\$_) = \$pos; |
168
|
|
|
|
|
|
|
EORT |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
elsif ($termdef{$t}[2] eq 'LITERAL') { # %token without regexp or code definition |
171
|
76
|
|
|
|
|
132
|
my $reg = $termdef{$t}[0]; |
172
|
76
|
|
|
|
|
288
|
$reg =~ s{^'?}{}; # $reg =~ s{^'?}{/\\G(}; |
173
|
76
|
|
|
|
|
294
|
$reg =~ s{'?$}{}; # $reg =~ s{'?$}{)/}; |
174
|
76
|
|
|
|
|
138
|
$reg = quotemeta($reg); |
175
|
76
|
|
|
|
|
228
|
$DEFINEDTOKENS .= << "EORT"; |
176
|
|
|
|
|
|
|
/\\G(${reg})/gc and return (\$1, \$1); |
177
|
|
|
|
|
|
|
EORT |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
elsif ($termdef{$t}[2] eq 'CODE') { # token definition is code |
180
|
0
|
|
|
|
|
0
|
$DEFINEDTOKENS .= "$termdef{$t}[0]\n"; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
54
|
|
|
|
|
279
|
my $frame = _lexerFrame(); |
185
|
54
|
|
|
|
|
360
|
$frame =~ s/<>/$INCREMENTAL/; |
186
|
54
|
|
|
|
|
310
|
$frame =~ s/<>/$WHITES/; |
187
|
|
|
|
|
|
|
|
188
|
54
|
100
|
|
|
|
384
|
if (@term) { |
189
|
42
|
|
|
|
|
461
|
$frame =~ s/<>/m{$TERM}gc and return (\$1, \$1);/ |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
else { |
192
|
12
|
|
|
|
|
54
|
$frame =~ s/<>// |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
54
|
|
|
|
|
3514
|
$frame =~ s/<>/$DEFINEDTOKENS/; |
196
|
|
|
|
|
|
|
|
197
|
54
|
|
|
|
|
416
|
return $frame; |
198
|
|
|
|
|
|
|
} |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
sub _incrementalLexerText { |
201
|
|
|
|
|
|
|
|
202
|
0
|
|
|
0
|
|
0
|
return << 'ENDOFINCREMENTAL'; |
203
|
|
|
|
|
|
|
if ($self->YYEndOfInput) { |
204
|
|
|
|
|
|
|
print $a if defined($a = $self->YYPrompt); |
205
|
|
|
|
|
|
|
my $file = $self->YYInputFile; |
206
|
|
|
|
|
|
|
$_ = <$file>; |
207
|
|
|
|
|
|
|
return ('', undef) unless $_; |
208
|
|
|
|
|
|
|
} |
209
|
|
|
|
|
|
|
ENDOFINCREMENTAL |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
sub _lexerFrame { |
213
|
54
|
|
|
54
|
|
379
|
return << 'EOLEXER'; |
214
|
|
|
|
|
|
|
# Default lexical analyzer |
215
|
|
|
|
|
|
|
our $LEX = sub { |
216
|
|
|
|
|
|
|
my $self = shift; |
217
|
|
|
|
|
|
|
my $pos; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
for (${$self->input}) { |
220
|
|
|
|
|
|
|
<> |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
<>; |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
<> |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
<> |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
return ('', undef) if ($_ eq '') || (defined(pos($_)) && (pos($_) >= length($_))); |
229
|
|
|
|
|
|
|
/\G\s*(\S+)/; |
230
|
|
|
|
|
|
|
my $near = substr($1,0,10); |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
return($near, $near); |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# die( "Error inside the lexical analyzer near '". $near |
235
|
|
|
|
|
|
|
# ."'. Line: ".$self->line() |
236
|
|
|
|
|
|
|
# .". File: '".$self->YYFilename()."'. No match found.\n"); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
; |
240
|
|
|
|
|
|
|
EOLEXER |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
#################################################################### |
244
|
|
|
|
|
|
|
# Returns : The string '{\n file contents }\n' with pre and post comments |
245
|
|
|
|
|
|
|
# Parameters : a file name |
246
|
|
|
|
|
|
|
sub _CopyModule { |
247
|
0
|
|
|
0
|
|
0
|
my ($module, $function, $file) = @_; |
248
|
|
|
|
|
|
|
|
249
|
0
|
0
|
|
|
|
0
|
open(DRV,$file) or die "BUG: could not open $file"; |
250
|
0
|
|
|
|
|
0
|
my $text = join('',); |
251
|
0
|
|
|
|
|
0
|
close(DRV); |
252
|
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
0
|
my $label = $module; |
254
|
0
|
|
|
|
|
0
|
$label =~ s/::/_/g; |
255
|
0
|
|
|
|
|
0
|
return << "EOCODE"; |
256
|
|
|
|
|
|
|
# Loading $module |
257
|
|
|
|
|
|
|
BEGIN { |
258
|
|
|
|
|
|
|
unless ($module->can('$function')) { |
259
|
|
|
|
|
|
|
eval << 'MODULE_$label' |
260
|
|
|
|
|
|
|
$text |
261
|
|
|
|
|
|
|
MODULE_$label |
262
|
|
|
|
|
|
|
}; # Unless $module was loaded |
263
|
|
|
|
|
|
|
} ########### End of BEGIN { load $file } |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
EOCODE |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
## This sub gives support to the "%tree alias" directive |
269
|
|
|
|
|
|
|
## Builds the text for the named accessors to the children |
270
|
|
|
|
|
|
|
sub make_accessors { |
271
|
54
|
|
|
54
|
0
|
162
|
my $accessors = shift; # hash reference: like left => 0 |
272
|
|
|
|
|
|
|
|
273
|
54
|
|
|
|
|
166
|
my $text = '{'; |
274
|
54
|
|
|
|
|
251
|
for (keys(%$accessors)) { |
275
|
52
|
|
|
|
|
159
|
$text .= "\n '$_' => $accessors->{$_},"; |
276
|
|
|
|
|
|
|
} |
277
|
54
|
|
|
|
|
249
|
return "$text\n }"; |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
# Compute line numbers for the outputfile. Need for debugging |
281
|
|
|
|
|
|
|
our $pattern = '################ @@@@@@@@@ End of User Code @@@@@@@@@ ###################'; |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
sub Output { |
284
|
54
|
|
|
54
|
0
|
175
|
my($self)=shift; |
285
|
|
|
|
|
|
|
|
286
|
54
|
|
|
|
|
317
|
$self->Options(@_); |
287
|
|
|
|
|
|
|
|
288
|
54
|
|
|
|
|
116
|
my ($GRAMMAR, $TERMS, $FILENAME, $PACKAGES, $LABELS); # Cas |
289
|
54
|
|
|
|
|
254
|
my($package)=$self->Option('classname'); |
290
|
|
|
|
|
|
|
|
291
|
54
|
|
|
|
|
262
|
my $modulino = $self->Option('modulino'); # prompt or undef |
292
|
|
|
|
|
|
|
|
293
|
54
|
50
|
|
|
|
283
|
if (defined($modulino)) { |
294
|
0
|
|
|
|
|
0
|
$modulino = <<"MODULINO"; |
295
|
|
|
|
|
|
|
unless (caller) { |
296
|
|
|
|
|
|
|
exit !__PACKAGE__->main('$modulino'); |
297
|
|
|
|
|
|
|
} |
298
|
|
|
|
|
|
|
MODULINO |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
else { |
301
|
54
|
|
|
|
|
178
|
$modulino = ''; |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
54
|
|
33
|
|
|
262
|
my $lexerisdefined = $self->Option('lexerisdefined') || $self->{GRAMMAR}{LEXERISDEFINED}; |
305
|
54
|
50
|
|
|
|
657
|
my $defaultLexer = $lexerisdefined ? q{} : $self->makeLexer(); |
306
|
|
|
|
|
|
|
|
307
|
54
|
|
|
|
|
157
|
my($head,$states,$rules,$tail,$driver, $bypass, $accessors, $buildingtree, $prefix, $conflict_handlers, $state_conflict); |
308
|
54
|
|
|
|
|
251
|
my($version)=$Parse::Eyapp::Driver::VERSION; |
309
|
54
|
|
|
|
|
116
|
my($datapos); |
310
|
54
|
|
|
|
|
122
|
my $makenodeclasses = ''; |
311
|
54
|
|
|
|
|
122
|
$driver=''; |
312
|
|
|
|
|
|
|
|
313
|
54
|
50
|
|
|
|
324
|
defined($package) |
314
|
|
|
|
|
|
|
or $package='Parse::Eyapp::Default'; # may be the caller package? |
315
|
|
|
|
|
|
|
|
316
|
54
|
|
|
|
|
814
|
$head= $self->Head(); |
317
|
54
|
|
|
|
|
608
|
$rules=$self->RulesTable(); |
318
|
54
|
|
|
|
|
698
|
$states=$self->DfaTable(); |
319
|
54
|
|
|
|
|
897
|
$tail= $self->Tail(); |
320
|
|
|
|
|
|
|
|
321
|
54
|
|
|
|
|
808
|
my $prompt = $self->Prompt(); |
322
|
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
# In case the file ends with documentation and without a |
324
|
|
|
|
|
|
|
# =cut |
325
|
|
|
|
|
|
|
# |
326
|
54
|
50
|
|
|
|
681
|
$tail = $tail."\n\n=for None\n\n=cut\n\n" unless $tail =~ /\n\n=cut\n/; |
327
|
|
|
|
|
|
|
#local $Data::Dumper::Purity = 1; |
328
|
|
|
|
|
|
|
|
329
|
54
|
|
|
|
|
711
|
($GRAMMAR, $PACKAGES, $LABELS) = $self->Rules(); |
330
|
54
|
|
|
|
|
337
|
$bypass = $self->Bypass; |
331
|
54
|
|
|
|
|
749
|
$prefix = $self->Prefix; |
332
|
|
|
|
|
|
|
|
333
|
54
|
|
|
|
|
646
|
$conflict_handlers = $self->conflictHandlers; |
334
|
54
|
|
|
|
|
661
|
$state_conflict = $self->stateConflict; |
335
|
|
|
|
|
|
|
|
336
|
54
|
|
|
|
|
663
|
$buildingtree = $self->Buildingtree; |
337
|
54
|
|
|
|
|
685
|
$accessors = $self->Accessors; |
338
|
54
|
|
|
|
|
295
|
my $accessors_hash = make_accessors($accessors); |
339
|
54
|
|
|
|
|
613
|
$TERMS = $self->Terms(); |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# Thanks Tom! previous double-quote use produced errors in windows |
342
|
54
|
|
|
|
|
283
|
$FILENAME = q{'}.$self->Option('inputfile').q{'}; |
343
|
|
|
|
|
|
|
|
344
|
54
|
50
|
|
|
|
258
|
if ($self->Option('standalone')) { |
345
|
|
|
|
|
|
|
# Copy Driver, Node and YATW |
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
0
|
$driver .=_CopyModule('Parse::Eyapp::Driver','YYParse', $Parse::Eyapp::Driver::FILENAME); |
348
|
0
|
|
|
|
|
0
|
$driver .= _CopyModule('Parse::Eyapp::Node', 'm', $Parse::Eyapp::Node::FILENAME); |
349
|
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
# Remove the line use Parse::Eyapp::YATW |
351
|
0
|
|
|
|
|
0
|
$driver =~ s/\n\s*use Parse::Eyapp::YATW;\n//g; |
352
|
0
|
|
|
|
|
0
|
$driver .= _CopyModule('Parse::Eyapp::YATW', 'm', $Parse::Eyapp::YATW::FILENAME); |
353
|
|
|
|
|
|
|
|
354
|
0
|
|
|
|
|
0
|
$makenodeclasses = '$self->make_node_classes('.$PACKAGES.');'; |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
else { |
357
|
54
|
|
|
|
|
259
|
$driver = make_header_for_driver_pm(); |
358
|
54
|
|
|
|
|
253
|
$makenodeclasses = '$self->make_node_classes('.$PACKAGES.');'; |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
|
361
|
54
|
|
33
|
|
|
281
|
my($text)=$self->Option('template') || Driver_pm(); |
362
|
|
|
|
|
|
|
|
363
|
54
|
|
|
|
|
592
|
$text=~s/<<(\$.+)>>/$1/gee; |
|
1350
|
|
|
|
|
73627
|
|
364
|
|
|
|
|
|
|
|
365
|
54
|
|
|
|
|
2141
|
$text; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub make_header_for_driver_pm { |
369
|
54
|
|
|
54
|
0
|
152
|
return q{ |
370
|
|
|
|
|
|
|
BEGIN { |
371
|
|
|
|
|
|
|
# This strange way to load the modules is to guarantee compatibility when |
372
|
|
|
|
|
|
|
# using several standalone and non-standalone Eyapp parsers |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
require Parse::Eyapp::Driver unless Parse::Eyapp::Driver->can('YYParse'); |
375
|
|
|
|
|
|
|
require Parse::Eyapp::Node unless Parse::Eyapp::Node->can('hnew'); |
376
|
|
|
|
|
|
|
} |
377
|
|
|
|
|
|
|
}; |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub Driver_pm { |
381
|
54
|
|
|
54
|
0
|
262
|
return <<'EOT'; |
382
|
|
|
|
|
|
|
######################################################################################## |
383
|
|
|
|
|
|
|
# |
384
|
|
|
|
|
|
|
# This file was generated using Parse::Eyapp version <<$version>>. |
385
|
|
|
|
|
|
|
# |
386
|
|
|
|
|
|
|
# (c) Parse::Yapp Copyright 1998-2001 Francois Desarmenien. |
387
|
|
|
|
|
|
|
# (c) Parse::Eyapp Copyright 2006-2008 Casiano Rodriguez-Leon. Universidad de La Laguna. |
388
|
|
|
|
|
|
|
# Don't edit this file, use source file <<$FILENAME>> instead. |
389
|
|
|
|
|
|
|
# |
390
|
|
|
|
|
|
|
# ANY CHANGE MADE HERE WILL BE LOST ! |
391
|
|
|
|
|
|
|
# |
392
|
|
|
|
|
|
|
######################################################################################## |
393
|
|
|
|
|
|
|
package <<$package>>; |
394
|
|
|
|
|
|
|
use strict; |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
push @<<$package>>::ISA, 'Parse::Eyapp::Driver'; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
<<$prompt>> |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
<<$driver>> |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub unexpendedInput { defined($_) ? substr($_, (defined(pos $_) ? pos $_ : 0)) : '' } |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
<<$head>> |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
<<$defaultLexer>> |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
my $warnmessage =<< "EOFWARN"; |
411
|
|
|
|
|
|
|
Warning!: Did you changed the \@<<$package>>::ISA variable inside the header section of the eyapp program? |
412
|
|
|
|
|
|
|
EOFWARN |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub new { |
415
|
|
|
|
|
|
|
my($class)=shift; |
416
|
|
|
|
|
|
|
ref($class) and $class=ref($class); |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
warn $warnmessage unless __PACKAGE__->isa('Parse::Eyapp::Driver'); |
419
|
|
|
|
|
|
|
my($self)=$class->SUPER::new( |
420
|
|
|
|
|
|
|
yyversion => '<<$version>>', |
421
|
|
|
|
|
|
|
yyGRAMMAR => |
422
|
|
|
|
|
|
|
<<$GRAMMAR>>, |
423
|
|
|
|
|
|
|
yyLABELS => |
424
|
|
|
|
|
|
|
<<$LABELS>>, |
425
|
|
|
|
|
|
|
yyTERMS => |
426
|
|
|
|
|
|
|
<<$TERMS>>, |
427
|
|
|
|
|
|
|
yyFILENAME => <<$FILENAME>>, |
428
|
|
|
|
|
|
|
yystates => |
429
|
|
|
|
|
|
|
<<$states>>, |
430
|
|
|
|
|
|
|
yyrules => |
431
|
|
|
|
|
|
|
<<$rules>>, |
432
|
|
|
|
|
|
|
################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### |
433
|
|
|
|
|
|
|
yybypass => <<$bypass>>, |
434
|
|
|
|
|
|
|
yybuildingtree => <<$buildingtree>>, |
435
|
|
|
|
|
|
|
yyprefix => '<<$prefix>>', |
436
|
|
|
|
|
|
|
yyaccessors => <<$accessors_hash>>, |
437
|
|
|
|
|
|
|
yyconflicthandlers => <<$conflict_handlers>>, |
438
|
|
|
|
|
|
|
yystateconflict => <<$state_conflict>>, |
439
|
|
|
|
|
|
|
@_, |
440
|
|
|
|
|
|
|
); |
441
|
|
|
|
|
|
|
bless($self,$class); |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
<<$makenodeclasses>> |
444
|
|
|
|
|
|
|
$self; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
<<$tail>> |
448
|
|
|
|
|
|
|
################ @@@@@@@@@ End of User Code @@@@@@@@@ ################### |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
<<$modulino>> |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
1; |
453
|
|
|
|
|
|
|
EOT |
454
|
|
|
|
|
|
|
} |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
#################################################################### |
457
|
|
|
|
|
|
|
# Usage : |
458
|
|
|
|
|
|
|
# my $warnings = Parse::Eyapp->new_grammar( |
459
|
|
|
|
|
|
|
# input=>$translationscheme, |
460
|
|
|
|
|
|
|
# classname=>'main', |
461
|
|
|
|
|
|
|
# firstline => 6, |
462
|
|
|
|
|
|
|
# outputfile => 'main.pm' |
463
|
|
|
|
|
|
|
# ); |
464
|
|
|
|
|
|
|
# die "$warnings\nSolve Ambiguities. See file main.output\n" if $warnings; |
465
|
|
|
|
|
|
|
# |
466
|
|
|
|
|
|
|
# Returns : string reporting about the ambiguities and conflicts or '' |
467
|
|
|
|
|
|
|
# Throws : croaks if invalid arguments, if the grammar has errors, if can not open |
468
|
|
|
|
|
|
|
# files or if the semantic actions have errors |
469
|
|
|
|
|
|
|
# |
470
|
|
|
|
|
|
|
# Parameters : |
471
|
|
|
|
|
|
|
my %_new_grammar = ( |
472
|
|
|
|
|
|
|
input => undef, |
473
|
|
|
|
|
|
|
classname => undef, |
474
|
|
|
|
|
|
|
firstline => undef, |
475
|
|
|
|
|
|
|
linenumbers => undef, |
476
|
|
|
|
|
|
|
outputfile => undef, |
477
|
|
|
|
|
|
|
); |
478
|
|
|
|
|
|
|
my $validkeys = do { local $" = ", "; my @validkeys = keys(%_new_grammar); "@validkeys" }; |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
sub new_grammar { |
481
|
57
|
|
|
57
|
0
|
43459
|
my $class = shift; |
482
|
|
|
|
|
|
|
|
483
|
57
|
100
|
|
|
|
641
|
croak "Error in new_grammar: Use named arguments" if (@_ %2); |
484
|
56
|
|
|
|
|
338
|
my %arg = @_; |
485
|
56
|
100
|
|
151
|
|
1042
|
if (defined($a = first { !exists($_new_grammar{$_}) } keys(%arg))) { |
|
151
|
|
|
|
|
1091
|
|
486
|
1
|
|
|
|
|
324
|
croak("Parse::Eyapp::Output::new_grammar Error!: unknown argument $a. Valid arguments are: $validkeys") |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
55
|
50
|
|
|
|
1231
|
my $grammar = $arg{input} or croak "Error in new_grammar: Specify a input grammar"; |
490
|
|
|
|
|
|
|
|
491
|
55
|
100
|
|
|
|
526
|
my $name = $arg{classname} or croak 'Error in new_grammar: Please provide a name for the grammar'; |
492
|
|
|
|
|
|
|
|
493
|
54
|
|
|
|
|
230
|
my ($package, $filename, $line) = caller; |
494
|
|
|
|
|
|
|
|
495
|
54
|
100
|
66
|
|
|
767
|
$line = $arg{firstline} if defined($arg{firstline}) and ($arg{firstline} =~ /\d+/); |
496
|
|
|
|
|
|
|
|
497
|
54
|
|
|
|
|
138
|
my $linenumbers = $arg{linenumbers}; |
498
|
54
|
100
|
|
|
|
253
|
$linenumbers = 1 unless defined($linenumbers); |
499
|
|
|
|
|
|
|
|
500
|
54
|
50
|
|
|
|
802
|
croak "Bad grammar." |
501
|
|
|
|
|
|
|
unless my $p = Parse::Eyapp->new( |
502
|
|
|
|
|
|
|
input => $grammar, |
503
|
|
|
|
|
|
|
inputfile => $filename, |
504
|
|
|
|
|
|
|
firstline => $line, |
505
|
|
|
|
|
|
|
linenumbers => $linenumbers, |
506
|
|
|
|
|
|
|
); |
507
|
|
|
|
|
|
|
|
508
|
54
|
50
|
|
|
|
593
|
my $text = $p->Output(classname => $name) or croak "Can't generate parser."; |
509
|
|
|
|
|
|
|
|
510
|
54
|
|
|
|
|
209
|
my $outputfile = $arg{outputfile}; |
511
|
54
|
50
|
|
|
|
406
|
croak "Error in new_grammar: Invalid option for parameter linenumber" unless $linenumbers =~ m{[01]}; |
512
|
|
|
|
|
|
|
|
513
|
54
|
50
|
|
|
|
269
|
if (defined($outputfile)) { |
514
|
0
|
|
|
|
|
0
|
my($base,$path,$sfx)=fileparse($outputfile,'\..*$'); |
515
|
0
|
|
|
|
|
0
|
$p->outputtables($path, $base); |
516
|
0
|
|
|
|
|
0
|
my($outfile)="$path$base.pm"; |
517
|
0
|
0
|
|
|
|
0
|
open(my $OUT,">$outfile") |
518
|
|
|
|
|
|
|
or die "Cannot open $outfile for writing.\n"; |
519
|
|
|
|
|
|
|
|
520
|
0
|
|
|
|
|
0
|
compute_lines(\$text, $outfile, $pattern); |
521
|
0
|
|
|
|
|
0
|
print $OUT $text; #$p->Output(classname => $name, linenumbers => $linenumbers); |
522
|
0
|
|
|
|
|
0
|
close $OUT; |
523
|
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
54
|
50
|
|
54
|
|
546
|
my $x = eval $text; |
|
54
|
50
|
|
54
|
|
127
|
|
|
54
|
50
|
|
19
|
|
7062
|
|
|
54
|
50
|
|
0
|
|
744
|
|
|
54
|
0
|
|
2
|
|
78132
|
|
|
54
|
0
|
|
0
|
|
6023
|
|
|
19
|
100
|
|
7
|
|
1791
|
|
|
19
|
50
|
|
1
|
|
88
|
|
|
19
|
0
|
|
|
|
227
|
|
|
1
|
|
|
|
|
49
|
|
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
8
|
|
|
1
|
|
|
|
|
2
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
|
0
|
|
|
|
|
0
|
|
526
|
54
|
100
|
|
|
|
1837
|
$@ and die "Error while compiling your parser: $@\n"; |
527
|
53
|
|
|
|
|
10682
|
return $p; |
528
|
|
|
|
|
|
|
} |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
1; |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
__END__ |