line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package MarpaX::Grammar::GraphViz2; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
853
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
35
|
|
4
|
1
|
|
|
1
|
|
1006
|
use utf8; |
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
6
|
|
5
|
1
|
|
|
1
|
|
38
|
use warnings; |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
39
|
|
6
|
1
|
|
|
1
|
|
5
|
use warnings qw(FATAL utf8); # Fatalize encoding glitches. |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
40
|
|
7
|
1
|
|
|
1
|
|
832
|
use open qw(:std :utf8); # Undeclared streams in UTF-8. |
|
1
|
|
|
|
|
1284
|
|
|
1
|
|
|
|
|
5
|
|
8
|
1
|
|
|
1
|
|
6582
|
use charnames qw(:full :short); # Unneeded in v5.16. |
|
1
|
|
|
|
|
43121
|
|
|
1
|
|
|
|
|
8
|
|
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
244
|
use File::Basename; # For basename(). |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
114
|
|
11
|
1
|
|
|
1
|
|
934
|
use File::Which; # For which(). |
|
1
|
|
|
|
|
1069
|
|
|
1
|
|
|
|
|
50
|
|
12
|
|
|
|
|
|
|
|
13
|
1
|
|
|
1
|
|
6630
|
use GraphViz2; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
use List::AllUtils qw/first_index indexes/; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use Log::Handler; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
use MarpaX::Grammar::Parser; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
use Moo; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
has default_count => |
24
|
|
|
|
|
|
|
( |
25
|
|
|
|
|
|
|
default => sub{return 0}, |
26
|
|
|
|
|
|
|
is => 'rw', |
27
|
|
|
|
|
|
|
#isa => 'Int', |
28
|
|
|
|
|
|
|
required => 0, |
29
|
|
|
|
|
|
|
); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
has discard_count => |
32
|
|
|
|
|
|
|
( |
33
|
|
|
|
|
|
|
default => sub{return 0}, |
34
|
|
|
|
|
|
|
is => 'rw', |
35
|
|
|
|
|
|
|
#isa => 'Int', |
36
|
|
|
|
|
|
|
required => 0, |
37
|
|
|
|
|
|
|
); |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
has driver => |
40
|
|
|
|
|
|
|
( |
41
|
|
|
|
|
|
|
default => sub{return ''}, |
42
|
|
|
|
|
|
|
is => 'rw', |
43
|
|
|
|
|
|
|
#isa => 'Str', |
44
|
|
|
|
|
|
|
required => 0, |
45
|
|
|
|
|
|
|
); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
has event_count => |
48
|
|
|
|
|
|
|
( |
49
|
|
|
|
|
|
|
default => sub{return 0}, |
50
|
|
|
|
|
|
|
is => 'rw', |
51
|
|
|
|
|
|
|
#isa => 'Int', |
52
|
|
|
|
|
|
|
required => 0, |
53
|
|
|
|
|
|
|
); |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
has format => |
56
|
|
|
|
|
|
|
( |
57
|
|
|
|
|
|
|
default => sub{return ''}, |
58
|
|
|
|
|
|
|
is => 'rw', |
59
|
|
|
|
|
|
|
#isa => 'Str', |
60
|
|
|
|
|
|
|
required => 0, |
61
|
|
|
|
|
|
|
); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
has graph => |
64
|
|
|
|
|
|
|
( |
65
|
|
|
|
|
|
|
default => sub{return ''}, |
66
|
|
|
|
|
|
|
is => 'rw', |
67
|
|
|
|
|
|
|
#isa => 'GraphViz', |
68
|
|
|
|
|
|
|
required => 0, |
69
|
|
|
|
|
|
|
); |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
has legend => |
72
|
|
|
|
|
|
|
( |
73
|
|
|
|
|
|
|
default => sub{return 0}, |
74
|
|
|
|
|
|
|
is => 'rw', |
75
|
|
|
|
|
|
|
#isa => 'Int', |
76
|
|
|
|
|
|
|
required => 0, |
77
|
|
|
|
|
|
|
); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
has lexeme_count => |
80
|
|
|
|
|
|
|
( |
81
|
|
|
|
|
|
|
default => sub{return 0}, |
82
|
|
|
|
|
|
|
is => 'rw', |
83
|
|
|
|
|
|
|
#isa => 'Int', |
84
|
|
|
|
|
|
|
required => 0, |
85
|
|
|
|
|
|
|
); |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
has lexemes => |
88
|
|
|
|
|
|
|
( |
89
|
|
|
|
|
|
|
default => sub{return {} }, |
90
|
|
|
|
|
|
|
is => 'rw', |
91
|
|
|
|
|
|
|
#isa => 'HashRef', |
92
|
|
|
|
|
|
|
required => 0, |
93
|
|
|
|
|
|
|
); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
has logger => |
96
|
|
|
|
|
|
|
( |
97
|
|
|
|
|
|
|
default => sub{return undef}, |
98
|
|
|
|
|
|
|
is => 'rw', |
99
|
|
|
|
|
|
|
# isa => 'Str', |
100
|
|
|
|
|
|
|
required => 0, |
101
|
|
|
|
|
|
|
); |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
has marpa_bnf_file => |
104
|
|
|
|
|
|
|
( |
105
|
|
|
|
|
|
|
default => sub{return ''}, |
106
|
|
|
|
|
|
|
is => 'rw', |
107
|
|
|
|
|
|
|
#isa => 'Str', |
108
|
|
|
|
|
|
|
required => 1, |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
has maxlevel => |
112
|
|
|
|
|
|
|
( |
113
|
|
|
|
|
|
|
default => sub{return 'info'}, |
114
|
|
|
|
|
|
|
is => 'rw', |
115
|
|
|
|
|
|
|
# isa => 'Str', |
116
|
|
|
|
|
|
|
required => 0, |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
has minlevel => |
120
|
|
|
|
|
|
|
( |
121
|
|
|
|
|
|
|
default => sub{return 'error'}, |
122
|
|
|
|
|
|
|
is => 'rw', |
123
|
|
|
|
|
|
|
# isa => 'Str', |
124
|
|
|
|
|
|
|
required => 0, |
125
|
|
|
|
|
|
|
); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
has nodes_seen => |
128
|
|
|
|
|
|
|
( |
129
|
|
|
|
|
|
|
default => sub{return {}}, |
130
|
|
|
|
|
|
|
is => 'rw', |
131
|
|
|
|
|
|
|
#isa => 'HashRef', |
132
|
|
|
|
|
|
|
required => 0, |
133
|
|
|
|
|
|
|
); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
has output_file => |
136
|
|
|
|
|
|
|
( |
137
|
|
|
|
|
|
|
default => sub{return ''}, |
138
|
|
|
|
|
|
|
is => 'rw', |
139
|
|
|
|
|
|
|
#isa => 'Str', |
140
|
|
|
|
|
|
|
required => 0, |
141
|
|
|
|
|
|
|
); |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
has parser => |
144
|
|
|
|
|
|
|
( |
145
|
|
|
|
|
|
|
default => sub{return ''}, |
146
|
|
|
|
|
|
|
is => 'rw', |
147
|
|
|
|
|
|
|
#isa => 'MarpaX::Grammar::Parser', |
148
|
|
|
|
|
|
|
required => 0, |
149
|
|
|
|
|
|
|
); |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
has root_node => |
152
|
|
|
|
|
|
|
( |
153
|
|
|
|
|
|
|
default => sub{return ''}, |
154
|
|
|
|
|
|
|
is => 'rw', |
155
|
|
|
|
|
|
|
#isa => 'Tree::DAG_Node', |
156
|
|
|
|
|
|
|
required => 0, |
157
|
|
|
|
|
|
|
); |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
has separators => |
160
|
|
|
|
|
|
|
( |
161
|
|
|
|
|
|
|
default => sub{return {} }, |
162
|
|
|
|
|
|
|
is => 'rw', |
163
|
|
|
|
|
|
|
#isa => 'HashRef', |
164
|
|
|
|
|
|
|
required => 0, |
165
|
|
|
|
|
|
|
); |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
has user_bnf_file => |
168
|
|
|
|
|
|
|
( |
169
|
|
|
|
|
|
|
default => sub{return ''}, |
170
|
|
|
|
|
|
|
is => 'rw', |
171
|
|
|
|
|
|
|
#isa => 'Str', |
172
|
|
|
|
|
|
|
required => 1, |
173
|
|
|
|
|
|
|
); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
our $VERSION = '1.00'; |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
# -------------------------------------------------- |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
sub add_legend |
180
|
|
|
|
|
|
|
{ |
181
|
|
|
|
|
|
|
my($self) = @_; |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
$self -> graph -> push_subgraph |
184
|
|
|
|
|
|
|
( |
185
|
|
|
|
|
|
|
# No options... |
186
|
|
|
|
|
|
|
# Legend: top. Border: no. Label: no. |
187
|
|
|
|
|
|
|
# |
188
|
|
|
|
|
|
|
# label => 'cluster_legend', |
189
|
|
|
|
|
|
|
# Legend: top. Border: no. Label: no. |
190
|
|
|
|
|
|
|
# |
191
|
|
|
|
|
|
|
# name => 'cluster_legend', |
192
|
|
|
|
|
|
|
# Legend: top. Border: yes. Label: *.bnf. |
193
|
|
|
|
|
|
|
# |
194
|
|
|
|
|
|
|
#graph => {label => 'cluster_legend'}, |
195
|
|
|
|
|
|
|
# Legend: top. Border: no. Label: no. Not using subgraph => {...}. |
196
|
|
|
|
|
|
|
#graph => {label => 'cluster_Legend'}, |
197
|
|
|
|
|
|
|
# Legend: bottom. Border: no. Label: no. Using subgraph => {...}. |
198
|
|
|
|
|
|
|
# Legend: top. Border: no. Label: no. Not using subgraph => {...}. |
199
|
|
|
|
|
|
|
subgraph => {rank => 'max'}, |
200
|
|
|
|
|
|
|
# Legend: top. Border: no. Label: no. Using graph => {...}. |
201
|
|
|
|
|
|
|
# Legend: bottom. Border: no. Label: no. Not using graph => {...}. |
202
|
|
|
|
|
|
|
); |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
$self -> graph -> add_node |
205
|
|
|
|
|
|
|
( |
206
|
|
|
|
|
|
|
label => |
207
|
|
|
|
|
|
|
q| |
208
|
|
|
|
|
|
|
<> |
225
|
|
|
|
|
|
|
|, |
226
|
|
|
|
|
|
|
name => 'Legend', |
227
|
|
|
|
|
|
|
shape => 'plaintext', |
228
|
|
|
|
|
|
|
); |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
$self -> graph -> pop_subgraph; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
} # End of add_legend. |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
# ------------------------------------------------ |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
sub add_node |
237
|
|
|
|
|
|
|
{ |
238
|
|
|
|
|
|
|
my($self, %attributes) = @_; |
239
|
|
|
|
|
|
|
my($name) = delete $attributes{name}; |
240
|
|
|
|
|
|
|
my($seen) = $self -> nodes_seen; |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
$self -> graph -> add_node(name => $name, %attributes) if (! $$seen{$name}); |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
$$seen{$name} = 1; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
$self -> nodes_seen($seen); |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
} # End of add_node. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# ------------------------------------------------ |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
sub BUILD |
253
|
|
|
|
|
|
|
{ |
254
|
|
|
|
|
|
|
my($self) = @_; |
255
|
|
|
|
|
|
|
|
256
|
|
|
|
|
|
|
die "No Marpa SLIF-DSL file found\n" if (! -e $self -> marpa_bnf_file); |
257
|
|
|
|
|
|
|
die "No user SLIF-DSL file found\n" if (! -e $self -> user_bnf_file); |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
$self -> driver($self -> driver || which('dot') ); |
260
|
|
|
|
|
|
|
$self -> format($self -> format || 'svg'); |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
if (! defined $self -> logger) |
263
|
|
|
|
|
|
|
{ |
264
|
|
|
|
|
|
|
$self -> logger(Log::Handler -> new); |
265
|
|
|
|
|
|
|
$self -> logger -> add |
266
|
|
|
|
|
|
|
( |
267
|
|
|
|
|
|
|
screen => |
268
|
|
|
|
|
|
|
{ |
269
|
|
|
|
|
|
|
maxlevel => $self -> maxlevel, |
270
|
|
|
|
|
|
|
message_layout => '%m', |
271
|
|
|
|
|
|
|
minlevel => $self -> minlevel, |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
); |
274
|
|
|
|
|
|
|
} |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
my($graph) ||= GraphViz2 -> new |
277
|
|
|
|
|
|
|
( |
278
|
|
|
|
|
|
|
edge => {color => 'grey'}, |
279
|
|
|
|
|
|
|
global => {directed => 1, driver => $self -> driver, format => $self -> format}, |
280
|
|
|
|
|
|
|
graph => {label => basename($self -> user_bnf_file), rankdir => 'TB'}, |
281
|
|
|
|
|
|
|
logger => $self -> logger, |
282
|
|
|
|
|
|
|
node => {shape => 'rectangle', style => 'filled'}, |
283
|
|
|
|
|
|
|
); |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
$self -> graph($graph); |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
$self -> parser |
288
|
|
|
|
|
|
|
( |
289
|
|
|
|
|
|
|
MarpaX::Grammar::Parser -> new |
290
|
|
|
|
|
|
|
( |
291
|
|
|
|
|
|
|
marpa_bnf_file => $self -> marpa_bnf_file, |
292
|
|
|
|
|
|
|
logger => $self -> logger, |
293
|
|
|
|
|
|
|
user_bnf_file => $self -> user_bnf_file, |
294
|
|
|
|
|
|
|
) |
295
|
|
|
|
|
|
|
); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
} # End of BUILD. |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
# -------------------------------------------------- |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub clean_name |
302
|
|
|
|
|
|
|
{ |
303
|
|
|
|
|
|
|
my($self, $name, $skip_symbols) = @_; |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# If $skip_symbols is defined (as in calls from rectify_name() ), |
306
|
|
|
|
|
|
|
# then do not do this check. |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
return $name if ( (! defined $skip_symbols) && ($name =~ /(?::=|=>|=)/) ); |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
$name =~ s/\\/\\\\/g; # Escape \. |
311
|
|
|
|
|
|
|
$name =~ s/\\
|
312
|
|
|
|
|
|
|
$name =~ s/>/\\>/g; # Escape >. |
313
|
|
|
|
|
|
|
$name =~ s/:/\x{a789}/g; # Escape :. |
314
|
|
|
|
|
|
|
$name =~ s/\"/\x{a78c}\x{a78c}/g; # Convert " into Unicode ' x 2. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
return $name; |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
} # End of clean_name. |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
# -------------------------------------------------- |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub clean_tree |
323
|
|
|
|
|
|
|
{ |
324
|
|
|
|
|
|
|
my($self) = @_; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
my($attributes); |
327
|
|
|
|
|
|
|
my($name); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
$self -> parser -> cooked_tree -> walk_down |
330
|
|
|
|
|
|
|
({ |
331
|
|
|
|
|
|
|
callback => sub |
332
|
|
|
|
|
|
|
{ |
333
|
|
|
|
|
|
|
my($node, $options) = @_; |
334
|
|
|
|
|
|
|
$name = $node -> name; |
335
|
|
|
|
|
|
|
$attributes = $node -> attributes; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
$node -> attributes($attributes); |
338
|
|
|
|
|
|
|
$node -> name($self -> clean_name($name) ); |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
return 1; # Keep walking. |
341
|
|
|
|
|
|
|
}, |
342
|
|
|
|
|
|
|
_depth => 0, |
343
|
|
|
|
|
|
|
}); |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
} # End of clean_tree. |
346
|
|
|
|
|
|
|
|
347
|
|
|
|
|
|
|
# -------------------------------------------------- |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
sub log |
350
|
|
|
|
|
|
|
{ |
351
|
|
|
|
|
|
|
my($self, $level, $s) = @_; |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
$self -> logger -> log($level => $s) if ($self -> logger); |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
} # End of log. |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# -------------------------------------------------- |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
sub _process_adverbs |
360
|
|
|
|
|
|
|
{ |
361
|
|
|
|
|
|
|
my($self, $daughters) = @_; |
362
|
|
|
|
|
|
|
my($end) = $#$daughters; |
363
|
|
|
|
|
|
|
my($separators) = $self -> separators; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# Chop adverbs off the end of the list. |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
my($adverb, @adverbs); |
368
|
|
|
|
|
|
|
my(@token); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
while ($end > 0) |
371
|
|
|
|
|
|
|
{ |
372
|
|
|
|
|
|
|
if ($$daughters[$end - 1] -> name eq '=>') |
373
|
|
|
|
|
|
|
{ |
374
|
|
|
|
|
|
|
$adverb = $$daughters[$end - 2] -> name; |
375
|
|
|
|
|
|
|
@token = $self -> rectify_name($$daughters[$end]); |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
pop @$daughters for 1 .. 3; |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
push @adverbs, |
380
|
|
|
|
|
|
|
{ |
381
|
|
|
|
|
|
|
adverb => $adverb, |
382
|
|
|
|
|
|
|
name => $token[0], |
383
|
|
|
|
|
|
|
}; |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
$end = $#$daughters; |
386
|
|
|
|
|
|
|
$$separators{$token[0]} = 1 if ($adverb eq 'separator'); |
387
|
|
|
|
|
|
|
} |
388
|
|
|
|
|
|
|
else |
389
|
|
|
|
|
|
|
{ |
390
|
|
|
|
|
|
|
$end = 0; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
} |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
# Construct the label as an array of hashrefs. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
if ($#adverbs >= 0) |
397
|
|
|
|
|
|
|
{ |
398
|
|
|
|
|
|
|
@adverbs = map{"$$_{adverb} =\\> $$_{name}"} @adverbs; |
399
|
|
|
|
|
|
|
$adverbs[0] = "\{$adverbs[0]"; |
400
|
|
|
|
|
|
|
$adverbs[$#adverbs] .= '}'; |
401
|
|
|
|
|
|
|
@adverbs = map{ {text => $_} } @adverbs; |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
|
404
|
|
|
|
|
|
|
return ([@$daughters], [@adverbs]); |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
} # End of _process_adverbs. |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
# -------------------------------------------------- |
409
|
|
|
|
|
|
|
# This handles prioritized rules and quantized rules. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
sub _process_complex_adverbs |
412
|
|
|
|
|
|
|
{ |
413
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
414
|
|
|
|
|
|
|
my($finished) = 0; |
415
|
|
|
|
|
|
|
my($daughters) = [$a_node -> daughters]; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# Sample inputs: |
418
|
|
|
|
|
|
|
# o 1 token, no adverbs: |
419
|
|
|
|
|
|
|
# |---number |
420
|
|
|
|
|
|
|
# | |---~ |
421
|
|
|
|
|
|
|
# | |---int |
422
|
|
|
|
|
|
|
# o 2 tokens, no adverbs: |
423
|
|
|
|
|
|
|
# |---json |
424
|
|
|
|
|
|
|
# | |---::= |
425
|
|
|
|
|
|
|
# | |---object |
426
|
|
|
|
|
|
|
# | |---| |
427
|
|
|
|
|
|
|
# | |---array |
428
|
|
|
|
|
|
|
# o 5 tokens, various adverbs: |
429
|
|
|
|
|
|
|
# |---object |
430
|
|
|
|
|
|
|
# | |---::= |
431
|
|
|
|
|
|
|
# | |---'{' |
432
|
|
|
|
|
|
|
# | |---'}' |
433
|
|
|
|
|
|
|
# | |---action |
434
|
|
|
|
|
|
|
# | |---=> |
435
|
|
|
|
|
|
|
# | |---do_empty_object |
436
|
|
|
|
|
|
|
# | |---| |
437
|
|
|
|
|
|
|
# | |---'{' |
438
|
|
|
|
|
|
|
# | |---members |
439
|
|
|
|
|
|
|
# | |---'}' |
440
|
|
|
|
|
|
|
# | |---action |
441
|
|
|
|
|
|
|
# | |---=> |
442
|
|
|
|
|
|
|
# | |---do_object |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
my($adverbs, @adverb_stack); |
445
|
|
|
|
|
|
|
my(@daughter_stack); |
446
|
|
|
|
|
|
|
my(@token_stack); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
while (! $finished) |
449
|
|
|
|
|
|
|
{ |
450
|
|
|
|
|
|
|
# Chew adverbs, if any, off the end of the list of daughters. |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
($daughters, $adverbs) = $self -> _process_adverbs($daughters); |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
# Stack the adverbs owned by the token(s) at the end of the daughters. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
unshift @adverb_stack, $adverbs; |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
# Chew the tokens owning the adverbs off the end of the list of daughters. |
459
|
|
|
|
|
|
|
# This backward processing stops with a '|' or $daughter[0]. |
460
|
|
|
|
|
|
|
|
461
|
|
|
|
|
|
|
@token_stack = (); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
my($i) = $#$daughters; |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
while ( ($i > 0) && ($$daughters[$i] -> name ne '|') ) |
466
|
|
|
|
|
|
|
{ |
467
|
|
|
|
|
|
|
unshift @token_stack, pop @$daughters; |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
$i--; |
470
|
|
|
|
|
|
|
} |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
unshift @daughter_stack, [@token_stack]; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
# Discard the '|' separating alternatives in the SLIF-DSL. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
pop @$daughters if ($$daughters[$i] -> name eq '|'); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
$finished = 1 if ($#$daughters == 0); |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
return ([@daughter_stack], [@adverb_stack]); |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
} # End of _process_complex_adverbs. |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
# -------------------------------------------------- |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub _process_default_rule |
488
|
|
|
|
|
|
|
{ |
489
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
$self -> default_count($self -> default_count + 1); |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
my($default_count) = $self -> default_count; |
494
|
|
|
|
|
|
|
my($default_name) = "\x{a789}default"; |
495
|
|
|
|
|
|
|
my($attributes) = |
496
|
|
|
|
|
|
|
{ |
497
|
|
|
|
|
|
|
fillcolor => 'lightblue', |
498
|
|
|
|
|
|
|
label => $default_name, |
499
|
|
|
|
|
|
|
}; |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
if ($default_count == 1) |
502
|
|
|
|
|
|
|
{ |
503
|
|
|
|
|
|
|
$self -> add_node(name => $default_name, %$attributes); |
504
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $self -> root_node -> name, to => $default_name); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
my($daughters, $adverbs) = $self -> _process_adverbs([$a_node -> daughters]); |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
if ($#$adverbs >= 0) |
510
|
|
|
|
|
|
|
{ |
511
|
|
|
|
|
|
|
$$attributes{fillcolor} = 'goldenrod'; |
512
|
|
|
|
|
|
|
$$attributes{label} = $adverbs; |
513
|
|
|
|
|
|
|
my($adverb_name) = "${default_name}_$default_count"; |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
$self -> add_node(name => $adverb_name, %$attributes); |
516
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $default_name, to => $adverb_name); |
517
|
|
|
|
|
|
|
} |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
} # End of _process_default_rule. |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# -------------------------------------------------- |
522
|
|
|
|
|
|
|
|
523
|
|
|
|
|
|
|
sub _process_discard_rule |
524
|
|
|
|
|
|
|
{ |
525
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
$self -> discard_count($self -> discard_count + 1); |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
my($discard_count) = $self -> discard_count; |
530
|
|
|
|
|
|
|
my($discard_name) = "\x{a789}discard"; |
531
|
|
|
|
|
|
|
my($attributes) = |
532
|
|
|
|
|
|
|
{ |
533
|
|
|
|
|
|
|
fillcolor => 'lightblue', |
534
|
|
|
|
|
|
|
label => $discard_name, |
535
|
|
|
|
|
|
|
}; |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
if ($discard_count == 1) |
538
|
|
|
|
|
|
|
{ |
539
|
|
|
|
|
|
|
$self -> add_node(name => $discard_name, %$attributes); |
540
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $self -> root_node -> name, to => $discard_name); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
# Ignore the first daughter, which is '=>'. |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
my(@daughters) = $a_node -> daughters; |
546
|
|
|
|
|
|
|
my(@name) = $self -> rectify_name($daughters[1]); |
547
|
|
|
|
|
|
|
$$attributes{label} = $name[1]; |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
$self -> add_node(name => $name[0], %$attributes); |
550
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $discard_name, to => $name[0]); |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
} # End of _process_discard_rule. |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
# -------------------------------------------------- |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
sub _process_event_rule |
557
|
|
|
|
|
|
|
{ |
558
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
$self -> event_count($self -> event_count + 1); |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
my($event_count) = $self -> event_count; |
563
|
|
|
|
|
|
|
my($event_name) = 'event'; |
564
|
|
|
|
|
|
|
my($attributes) = |
565
|
|
|
|
|
|
|
{ |
566
|
|
|
|
|
|
|
fillcolor => 'firebrick1', |
567
|
|
|
|
|
|
|
label => $event_name, |
568
|
|
|
|
|
|
|
}; |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
if ($event_count == 1) |
571
|
|
|
|
|
|
|
{ |
572
|
|
|
|
|
|
|
$self -> add_node(name => $event_name, %$attributes); |
573
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $self -> root_node -> name, to => $event_name); |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
my($item_name) = "${event_name}_$event_count"; |
577
|
|
|
|
|
|
|
my(@daughters) = $a_node -> daughters; |
578
|
|
|
|
|
|
|
my(@lhs) = $self -> rectify_name($daughters[3]); |
579
|
|
|
|
|
|
|
$$attributes{label} = |
580
|
|
|
|
|
|
|
[ |
581
|
|
|
|
|
|
|
{text => '{' . $daughters[0] -> name}, |
582
|
|
|
|
|
|
|
{text => $daughters[2] -> name}, |
583
|
|
|
|
|
|
|
{text => "$lhs[0]}"}, |
584
|
|
|
|
|
|
|
]; |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
$self -> add_node(name => $item_name, %$attributes); |
587
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $event_name, to => $item_name); |
588
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $item_name, to => $lhs[0]); |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
} # End of _process_event_rule. |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
# -------------------------------------------------- |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
sub _process_lexeme_default_rule |
595
|
|
|
|
|
|
|
{ |
596
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
597
|
|
|
|
|
|
|
my($lexeme_name) = 'lexeme default'; |
598
|
|
|
|
|
|
|
my($attributes) = |
599
|
|
|
|
|
|
|
{ |
600
|
|
|
|
|
|
|
fillcolor => 'lightblue', |
601
|
|
|
|
|
|
|
label => $lexeme_name, |
602
|
|
|
|
|
|
|
}; |
603
|
|
|
|
|
|
|
|
604
|
|
|
|
|
|
|
$self -> add_node(name => $lexeme_name, %$attributes); |
605
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $self -> root_node -> name, to => $lexeme_name); |
606
|
|
|
|
|
|
|
|
607
|
|
|
|
|
|
|
my($daughters, $adverbs) = $self -> _process_adverbs([$a_node -> daughters]); |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
if ($#$adverbs >= 0) |
610
|
|
|
|
|
|
|
{ |
611
|
|
|
|
|
|
|
$$attributes{label} = $adverbs; |
612
|
|
|
|
|
|
|
my($adverb_name) = "${lexeme_name}_1"; |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
$self -> add_node(name => $adverb_name, %$attributes); |
615
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $lexeme_name, to => $adverb_name); |
616
|
|
|
|
|
|
|
} |
617
|
|
|
|
|
|
|
|
618
|
|
|
|
|
|
|
} # End of _process_lexeme_default_rule. |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
# -------------------------------------------------- |
621
|
|
|
|
|
|
|
|
622
|
|
|
|
|
|
|
sub _process_lexeme_rule |
623
|
|
|
|
|
|
|
{ |
624
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
625
|
|
|
|
|
|
|
my($daughters, $adverbs) = $self -> _process_adverbs([$a_node -> daughters]); |
626
|
|
|
|
|
|
|
my(@name) = $self -> rectify_name($$daughters[1]); |
627
|
|
|
|
|
|
|
my($lexeme) = $self -> lexemes; |
628
|
|
|
|
|
|
|
$$lexeme{$name[0]} = $#$adverbs >= 0 ? $adverbs : ''; |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
$self -> lexemes($lexeme); |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
} # End of _process_lexeme_rule. |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
# -------------------------------------------------- |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
sub _process_lexeme_token |
637
|
|
|
|
|
|
|
{ |
638
|
|
|
|
|
|
|
my($self, $index, $lexemes, $name, $label) = @_; |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
my($attributes); |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
if ($$lexemes{$name}) |
643
|
|
|
|
|
|
|
{ |
644
|
|
|
|
|
|
|
$attributes = |
645
|
|
|
|
|
|
|
{ |
646
|
|
|
|
|
|
|
fillcolor => 'orchid', |
647
|
|
|
|
|
|
|
label => [{text => "\{\x{a789}lexeme"}, {text => "$label}"}], |
648
|
|
|
|
|
|
|
}; |
649
|
|
|
|
|
|
|
} |
650
|
|
|
|
|
|
|
else |
651
|
|
|
|
|
|
|
{ |
652
|
|
|
|
|
|
|
$attributes = |
653
|
|
|
|
|
|
|
{ |
654
|
|
|
|
|
|
|
fillcolor => 'white', |
655
|
|
|
|
|
|
|
label => $label, |
656
|
|
|
|
|
|
|
}; |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
return $attributes; |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
} # End of _process_lexeme_token. |
662
|
|
|
|
|
|
|
|
663
|
|
|
|
|
|
|
# -------------------------------------------------- |
664
|
|
|
|
|
|
|
|
665
|
|
|
|
|
|
|
sub _process_normal_rule |
666
|
|
|
|
|
|
|
{ |
667
|
|
|
|
|
|
|
my($self, $index, $a_node, $lexemes) = @_; |
668
|
|
|
|
|
|
|
my($daughters, $adverbs) = $self -> _process_complex_adverbs($index, $a_node); |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
for my $i (0 .. $#$daughters) |
671
|
|
|
|
|
|
|
{ |
672
|
|
|
|
|
|
|
$self -> _process_normal_tokens($index, $a_node, $lexemes, $$daughters[$i], $$adverbs[$i]); |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
} # End of _process_normal_rule. |
676
|
|
|
|
|
|
|
|
677
|
|
|
|
|
|
|
# -------------------------------------------------- |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
sub _process_normal_tokens |
680
|
|
|
|
|
|
|
{ |
681
|
|
|
|
|
|
|
my($self, $index, $a_node, $lexemes, $daughters, $adverbs) = @_; |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
# rectify_name() returns a set of ($name => $label) pairs. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
my(@name_map) = map{$self -> rectify_name($_)} @$daughters; |
686
|
|
|
|
|
|
|
my(@name) = map{$name_map[$_]} indexes{$_ % 2 == 0} 0 .. $#name_map; |
687
|
|
|
|
|
|
|
my(@label) = map{$name_map[$_]} indexes{$_ % 2 != 0} 0 .. $#name_map; |
688
|
|
|
|
|
|
|
my($rule_name) = join(' ', @name); |
689
|
|
|
|
|
|
|
my($rule_label) = join(' ', @label); |
690
|
|
|
|
|
|
|
my($attributes) = $self -> _process_lexeme_token($index, $lexemes, $rule_name, $rule_label); |
691
|
|
|
|
|
|
|
my(@parent) = $self -> rectify_name($a_node); |
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
$self -> add_node(name => $rule_name, %$attributes); |
694
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $parent[0], to => $rule_name); |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
my($attr_name); |
697
|
|
|
|
|
|
|
my($name); |
698
|
|
|
|
|
|
|
|
699
|
|
|
|
|
|
|
for my $i (0 .. $#name) |
700
|
|
|
|
|
|
|
{ |
701
|
|
|
|
|
|
|
$name = $name[$i]; |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
$attributes = $self -> _process_lexeme_token($index, $lexemes, $name, $label[$i]); |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
# Don't re-add the node added just above. |
706
|
|
|
|
|
|
|
# This happens in cases where there is just 1 daughter, |
707
|
|
|
|
|
|
|
# which mean the join() above only had 1 name to 'join'. |
708
|
|
|
|
|
|
|
# Nevertheless, after this 'if', we still add its attributes (outside the loop). |
709
|
|
|
|
|
|
|
|
710
|
|
|
|
|
|
|
if ($name ne $rule_name) |
711
|
|
|
|
|
|
|
{ |
712
|
|
|
|
|
|
|
$self -> add_node(name => $name, %$attributes); |
713
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $rule_name, to => $name); |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
if ($$lexemes{$name}) |
717
|
|
|
|
|
|
|
{ |
718
|
|
|
|
|
|
|
$$attributes{fillcolor} = 'lightblue'; |
719
|
|
|
|
|
|
|
$$attributes{label} = $$lexemes{$name}; |
720
|
|
|
|
|
|
|
$attr_name = "${name}_$i"; |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
$self -> add_node(name => $attr_name, %$attributes); |
723
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $name, to => $attr_name); |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
if ($#$adverbs >= 0) |
728
|
|
|
|
|
|
|
{ |
729
|
|
|
|
|
|
|
$$attributes{fillcolor} = 'goldenrod'; |
730
|
|
|
|
|
|
|
$$attributes{label} = $adverbs; |
731
|
|
|
|
|
|
|
$attr_name = "${rule_name}_attributes"; |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
$self -> add_node(name => $attr_name, %$attributes); |
734
|
|
|
|
|
|
|
$self -> graph -> add_edge(from => $rule_name, to => $attr_name); |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
|
737
|
|
|
|
|
|
|
} # End of _process_normal_tokens. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
# -------------------------------------------------- |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
sub _process_start_rule |
742
|
|
|
|
|
|
|
{ |
743
|
|
|
|
|
|
|
my($self, $index, $a_node) = @_; |
744
|
|
|
|
|
|
|
my(@daughters) = $a_node -> daughters; |
745
|
|
|
|
|
|
|
my(@name) = $self -> rectify_name($daughters[1]); |
746
|
|
|
|
|
|
|
|
747
|
|
|
|
|
|
|
$self -> root_node($daughters[1]); |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
my($attributes) = |
750
|
|
|
|
|
|
|
{ |
751
|
|
|
|
|
|
|
fillcolor => 'lightgreen', |
752
|
|
|
|
|
|
|
label => [{text => '{:start'}, {text => "$name[1]}"}], |
753
|
|
|
|
|
|
|
}; |
754
|
|
|
|
|
|
|
|
755
|
|
|
|
|
|
|
$self -> add_node(name => $name[0], %$attributes); |
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
} # End of _process_start_rule. |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
# -------------------------------------------------- |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
sub rectify_name |
762
|
|
|
|
|
|
|
{ |
763
|
|
|
|
|
|
|
my($self, $node) = @_; |
764
|
|
|
|
|
|
|
my($attributes) = $node -> attributes; |
765
|
|
|
|
|
|
|
my($name) = $self -> clean_name($$attributes{real_name}, 1); |
766
|
|
|
|
|
|
|
my($label) = $name . $$attributes{quantifier}; |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
return ($name, $label); |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
} # End of rectify_name. |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# ------------------------------------------------ |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
sub run |
775
|
|
|
|
|
|
|
{ |
776
|
|
|
|
|
|
|
my($self) = @_; |
777
|
|
|
|
|
|
|
my($result) = $self -> parser -> run; |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
# Return 0 for success and 1 for failure. |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
return $result if ($result == 1); |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
$self -> clean_tree; |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
#$self -> log(debug => $_) for @{$self -> parser -> cooked_tree -> tree2string({no_attributes => 0})}; |
786
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
my(@rule) = $self -> parser -> cooked_tree -> daughters; |
788
|
|
|
|
|
|
|
my($start_index) = first_index{$_ -> name eq "\x{a789}start"} @rule; |
789
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
# Warning: This must be first because it sets $self -> root_node(). |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
$self -> _process_start_rule($start_index + 1, $rule[$start_index]); |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
for my $index (indexes {$_ -> name eq "\x{a789}default"} @rule) |
795
|
|
|
|
|
|
|
{ |
796
|
|
|
|
|
|
|
$self -> _process_default_rule($index + 1, $rule[$index]); |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
for my $index (indexes {$_ -> name eq "\x{a789}discard"} @rule) |
800
|
|
|
|
|
|
|
{ |
801
|
|
|
|
|
|
|
$self -> _process_discard_rule($index + 1, $rule[$index]); |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
my($lexeme_default_index) = first_index{$_ -> name eq 'lexeme default'} @rule; |
805
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
$self -> _process_lexeme_default_rule($lexeme_default_index + 1, $rule[$lexeme_default_index]) if ($lexeme_default_index >= 0); |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
for my $index (indexes {$_ -> name eq "\x{a789}lexeme"} @rule) |
809
|
|
|
|
|
|
|
{ |
810
|
|
|
|
|
|
|
$self -> _process_lexeme_rule($index + 1, $rule[$index]); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
my(%seen) = |
814
|
|
|
|
|
|
|
( |
815
|
|
|
|
|
|
|
"\x{a789}default" => 1, |
816
|
|
|
|
|
|
|
"\x{a789}discard" => 1, |
817
|
|
|
|
|
|
|
'event' => 1, # Not yet, but we want process_normal_rule() to skip events. |
818
|
|
|
|
|
|
|
"\x{a789}lexeme" => 1, |
819
|
|
|
|
|
|
|
'lexeme default' => 1, |
820
|
|
|
|
|
|
|
"\x{a789}start" => 1, |
821
|
|
|
|
|
|
|
); |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
my($lexemes) = $self -> lexemes; |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
for my $index (0 .. $#rule) |
826
|
|
|
|
|
|
|
{ |
827
|
|
|
|
|
|
|
next if ($seen{$rule[$index] -> name}); |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
$self -> _process_normal_rule($index + 1, $rule[$index], $lexemes); |
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
for my $index (indexes {$_ -> name eq 'event'} @rule) |
833
|
|
|
|
|
|
|
{ |
834
|
|
|
|
|
|
|
$self -> _process_event_rule($index + 1, $rule[$index]); |
835
|
|
|
|
|
|
|
} |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
$self -> add_legend if ($self -> legend); |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
my($output_file) = $self -> output_file; |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
$self -> graph -> run(output_file => $output_file); |
842
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
# Return 0 for success and 1 for failure. |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
return $result; |
846
|
|
|
|
|
|
|
|
847
|
|
|
|
|
|
|
} # End of run. |
848
|
|
|
|
|
|
|
|
849
|
|
|
|
|
|
|
# ------------------------------------------------ |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
1; |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
=pod |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
=encoding utf8 |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=head1 NAME |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
L - Convert a Marpa grammar into an image |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
=head1 Synopsis |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
use MarpaX::Grammar::GraphViz2; |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
my(%option) = |
866
|
|
|
|
|
|
|
( # Inputs: |
867
|
|
|
|
|
|
|
legend => 1, |
868
|
|
|
|
|
|
|
marpa_bnf_file => 'share/metag.bnf', |
869
|
|
|
|
|
|
|
user_bnf_file => 'share/stringparser.bnf', |
870
|
|
|
|
|
|
|
# Outputs: |
871
|
|
|
|
|
|
|
output_file => 'html/stringparser.svg', |
872
|
|
|
|
|
|
|
); |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
MarpaX::Grammar::GraphViz2 -> new(%option) -> run; |
875
|
|
|
|
|
|
|
|
876
|
|
|
|
|
|
|
See share/*.bnf for input files and html/*.svg for output files. |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
For more help, run: |
879
|
|
|
|
|
|
|
|
880
|
|
|
|
|
|
|
shell> perl -Ilib scripts/bnf2graph.pl -h |
881
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
Note: Installation includes copying all files from the share/ directory, into a dir chosen by L. |
883
|
|
|
|
|
|
|
Run scripts/find.grammars.pl to display the name of the latter dir. |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
See also L. |
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
=head1 Description |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
Process the output cooked tree from L, and turn it into an image. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
The tree holds a representation of the user's SLIF-DSL, and is managed by L. |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
This modules uses L internally. It does not read that module's output file. |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
=head1 Installation |
896
|
|
|
|
|
|
|
|
897
|
|
|
|
|
|
|
Install L as you would for any C module: |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
Run: |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
cpanm MarpaX::Grammar::GraphViz2 |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
or run: |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
sudo cpan MarpaX::Grammar::GraphViz2 |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
or unpack the distro, and then either: |
908
|
|
|
|
|
|
|
|
909
|
|
|
|
|
|
|
perl Build.PL |
910
|
|
|
|
|
|
|
./Build |
911
|
|
|
|
|
|
|
./Build test |
912
|
|
|
|
|
|
|
sudo ./Build install |
913
|
|
|
|
|
|
|
|
914
|
|
|
|
|
|
|
or: |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
perl Makefile.PL |
917
|
|
|
|
|
|
|
make (or dmake or nmake) |
918
|
|
|
|
|
|
|
make test |
919
|
|
|
|
|
|
|
make install |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
Note: Installation includes copying all files from the share/ directory, into a dir chosen by L. |
922
|
|
|
|
|
|
|
Run scripts/find.grammars.pl to display the name of the latter dir. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
=head1 Constructor and Initialization |
925
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
C is called as C<< my($parser) = MarpaX::Grammar::GraphViz2 -> new(k1 => v1, k2 => v2, ...) >>. |
927
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
It returns a new object of type C. |
929
|
|
|
|
|
|
|
|
930
|
|
|
|
|
|
|
Key-value pairs accepted in the parameter list (see also the corresponding methods |
931
|
|
|
|
|
|
|
[e.g. L]): |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
=over 4 |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
=item o driver aGraphvizDriverName |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
The name of the Graphviz program to provide to L. |
938
|
|
|
|
|
|
|
|
939
|
|
|
|
|
|
|
Default: 'dot'. |
940
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
=item o format => $format_name |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
This is the format of the output file, to be passed to L. |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
Default: 'svg'. |
946
|
|
|
|
|
|
|
|
947
|
|
|
|
|
|
|
=item o graph => $graphviz2_object |
948
|
|
|
|
|
|
|
|
949
|
|
|
|
|
|
|
Provides an object of type L, to do the rendering. |
950
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
Default: |
952
|
|
|
|
|
|
|
|
953
|
|
|
|
|
|
|
GraphViz2 -> new |
954
|
|
|
|
|
|
|
( |
955
|
|
|
|
|
|
|
edge => {color => 'grey'}, |
956
|
|
|
|
|
|
|
global => {directed => 1, driver => $self -> driver, format => $self -> format}, |
957
|
|
|
|
|
|
|
graph => {label => basename($self -> user_bnf_file), rankdir => 'TB'}, |
958
|
|
|
|
|
|
|
logger => $self -> logger, |
959
|
|
|
|
|
|
|
node => {shape => 'rectangle', style => 'filled'}, |
960
|
|
|
|
|
|
|
); |
961
|
|
|
|
|
|
|
|
962
|
|
|
|
|
|
|
=item o legend => $Boolean |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
Add a legend (1) to the graph, or omit it (0). |
965
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
Default: 0. |
967
|
|
|
|
|
|
|
|
968
|
|
|
|
|
|
|
=item o logger => $logger_object |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
Specify a logger object. |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
The default value triggers creation of an object of type L which outputs to the screen. |
973
|
|
|
|
|
|
|
|
974
|
|
|
|
|
|
|
To disable logging, just set I to the empty string. |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
The value for I is passed to L. |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
Default: undef. |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
=item o marpa_bnf_file aMarpaSLIF-DSLFileName |
981
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
Specify the name of Marpa's own SLIF-DSL file. This file ships with L. It's name is metag.bnf. |
983
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
A copy, as of Marpa::R2 V 2.068000, ships with C. See share/metag.bnf. |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
This option is mandatory. |
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
Default: ''. |
989
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
=item o maxlevel => $level |
991
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
This option is only used if an object of type L is created. See I above. |
993
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
See also L. |
995
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Default: 'info'. A typical value is 'debug'. |
997
|
|
|
|
|
|
|
|
998
|
|
|
|
|
|
|
=item o minlevel => $level |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
This option is only used if an object of type L is created. See I above. |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
See also L. |
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
Default: 'error'. |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
No lower levels are used. |
1007
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=item o output_file => $output_file_name |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
Write the image to this file. |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
Use the C option to specify the type of image desired. |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
If '', the file is not written. |
1015
|
|
|
|
|
|
|
|
1016
|
|
|
|
|
|
|
Default: ''. |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
=item o user_bnf_file aUserSLIF-DSLFileName |
1019
|
|
|
|
|
|
|
|
1020
|
|
|
|
|
|
|
Specify the name of the file containing your Marpa::R2-style grammar. |
1021
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
See share/stringparser.bnf for a sample. |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
This option is mandatory. |
1025
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
Default: ''. |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
=back |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
=head1 Methods |
1031
|
|
|
|
|
|
|
|
1032
|
|
|
|
|
|
|
=head2 add_legend() |
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
Adds a legend to the graph if new() was called as C<< new(legend => 1) >>. |
1035
|
|
|
|
|
|
|
|
1036
|
|
|
|
|
|
|
=head2 add_node(%attributes) |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
Adds (once only) a node to the graph. The node's name is C<$attributes{name}>. |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
Also, adds that name to the hashref of node names seen, which is returned by L. |
1041
|
|
|
|
|
|
|
|
1042
|
|
|
|
|
|
|
=head2 clean_name($name, $skip_symbols) |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
Cleans the given name to escape or replace characters special to L. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
Note: L also escapes some characters. |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
$skip_symbols is used by the caller in 1 case to stop a regexp being activated. |
1049
|
|
|
|
|
|
|
|
1050
|
|
|
|
|
|
|
See the L for details. |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
Returns the cleaned-up name. |
1053
|
|
|
|
|
|
|
|
1054
|
|
|
|
|
|
|
=head2 clean_tree() |
1055
|
|
|
|
|
|
|
|
1056
|
|
|
|
|
|
|
Calls L for each node in the tree. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
=head2 default_count() |
1059
|
|
|
|
|
|
|
|
1060
|
|
|
|
|
|
|
Returns the number of C<:default>' rules in the user's input. |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=head2 discard_count() |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
Returns the number of C<:discard> rules in the user's input. |
1065
|
|
|
|
|
|
|
|
1066
|
|
|
|
|
|
|
=head2 driver([$executable_name]) |
1067
|
|
|
|
|
|
|
|
1068
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1069
|
|
|
|
|
|
|
|
1070
|
|
|
|
|
|
|
Get or set the name of the Graphviz program to provide to L. |
1071
|
|
|
|
|
|
|
|
1072
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1073
|
|
|
|
|
|
|
|
1074
|
|
|
|
|
|
|
=head2 event_count() |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
Returns the number of C rules in the user's input. |
1077
|
|
|
|
|
|
|
|
1078
|
|
|
|
|
|
|
=head2 format([$format]) |
1079
|
|
|
|
|
|
|
|
1080
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1081
|
|
|
|
|
|
|
|
1082
|
|
|
|
|
|
|
Get or set the format of the output file, to be created by the renderer. |
1083
|
|
|
|
|
|
|
|
1084
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
=head2 graph([$graph]) |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
Get of set the L object which will do the graphing. |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
See also L. |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
=head2 legend([$Boolean]) |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1097
|
|
|
|
|
|
|
|
1098
|
|
|
|
|
|
|
Get or set the option to include (1) or exclude (0) a legend from the image. |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
Note: C |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=head2 lexeme_count() |
1103
|
|
|
|
|
|
|
|
1104
|
|
|
|
|
|
|
Returns the number of C<:lexeme> rules in the user's input. |
1105
|
|
|
|
|
|
|
|
1106
|
|
|
|
|
|
|
=head2 lexemes() |
1107
|
|
|
|
|
|
|
|
1108
|
|
|
|
|
|
|
Returns a hashref keyed by the clean name, of lexemes seen in the user's input. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
The value for each key is an arrayref of hashrefs suitable for forcing L to plot the node as |
1111
|
|
|
|
|
|
|
a record structure. See L for the gory details. |
1112
|
|
|
|
|
|
|
|
1113
|
|
|
|
|
|
|
=head2 log($level, $s) |
1114
|
|
|
|
|
|
|
|
1115
|
|
|
|
|
|
|
Calls $self -> logger -> log($level => $s) if ($self -> logger). |
1116
|
|
|
|
|
|
|
|
1117
|
|
|
|
|
|
|
=head2 logger([$logger_object]) |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1120
|
|
|
|
|
|
|
|
1121
|
|
|
|
|
|
|
Get or set the logger object. |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
To disable logging, just set logger to the empty string. |
1124
|
|
|
|
|
|
|
|
1125
|
|
|
|
|
|
|
This logger is passed to L. |
1126
|
|
|
|
|
|
|
|
1127
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
=head2 marpa_bnf_file([$bnf_file_name]) |
1130
|
|
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1132
|
|
|
|
|
|
|
|
1133
|
|
|
|
|
|
|
Get or set the name of the file to read Marpa's grammar from. |
1134
|
|
|
|
|
|
|
|
1135
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1136
|
|
|
|
|
|
|
|
1137
|
|
|
|
|
|
|
=head2 maxlevel([$string]) |
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1140
|
|
|
|
|
|
|
|
1141
|
|
|
|
|
|
|
Get or set the value used by the logger object. |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
This option is only used if an object of type L is created. See L. |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1146
|
|
|
|
|
|
|
|
1147
|
|
|
|
|
|
|
=head2 minlevel([$string]) |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1150
|
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
|
Get or set the value used by the logger object. |
1152
|
|
|
|
|
|
|
|
1153
|
|
|
|
|
|
|
This option is only used if an object of type L is created. See L. |
1154
|
|
|
|
|
|
|
|
1155
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1156
|
|
|
|
|
|
|
|
1157
|
|
|
|
|
|
|
=head2 new() |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
The constructor. See L. |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=head2 nodes_seen() |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
Returns a hashref keyed by the node name, of nodes passed to L. |
1164
|
|
|
|
|
|
|
|
1165
|
|
|
|
|
|
|
This is simply used to stop nodes being plotted twice. |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
=head2 output_file([$output_file_name]) |
1168
|
|
|
|
|
|
|
|
1169
|
|
|
|
|
|
|
Here, the [] indicate an optional parameter. |
1170
|
|
|
|
|
|
|
|
1171
|
|
|
|
|
|
|
Get or set the name of the file to which the renderer will write the resultant graph. |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
If no output file is supplied, nothing is written. |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
See also L. |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
Note: C is a parameter to new(). |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
=head2 parser() |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
Returns the L object which will do the analysis of the user's grammar. |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
This object is created automatically during the call to L. |
1184
|
|
|
|
|
|
|
|
1185
|
|
|
|
|
|
|
=head2 rectify_node($node) |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
For the given $node, which is an object of type L, clean it's real name. |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
Then it adds the node's quantifier ('', '*' or '+') to that name, to act as the label (visible name) of the |
1190
|
|
|
|
|
|
|
node, when the node is finally passed to L. |
1191
|
|
|
|
|
|
|
|
1192
|
|
|
|
|
|
|
Returns a 2-element list of ($name, $label). |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=head2 root_name() |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
Returns an object of type L, representing the C<:start> token in the user's grammar. |
1197
|
|
|
|
|
|
|
|
1198
|
|
|
|
|
|
|
=head2 run() |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
The method which does all the work. |
1201
|
|
|
|
|
|
|
|
1202
|
|
|
|
|
|
|
See L and scripts/bnf2graph.pl for sample code. |
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
=head2 separators() |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
Returns a hashref keyed by token name, of tokens used in the grammar construct C<< separator => $token >>. |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
This hashref is currently not used. |
1209
|
|
|
|
|
|
|
|
1210
|
|
|
|
|
|
|
=head1 Files Shipped with this Module |
1211
|
|
|
|
|
|
|
|
1212
|
|
|
|
|
|
|
=head2 Data Files |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=over 4 |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
=item o share/c.ast.bnf |
1217
|
|
|
|
|
|
|
|
1218
|
|
|
|
|
|
|
This is part of L, by Jean-Damien Durand. It's 1,565 lines long. |
1219
|
|
|
|
|
|
|
|
1220
|
|
|
|
|
|
|
=item o html/c.ast.svg |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
This is the image from c.ast.bnf. |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
See the next point for how this file is created. |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=item o share/c.ast.log |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
This is the log produced by running the code at log level C: |
1229
|
|
|
|
|
|
|
|
1230
|
|
|
|
|
|
|
shell> scripts/bnf2graph.sh c.ast -max debug > share/c.ast.log |
1231
|
|
|
|
|
|
|
|
1232
|
|
|
|
|
|
|
=item o share/json.1.bnf |
1233
|
|
|
|
|
|
|
|
1234
|
|
|
|
|
|
|
It is part of L, written as a gist by Peter Stuifzand. |
1235
|
|
|
|
|
|
|
|
1236
|
|
|
|
|
|
|
See L. |
1237
|
|
|
|
|
|
|
|
1238
|
|
|
|
|
|
|
=item o html/json.1.svg |
1239
|
|
|
|
|
|
|
|
1240
|
|
|
|
|
|
|
This is the image from json.1.bnf. |
1241
|
|
|
|
|
|
|
|
1242
|
|
|
|
|
|
|
See the next point for how this file is created. |
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
=item o share/json.1.log |
1245
|
|
|
|
|
|
|
|
1246
|
|
|
|
|
|
|
This is the log produced by running the code at log level C: |
1247
|
|
|
|
|
|
|
|
1248
|
|
|
|
|
|
|
shell> scripts/bnf2graph.sh json.1 -max debug > share/json.1.log |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
=item o share/json.2.bnf |
1251
|
|
|
|
|
|
|
|
1252
|
|
|
|
|
|
|
It also is part of L, written by Jeffrey Kegler as a reply to the gist above from Peter. |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
=item o html/json.2.svg |
1255
|
|
|
|
|
|
|
|
1256
|
|
|
|
|
|
|
This is the image from json.2.bnf. |
1257
|
|
|
|
|
|
|
|
1258
|
|
|
|
|
|
|
See the next point for how this file is created. |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
=item o share/json.2.log |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
This is the log produced by running the code at log level C: |
1263
|
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
shell> scripts/bnf2graph.sh json.2 -max debug > share/json.2.log |
1265
|
|
|
|
|
|
|
|
1266
|
|
|
|
|
|
|
=item o share/metag.bnf. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
This is a copy of L's SLIF-DSL, as of Marpa::R2 V 2.068000. |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
See L above. |
1271
|
|
|
|
|
|
|
|
1272
|
|
|
|
|
|
|
=item o share/stringparser.bnf. |
1273
|
|
|
|
|
|
|
|
1274
|
|
|
|
|
|
|
This is a copy of L's SLIF-DSL. |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=item o html/stringparser.svg |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
This is the image from stringparser.bnf. |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
See the next point for how this file is created. |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
=item o share/stringparser.log |
1283
|
|
|
|
|
|
|
|
1284
|
|
|
|
|
|
|
This is the log produced by running the code at log level C: |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
shell> scripts/bnf2graph.sh stringparser -max debug > share/stringparser.log |
1287
|
|
|
|
|
|
|
|
1288
|
|
|
|
|
|
|
See L above. |
1289
|
|
|
|
|
|
|
|
1290
|
|
|
|
|
|
|
=item o share/termcap.info.bnf |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
It also is part of L, written by Jean-Damien Durand. |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
=item o html/termcap.info.svg |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
This is the image from termcap.info.bnf. |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
See the next point for how this file is created. |
1299
|
|
|
|
|
|
|
|
1300
|
|
|
|
|
|
|
=item o share/termcap.info.log |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
This is the log produced by running the code at log level C: |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
shell> scripts/bnf2graph.sh termcap.info -max debug > share/termcap.info.log |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
=back |
1307
|
|
|
|
|
|
|
|
1308
|
|
|
|
|
|
|
=head2 Scripts |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
=over 4 |
1311
|
|
|
|
|
|
|
|
1312
|
|
|
|
|
|
|
=item o scripts/bnf2graph.pl |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
This is a neat way of using the module. For help, run: |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
shell> perl -Ilib scripts/bnf2graph.pl -h |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
Of course you are also encouraged to include this module directly in your own code. |
1319
|
|
|
|
|
|
|
|
1320
|
|
|
|
|
|
|
=item o scripts/bnf2graph.sh |
1321
|
|
|
|
|
|
|
|
1322
|
|
|
|
|
|
|
This is a quick way for me to run bnf2graph.pl. |
1323
|
|
|
|
|
|
|
|
1324
|
|
|
|
|
|
|
=item o scripts/find.grammars.pl |
1325
|
|
|
|
|
|
|
|
1326
|
|
|
|
|
|
|
This prints the path to a grammar file. After installation of the module, run it with: |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
shell> perl scripts/find.grammars.pl (Defaults to json.1.bnf) |
1329
|
|
|
|
|
|
|
shell> perl scripts/find.grammars.pl c.ast.bnf |
1330
|
|
|
|
|
|
|
shell> perl scripts/find.grammars.pl json.1.bnf |
1331
|
|
|
|
|
|
|
shell> perl scripts/find.grammars.pl json.2.bnf |
1332
|
|
|
|
|
|
|
shell> perl scripts/find.grammars.pl stringparser.bnf |
1333
|
|
|
|
|
|
|
shell> perl scripts/find.grammars.pl termcap.inf.bnf |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
It will print the name of the path to given grammar file. |
1336
|
|
|
|
|
|
|
|
1337
|
|
|
|
|
|
|
=item o scripts/generate.demo.pl |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
Generates html/index.html. |
1340
|
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
|
=item o scripts/generate.demo.sh |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
This calls generate.demo.pl for each grammar shipped with the module. |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
Actually, it skips c.ast by default, since it takes 6 m 47 s to run that. But if you pass any command line |
1346
|
|
|
|
|
|
|
parameter to the script, it includes c.ast. |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
Then it copies html/* to my web server's doc root (which is in Debian's default RAM disk) at /dev/shm/html. |
1349
|
|
|
|
|
|
|
|
1350
|
|
|
|
|
|
|
=item o scripts/pod2html.sh |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
This lets me quickly proof-read edits to the docs. |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
=back |
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
=head1 FAQ |
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
=head2 Why are some characters in the images replaced by Unicode versions? |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
Firstly, the Perl module L escapes some characters. Currently, these are: |
1361
|
|
|
|
|
|
|
|
1362
|
|
|
|
|
|
|
[ ] " (in various circumstances) |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
We let L handle these. |
1365
|
|
|
|
|
|
|
|
1366
|
|
|
|
|
|
|
Secondly, L itself treats some characters specially. Currently, these are: |
1367
|
|
|
|
|
|
|
|
1368
|
|
|
|
|
|
|
< > : " |
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
We use this code to handle these: |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
$name =~ s/\\/\\\\/g; # Escape \. |
1373
|
|
|
|
|
|
|
$name =~ s/\\
|
1374
|
|
|
|
|
|
|
$name =~ s/>/\\>/g; # Escape >. |
1375
|
|
|
|
|
|
|
$name =~ s/:/\x{a789}/g; # Replace : with a Unicode : |
1376
|
|
|
|
|
|
|
$name =~ s/\"/\x{a78c}\x{a78c}/g; # Replace " with 2 copies of a Unicode ' ... |
1377
|
|
|
|
|
|
|
# ... because I could not find a Unicode ". |
1378
|
|
|
|
|
|
|
|
1379
|
|
|
|
|
|
|
=head2 Why do some images have a tiny sub-graph, whose root is, e.g., ''? |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
This is due to the author using both 'comma' and '' as tokens within the grammar. |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
So far this module does not handle that. |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
A similar thing can happen elsewhere, e.g. with named event statements, when the rhs name uses (say) '' |
1386
|
|
|
|
|
|
|
and the rule referred to uses just 'xyz'. |
1387
|
|
|
|
|
|
|
|
1388
|
|
|
|
|
|
|
In all such cases, there will be 2 nodes, with 2 names differing in just the brackets. |
1389
|
|
|
|
|
|
|
|
1390
|
|
|
|
|
|
|
=head2 Why do some nodes have (or lack) a quantifier when I use it both with and without one? |
1391
|
|
|
|
|
|
|
|
1392
|
|
|
|
|
|
|
There is simply no way to plot a node both with and without the quantifier. The one which appears is chosen |
1393
|
|
|
|
|
|
|
arbitrarily, depending on how the code scans the grammar. This means it is currently beyond control. |
1394
|
|
|
|
|
|
|
|
1395
|
|
|
|
|
|
|
=head2 Why do the nodes on the demo page lack rule numbers? |
1396
|
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
|
I'm undecided as to whether or not they are a good idea. I documented it on the demo page to indicate |
1398
|
|
|
|
|
|
|
it was easy (for some nodes), and await feedback. |
1399
|
|
|
|
|
|
|
|
1400
|
|
|
|
|
|
|
=head2 Can I control the format or placement of the legend? |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
No, but you can turn it off with the C |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
=head1 ToDo |
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
=over 4 |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
=item o Perhaps add rule # to each node |
1409
|
|
|
|
|
|
|
|
1410
|
|
|
|
|
|
|
This is the rule # within the input stream. Doing this is simple for some nodes, and difficult for others. |
1411
|
|
|
|
|
|
|
|
1412
|
|
|
|
|
|
|
=back |
1413
|
|
|
|
|
|
|
|
1414
|
|
|
|
|
|
|
=head1 Machine-Readable Change Log |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
The file Changes was converted into Changelog.ini by L. |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
=head1 Version Numbers |
1419
|
|
|
|
|
|
|
|
1420
|
|
|
|
|
|
|
Version numbers < 1.00 represent development versions. From 1.00 up, they are production versions. |
1421
|
|
|
|
|
|
|
|
1422
|
|
|
|
|
|
|
=head1 Support |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
Email the author, or log a bug on RT: |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
L. |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
=head1 Author |
1429
|
|
|
|
|
|
|
|
1430
|
|
|
|
|
|
|
L was written by Ron Savage Iron@savage.net.auE> in 2013. |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
Home page: L. |
1433
|
|
|
|
|
|
|
|
1434
|
|
|
|
|
|
|
=head1 Copyright |
1435
|
|
|
|
|
|
|
|
1436
|
|
|
|
|
|
|
Australian copyright (c) 2013, Ron Savage. |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
All Programs of mine are 'OSI Certified Open Source Software'; |
1439
|
|
|
|
|
|
|
you can redistribute them and/or modify them under the terms of |
1440
|
|
|
|
|
|
|
The Artistic License, a copy of which is available at: |
1441
|
|
|
|
|
|
|
http://www.opensource.org/licenses/index.html |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
=cut |